# HG changeset patch # User cvs # Date 1186996410 -7200 # Node ID 74fd4e045ea67779c5f7762e5bd722dc79766786 # Parent f4aeb21a5badc0ff29ec986735d488192b9b227b Import from CVS: tag r21-2-29 diff -r f4aeb21a5bad -r 74fd4e045ea6 .cvsignore --- a/.cvsignore Mon Aug 13 11:12:06 2007 +0200 +++ b/.cvsignore Mon Aug 13 11:13:30 2007 +0200 @@ -7,3 +7,7 @@ GNUmakefile Makefile.in so_locations +xemacs-packages +mule-packages +site-packages +gmon.out diff -r f4aeb21a5bad -r 74fd4e045ea6 CHANGES-beta --- a/CHANGES-beta Mon Aug 13 11:12:06 2007 +0200 +++ b/CHANGES-beta Mon Aug 13 11:13:30 2007 +0200 @@ -1,4 +1,259 @@ - -*- indented-text -*- +to 21.2.29 "Hestia" +-- Fix compile errors on pre-X11R6 systems, introduced in 21.2.28. +-- Fix autodetection of Berkeley DB on Linux Glibc 2 systems. + (but more work needed) +-- Allow non-symbols (anything compared with `eq') in object plists. +-- Cleanup of property frobbing code. +-- Various AIX 4 fixes, including port of PDUMP. +-- Unconditionally define _POSIX_C_SOURCE, _XOPEN_SOURCE, _XOPEN_SOURCE_EXTENDED. +-- MS-Windows redisplay and font fixes from Jonathan Harris. +-- various fixes from Craig Lanning, Daiki Ueno. +-- Asynchronous widget updates from Andy Piper. +-- More widget fixes from Andy Piper. +-- Don't use rel_alloc on glibc systems, including Linux +-- Upgrade etags.c to version 13.44, Francesco Potorti +-- etags does a better job of finding the exact match first, Kyle Jones +-- Portable dumper now described in Internals manual, Olivier and Martin +-- Object Plist documentation in lispref updated, Martin Buchholz +-- Just use standard `const' everywhere, instead of CONST +-- More pdump changes, Olivier Galibert + +to 21.2.28 "Hermes" +-- Add configure support for NetWinders, Sean MacLennan +-- Make the "Load .emacs" menu item work again, Kirill Katsnelson +-- Make --without-x work again. +-- Detect Xaw3d and friends using #include +-- Experimental Drag-N-Drop now defaults to "no" until there is again + active development. +-- SGI dumping fixes should make XEmacs work again on Irix 6. +-- More warning flags on by default when building with gcc. +-- process coding changes, Kirill Katsnelson +-- help now knows how to print macro arglists, Yoshiki Hayashi +-- Windows printing support, Kirill Katsnelson +-- Obscure crash fixes, Martin Buchholz +-- Memory leak fixes, Martin Buchholz +-- We now always use our own realpath(), never the system-provided one. +-- More gutter/tab widget changes, Andy Piper +-- Crash fix when using dead processes, Gunnar Evermann (fix PR#1061) +-- Pdump stability fixes, Olivier Galibert +-- New coding system alias implementation, Ben Wing and Martin Buchholz +-- New internal data conversion infrastructure, Ben Wing and Martin Buchholz +-- IPv6 support, URA Hiroshi +-- Runtime Athena mismatch warnings added, Daniel Pittman +-- Removal of old MSDOS support, Kirill Katsnelson +-- Correctly define Latin-3 and Latin-4 character syntax as "w". +-- Auto-define all X-defined keysyms as self-inserting, not just Latin-1. +-- Workaround egcs-20000131 c++ compiler bug +-- Byte-optimize (length "foo") to 3. +-- (define-key ctl-x-4-map "p" global-map) no longer causes stack overflow crash. +-- Partially implement dontusethis-set-symbol-value-handler. +-- Fix bug: (getf nil t t) ==> Lisp nesting exceeds `max-lisp-eval-depth' +-- lib-src partially C++ized, Zack Weinberg. + +to 21.2.27 "Hera" +-- Dynamic layout for widgets from Andy Piper +-- Vertical tab widgets for MS-Windows from Andy Piper +-- pdump fixes for MS-Windows from Big K +-- config.sub, config.guess major upgrade, Marcus Thiessel +-- gdbinit renamed to .gdbinit +-- dbxrc renamed to .dbxrc +-- Mail locking overhaul, Michael Sperber +-- Info-visit-file can now be used non-interactively, Martin Buchholz +-- FAQ updates, Sandra Wambold +-- Document lisp-level error handling, Hrvoje Niksic +-- Windows changes, Kirill Katsnelson +-- Portable dumper ported to Windows, Kirill Katsnelson +-- idlwave-mode added, Carsten Dominik +-- Info changes, Yoshiki Hayashi and Didier Verna. +-- Again support BSD/OS 2.0 +-- minibuf.* changes, Yoshiki Hayashi +-- hyper-apropos changes, Yoshiki Hayashi +-- buffers tab has its own face, Andy Piper +-- modeline scrolling changes, Didier Verna + +to 21.2.26 "Millenium" +-- Fix unpredictable results, perhaps even crashes, if using the + `return from debugger feature' and errors in `eval' or `funcall'. +-- fix for Tab widgets causing X errors in XMapWindow(). + +to 21.2.25 "Hephaestus" +-- the LATEST.IS.* file has been renamed to LATEST-IS-*. +-- the CVS tag to checkout the latest tarball is `r21-2-latest-beta'. +-- 3 crashes in mapcar1 have been fixed. +-- lwlib arg passing cleanup +-- yet more widget and tab fixes +-- yet another Tab sync +-- specifier copying fix for widgets +-- preparation for proper layouts +-- native widgets used for some custom widgets +-- (+ 1) is no longer incorrectly compiled +-- char-before no longer has performance penalty +-- xpm again works on Windows +-- native Windows fixes from Adrian Aichner +-- Mule fixes from Yoshiki Hayashi +-- properly detect Athena widgets headers and libs, preventing crashes + from misdetection and from libraries and headers that don't match, + from Daniel Pittman + +to 21.2.24 "Hecate" +-- Tabs fixes from Andy Piper +-- Widget leak fixes from Andy Piper +-- (coding-system-list) deals properly with coding system aliases, Shenghuo ZHU +-- configure support for ESD sound rewritte, Martin Buchholz +-- directory separator fix from Mike Alexander +-- Windows process support cleanup, Adrian Aichner +-- NT now encapsulates fstat to get correct file mod time, Adrian Aichner + +to 21.2.23 "Hebe" +-- MS-Windows selection fixes from Mike Alexander +-- MS-WIndows process handling fixes from Mike Alexander +-- Subwindow GC fix from Andy Piper +-- Various minor fixes from Andy Piper +-- Rewrite module configure support, Martin Buchholz +-- Various Windows fixes, Martin Buchholz, Adrian Aichner, Andy Piper +-- HP native compiler compilation fixes, Martin Buchholz +-- Workarounds for Cygnus compiler bugs, Martin Buchholz +-- Workarounds for Cygwin broken header files, Martin Buchholz +-- itimers work again, Kyle Jones +-- random code cleanup, Martin Buchholz +-- various redisplay fixes, Andy Piper, Jan Vroonhof +-- various fixes from Hrvoje Niksic, Yoshiki Hayashi + +to 21.2.22 "Mercedes" +-- ESD Sound support from Robert Bihlmeyer +-- 10% faster redisplay from Jan Vroonhof +-- Fixes from Jeff Miller, Alexandre Oliva and Yoshiki Hayashi +-- "If you've got problems, read PROBLEMS!" from Robert Pluim +-- Lstream code now uses size_t, ssize_t consistently, Martin Buchholz +-- Fix `make install' if prefix != exec_prefix, Martin Buchholz +-- Fix compile warnings and C++ compilation, Martin Buchholz +-- Fix detection of coding: cookie in -*- first line. +-- More xim-xlib work by Kazuyuki Ienaga +-- Fix crash in abbrev.c (abbrev_location), Eric Darve + +to 21.2.20 "Yoko" +-- UTF-8 & file-coding magic cookie fix from MORIOKA Tomohiko +-- bug fixes from Adrian Aichner, Sean MacLennan, and Jeff Miller +-- glyph widget support under X/Athena from Andy Piper +-- tab widget support under X (all variants) from Andy Piper +-- many gutter, redisplay & widget fixes from Andy Piper +-- mswindows mousewheel support from Mike Woolley +-- combo box support under X/Motif from Andy Piper +-- buffer tab grouping from Andy Piper +-- layout widget support from Andy Piper +-- partial display line scrolling support from Andy Piper +-- cleanup patches from Gleb Arshinov +-- hash table FSF API sync from Martin Buchholz +-- widget cleanup from Martin Buchholz +-- process-environment fix for nt from Julian Back +-- widget to frame fix from Jan Vroonhof +-- animated glyph support from Andy Piper +-- glyph redisplay improvements from Andy Piper +-- color cells allocation fix from Lee Kindness +-- recover file fix for windows nt +-- mingw install fix from Craig Lanning +-- recognize keypad keys under MS-Windows from Jonathan Harris +-- Switch gui dialogs to native widgets from Andy Piper +-- fixes from Yoshiki Hayashi and Norbert Koch + +to 21.2.19 "Shinjuku" +-- various fixes from Gunnar Evermann +-- XIM fixes from Kazuyuki IENAGA +-- keymap fix from Katsumi Yamaoka +-- Microsoft build fixes from Adrian Aichner +-- documentation update from Adrian Aichner +-- rect.el rewrite from Didier Verna +-- custom comment fields from Didier Verna +-- various fixes from Karl Hegbloom +-- filling fix from Yoshiki Hayashi +-- miscellaneous changes from Jeff Miller and Didier Verna +-- configure hacking from Steve Baur +-- various fixes from Bob Weiner +-- Mule synching from MORIOKA Tomohiko +-- various fixes from Steve Baur +-- LDAP configure changes from Gregory Neil Shapiro +-- gutter implementation from Andy Piper +-- tab widgets in gutter from Andy Piper +-- Custom themes, API part. See etc/custom/theme-examples from Jan Vroonhof + +to 21.2.18 "Toshima" +-- miscellaneous fixes from Steve Baur +-- miscellaneous fixes from Didier Verna +-- various bug fixes from Karl Hegbloom +-- miscellaneous fixes from Bob Weiner +-- fix for XIM server crashing and taking down XEmacs from Kazuyuki IENAGA +-- valid-image-instantiator-format-p tightened up by Andy Piper. +-- glyph widget support under X/Motif from Andy Piper +-- Make docdir configurable, update package searching rules from Michael + Sperber +-- Fix for Japanese word/character movements from MORIOKA Tomohiko +-- lrecord struct header size fix from Olivier Galibert + +to 21.2.17 "Chiyoda" +-- miscellaneous bug fixes from Steve Baur +-- font menu fix from Robert Pluim +-- ldap API update from Oscar Figueiredo +-- Fix thai-xtis charset width from MORIOKA Tomohiko +-- CCL engine fix from MORIOKA Tomohiko +-- mswindows build fixes from Norbert Koch +-- miscellaneous fixes from Andy Piper +-- automated tests for mswindows from Adrian Aichner +-- tree-view and tab-control widget glyph support from Andy Piper + +to 21.2.16 "Sumida" +-- miscellaneous fixes from Hrvoje Niksic and Olivier Galibert +-- make selection more mswindows conformant. +-- Make customize use specifiers from Jan Vroonhof +-- Cyrillic CCL crash fix from MORIOKA Tomohiko +-- DEC OSF Build fix and miscellaneous Lisp fix from Steve Baur +-- raw-text coding system synch from MORIOKA Tomohiko + +to 21.2.15 "Sakuragawa" +-- new self tests from Oscar Figueiredo and Hrvoje Niksic +-- Miscellaneous bug fixes from Yoshiki Hayashi, Jerry James, Hirokazu FUKUI, + Hrvoje Niksic, MORIOKA Tomohiko +-- LDAP internationalization from Oscar Figueiredo +-- DEC OSF build fixes from Steve Baur +-- Documentation fixes from Mike McEwan, Vin Shelton and Gunnar Evermann +-- Build fixes from Jan Vroonhof +-- Miscellaneous fixes from Hrvoje Niksic +-- Documentation updates from Hrvoje Niksic and Albert Chin-A-Young +-- mule-charset.el synch with Mule from Steve Baur +-- miscellaneous build and cosmetic fixes from Steve Baur +-- font-menu for mswindows from Andy Piper +-- select rationalisation for window systems from Andy Piper +-- reinstate sheap adjustment + mingw32 fixes from Andy Piper + +to 21.2.14 "Dionysos" +-- mingw32 port from Andy Piper +-- fix for Solaris build lossage from Hrvoje Niksic +-- THAI/Cyrillic-KOI8, Vietnamese, Ethiopic support from MORIOKA Tomohiko +-- miscellaneous bug fixes from Gunnar Evermann +-- Internal purespace cleanup from Olivier Galibert +-- documentation updates from Hrvoje Niksic +-- dump time tuning from Hrvoje Niksic +-- miscellaneous bug fixes from Giacomo Boffi +-- font hacking from Jan Vroonhof +-- Czech language support from David Sauer +-- `delete-key-deletes-forward' now defaults to t +-- `locate-file' update from Hrvoje Niksic +-- MS Windows build fixes from Adrian Aichner +-- LDAP updates from Oscar Figueiredo +-- miscellaneous bug fixes from Colin Rafferty and Kai Haberzettl +-- disable display of images in buffers by file format +-- miscellaneous Mule fixes from Olivier Galibert +-- documentation updates from Albert Chin-A-Young +-- documentation updates from Gunnar Evermann and Stephen Turnbull +-- MS Windows build fix from Norbert Koch +-- miscellaneous MS Windows fixes from Andy Piper +-- redisplay bug fixes from Jan Vroonhof +-- miscellaneous bug fixes from Robert Pluim, MORIOKA Tomohiko +-- many, many bug fixes and enhancements from Hrvoje Niksic and Olivier + Galibert +-- miscellaneous bug fixes from Martin Buchholz +-- Miscellaneous MS Windows fixes from Philip Aston +-- lots of new tests from Hrvoje Niksic + to 21.2.13 "Demeter" -- Build fixes from Martin Buchholz -- experimental splash screen rewrite from Didier Verna diff -r f4aeb21a5bad -r 74fd4e045ea6 ChangeLog --- a/ChangeLog Mon Aug 13 11:12:06 2007 +0200 +++ b/ChangeLog Mon Aug 13 11:13:30 2007 +0200 @@ -1,3 +1,584 @@ +2000-02-16 Martin Buchholz + + * XEmacs 21.2.29 is released. + +2000-02-16 Martin Buchholz + + * configure.in: Don't use rel_alloc if malloc() calls mmap(). + Discover this by looking for M_MMAP_THRESHOLD. + + * configure.in: Don't define POSIX_C_SOURCE on Solaris, due to + bugs in (at least) Solaris 2.5 headers. + +2000-01-29 Craig Lanning + + * configure.in: Fix detection of XPM on systems without X11. + +2000-02-11 Martin Buchholz + + * configure.in: + * src/config.h.in: + Define _POSIX_C_SOURCE, _XOPEN_SOURCE, _XOPEN_SOURCE_EXTENDED, + but only on tested Operating systems - Linux && SunOS >= 5.5. + +2000-02-09 Valdis Kletnieks + + * aclocal.m4: Support dlls on aix[34]. + +2000-02-09 Martin Buchholz + + * .cvsignore: Ignore gmon.out + +2000-02-08 Martin Buchholz + + * configure.in: Sync Berkeley db autodetection with src/database.c + +2000-02-07 Martin Buchholz + + * configure.in: check for XConvertCase. + +2000-02-07 Martin Buchholz + + * XEmacs 21.2.28 is released. + +2000-01-27 URA Hiroshi + + * configure.in: added getaddrinfo and getnameinfo to AC_FUNC. + +2000-01-26 Martin Buchholz + + * configure.in: Backout the /etc/ld.so.conf patch of 2000-01-18. + +2000-01-24 Martin Buchholz + + * configure.in: Always use our own realpath(), not the system one. + +2000-01-25 Martin Buchholz + + * configure.in: Default Drag-N-Drop to "no" + +1999-12-28 Max Matveev + + * configure.in: add new machine type for IRIX 6.[2-5] to + switch from using unexelf.o to unexelfsgi.o for just those + versions of IRIX. + In the ideal world it would be handled by the s/irix6-0.h but + since machine config is included AFTER OS config, I had to add a + new machine type. + +2000-01-22 Andy Piper + + * configure.in: add winspool to windows libraries. + +2000-01-22 Martin Buchholz + + * configure.in: Add more warnings to default gcc flags. + +2000-01-20 Daniel Pittman + + * configure.in: Find Athena headers hidden in even more obscure + places. That is, search Xaw3D/ as well as X11/Xaw3D/. + +2000-01-19 Martin Buchholz + + * configure.in: Add support for NetWinders. + Patch by Sean MacLennan + +2000-01-18 Martin Buchholz + + * configure.in: Use /etc/ld.so.conf at link-time, if available. + +2000-01-18 Martin Buchholz + + * XEmacs 21.2.27 is released. + +2000-01-15 Adrian Aichner + + * etc/TUTORIAL.de: Update copyright and fix typo. + +2000-01-14 Martin Buchholz + + * configure.in: Create a .dbxrc in the src directory, like .gdbinit. + + * configure.in: Add `tests' symlink to make it easier to find + automated tests directory. + +2000-01-14 Andy Piper + + * configure.in: for cygwin 1.0 we must pick up the mingw32 headers + before the cygwin headers. + +2000-01-08 Martin Buchholz + + * configure.in: + - Allow find-tag to work in the build directory. + - rename src/gdbinit to src/.gdbinit, so that gdb can find it. + - Less verbose messages when creating .sbinit, .gdbinit, TAGS. + +2000-01-07 Marcus Thiessel + + * config.sub: Upgrade to 1.169, imported from autoconf's CVS + * config.guess: Upgrade to 1.158, imported from autoconf's CVS + +2000-01-03 Michael Sperber [Mr. Preprocessor] + + * etc/NEWS: Document mail spool locking overhaul. + + * configure.usage (--mail-locking): + * configure.in: Handle --mail-locking option correctly in + preparation for the movemail locking overhaul. + +2000-01-05 Daniel Pittman + + * configure.in (Installation): Report which Athena header/library + combo is being used. + +1999-12-31 Martin Buchholz + + * XEmacs 21.2.26 is released. + +1999-12-24 Martin Buchholz + + * XEmacs 21.2.25 is released. + +1999-12-17 Yoshiki Hayashi + + * README: Remove msdos part. + +1999-12-17 Martin Buchholz + + * configure.in: Oops. xpm doesn't actually depend on X11. + I got confused by the name (like others get confused by `xemacs'?) + +1999-12-14 Martin Buchholz + + * XEmacs 21.2.24 is released. + +1999-12-13 Martin Buchholz + + * configure.in: + * configure.usage: + - Autodetect NAS. Change Docs accordingly. + + * configure.in: Warn if configure --with-xpm --without-x11. + +1999-12-09 Martin Buchholz + + * configure.in: Clean up sound support. + - variable `old_nas' was used but never set. + - change `with_esd' to `with_esd_sound' for consistency. + - Don't trust the output of `esd-config --libs`; test it. + - Add `esd-config --cflags` to c_switch_site. + - Die if ESD sound requested, but not available. + - ESD is not dependent on X, therefore use LIBS, not libs_x. + +1999-12-07 Martin Buchholz + + * configure.in (--with-sound): Variable with_esd was mispelled. + +1999-12-07 Martin Buchholz + + * XEmacs 21.2.23 is released. + +1999-11-30 Martin Buchholz + + * configure.in: Fix module support. + --with-modules=yes was completely broken. + AC_DEFINE(HAVE_DLFCN_H) was invoked twice. + Remove linking test for _dlopen - seems totally bogus. + Die if --with-modules=yes but no module support found. + Do nothing, not even msg, if --with-modules=no. + +1999-11-17 Isaac Hollander + + * Makefile.in.in: add and use TAR macro. Sometimes tar only copies + symlinks instead of the actual files + +1999-11-30 Martin Buchholz + + * aclocal.m4: Shared library support for hpux >= version 11 + +1999-11-29 Martin Buchholz + + * Makefile.in.in (beta): `make beta' should rebuild info. + +1999-11-29 XEmacs Build Bot + + * XEmacs 21.2.22 is released + +1999-11-28 Martin Buchholz + + * XEmacs 21.2.21 is released. + +1999-11-26 Martin Buchholz + + * configure.in: + Add configure support for Unix 98 type ssize_t. + +1999-11-27 Martin Buchholz + + * Makefile.in.in: + Make sure config.values.sh is up to date. + Use $(SHELL) instead of sh or /bin/sh consistently. + Delegate `depend' target to src/Makefile.in.in. + +1999-10-27 Yoshiki Hayashi + + * INSTALL: Update configure option. + +1999-10-12 Alexandre Oliva + + * configure.in (native_sound_lib, *-sgi-*): Check for audio.h. + (LIBS): Check for libCsup. + + * etc/sample.Xdefaults: adds a reference to beNiceToColormap, + so that the user can guess what to do if xemacs' dialogs are + butt ugly. + +1999-10-24 Jan Vroonhof + + * config.h.in: define HAVE_ESD_SOUND + + * configure.in: Add support for esd sound. --with-sound + now accepts a list of options. + * configure.usage (--native-sound-lib): ditto. + +1999-11-17 Martin Buchholz + + * Makefile.in.in (install-arch-dep): + Fix `make install' if prefix != exec_prefix. + +1999-11-15 Martin Buchholz + + * configure.in: + - Accept --with-database=gdbm as an alias for + --with-database=gnudbm. + - rename with_database_gnudbm to with_database_gdbm. + + * aclocal.m4 (ld_dynamic_link_flags): Just use empty value for + ld_dynamic_link_flags on Solaris. Else CC gives us: + CC: Warning: Option -Wl,-Bdynamic passed to ld, if ld is invoked, ignored otherwise + /usr/ccs/bin/ld: illegal option -- W + + +1999-11-13 Jason R Mastaler + + * etc/FTP: Updated FTP mirrors list. Replaced GNU FTP document + with a URL. + +1999-11-13 Jason R Mastaler + + * etc/MAILINGLISTS: Updated mailing list subscription information. + Replaced GNU MAILINGLISTS document with a URL. + +1999-11-10 XEmacs Build Bot + + * XEmacs 21.2.20 is released + +1999-09-21 Martin Buchholz + * configure.in: Autodetect Unix98 PTY + +1999-08-30 Robert Pluim + + * README.packages: Add description of package-get-provider + +1999-10-22 Vin Shelton + + * INSTALL: Added more information about README.packages, and + re-numbered some bullets. + +1999-10-24 Jan Vroonhof + + * INSTALL: Update disk requirements. Refer to README.packages + +1999-10-21 Andy Piper + + * configure.in (all_widgets): Only use xaw3d if we really have it. + +1999-10-06 Andy Piper + + * Makefile.in.in: use WINDOWSNT for mingw install. + +1999-08-01 Adrian Aichner + + * etc/DISTRIB: Update IP address of ftp.xemacs.org. + * etc/NEWS: Fix typo + +1999-09-25 Andy Piper + + * configure.in: check for Xaw3d and use in preference to Xaw + +1999-09-21 Martin Buchholz + + * Makefile.in.in: All Makefiles should #include config.h + +1999-09-19 Michael Sperber [Mr. Preprocessor] + + * configure.in (EMACS_CONFIGURATION): Use $configuration, not + $canonical, so that installation paths and dynamic path setup will + stay in synch. + +1999-09-20 Andy Piper + + * Makefile.in.in: use __CYGWIN32__ and __MINGW32__ to predicate + installation linkage. + +1999-08-29 Andreas Jaeger + + * configure.in (machine): Recognize MIPS/Linux. + +1999-08-27 Jan Vroonhof + + * modules/zlib/Makefile (distclean): + * modules/ldap/Makefile (distclean): + * modules/sample/Makefile (distclean): + * modules/base64/Makefile (distclean): new target + + * Makefile.in.in (top_distclean): Add package directories + (SUBDIR_DISTCLEAN): New variable, add module directories + +1999-09-01 Martin Buchholz + + * configure.in: Warn, but otherwise ignore, obsolete arguments. + +1999-08-20 Olivier Galibert + + * configure.in: Add --pdump option. + * configure.usage: Ditto. + +1999-08-04 Andy Piper + + * configure.in: report widget usage correctly. beef up setting. + + * Makefile.in.in: fix install-arch-dep for mingw32. + +1999-07-28 Andy Piper + + * config.h.in: add new LWLIB defines. + + * configure.in: fix definitions of widget defines with various + toolkit options. + +1999-07-30 XEmacs Build Bot + + * XEmacs 21.2.19 is released + +1999-07-28 Michael Sperber [Mr. Preprocessor] + + * configure.in: Removed superfluous call to AC_FUNC_MMAP. + +1999-03-07 Gregory Neil Shapiro + + * configure.in: Check for Kerberos and the need for the DES + library before checking for LDAP in case LDAP requires these + libraries. + +1999-07-26 SL Baur + + * configure.in: Rename --with-shlib to --with-modules for + consistency with the other two options that use that name. + + * configure.usage (--with-modules): Document it. + +1999-07-23 Jan Vroonhof + + * etc/custom/example-themes/example-theme.el: + * etc/custom/example-themes/europe-theme.el: + * etc/custom/example-themes/ex-custom-file: Some simple examples + illustrating the custom theme support. + +1999-07-17 MORIOKA Tomohiko + + * etc/HELLO (Thai): Modify for new font. + +1999-07-22 SL Baur + + * configure.in: add sco7 support + From Bob Weiner + +1999-07-22 SL Baur + + * Makefile.in.in (install-arch-dep): Install config.values into + docdir. + From Karl M. Hegbloom + +1999-07-21 SL Baur + + * Makefile.in.in (inststaticdir): New variable. + (instvardir): Ditto. + (install-arch-dep): Use them. + + * configure.in (sitelispdir): Need to use ${PROGNAME}. + (sitemoduledir): Ditto. + (inststaticdir): New variable. + (instvardir): Ditto. + (infodir): Use them. + (lispdir): Ditto. + (moduledir): Ditto. + (pkgdir): Ditto. + (etcdir): Ditto. + (lockdir): Ditto. + (archlibdir): Ditto. + +1999-07-14 SL Baur + + * InfoDock 4.0.8 is released + +1999-07-13 XEmacs Build Bot + + * XEmacs 21.2.18 is released + +1999-07-06 SL Baur + + * config.guess (main): Synch with newer config.guess for HP + support. + From Marcus Thiessel + +1999-06-25 Michael Sperber [Mr. Preprocessor] + + * configure.in (with_prefix): Added --with-prefix, defaults to + yes, to control whether the value of --prefix is compiled into the + binary. + +1999-07-03 Andy Piper + + * configure.usage (--with-widgets): add. + +1999-07-02 Andy Piper + + * configure.in: Make sure we get motif in lwlib if we have widgets + and motif. + +1999-06-25 SL Baur + + * configure.in (version): Fix --with-infodock test. + +1999-06-15 Michael Sperber [Mr. Preprocessor] + + * configure.in: --prefix and --exec-prefix are now only compiled + into the binary if user-defined. + +1999-03-23 Michael Sperber [Mr. Preprocessor] + + * configure.in: Made docdir configurable. + + * Makefile.in (docdir): Added variable for custom DOC directory. + +1999-06-22 XEmacs Build Bot + + * XEmacs 21.2.17 is released + +1999-06-13 Oscar Figueiredo + + * configure.in (with_ldap): Check libldap independently of liblber + Do not test alternate library names such as libldap10 + Test the presence of a variety of LDAP API functions which were + formerly assumed to be present according to dubious heuristics + +1999-06-11 XEmacs Build Bot + + * XEmacs 21.2.16 is released + +1999-06-04 SL Baur + + * configure.in (CPP): Correct test for locating $site_prefix + include directories. + +1999-06-04 XEmacs Build Bot + + * XEmacs 21.2.15 is released + +1999-06-01 Gunnar Evermann + + * README.packages: fix typos: user pacakge hierarchy is ~/.xemacs + From: Eric Veldhuyzen + +1999-05-25 Jan Vroonhof + + * configure.in: For non-beta's use x.y.z format for version strings. + +1999-06-03 SL Baur + + * version.sh: add emacs_is_beta initialization + + * configure.in: Implement patch levels in version number + From Jan Vroonhof + + * configure.in: + * configure.usage: + * config.h.in: Rename session option to wmcommand. + From Oliver Graf + +1999-05-16 Mike McEwan + + * info/dir: Add `emodules.info' entry to the top info dir. + +1999-05-31 SL Baur + + * configure.in (CPP): Don't check for include subdirectories in + site-prefix directories. This check loses in valid configurations + like /usr/jp in TurboLinux. Conditionally add include directory to + site switches. + +1999-05-14 Hrvoje Niksic + + * configure.in (quoted_arguments): Support + --error-checking=byte-code. + +1999-05-14 XEmacs Build Bot + + * XEmacs 21.2.14 is released + +1999-05-11 SL Baur + + * version.sh (infodock_build_version): Synch InfoDock version. + +1999-05-06 Hrvoje Niksic + + * aclocal.m4 (ld_dynamic_link_flags): Change -Bexport to -Bdynamic + for Solaris. + +1999-05-03 Hrvoje Niksic + + * configure.in (xemacs_betaname): Don't generate Installation.el. + + * Makefile.in.in (top_distclean): Don't remove Installation.el. + +1999-04-29 Andy Piper + + * configure.in: add mingw32 as a target platform. add nt process + support options. + +1999-03-30 MORIOKA Tomohiko + + * etc/HELLO (Amharic): New language. + (Slovak): Likewise. + (Thai): Likewise (by Virach Sornlertlamvanich). + (Greek): Fixed (by Yannis Haralambous). + +1998-09-04 MORIOKA Tomohiko + + * configure.in: Delete mule-coding.o. + +1999-04-22 Gunnar Evermann + + * lwlib/xlwmenu.c (string_width_u): Initialise chars before + calling XmStringGetLtoR + (string_draw_u): ditto and check return value of XmStringGetLtoR() + +1999-04-05 Olivier Galibert + + * Makefile.in.in (GENERATED_HEADERS): Don't generate + puresize-adjust.h anymore + + * configure.usage: Remove everything gung-ho or purespace related + + * configure.in: Ditto + +1999-04-17 Hrvoje Niksic + + * configure.in: Check for getloadavg(). + 1999-03-12 XEmacs Build Bot * XEmacs 21.2.13 is released @@ -254,7 +835,7 @@ * etc/check_cygwin_setup.sh: fix a couple of buglets. -1998-08-23 Adrian Aichner +1998-08-23 Adrian Aichner * etc/sample.emacs: Enable sound support on mswindows devices. @@ -265,7 +846,7 @@ conditions for both PNG and XPM, stop screaming if png is not found and no window-system is selected, and fixed a bug in the XPM checking. -1998-08-06 Adrian Aichner +1998-08-06 Adrian Aichner * etc/TUTORIAL.de: Fixing typos and grammatical errors. Fixing inconsistent usage of RET, , and (only using @@ -1083,7 +1664,7 @@ * etc/aliases.ksh: Add `mak' function to create beta.err for build-report. - From Adrian Aichner + From Adrian Aichner Suggested by Karl M. Hegbloom 1998-01-27 SL Baur @@ -1497,13 +2078,13 @@ * lwlib/lwlib-Xm.c(update_one_menu_entry): Add missing variable. From Skip Montanaro -1997-11-04 Adrian Aichner +1997-11-04 Adrian Aichner * etc/TUTORIAL.de: Updated copyright information. Translated most of the COPYING section. Translated the <<.*>> didactic line. -1997-10-22 Adrian Aichner +1997-10-22 Adrian Aichner * etc/TUTORIAL.de: Fixed two issues reported by Achim Oppelt @@ -1516,12 +2097,12 @@ Applied patches supplied by Marc Aurel <4-tea-2@bong.saar.de>. They fix yet more typos and quite a few awkward sentences. -1997-10-21 Adrian Aichner +1997-10-21 Adrian Aichner * etc/TUTORIAL.de: Manually merged a few more corrections by Carsten Leonhardt -1997-10-20 Adrian Aichner +1997-10-20 Adrian Aichner * etc/TUTORIAL.de: Applied patches from Andreas Jaeger to 1.2, @@ -1652,7 +2233,7 @@ 1997-10-18 SL Baur - * XEmacs 20.3-beta91 is released. + * XEmacs 20.3-beta91 is released. 1997-10-16 Hrvoje Niksic @@ -2974,7 +3555,7 @@ Sat Mar 22 21:27:41 1997 Tomasz J. Cholewo - * configure.in: Echo only current configuration using 'tee -a'. + * configure.in: Echo only current configuration using 'tee -a'. Fri Mar 21 21:26:01 1997 Steven L Baur diff -r f4aeb21a5bad -r 74fd4e045ea6 INSTALL --- a/INSTALL Mon Aug 13 11:12:06 2007 +0200 +++ b/INSTALL Mon Aug 13 11:13:30 2007 +0200 @@ -1,6 +1,6 @@ XEmacs Installation Guide Copyright (c) 1994, 1995, 1996 Board of Trustees, University of Illinois -Copyright (c) 1994 Free Software Foundation, Inc. +Copyright (c) 1994-1999 Free Software Foundation, Inc. Synched up with: FSF 19.30. @@ -23,20 +23,22 @@ 1) Make sure your system has enough swapping space allocated to handle a program whose pure code is 900k bytes and whose data area is at - least 400k and can reach 8Mb or more. If the swapping space is + least 400k and can reach 8Mb or more. Note that a typical XEmacs + build is much bigger. If the swapping space is insufficient, you will get an error in the command `temacs -batch -l loadup dump', found in `./src/Makefile.in.in', or possibly when running the final dumped XEmacs. -Building XEmacs requires about 41 Mb of disk space (including the -XEmacs sources). Once installed, XEmacs occupies about 16 Mb in the -file system where it is installed; this includes the executable files, -Lisp libraries, miscellaneous data files, and on-line documentation. -The amount of storage of the Lisp directories may be reduced by -compressing the .el files. If the building and installation take place -in different directories, then the installation procedure temporarily -requires 41+16 Mb. Adjust this value upwards depending upon what -additional Lisp support is installed. + Verify that your users have a high enough stack limit. On some + systems such as OpenBSD and OSF/Tru64 the default is 2MB which is + too low. See 'PROBLEMS' for details. + +Building XEmacs requires about 100 Mb of disk space (including the +XEmacs sources). Once installed, XEmacs occupies between 20 and 100 Mb +in the file system where it is installed; this includes the executable files, +Lisp libraries, miscellaneous data files, and on-line documentation. The +exact amount depends greatly on the number of extra lisp packages that are +installed XEmacs requires an ANSI C compiler, such as GCC. If you wish to build the documentation yourself, you will need at least version 1.68 of @@ -65,20 +67,34 @@ XEmacs to allow configure to find the external software packages. If you link with dynamic (``.so'') external package libraries, which is not recommended, you will also need to add the library directories -to the --site-runtime-libraries option. - +to the --site-runtime-libraries option. For your convenience these can +be set together by using the --with-site-prefix command. This will set +these variables as needed assuming your libraries are organised as a +typical /usr tree. -3) Decide what Initial Lisp you need with XEmacs. XEmacs is -distributed separately from most of its runtime environment. This is +3) [N.B. Most of this section can be done during or after the +compilation of the core source code, but is present early to catch +your attention.] + +Decide what Initial Lisp you need with XEmacs. XEmacs is +distributed separately from most of its runtime environment. This is done to make it easier for administrators to tune an installation for -what the local users need. See the file etc/PACKAGES for an overview -of what is available and which packages need to be installed prior to -building XEmacs. At this point you only need a minimum to get started -at which point you may install what you wish without further changes -to the XEmacs binary. A sample minimum configuration for a Linux -system using Mule and Wnn6 from OMRON corporation would be the -packages `mule-base' and `egg-its'. By default, packages will be -searched for in the path +what the local users need. Note that while XEmacs will compile and +install without any packages present at least some additional lisp +packages are needed to bring XEmacs up to "normal" editor +functionality. Installation and upgrading of the packages can be done +almost automatically when from inside XEmacs when it has been compiled +and installed. + +More information and suggestions for which packages to install see the +file README.packages. + +IMPORTANT! The file README.packages contain information vital to have +a fully working XEmacs. This information was not included in this file +only because it is too large for this terse INSTALL. Please read +README.packages now! + +By default, packages will be searched for in the path ~/.xemacs::$prefix/lib/xemacs-${version}/mule-packages:$prefix/lib/xemacs/mule-packages:$prefix/lib/xemacs-${version}/xemacs-packages:$prefix/lib/xemacs/xemacs-packages @@ -294,12 +310,12 @@ configuration for your system. You can tweak this based on how you use XEmacs, and the memory and cpu resources available on your system. -The `--use-system-malloc' option can be use to either enable or +The `--with-system-malloc' option can be use to either enable or disable use of the system malloc. Generally, it's best to go with the default configuration for your system. Note that on many systems using the system malloc disables the use of the relocating allocator. -The `--use-debug-malloc' option can be used to link a special debugging +The `--with-debug-malloc' option can be used to link a special debugging version of malloc. Debug Malloc is not included with XEmacs, is intended for use only by the developers and may be obtained from . @@ -380,7 +396,7 @@ same configuration. If `configure' exits with an error after disturbing the status quo, it removes `config.status'. -4) Look at `./lisp/paths.el'; if some of those values are not right +5) Look at `./lisp/paths.el'; if some of those values are not right for your system, set up the file `./lisp/site-init.el' with XEmacs Lisp code to override them; it is not a good idea to edit paths.el itself. YOU MUST USE THE LISP FUNCTION `setq' TO ASSIGN VALUES, @@ -403,7 +419,7 @@ XEmacs cannot detect, you may need to change the value of `directory-abbrev-alist'. -5) Put into `./lisp/site-init.el' or `./lisp/site-load.el' any Emacs +6) Put into `./lisp/site-init.el' or `./lisp/site-load.el' any Emacs Lisp code you want XEmacs to load before it is dumped out. Use site-load.el for additional libraries if you arrange for their documentation strings to be in the lib-src/DOC file (see @@ -422,12 +438,12 @@ The `site-*.el' files are nonexistent in the distribution. You do not need to create them if you have nothing to put in them. -6) Refer to the file `./etc/TERMS' for information on fields you may +7) Refer to the file `./etc/TERMS' for information on fields you may wish to add to various termcap entries. The files `./etc/termcap.ucb' and `./etc/termcap.dat' may already contain appropriately-modified entries. -7) Run `make' in the top directory of the XEmacs distribution to finish +8) Run `make' in the top directory of the XEmacs distribution to finish building XEmacs in the standard way. The final executable file is named `src/emacs'. You can execute this file "in place" without copying it, if you wish; then it automatically uses the sibling @@ -505,18 +521,18 @@ Using GNU Make allows for simultaneous builds with and without the --srcdir option. -8) If your system uses lock files to interlock access to mailer inbox files, -then you might need to make the movemail program setuid or setgid -to enable it to write the lock files. We believe this is safe. +9) If your system uses lock files to interlock access to mailer inbox +files, then you might need to make the movemail program setuid or +setgid to enable it to write the lock files. We believe this is safe. The setuid/setgid bits need not be set on any other XEmacs-related executables. -9) You are done with the hard part! You can remove executables and +10) You are done with the hard part! You can remove executables and object files from the build directory by typing `make clean'. To also remove the files that `configure' created (so you can compile XEmacs for a different configuration), type `make distclean'. -10) You should now go to the XEmacs web page at http://www.xemacs.org/ +11) You should now go to the XEmacs web page at http://www.xemacs.org/ and decide what additional Lisp support you wish to have. MAKE VARIABLES @@ -630,6 +646,10 @@ above), is `/usr/local/lib/xemacs-VERSION/CONFIGURATION-NAME' (where VERSION and CONFIGURATION-NAME are as described above). +`docdir' indicates where to put Lisp documentation strings that XEmacs + refers to as it runs. It defaults the value of `archlibdir' + (see above). + `moduledir' indicates where XEmacs installs and expects to find any dynamic modules. Its default value, based on `archlibdir' (see above) is @@ -666,13 +686,13 @@ `src/config.h', and change the two `#include' directives to include the appropriate system and architecture description files. -2) Edit `./src/config.h' to set the right options for your system. If +3) Edit `./src/config.h' to set the right options for your system. If you need to override any of the definitions in the s/*.h and m/*.h files for your system and machine, do so by editing config.h, not by changing the s/*.h and m/*.h files. Occasionally you may need to redefine parameters used in `./lib-src/movemail.c'. -3) If you're going to use the make utility to build XEmacs, you will +4) If you're going to use the make utility to build XEmacs, you will still need to run `configure' first, giving the appropriate values for the variables in the sections entitled "Things `configure' Might Edit" and "Where To Install Things." Note that you may only need to change @@ -772,6 +792,10 @@ PROBLEMS +The most likely problem is that you forgot to read and follow the +directions in README.packages. You can not have a working XEmacs +without downloading some additional packages. + See the file PROBLEMS in this directory for a list of various problems sometimes encountered, and what to do about them. diff -r f4aeb21a5bad -r 74fd4e045ea6 Makefile.in.in --- a/Makefile.in.in Mon Aug 13 11:12:06 2007 +0200 +++ b/Makefile.in.in Mon Aug 13 11:13:30 2007 +0200 @@ -49,6 +49,9 @@ ## make extraclean ## Still more severe - delete backup and autosave files, too. +#define NOT_C_CODE +#include "src/config.h" + #ifdef USE_GNU_MAKE RECURSIVE_MAKE=$(MAKE) #else @@ -60,7 +63,9 @@ LANG = C LC_ALL = C RM = rm -f +MAKEPATH=./lib-src/make-path pwd = /bin/pwd +TAR = tar ## ==================== Things `configure' Might Edit ==================== @@ -93,6 +98,14 @@ ## not need to change them. This defaults to /usr/local. prefix=@prefix@ +## Variable data (as per each program update) goes here +## The default is ${PROGNAME} +inststaticdir=@inststaticdir@ + +## Static data (constant across program updates) goes here +## The default is ${PROGNAME}-${version} +instvardir=@instvardir@ + ## Like `prefix', but used for architecture-specific files. exec_prefix=@exec_prefix@ @@ -191,6 +204,9 @@ ## currently being edited. lockdir=@lockdir@ +## Where to put the DOC file. +docdir=@docdir@ + ## Where to put executables to be run by XEmacs rather than ## the user. This path usually includes the XEmacs version ## and configuration name, so that multiple configurations @@ -213,7 +229,10 @@ MAKE_SUBDIR = @MAKE_SUBDIR@ ## Subdirectories that can be made recursively. -SUBDIR = ${MAKE_SUBDIR} man +SUBDIR = ${MAKE_SUBDIR} man + +## Subdirectories that must be cleaned on distclean +SUBDIR_DISTCLEAN = ${SUBDIR} modules/sample modules/ldap modules/zlib modules/base64 ## The makefiles of the directories in ${MAKE_SUBDIR}. SUBDIR_MAKEFILES = @SUBDIR_MAKEFILES@ @@ -228,7 +247,7 @@ ## instead, we have written out explicit code in the `install' targets. COPYDIR = ${srcdir}/etc ${srcdir}/lisp COPYDESTS = ${etcdir} ${lispdir} -GENERATED_HEADERS = src/paths.h src/Emacs.ad.h src/puresize-adjust.h src/config.h lwlib/config.h src/sheap-adjust.h +GENERATED_HEADERS = src/paths.h src/Emacs.ad.h src/config.h lwlib/config.h src/sheap-adjust.h GENERATED_LISP = lisp/finder-inf.el all: ${PROGNAME} all-elc info @@ -242,7 +261,7 @@ .PHONY: ${SUBDIR} all beta all-elc all-elcs dump-elc dump-elcs autoloads finder ## Convenience target for XEmacs beta testers -beta: clean all-elc finder +beta: clean all-elc finder info ## Convenience target for XEmacs maintainers ## This would run `make-xemacsdist' if I were really confident that everything @@ -256,30 +275,31 @@ ## - src/depend from src/*.[ch] .PHONY: config configure depend config: configure depend -configure: ${srcdir}/configure -${srcdir}/configure: ${srcdir}/configure.in +configure: ${srcdir}/configure ${srcdir}/lib-src/config.values.in + +${srcdir}/configure : ${srcdir}/configure.in cd ${srcdir} && autoconf - cd ${srcdir} && /bin/sh lib-src/config.values.sh -depend ${srcdir}/src/depend: - cd ${srcdir}/src && \ - perl ./make-src-depend > depend.tmp && \ - $(RM) depend && mv depend.tmp depend +${srcdir}/lib-src/config.values.in : ${srcdir}/configure + cd ${srcdir} && $(SHELL) lib-src/config.values.sh + +depend ${srcdir}/src/depend : + cd ${srcdir}/src && $(RECURSIVE_MAKE) depend ## Build XEmacs and recompile out-of-date and missing .elc files along ## the way. all-elc all-elcs: lib-src lwlib dump-elcs src - MAKE='$(MAKE)' EMACS='./src/$(PROGNAME)' sh ${srcdir}/lib-src/update-elc.sh + MAKE='$(MAKE)' EMACS='./src/$(PROGNAME)' $(SHELL) ${srcdir}/lib-src/update-elc.sh ## Sub-target for all-elc. dump-elc dump-elcs: ${GENERATED_HEADERS} FRC.dump-elcs cd ./src && $(RECURSIVE_MAKE) dump-elcs autoloads: src - MAKE='$(MAKE)' EMACS='./src/$(PROGNAME)' sh ${srcdir}/lib-src/update-autoloads.sh + MAKE='$(MAKE)' EMACS='./src/$(PROGNAME)' $(SHELL) ${srcdir}/lib-src/update-autoloads.sh custom-loads: - MAKE='$(MAKE)' EMACS='./src/$(PROGNAME)' sh ${srcdir}/lib-src/update-custom.sh + MAKE='$(MAKE)' EMACS='./src/$(PROGNAME)' $(SHELL) ${srcdir}/lib-src/update-custom.sh finder: src @echo "Building finder database ..." @@ -306,15 +326,9 @@ @(echo "/* Do not edit this file!" ; \ echo " Automatically generated from ${srcdir}/etc/Emacs.ad" ; \ echo " */" ; \ - /bin/sh ${srcdir}/lib-src/ad2c ${srcdir}/etc/Emacs.ad ) > \ + $(SHELL) ${srcdir}/lib-src/ad2c ${srcdir}/etc/Emacs.ad ) > \ src/Emacs.ad.h -src/puresize-adjust.h: ${srcdir}/src/puresize.h - @echo "Resetting \`src/puresize-adjust.h'."; \ - (echo "/* Do not edit this file!" ; \ - echo " Automatically generated by XEmacs */" ; \ - echo "#define PURESIZE_ADJUSTMENT 0") > $@ - src/sheap-adjust.h: @echo "Resetting \`src/sheap-adjust.h'."; \ (echo "/* Do not edit this file!" ; \ @@ -399,21 +413,30 @@ if test -f ../Installation; then \ ${INSTALL_DATA} ../Installation ${archlibdir}/Installation; \ fi; \ - for f in DOC config.values; do \ - ${INSTALL_DATA} lib-src/$${f} ${archlibdir}/$${f}; \ - done ; \ + ${INSTALL_DATA} lib-src/config.values ${docdir}/config.values; \ + ${INSTALL_DATA} lib-src/DOC ${docdir}/DOC; \ for subdir in `find ${archlibdir} -type d ! -name RCS ! -name SCCS ! -name CVS -print` ; \ do (cd $${subdir} && $(RM) -r RCS CVS SCCS \#* *~) ; done ; \ else true; fi +#ifdef WINDOWSNT + ${INSTALL_PROGRAM} src/${PROGNAME} ${bindir}/${PROGNAME} + -chmod 0755 ${bindir}/${PROGNAME} +#else ${INSTALL_PROGRAM} src/${PROGNAME} ${bindir}/${PROGNAME}-${version} -chmod 0755 ${bindir}/${PROGNAME}-${version} +# ifdef __CYGWIN32__ + cd ${bindir} && $(RM) ./${PROGNAME} && ${LN_S} ${PROGNAME}-${version}.exe ./${PROGNAME} +# else cd ${bindir} && $(RM) ./${PROGNAME} && ${LN_S} ${PROGNAME}-${version} ./${PROGNAME} +# endif /* __CYGWIN32__ */ +#endif /* WINDOWSNT */ if test "${prefix}" != "${exec_prefix}"; then \ + $(MAKEPATH) ${exec_prefix}/lib/${instvardir}; \ for dir in \ - lib/${PROGNAME} \ - lib/${PROGNAME}-${version}/etc \ - lib/${PROGNAME}-${version}/info \ - lib/${PROGNAME}-${version}/lisp; do \ + lib/${inststaticdir} \ + lib/${instvardir}/etc \ + lib/${instvardir}/info \ + lib/${instvardir}/lisp; do \ if test ! -d ${exec_prefix}/$${dir}; then \ $(LN_S) ${prefix}/$${dir} ${exec_prefix}/$${dir}; fi; \ done; \ @@ -438,8 +461,8 @@ -a "`(cd $${dir} && $(pwd))`" != \ "`(cd $${dest} && $(pwd))`" \ && (echo "Copying $${dir}..." ; \ - (cd $${dir} && tar -cf - . ) | \ - (cd $${dest} && umask 022 && tar -xf - );\ + (cd $${dir} && $(TAR) -cf - . ) | \ + (cd $${dest} && umask 022 && $(TAR) -xf - );\ chmod 0755 $${dest}; \ for subdir in `find $${dest} -type d ! -name RCS ! -name SCCS ! -name CVS -print` ; do \ (cd $${subdir} && $(RM) -r RCS CVS SCCS \#* *~) ; \ @@ -455,7 +478,6 @@ chmod 0644 ${infodir}/$${file}; \ done ; \ fi - ## Note it's `xemacs' not ${PROGNAME} cd ${srcdir}/etc && \ for page in xemacs etags ctags gnuserv gnuclient gnuattach gnudoit; do \ ${INSTALL_DATA} ${srcdir}/etc/$${page}.1 ${mandir}/$${page}${manext} ; \ @@ -469,15 +491,14 @@ @echo "${lispdir}" gzip-el: - ${srcdir}/lib-src/gzip-el.sh ${lispdir} + $(SHELL) ${srcdir}/lib-src/gzip-el.sh ${lispdir} -MAKEPATH=./lib-src/make-path ## Build all the directories to install XEmacs in. ## Since we may be creating several layers of directories, ## (e.g. /usr/local/lib/${PROGNAME}-20.5/sparc-sun-solaris2.6), we use ## make-path instead of mkdir. Not all mkdirs have the `-p' flag. mkdir: FRC.mkdir - ${MAKEPATH} ${COPYDESTS} ${lockdir} ${infodir} ${archlibdir} \ + ${MAKEPATH} ${COPYDESTS} ${lockdir} ${docdir} ${infodir} ${archlibdir} \ ${mandir} ${bindir} ${datadir} ${libdir} ${pkgdir} \ ${sitelispdir} ${moduledir} ${sitemoduledir} -chmod 0777 ${lockdir} @@ -549,10 +570,10 @@ $(RM) config.status config.log confdefs.h config-tmp-* build-install Installation ; \ $(RM) core .sbinit lock/* GNUmakefile Makefile Makefile.in ; \ $(RM) lisp/finder-inf.el* Installation.el Installation.elc ; \ - $(RM) packages mule-packages site-lisp + $(RM) -r site-packages xemacs-packages mule-packages site-lisp distclean: FRC.distclean - for d in $(SUBDIR); do (cd ./$$d && $(RECURSIVE_MAKE) $@); done + for d in $(SUBDIR_DISTCLEAN); do (cd ./$$d && $(RECURSIVE_MAKE) $@); done -${top_distclean} ## `realclean' diff -r f4aeb21a5bad -r 74fd4e045ea6 PROBLEMS --- a/PROBLEMS Mon Aug 13 11:12:06 2007 +0200 +++ b/PROBLEMS Mon Aug 13 11:13:30 2007 +0200 @@ -41,8 +41,8 @@ There have been reports of egcs-1.1 not compiling XEmacs correctly on Alpha Linux. There have also been reports that egcs-1.0.3a is O.K. -*** Don't use -O2 with gcc 2.7.2 under Intel/XXX without also using -`-fno-strength-reduce'. +*** Don't use -O2 or -O3 with Cygwin 1.0, CodeFusion-99070 or gcc 2.7.2 on x86 +without also using `-fno-strength-reduce'. gcc will generate incorrect code otherwise. This bug is present in at least 2.6.x and 2.7.[0-2]. This bug has been fixed in GCC 2.7.2.1 and @@ -50,6 +50,25 @@ This problem is known to be fixed in egcs (or pgcc) 1.0 or later. +Unfortunately, later releases of Cygnus-released compilers (not the +Net-released ones) have a bug with the same `problem signature'. + +If you're lucky, you'll get an error while compiling that looks like: + +event-stream.c:3189: internal error--unrecognizable insn: +(insn 256 14 15 (set (reg/v:SI 24) + (minus:SI (reg/v:SI 25) + (const_int 2))) -1 (insn_list 11 (nil)) + (nil)) + 0 0 [main] + +If you're unlucky, your code will simply execute incorrectly. + +*** Don't use gcc-2.95.2 with -mcpu=ultrasparc on Solaris 2.6. + +gcc will assume a 64-bit operating system, even though you've +merely told it to assume a 64-bit instruction set. + *** Don't use -O2 with gcc 2.7.2 under Intel architectures without also using `-fno-caller-saves'. @@ -391,8 +410,8 @@ Marcus Thiessel - Unfortunately, XEmacs releases <21.0 don't work with Motif2.1. It - will compile but you will get excessive X11 errors like + Unfortunately, XEmacs releases prior to 21.0 don't work with + Motif2.1. It will compile but you will get excessive X11 errors like xemacs: X Error of failed request: BadGC (invalid GC parameter) @@ -542,17 +561,23 @@ *** You type Control-H (Backspace) expecting to delete characters. Emacs has traditionally used Control-H for help; unfortunately this -interferes with its use as Backspace on TTY's. One way to solve this -problem is to put this in your .emacs: +interferes with its use as Backspace on TTY's. As of XEmacs 21, +XEmacs looks at the "erase" setting of TTY structures and maps C-h to +backspace when erase is set to C-h. This is sort of a special hack, +but it makes it possible for you to use the standard: + + stty erase ^H - (when (eq tty-erase-char ?\C-h) - (keyboard-translate ?\C-h ?\C-?) - (global-set-key "\M-?" 'help-command)) +to get your backspace key to erase characters. The erase setting is +recorded in the Lisp variable `tty-erase-char', which you can use to +tune the settings in your .emacs. -This checks whether the TTY erase char is C-h, and if it is, makes -Control-H (Backspace) work sensibly, and moves help to Meta-? (ESC ?). +A major drawback of this is that when C-h becomes backspace, it no +longer invokes help. In that case, you need to use f1 for help, or +bind another key. An example of the latter is the following code, +which moves help to Meta-? (ESC ?): -Note that you can probably also access help using F1. + (global-set-key "\M-?" 'help-command) *** Mail agents (VM, Gnus, rmail) cannot get new mail diff -r f4aeb21a5bad -r 74fd4e045ea6 README --- a/README Mon Aug 13 11:12:06 2007 +0200 +++ b/README Mon Aug 13 11:13:30 2007 +0200 @@ -16,6 +16,9 @@ See the file `nt/README' for instructions on building XEmacs for Microsoft Windows. +The file 'README.packages' will guide you in the installation of +(essential) add on packages. + Reports of bugs in XEmacs should be posted to the newsgroup comp.emacs.xemacs or sent to the mailing list xemacs@xemacs.org. See the "Bugs" section of the XEmacs manual for more information on how to @@ -56,8 +59,5 @@ `info' holds the Info documentation tree for XEmacs. `man' holds the source code for the XEmacs info documentation tree. -`msdos' holds configuration files for compiling XEmacs under MSDOG. - See the file etc/MSDOS for more information. - `nt' holds configuration files for compiling XEmacs under Microsoft Windows NT. The support for NT is very tentative right now. diff -r f4aeb21a5bad -r 74fd4e045ea6 README.packages --- a/README.packages Mon Aug 13 11:12:06 2007 +0200 +++ b/README.packages Mon Aug 13 11:13:30 2007 +0200 @@ -9,8 +9,10 @@ ------------------------ Q. Do I need to have the packages to compile XEmacs? -A. If you want to compile with MULE, you need the mule-base package installed. - Otherwise, no package is required before compilation. +A. No, XEmacs will build and install just fine without any packages + installed. However, only the most basic editing functions will be + available with no packages installed, so installing packages is an + essential part of making your installed XEmacs _useful_. Q. I really liked the old way that packages were bundled and do not want to mess with packages at all. @@ -20,11 +22,11 @@ A note of caution ----------------- -The XEmacs package system is still in its infancy. Please expect a few -minor hurdles on the way. Also neither the interface nor the structure is +The XEmacs package system is still in its infancy. Please expect a few +minor hurdles on the way. Also neither the interface nor the structure is set in stone. The XEmacs maintainers reserve the right to sacrifice backwards compatibility as quirks are worked out over the coming -releases. +releases. Some Package Theory ------------------- @@ -35,7 +37,7 @@ Each elisp add-on (or groups of them when they are small) now comes in its own tarball that contains a small search hierarchy. -You select just the ones you need. Install them by untarring them into +You select just the ones you need. Install them by untarring them into the right place. On startup XEmacs will find them, set up the load path correctly, install autoloads, etc, etc. @@ -60,7 +62,7 @@ ------------------------- Packages are available from ftp://ftp.xemacs.org/pub/xemacs/packages -and its mirror. +and its mirrors. How to install the packages --------------------------- @@ -73,14 +75,14 @@ ---------------- Those with little time, cheap connections and plenty of disk space can -install all packages at once using the sumo tarballs. +install all the packages at once using the sumo tarballs. Download the file -xemacs-sumo-.tar.gz +xemacs-sumo.tar.gz For an XEmacs compiled with Mule you also need -xemacs-mule-sumo-.tar.gz +xemacs-mule-sumo.tar.gz N.B. They are called 'Sumo Tarballs' for good reason. They are currently about 15MB and 2.3MB (gzipped) respectively. @@ -120,8 +122,8 @@ installing easier. It will notice if new packages or versions are available and will fetch them from the ftp site. -Unfortunately this requires that a few packages are already in place. -You will have to install them by hand as above or use a SUMO tarball. +Unfortunately this requires that a few packages are already in place. +You will have to install them by hand as above or use a SUMO tarball. This requirement will hopefully go away in the future. The packages you need are: @@ -132,7 +134,7 @@ mailcrypt - If you have PGP installed and want to verify the signature of the index file. - mule-base - Needed if you want to compile XEmacs with MULE. + mule-base - Needed if you want to use XEmacs with MULE. After installing these by hand, you can start XEmacs. (It is a good idea to use 'xemacs -vanilla' here as your startup files might need @@ -164,7 +166,7 @@ - When you are finished choosing packages, invoke 'Packages->Install/Remove Select' from the menu or type 'x' to begin installing packages. - + After Installation ------------------ @@ -173,7 +175,7 @@ Note to MULE users ------------------ -Unlike all other packages the mule-base package is used at build/dump +Unlike all other packages the mule-base package is used at build/dump time. This means that you need this available before compiling XEmacs with MULE. Also it is a good idea to keep packages that are MULE-only separate by putting them in the mule-packages hierarchy. @@ -200,7 +202,7 @@ --------------------------- As the exact files and their locations contained in a package may -change it is recommend to remove a package first before installing a +change it is recommended to remove a package first before installing a new version. In order to facilitate removal each package contains an pgkinfo/MANIFEST.pkgname file which list all the files belong to the package. M-x package-admin-delete-binary-package RET can be used to @@ -213,10 +215,9 @@ ------------------------ In addition to the system wide packages, each user can have his own -packages installed in "./xemacs" (Note that this will most likely -change to "./xemacs/packages" in the near future). If you want to +packages installed in "~/.xemacs/xemacs-packages". If you want to install packages there using the interactive tools, you need to set -'pui-package-install-dest-dir' to "/xemacs" +'pui-package-install-dest-dir' to "~/.xemacs/xemacs-packages" Site lisp/Site start -------------------- @@ -225,3 +226,13 @@ XEmacs no longer looks into a 'site-lisp' directly by default. A good place to put 'site-start.el' would be in $prefix/lib/xemacs/site-packages/lisp/ + +Finding the right packages +-------------------------- + +If you want to find out which package contains the functionality you +are looking for, use M-x package-get-package-provider, and give it a +symbol that is likely to be in that package. For example, if some +code you want to use has a (require 'thingatpt) in it, try doing +M-x package-get-package-provider RET thingatpt , which will return +something like: (fsf-compat "1.06"). diff -r f4aeb21a5bad -r 74fd4e045ea6 aclocal.m4 --- a/aclocal.m4 Mon Aug 13 11:12:06 2007 +0200 +++ b/aclocal.m4 Mon Aug 13 11:13:30 2007 +0200 @@ -92,7 +92,7 @@ # PIC is the default for these OSes. ;; - os2*) + aix3* | aix4* | os2*) # We can build DLLs from non-PIC. ;; amigaos*) @@ -108,7 +108,7 @@ else # PORTME Check for PIC flags for the system compiler. case "$xehost_os" in - hpux9* | hpux10*) + hpux9* | hpux1[[0-9]]*) # Is there a better link_static_flag that works with the bundled CC? wl='-Wl,' dll_cflags='+Z' @@ -568,7 +568,11 @@ ld_dynamic_link_flags= ;; - sco3.2v5* | unixware* | sysv5* | sysv4* | solaris2* | solaris7*) + solaris2* | solaris7*) + ld_dynamic_link_flags= + ;; + + sco3.2v5* | unixware* | sysv5* | sysv4*) ld_dynamic_link_flags="${wl}-Bexport" ;; diff -r f4aeb21a5bad -r 74fd4e045ea6 config.guess --- a/config.guess Mon Aug 13 11:12:06 2007 +0200 +++ b/config.guess Mon Aug 13 11:13:30 2007 +0200 @@ -1,6 +1,7 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright (C) 1992, 93, 94, 95, 96, 97, 1998 Free Software Foundation, Inc. +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999 +# Free Software Foundation, Inc. # # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -23,6 +24,7 @@ # Written by Per Bothner . # The master version of this file is at the FSF in /home/gd/gnu/lib. +# Please send patches to . # # This script attempts to guess a canonical system name similar to # config.sub. If it succeeds, it prints the system name on stdout, and @@ -35,6 +37,20 @@ # (but try to keep the structure clean). # +# Use $HOST_CC if defined. $CC may point to a cross-compiler +if test x"$CC_FOR_BUILD" = x; then + if test x"$HOST_CC" != x; then + CC_FOR_BUILD="$HOST_CC" + else + if test x"$CC" != x; then + CC_FOR_BUILD="$CC" + else + CC_FOR_BUILD=cc + fi + fi +fi + + # This is needed to find uname on a Pyramid OSx when run in the BSD universe. # (ghazi@noc.rutgers.edu 8/24/94.) if (test -f /.attbin/uname) >/dev/null 2>&1 ; then @@ -46,7 +62,8 @@ UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown -trap 'rm -f dummy.c dummy.o dummy; exit 1' 1 2 15 +dummy=dummy-$$ +trap 'rm -f $dummy.c $dummy.o $dummy; exit 1' 1 2 15 # Note: order is significant - the case branches are not exclusive. @@ -59,7 +76,7 @@ # A Tn.n version is a released field test version. # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. - cat <dummy.s + cat <$dummy.s .globl main .ent main main: @@ -76,9 +93,9 @@ ret \$31,(\$26),1 .end main EOF - ${CC-cc} dummy.s -o dummy 2>/dev/null + $CC_FOR_BUILD $dummy.s -o $dummy 2>/dev/null if test "$?" = 0 ; then - ./dummy + ./$dummy case "$?" in 7) UNAME_MACHINE="alpha" @@ -97,8 +114,14 @@ ;; esac fi - rm -f dummy.s dummy - echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[VTX]//' | tr [[A-Z]] [[a-z]]` + rm -f $dummy.s $dummy + echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[VTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` + exit 0 ;; + Alpha\ *:Windows_NT*:*) + # How do we know it's Interix rather than the generic POSIX subsystem? + # Should we change UNAME_MACHINE based on the output of uname instead + # of the specific Alpha model? + echo alpha-pc-interix exit 0 ;; 21064:Windows_NT:50:3) echo alpha-dec-winnt3.5 @@ -133,6 +156,9 @@ wgrisc:OpenBSD:*:*) echo mipsel-unknown-openbsd${UNAME_RELEASE} exit 0 ;; + *:OS/390:*:*) + echo i370-ibm-openedition + exit 0 ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit 0;; @@ -142,7 +168,7 @@ SR2?01:HI-UX/MPP:*:*) echo hppa1.1-hitachi-hiuxmpp exit 0;; - Pyramid*:OSx*:*:*|MIS*:OSx*:*:*|MIS*:SMP_DC-OSx*:*:*) + Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. if test "`(/bin/universe) 2>/dev/null`" = att ; then echo pyramid-pyramid-sysv3 @@ -150,7 +176,7 @@ echo pyramid-pyramid-bsd fi exit 0 ;; - NILE:*:*:dcosx) + NILE*:*:*:dcosx) echo pyramid-pyramid-svr4 exit 0 ;; sun4H:SunOS:5.*:*) @@ -201,6 +227,32 @@ atari*:OpenBSD:*:*) echo m68k-unknown-openbsd${UNAME_RELEASE} exit 0 ;; + # The situation for MiNT is a little confusing. The machine name + # can be virtually everything (everything which is not + # "atarist" or "atariste" at least should have a processor + # > m68000). The system name ranges from "MiNT" over "FreeMiNT" + # to the lowercase version "mint" (or "freemint"). Finally + # the system name "TOS" denotes a system which is actually not + # MiNT. But MiNT is downward compatible to TOS, so this should + # be no problem. + atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} + exit 0 ;; + atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} + exit 0 ;; + *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} + exit 0 ;; + milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) + echo m68k-milan-mint${UNAME_RELEASE} + exit 0 ;; + hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) + echo m68k-hades-mint${UNAME_RELEASE} + exit 0 ;; + *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) + echo m68k-unknown-mint${UNAME_RELEASE} + exit 0 ;; sun3*:NetBSD:*:*) echo m68k-sun-netbsd${UNAME_RELEASE} exit 0 ;; @@ -234,12 +286,16 @@ VAX*:ULTRIX*:*:*) echo vax-dec-ultrix${UNAME_RELEASE} exit 0 ;; - 2020:CLIX:*:*) + 2020:CLIX:*:* | 2430:CLIX:*:*) echo clipper-intergraph-clix${UNAME_RELEASE} exit 0 ;; mips:*:*:UMIPS | mips:*:*:RISCos) - sed 's/^ //' << EOF >dummy.c - int main (argc, argv) int argc; char **argv; { + sed 's/^ //' << EOF >$dummy.c +#ifdef __cplusplus + int main (int argc, char *argv[]) { +#else + int main (argc, argv) int argc; char *argv[]; { +#endif #if defined (host_mips) && defined (MIPSEB) #if defined (SYSTYPE_SYSV) printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0); @@ -254,10 +310,10 @@ exit (-1); } EOF - ${CC-cc} dummy.c -o dummy \ - && ./dummy `echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` \ - && rm dummy.c dummy && exit 0 - rm -f dummy.c dummy + $CC_FOR_BUILD $dummy.c -o $dummy \ + && ./$dummy `echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` \ + && rm $dummy.c $dummy && exit 0 + rm -f $dummy.c $dummy echo mips-mips-riscos${UNAME_RELEASE} exit 0 ;; Night_Hawk:Power_UNIX:*:*) @@ -275,15 +331,18 @@ AViiON:dgux:*:*) # DG/UX returns AViiON for all architectures UNAME_PROCESSOR=`/usr/bin/uname -p` - if [ $UNAME_PROCESSOR = mc88100 -o $UNAME_PROCESSOR = mc88110 ] ; then - if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx \ - -o ${TARGET_BINARY_INTERFACE}x = x ] ; then + if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110] + then + if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ + [ ${TARGET_BINARY_INTERFACE}x = x ] + then echo m88k-dg-dgux${UNAME_RELEASE} + else + echo m88k-dg-dguxbcs${UNAME_RELEASE} + fi else - echo m88k-dg-dguxbcs${UNAME_RELEASE} + echo i586-dg-dgux${UNAME_RELEASE} fi - else echo i586-dg-dgux${UNAME_RELEASE} - fi exit 0 ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 @@ -309,7 +368,7 @@ exit 0 ;; *:AIX:2:3) if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then - sed 's/^ //' << EOF >dummy.c + sed 's/^ //' << EOF >$dummy.c #include main() @@ -320,8 +379,8 @@ exit(0); } EOF - ${CC-cc} dummy.c -o dummy && ./dummy && rm dummy.c dummy && exit 0 - rm -f dummy.c dummy + $CC_FOR_BUILD $dummy.c -o $dummy && ./$dummy && rm $dummy.c $dummy && exit 0 + rm -f $dummy.c $dummy echo rs6000-ibm-aix3.2.5 elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then echo rs6000-ibm-aix3.2.4 @@ -368,25 +427,25 @@ case "${UNAME_MACHINE}" in 9000/31? ) HP_ARCH=m68000 ;; 9000/[34]?? ) HP_ARCH=m68k ;; - 9000/6?? | 9000/7?? | 9000/80[24] | 9000/8?[13679] | 9000/892 ) - sed 's/^ //' << EOF >dummy.c + 9000/[678][0-9][0-9]) + sed 's/^ //' << EOF >$dummy.c #include #include - + int main () { #if defined(_SC_KERNEL_BITS) long bits = sysconf(_SC_KERNEL_BITS); - #endif + #endif long cpu = sysconf (_SC_CPU_VERSION); - - switch (cpu) + + switch (cpu) { case CPU_PA_RISC1_0: puts ("hppa1.0"); break; case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: + case CPU_PA_RISC2_0: #if defined(_SC_KERNEL_BITS) - switch (bits) + switch (bits) { case 64: puts ("hppa2.0w"); break; case 32: puts ("hppa2.0n"); break; @@ -394,20 +453,20 @@ } break; #else /* !defined(_SC_KERNEL_BITS) */ puts ("hppa2.0"); break; - #endif + #endif default: puts ("hppa1.0"); break; } exit (0); } EOF - ${CC-cc} dummy.c -o dummy && HP_ARCH=`./dummy` - rm -f dummy.c dummy + (CCOPTS= $CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null ) && HP_ARCH=`./$dummy` + rm -f $dummy.c $dummy esac HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` echo ${HP_ARCH}-hp-hpux${HPUX_REV} exit 0 ;; 3050*:HI-UX:*:*) - sed 's/^ //' << EOF >dummy.c + sed 's/^ //' << EOF >$dummy.c #include int main () @@ -432,8 +491,8 @@ exit (0); } EOF - ${CC-cc} dummy.c -o dummy && ./dummy && rm dummy.c dummy && exit 0 - rm -f dummy.c dummy + $CC_FOR_BUILD $dummy.c -o $dummy && ./$dummy && rm $dummy.c $dummy && exit 0 + rm -f $dummy.c $dummy echo unknown-hitachi-hiuxwe2 exit 0 ;; 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) @@ -442,6 +501,9 @@ 9000/8??:4.3bsd:*:*) echo hppa1.0-hp-bsd exit 0 ;; + *9??*:MPE/iX:*:*) + echo hppa1.0-hp-mpeix + exit 0 ;; hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) echo hppa1.1-hp-osf exit 0 ;; @@ -458,6 +520,9 @@ parisc*:Lites*:*:*) echo hppa1.1-hp-lites exit 0 ;; + hppa*:OpenBSD:*:*) + echo hppa-unknown-openbsd + exit 0 ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd exit 0 ;; @@ -490,11 +555,14 @@ CRAY*TS:*:*:*) echo t90-cray-unicos${UNAME_RELEASE} exit 0 ;; + CRAY*T3E:*:*:*) + echo alpha-cray-unicosmk${UNAME_RELEASE} + exit 0 ;; CRAY-2:*:*:*) echo cray2-cray-unicos exit 0 ;; F300:UNIX_System_V:*:*) - FUJITSU_SYS=`uname -p | tr [A-Z] [a-z] | sed -e 's/\///'` + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` echo "f300-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit 0 ;; @@ -507,29 +575,47 @@ hp300:OpenBSD:*:*) echo m68k-unknown-openbsd${UNAME_RELEASE} exit 0 ;; + i?86:BSD/386:*:* | i?86:BSD/OS:*:*) + echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} + exit 0 ;; sparc*:BSD/OS:*:*) echo sparc-unknown-bsdi${UNAME_RELEASE} exit 0 ;; - i?86:BSD/386:*:* | *:BSD/OS:*:*) - echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} + *:BSD/OS:*:*) + echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit 0 ;; *:FreeBSD:*:*) + if test -x /usr/bin/objformat; then + if test "elf" = "`/usr/bin/objformat`"; then + echo ${UNAME_MACHINE}-unknown-freebsdelf`echo ${UNAME_RELEASE}|sed -e 's/[-_].*//'` + exit 0 + fi + fi echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit 0 ;; *:NetBSD:*:*) - echo ${UNAME_MACHINE}-unknown-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` + echo ${UNAME_MACHINE}-unknown-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*//'` exit 0 ;; *:OpenBSD:*:*) echo ${UNAME_MACHINE}-unknown-openbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` exit 0 ;; i*:CYGWIN*:*) - echo ${UNAME_MACHINE}-pc-cygwin32 + echo ${UNAME_MACHINE}-pc-cygwin exit 0 ;; i*:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit 0 ;; + i*:Windows_NT*:* | Pentium*:Windows_NT*:*) + # How do we know it's Interix rather than the generic POSIX subsystem? + # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we + # UNAME_MACHINE based on the output of uname instead of i386? + echo i386-pc-interix + exit 0 ;; + i*:UWIN*:*) + echo ${UNAME_MACHINE}-pc-uwin + exit 0 ;; p*:CYGWIN*:*) - echo powerpcle-unknown-cygwin32 + echo powerpcle-unknown-cygwin exit 0 ;; prep*:SunOS:5.*:*) echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` @@ -538,15 +624,11 @@ echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` exit 0 ;; *:Linux:*:*) - # uname on the ARM produces all sorts of strangeness, and we need to - # filter it out. - case "$UNAME_MACHINE" in - arm* | sa110*) UNAME_MACHINE="arm" ;; - esac # The BFD linker knows what the default object file format is, so - # first see if it will tell us. - ld_help_string=`ld --help 2>&1` + # first see if it will tell us. cd to the root directory to prevent + # problems with other programs or directories called `ld' in the path. + ld_help_string=`cd /; ld --help 2>&1` ld_supported_emulations=`echo $ld_help_string \ | sed -ne '/supported emulations:/!d s/[ ][ ]*/ /g @@ -554,16 +636,74 @@ s/ .*// p'` case "$ld_supported_emulations" in - i?86linux) echo "${UNAME_MACHINE}-pc-linux-gnuaout" ; exit 0 ;; - i?86coff) echo "${UNAME_MACHINE}-pc-linux-gnucoff" ; exit 0 ;; - sparclinux) echo "${UNAME_MACHINE}-unknown-linux-gnuaout" ; exit 0 ;; - armlinux) echo "${UNAME_MACHINE}-unknown-linux-gnuaout" ; exit 0 ;; - m68klinux) echo "${UNAME_MACHINE}-unknown-linux-gnuaout" ; exit 0 ;; - elf32ppc) echo "powerpc-unknown-linux-gnu" ; exit 0 ;; + *ia64) + echo "${UNAME_MACHINE}-unknown-linux" + exit 0 + ;; + i?86linux) + echo "${UNAME_MACHINE}-pc-linux-gnuaout" + exit 0 + ;; + i?86coff) + echo "${UNAME_MACHINE}-pc-linux-gnucoff" + exit 0 + ;; + sparclinux) + echo "${UNAME_MACHINE}-unknown-linux-gnuaout" + exit 0 + ;; + armlinux) + echo "${UNAME_MACHINE}-unknown-linux-gnuaout" + exit 0 + ;; + elf32arm*) + echo "${UNAME_MACHINE}-unknown-linux-gnu" + exit 0 + ;; + armelf_linux*) + echo "${UNAME_MACHINE}-unknown-linux-gnu" + exit 0 + ;; + m68klinux) + echo "${UNAME_MACHINE}-unknown-linux-gnuaout" + exit 0 + ;; + elf32ppc) + # Determine Lib Version + cat >$dummy.c < +#if defined(__GLIBC__) +extern char __libc_version[]; +extern char __libc_release[]; +#endif +main(argc, argv) + int argc; + char *argv[]; +{ +#if defined(__GLIBC__) + printf("%s %s\n", __libc_version, __libc_release); +#else + printf("unkown\n"); +#endif + return 0; +} +EOF + LIBC="" + $CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null + if test "$?" = 0 ; then + ./$dummy | grep 1\.99 > /dev/null + if test "$?" = 0 ; then + LIBC="libc1" + fi + fi + rm -f $dummy.c $dummy + echo powerpc-unknown-linux-gnu${LIBC} + exit 0 + ;; esac if test "${UNAME_MACHINE}" = "alpha" ; then - sed 's/^ //' <dummy.s + sed 's/^ //' <$dummy.s .globl main .ent main main: @@ -581,9 +721,9 @@ .end main EOF LIBC="" - ${CC-cc} dummy.s -o dummy 2>/dev/null + $CC_FOR_BUILD $dummy.s -o $dummy 2>/dev/null if test "$?" = 0 ; then - ./dummy + ./$dummy case "$?" in 7) UNAME_MACHINE="alpha" @@ -600,22 +740,23 @@ 16) UNAME_MACHINE="alphaev6" ;; - esac + esac - objdump --private-headers dummy | \ + objdump --private-headers $dummy | \ grep ld.so.1 > /dev/null if test "$?" = 0 ; then LIBC="libc1" fi - fi - rm -f dummy.s dummy + fi + rm -f $dummy.s $dummy echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} ; exit 0 elif test "${UNAME_MACHINE}" = "mips" ; then - cat >dummy.c <$dummy.c </dev/null && ./dummy "${UNAME_MACHINE}" && rm dummy.c dummy && exit 0 - rm -f dummy.c dummy + $CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null && ./$dummy "${UNAME_MACHINE}" && rm $dummy.c $dummy && exit 0 + rm -f $dummy.c $dummy else # Either a pre-BFD a.out linker (linux-gnuoldld) # or one that does not give us useful --help. @@ -645,12 +786,13 @@ ;; esac # Determine whether the default compiler is a.out or elf - cat >dummy.c <$dummy.c < -main(argc, argv) - int argc; - char *argv[]; -{ +#ifdef __cplusplus + int main (int argc, char *argv[]) { +#else + int main (argc, argv) int argc; char *argv[]; { +#endif #ifdef __ELF__ # ifdef __GLIBC__ # if __GLIBC__ >= 2 @@ -667,8 +809,8 @@ return 0; } EOF - ${CC-cc} dummy.c -o dummy 2>/dev/null && ./dummy "${UNAME_MACHINE}" && rm dummy.c dummy && exit 0 - rm -f dummy.c dummy + $CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null && ./$dummy "${UNAME_MACHINE}" && rm $dummy.c $dummy && exit 0 + rm -f $dummy.c $dummy fi ;; # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. earlier versions # are messed up and put the nodename in both sysname and nodename. @@ -684,10 +826,20 @@ echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} exit 0 ;; i?86:*:4.*:* | i?86:SYSTEM_V:4.*:*) + UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'` if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then - echo ${UNAME_MACHINE}-univel-sysv${UNAME_RELEASE} + echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL} else - echo ${UNAME_MACHINE}-pc-sysv${UNAME_RELEASE} + echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL} + fi + exit 0 ;; + i?86:*:5:7*) + # Fixed at (any) Pentium or better + UNAME_MACHINE=i586 + if [ ${UNAME_SYSTEM} = "UnixWare" ] ; then + echo ${UNAME_MACHINE}-sco-sysv${UNAME_RELEASE}uw${UNAME_VERSION} + else + echo ${UNAME_MACHINE}-pc-sysv${UNAME_RELEASE} fi exit 0 ;; i?86:*:3.2:*) @@ -699,18 +851,15 @@ (/bin/uname -X|egrep i80486 >/dev/null) && UNAME_MACHINE=i486 (/bin/uname -X|egrep '^Machine.*Pentium' >/dev/null) \ && UNAME_MACHINE=i586 + (/bin/uname -X|egrep '^Machine.*Pent ?II' >/dev/null) \ + && UNAME_MACHINE=i686 + (/bin/uname -X|egrep '^Machine.*Pentium Pro' >/dev/null) \ + && UNAME_MACHINE=i686 echo ${UNAME_MACHINE}-pc-sco$UNAME_REL else echo ${UNAME_MACHINE}-pc-sysv32 fi exit 0 ;; - i?86:UnixWare:*:*) - if /bin/uname -X 2>/dev/null >/dev/null ; then - (/bin/uname -X|egrep '^Machine.*Pentium' >/dev/null) \ - && UNAME_MACHINE=i586 - fi - echo ${UNAME_MACHINE}-unixware-${UNAME_RELEASE}-${UNAME_VERSION} - exit 0 ;; pc:*:*:*) # uname -m prints for DJGPP always 'pc', but it prints nothing about # the processor, so we play safe by assuming i386. @@ -752,7 +901,7 @@ mc68030:UNIX_System_V:4.*:*) echo m68k-atari-sysv4 exit 0 ;; - i?86:LynxOS:2.*:*) + i?86:LynxOS:2.*:* | i?86:LynxOS:3.[01]*:*) echo i386-unknown-lynxos${UNAME_RELEASE} exit 0 ;; TSUNAMI:LynxOS:2.*:*) @@ -764,6 +913,9 @@ SM[BE]S:UNIX_SV:*:*) echo mips-dde-sysv${UNAME_RELEASE} exit 0 ;; + RM*:ReliantUNIX-*:*:*) + echo mips-sni-sysv4 + exit 0 ;; RM*:SINIX-*:*:*) echo mips-sni-sysv4 exit 0 ;; @@ -794,7 +946,7 @@ news*:NEWS-OS:*:6*) echo mips-sony-newsos6 exit 0 ;; - R3000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R4000:UNIX_SV:*:*) + R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) if [ -d /usr/nec ]; then echo mips-nec-sysv${UNAME_RELEASE} else @@ -810,12 +962,27 @@ BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos exit 0 ;; + SX-4:SUPER-UX:*:*) + echo sx4-nec-superux${UNAME_RELEASE} + exit 0 ;; + SX-5:SUPER-UX:*:*) + echo sx5-nec-superux${UNAME_RELEASE} + exit 0 ;; + Power*:Rhapsody:*:*) + echo powerpc-apple-rhapsody${UNAME_RELEASE} + exit 0 ;; + *:Rhapsody:*:*) + echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE} + exit 0 ;; + *:QNX:*:4*) + echo i386-qnx-qnx${UNAME_VERSION} + exit 0 ;; esac #echo '(No uname command or uname output not recognized.)' 1>&2 #echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 -cat >dummy.c <$dummy.c < # include @@ -853,7 +1020,10 @@ #endif int version; version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; - printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); + if (version < 4) + printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); + else + printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); exit (0); #endif @@ -913,8 +1083,8 @@ } EOF -${CC-cc} dummy.c -o dummy 2>/dev/null && ./dummy && rm dummy.c dummy && exit 0 -rm -f dummy.c dummy +$CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null && ./$dummy && rm $dummy.c $dummy && exit 0 +rm -f $dummy.c $dummy # Apollos put the system type in the environment. diff -r f4aeb21a5bad -r 74fd4e045ea6 config.sub --- a/config.sub Mon Aug 13 11:12:06 2007 +0200 +++ b/config.sub Mon Aug 13 11:13:30 2007 +0200 @@ -1,6 +1,6 @@ #! /bin/sh # Configuration validation subroutine script, version 1.1. -# Copyright (C) 1991, 92-97, 1998 Free Software Foundation, Inc. +# Copyright (C) 1991, 92-97, 1998, 1999 Free Software Foundation, Inc. # This file is (in principle) common to ALL GNU software. # The presence of a machine in this file suggests that SOME GNU software # can handle that machine. It does not imply ALL GNU software can. @@ -98,11 +98,21 @@ os= basic_machine=$1 ;; + -sim | -cisco | -oki | -wec | -winbond) + os= + basic_machine=$1 + ;; + -scout) + ;; + -wrs) + os=-vxworks + basic_machine=$1 + ;; -hiux*) os=-hiuxwe2 ;; -sco5) - os=sco3.2v5 + os=-sco3.2v5 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco4) @@ -121,6 +131,9 @@ os=-sco3.2v2 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; + -udk*) + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; -isc) os=-isc2.2 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` @@ -143,22 +156,33 @@ -psos*) os=-psos ;; + -mint | -mint[0-9]*) + basic_machine=m68k-atari + os=-mint + ;; esac # Decode aliases for certain CPU-COMPANY combinations. case $basic_machine in # Recognize the basic CPU types without company name. # Some are omitted here because they have special meanings below. - tahoe | i860 | m32r | m68k | m68000 | m88k | ns32k | arc | arm \ + tahoe | i860 | ia64 | m32r | m68k | m68000 | m88k | ns32k | arc | arm \ | arme[lb] | pyramid | mn10200 | mn10300 | tron | a29k \ - | 580 | i960 | h8300 | hppa | hppa1.0 | hppa1.1 | hppa2.0 \ - | alpha | alphaev5 | alphaev56 | we32k | ns16k | clipper \ - | i370 | sh | powerpc | powerpcle | 1750a | dsp16xx | pdp11 \ - | mips64 | mipsel | mips64el | mips64orion | mips64orionel \ - | mipstx39 | mipstx39el \ - | sparc | sparclet | sparclite | sparc64 | v850) + | 580 | i960 | h8300 \ + | hppa | hppa1.0 | hppa1.1 | hppa2.0 | hppa2.0w | hppa2.0n \ + | alpha | alphaev[4-7] | alphaev56 | alphapca5[67] \ + | we32k | ns16k | clipper | i370 | sh | powerpc | powerpcle \ + | 1750a | dsp16xx | pdp11 | mips16 | mips64 | mipsel | mips64el \ + | mips64orion | mips64orionel | mipstx39 | mipstx39el \ + | mips64vr4300 | mips64vr4300el | mips64vr4100 | mips64vr4100el \ + | mips64vr5000 | miprs64vr5000el | mcore \ + | sparc | sparclet | sparclite | sparc64 | sparcv9 | v850 | c4x \ + | thumb | d10v | fr30) basic_machine=$basic_machine-unknown ;; + m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | z8k | v70 | h8500 | w65 | pj | pjl) + ;; + # We use `pc' rather than `unknown' # because (1) that's what they normally are, and # (2) the word "unknown" tends to confuse beginning users. @@ -171,27 +195,45 @@ exit 1 ;; # Recognize the basic CPU types with company name. - vax-* | tahoe-* | i[34567]86-* | i860-* | m32r-* | m68k-* | m68000-* \ + # FIXME: clean up the formatting here. + vax-* | tahoe-* | i[34567]86-* | i860-* | ia64-* | m32r-* | m68k-* | m68000-* \ | m88k-* | sparc-* | ns32k-* | fx80-* | arc-* | arm-* | c[123]* \ | mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* \ - | power-* | none-* | 580-* | cray2-* | h8300-* | i960-* \ - | xmp-* | ymp-* | hppa-* | hppa1.0-* | hppa1.1-* | hppa2.0-* \ - | alpha-* | alphaev5-* | alphaev56-* | we32k-* | cydra-* \ - | ns16k-* | pn-* | np1-* | xps100-* | clipper-* | orion-* \ + | power-* | none-* | 580-* | cray2-* | h8300-* | h8500-* | i960-* \ + | xmp-* | ymp-* \ + | hppa-* | hppa1.0-* | hppa1.1-* | hppa2.0-* | hppa2.0w-* | hppa2.0n-* \ + | alpha-* | alphaev[4-7]-* | alphaev56-* | alphapca5[67]-* \ + | we32k-* | cydra-* | ns16k-* | pn-* | np1-* | xps100-* \ + | clipper-* | orion-* \ | sparclite-* | pdp11-* | sh-* | powerpc-* | powerpcle-* \ - | sparc64-* | mips64-* | mipsel-* \ - | mips64el-* | mips64orion-* | mips64orionel-* \ - | mipstx39-* | mipstx39el-* \ - | f301-*) + | sparc64-* | sparcv9-* | sparc86x-* | mips16-* | mips64-* | mipsel-* \ + | mips64el-* | mips64orion-* | mips64orionel-* \ + | mips64vr4100-* | mips64vr4100el-* | mips64vr4300-* | mips64vr4300el-* \ + | mipstx39-* | mipstx39el-* | mcore-* \ + | f301-* | armv*-* | t3e-* \ + | m88110-* | m680[01234]0-* | m683?2-* | m68360-* | z8k-* | d10v-* \ + | thumb-* | v850-* | d30v-* | tic30-* | c30-* | fr30-* ) ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. + 386bsd) + basic_machine=i386-unknown + os=-bsd + ;; 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) basic_machine=m68000-att ;; 3b*) basic_machine=we32k-att ;; + a29khif) + basic_machine=a29k-amd + os=-udi + ;; + adobe68k) + basic_machine=m68010-adobe + os=-scout + ;; alliant | fx80) basic_machine=fx80-alliant ;; @@ -221,6 +263,10 @@ basic_machine=m68k-apollo os=-sysv ;; + apollo68bsd) + basic_machine=m68k-apollo + os=-bsd + ;; aux) basic_machine=m68k-apple os=-aux @@ -297,6 +343,10 @@ encore | umax | mmax) basic_machine=ns32k-encore ;; + es1800 | OSE68k | ose68k | ose | OSE) + basic_machine=m68k-ericsson + os=-ose + ;; fx2800) basic_machine=i860-alliant ;; @@ -315,6 +365,14 @@ basic_machine=h8300-hitachi os=-hms ;; + h8300xray) + basic_machine=h8300-hitachi + os=-xray + ;; + h8500hms) + basic_machine=h8500-hitachi + os=-hms + ;; harris) basic_machine=m88k-harris os=-sysv3 @@ -330,13 +388,30 @@ basic_machine=m68k-hp os=-hpux ;; + hp3k9[0-9][0-9] | hp9[0-9][0-9]) + basic_machine=hppa1.0-hp + ;; hp9k2[0-9][0-9] | hp9k31[0-9]) basic_machine=m68000-hp ;; hp9k3[2-9][0-9]) basic_machine=m68k-hp ;; - hp9k7[0-9][0-9] | hp7[0-9][0-9] | hp9k8[0-9]7 | hp8[0-9]7) + hp9k6[0-9][0-9] | hp6[0-9][0-9]) + basic_machine=hppa1.0-hp + ;; + hp9k7[0-79][0-9] | hp7[0-79][0-9]) + basic_machine=hppa1.1-hp + ;; + hp9k78[0-9] | hp78[0-9]) + # FIXME: really hppa2.0-hp + basic_machine=hppa1.1-hp + ;; + hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) + # FIXME: really hppa2.0-hp + basic_machine=hppa1.1-hp + ;; + hp9k8[0-9][13679] | hp8[0-9][13679]) basic_machine=hppa1.1-hp ;; hp9k8[0-9][0-9] | hp8[0-9][0-9]) @@ -345,9 +420,16 @@ hppa-next) os=-nextstep3 ;; + hppaosf) + basic_machine=hppa1.1-hp + os=-osf + ;; + hppro) + basic_machine=hppa1.1-hp + os=-proelf + ;; i370-ibm* | ibm*) basic_machine=i370-ibm - os=-mvs ;; # I'm not sure what "Sysv32" means. Should this be sysv3.2? i[34567]86v32) @@ -366,6 +448,25 @@ basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-solaris2 ;; + i386mach) + basic_machine=i386-mach + os=-mach + ;; + i386-vsta | vsta) + basic_machine=i386-unknown + os=-vsta + ;; + i386-go32 | go32) + basic_machine=i386-unknown + os=-go32 + ;; + i386-mingw32 | mingw32) + basic_machine=i386-unknown + os=-mingw32 + ;; + i386-qnx | qnx) + basic_machine=i386-qnx + ;; iris | iris4d) basic_machine=mips-sgi case $os in @@ -394,6 +495,10 @@ miniframe) basic_machine=m68000-convergent ;; + *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*) + basic_machine=m68k-atari + os=-mint + ;; mipsel*-linux*) basic_machine=mipsel-unknown os=-linux-gnu @@ -408,10 +513,30 @@ mips3*) basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown ;; + monitor) + basic_machine=m68k-rom68k + os=-coff + ;; + msdos) + basic_machine=i386-unknown + os=-msdos + ;; + mvs) + basic_machine=i370-ibm + os=-mvs + ;; ncr3000) basic_machine=i486-ncr os=-sysv4 ;; + netbsd386) + basic_machine=i386-unknown + os=-netbsd + ;; + netwinder) + basic_machine=armv4l-rebel + os=-linux + ;; news | news700 | news800 | news900) basic_machine=m68k-sony os=-newsos @@ -424,6 +549,10 @@ basic_machine=mips-sony os=-newsos ;; + necv70) + basic_machine=v70-nec + os=-sysv + ;; next | m*-next ) basic_machine=m68k-next case $os in @@ -449,9 +578,25 @@ basic_machine=i960-intel os=-nindy ;; + mon960) + basic_machine=i960-intel + os=-mon960 + ;; np1) basic_machine=np1-gould ;; + op50n-* | op60c-*) + basic_machine=hppa1.1-oki + os=-proelf + ;; + OSE68000 | ose68000) + basic_machine=m68000-ericsson + os=-ose + ;; + os68k) + basic_machine=m68k-none + os=-os68k + ;; pa-hitachi) basic_machine=hppa1.1-hitachi os=-hiuxwe2 @@ -469,19 +614,19 @@ pc532 | pc532-*) basic_machine=ns32k-pc532 ;; - pentium | p5 | k5 | nexen) + pentium | p5 | k5 | k6 | nexen) basic_machine=i586-pc ;; - pentiumpro | p6 | k6 | 6x86) + pentiumpro | p6 | 6x86) basic_machine=i686-pc ;; pentiumii | pentium2) basic_machine=i786-pc ;; - pentium-* | p5-* | k5-* | nexen-*) + pentium-* | p5-* | k5-* | k6-* | nexen-*) basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` ;; - pentiumpro-* | p6-* | k6-* | 6x86-*) + pentiumpro-* | p6-* | 6x86-*) basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentiumii-* | pentium2-*) @@ -505,12 +650,20 @@ ps2) basic_machine=i386-ibm ;; + rom68k) + basic_machine=m68k-rom68k + os=-coff + ;; rm[46]00) basic_machine=mips-siemens ;; rtpc | rtpc-*) basic_machine=romp-ibm ;; + sa29200) + basic_machine=a29k-amd + os=-udi + ;; sequent) basic_machine=i386-sequent ;; @@ -518,6 +671,10 @@ basic_machine=sh-hitachi os=-hms ;; + sparclite-wrs) + basic_machine=sparclite-wrs + os=-vxworks + ;; sps7) basic_machine=m68k-bull os=-sysv2 @@ -525,6 +682,13 @@ spur) basic_machine=spur-unknown ;; + st2000) + basic_machine=m68k-tandem + ;; + stratus) + basic_machine=i860-stratus + os=-sysv4 + ;; sun2) basic_machine=m68000-sun ;; @@ -569,6 +733,10 @@ basic_machine=i386-sequent os=-dynix ;; + t3e) + basic_machine=t3e-cray + os=-unicos + ;; tx39) basic_machine=mipstx39-unknown ;; @@ -586,6 +754,10 @@ basic_machine=a29k-nyu os=-sym1 ;; + v810 | necv810) + basic_machine=v810-nec + os=-none + ;; vaxv) basic_machine=vax-dec os=-sysv @@ -609,6 +781,14 @@ basic_machine=a29k-wrs os=-vxworks ;; + w65*) + basic_machine=w65-wdc + os=-none + ;; + w89k-*) + basic_machine=hppa1.1-winbond + os=-proelf + ;; xmp) basic_machine=xmp-cray os=-unicos @@ -616,6 +796,10 @@ xps | xps100) basic_machine=xps100-honeywell ;; + z8k-*-coff) + basic_machine=z8k-unknown + os=-sim + ;; none) basic_machine=none-none os=-none @@ -623,6 +807,15 @@ # Here we handle the default manufacturer of certain CPU types. It is in # some cases the only manufacturer, in others, it is the most popular. + w89k) + basic_machine=hppa1.1-winbond + ;; + op50n) + basic_machine=hppa1.1-oki + ;; + op60c) + basic_machine=hppa1.1-oki + ;; mips) if [ x$os = x-linux-gnu ]; then basic_machine=mips-unknown @@ -645,7 +838,7 @@ we32k) basic_machine=we32k-att ;; - sparc) + sparc | sparcv9) basic_machine=sparc-sun ;; cydra) @@ -657,6 +850,16 @@ orion105) basic_machine=clipper-highlevel ;; + mac | mpw | mac-mpw) + basic_machine=m68k-apple + ;; + pmac | pmac-mpw) + basic_machine=powerpc-apple + ;; + c4x*) + basic_machine=c4x-none + os=-coff + ;; *) echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 exit 1 @@ -710,13 +913,21 @@ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -netbsd* | -openbsd* | -freebsd* | -riscix* \ - | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* \ + | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -cygwin32* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -uxpv* | -beos*) + | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ + | -mingw32* | -linux-gnu* | -uxpv* | -beos* | -mpeix* | -udk* \ + | -interix* | -uwin* | -rhapsody* | -opened* | -openstep* | -oskit*) # Remember, each alternative MUST END IN *, to match a version number. ;; + -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ + | -windows* | -osx | -abug | -netware* | -os9* | -beos* \ + | -macos* | -mpw* | -magic* | -mon960* | -lnews*) + ;; + -mac*) + os=`echo $os | sed -e 's|mac|macos|'` + ;; -linux*) os=`echo $os | sed -e 's|linux|linux-gnu|'` ;; @@ -726,6 +937,9 @@ -sunos6*) os=`echo $os | sed -e 's|sunos6|solaris3|'` ;; + -opened*) + os=-openedition + ;; -osfrose*) os=-osfrose ;; @@ -741,6 +955,9 @@ -acis*) os=-aos ;; + -386bsd) + os=-bsd + ;; -ctix* | -uts*) os=-sysv ;; @@ -760,6 +977,9 @@ -oss*) os=-sysv3 ;; + -qnx) + os=-qnx4 + ;; -svr4) os=-sysv4 ;; @@ -772,9 +992,18 @@ # This must come after -sysvr4. -sysv*) ;; + -ose*) + os=-ose + ;; + -es1800*) + os=-ose + ;; -xenix) os=-xenix ;; + -*mint | -*MiNT) + os=-mint + ;; -none) ;; *) @@ -800,6 +1029,9 @@ *-acorn) os=-riscix1.2 ;; + arm*-rebel) + os=-linux + ;; arm*-semi) os=-aout ;; @@ -821,6 +1053,15 @@ # default. # os=-sunos4 ;; + m68*-cisco) + os=-aout + ;; + mips*-cisco) + os=-elf + ;; + mips*-*) + os=-elf + ;; *-tti) # must be before sparc entry or we get the wrong os. os=-sysv3 ;; @@ -833,6 +1074,15 @@ *-ibm) os=-aix ;; + *-wec) + os=-proelf + ;; + *-winbond) + os=-proelf + ;; + *-oki) + os=-proelf + ;; *-hp) os=-hpux ;; @@ -896,6 +1146,18 @@ f301-fujitsu) os=-uxpv ;; + *-rom68k) + os=-coff + ;; + *-*bug) + os=-coff + ;; + *-apple) + os=-macos + ;; + *-atari*) + os=-mint + ;; *) os=-none ;; @@ -917,9 +1179,15 @@ -aix*) vendor=ibm ;; + -beos*) + vendor=be + ;; -hpux*) vendor=hp ;; + -mpeix*) + vendor=hp + ;; -hiux*) vendor=hitachi ;; @@ -935,7 +1203,7 @@ -genix*) vendor=ns ;; - -mvs*) + -mvs* | -opened*) vendor=ibm ;; -ptx*) @@ -947,6 +1215,15 @@ -aux*) vendor=apple ;; + -hms*) + vendor=hitachi + ;; + -mpw* | -macos*) + vendor=apple + ;; + -*mint | -*MiNT) + vendor=atari + ;; esac basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` ;; diff -r f4aeb21a5bad -r 74fd4e045ea6 configure --- a/configure Mon Aug 13 11:12:06 2007 +0200 +++ b/configure Mon Aug 13 11:13:30 2007 +0200 @@ -227,25 +227,29 @@ statedir='${prefix}/lib' libdir='${exec_prefix}/lib' mandir='${prefix}/man/man1' -infodir='${datadir}/${PROGNAME}-${version}/info' +inststaticdir='${PROGNAME}' +instvardir='${PROGNAME}-${version}' +infodir='${datadir}/${instvardir}/info' infopath='' install_pp='' -lispdir='${datadir}/${PROGNAME}-${version}/lisp' -moduledir='${datadir}/${PROGNAME}-${version}/${configuration}/modules' -sitelispdir='${datadir}/xemacs/site-lisp' -sitemoduledir='${datadir}/xemacs/site-modules' -pkgdir='${datadir}/${PROGNAME}-${version}/lisp' +lispdir='${datadir}/${instvardir}/lisp' +moduledir='${datadir}/${instvardir}/${configuration}/modules' +sitelispdir='${datadir}/${inststaticdir}/site-lisp' +sitemoduledir='${datadir}/${inststaticdir}/site-modules' +pkgdir='${datadir}/${instvardir}/lisp' package_path='' -etcdir='${datadir}/${PROGNAME}-${version}/etc' -lockdir='${statedir}/${PROGNAME}/lock' -archlibdir='${datadir}/${PROGNAME}-${version}/${configuration}' +etcdir='${datadir}/${instvardir}/etc' +lockdir='${statedir}/${inststaticdir}/lock' +archlibdir='${datadir}/${instvardir}/${configuration}' +docdir='${archlibdir}' +with_prefix='yes' with_site_lisp='no' with_site_modules='yes' with_menubars='' with_scrollbars='' +with_widgets='' with_dialogs='' with_file_coding='' -puresize='' cpp='' cppflags='' libs='' ldflags='' dynamic='' with_x11='' @@ -259,6 +263,8 @@ with_tty="" use_union_type="no" with_dnet="" +pdump="no" +with_dragndrop="no" @@ -307,7 +313,8 @@ case "$opt" in with_site_lisp | \ - with_site_modules | \ + with_prefix | \ + with_site_modules | \ with_x | \ with_x11 | \ with_msw | \ @@ -326,7 +333,7 @@ with_jpeg | \ with_png | \ with_tiff | \ - with_session | \ + with_wmcommand | \ with_xmu | \ with_purify | \ with_quantify | \ @@ -351,17 +358,14 @@ external_widget | \ verbose | \ extra_verbose | \ - const_is_losing | \ usage_tracking | \ use_union_type | \ + pdump | \ debug | \ use_assertions | \ - gung_ho | \ - use_minimal_tagbits | \ - use_indexed_lrecord_implementation | \ memory_usage_stats | \ with_clash_detection | \ - with_shlib | \ + with_modules | \ no_doc_file ) case "$val" in y | ye | yes ) val=yes ;; @@ -380,7 +384,6 @@ cppflags | \ libs | \ ldflags | \ - puresize | \ cache_file | \ native_sound_lib| \ site_lisp | \ @@ -421,22 +424,22 @@ "with_database" ) with_database_berkdb=no with_database_dbm=no - with_database_gnudbm=no + with_database_gdbm=no for x in `echo "$val" | sed -e 's/,/ /g'` ; do case "$x" in - no ) ;; - b | be | ber | berk | berkd | berkdb ) with_database_berkdb=yes ;; - d | db | dbm ) with_database_dbm=yes ;; - g | gn | gnu | gnud | gnudb | gnudbm ) with_database_gnudbm=yes ;; - * ) (echo "$progname: Usage error:" + no ) ;; + b | be | ber | berk | berkd | berkdb ) with_database_berkdb=yes ;; + d | db | dbm ) with_database_dbm=yes ;; + g | gn | gnu | gnud | gnudb | gnudbm | gdbm) with_database_gdbm=yes ;; + * ) (echo "$progname: Usage error:" echo " " "The \`--$optname' option value must be either \`no' or a comma-separated list of one or more of \`berkdb' and either \`dbm' or \`gnudbm'." echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;; esac done - if test "$with_database_dbm" = "yes" -a \ - "$with_database_gnudbm" = "yes"; then + if test "$with_database_dbm" = "yes" -a \ + "$with_database_gdbm" = "yes"; then (echo "$progname: Usage error:" echo " " "Only one of \`dbm' and \`gnudbm' may be specified with the \`--$optname' option." @@ -445,15 +448,50 @@ ;; "with_sound" ) - case "$val" in - y | ye | yes ) val=native ;; - n | no | non | none ) val=no;; - na | nat | nati | nativ | native ) val=native ;; - ne | net | neta | netau | netaud | netaudi | netaudio | nas ) val=nas ;; - b | bo | bot | both ) val=both;; + for x in `echo "$val" | sed -e 's/,/ /g'` ; do + case "$x" in + n | no | non | none ) new_sdefault=no ;; + a | al | all | both ) new_sdefault=yes ;; + + native ) with_native_sound=yes ;; + nonative ) with_native_sound=no ;; + + nas ) with_nas_sound=yes ;; + nonas ) with_nas_sound=no ;; + + esd ) with_esd_sound=yes ;; + noesd ) with_esd_sound=no ;; + + * ) bogus_sound=yes ;; + esac + if test "$bogus_sound" -o \ + \( -n "$new_sdefault" -a -n "$sound_notfirst" \) ; then + types="\`all', \`none', \`(no)native', \`no(nas)', \`(no)esd'." + (echo "$progname: Usage error:" +echo " " "Valid types for the \`--$optname' option are: + $types. +The default is to autodetect all sound support." +echo " Use \`$progname --help' to show usage.") >&2 && exit 1 + elif test -n "$new_sdefault" ; then + with_native_sound=$new_sdefault + with_nas_sound=$new_sdefault + with_esd_sound=$new_sdefault + new_sdefault= # reset this + fi + sound_notfirst=true + done + ;; + + "with_athena" ) + case "$val" in + xa | xaw ) val=xaw ;; + 3 | 3d | xaw3d ) val=3d ;; + ne | nex | next | naxtaw) val=next ;; + 9 | 95 | xaw95 ) val=95 ;; + xp | xpm | xawxpm ) val=xpm ;; * ) (echo "$progname: Usage error:" echo " " "The \`--$optname' option must have one of these values: - \`native', \`nas', \`both', or \`none'." + \`xaw', \`3d', \`next', \`95', or \`xpm'." echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;; esac eval "$opt=\"$val\"" @@ -477,10 +515,11 @@ case "$val" in lockf ) val=lockf ;; flock ) val=flock ;; - file ) val=file ;; + file | dot ) val=file ;; + locking ) val=locking ;; * ) (echo "$progname: Usage error:" echo " " "The \`--$optname' option must have one of these values: - \`lockf', \`flock', or \`file'." + \`lockf', \`flock', \`file', \`locking', or \`mmdf'." echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;; esac eval "$opt=\"$val\"" @@ -508,14 +547,17 @@ malloc ) error_check_malloc=yes ;; nomalloc ) error_check_malloc=no ;; + byte_code ) error_check_byte_code=yes ;; + nobyte_code ) error_check_byte_code=no ;; + * ) bogus_error_check=yes ;; esac if test "$bogus_error_check" -o \ \( -n "$new_default" -a -n "$echeck_notfirst" \) ; then if test "$error_check_default" = yes ; then - types="\`all' (default), \`none', \`noextents', \`notypecheck', \`nobufpos', \`nogc', and \`nomalloc'." + types="\`all' (default), \`none', \`noextents', \`notypecheck', \`nobufpos', \`nogc', \`nomalloc', and \`nobyte-code'." else - types="\`all', \`none' (default), \`extents', \`typecheck', \`bufpos', \`gc', and \`malloc'." + types="\`all', \`none' (default), \`extents', \`typecheck', \`bufpos', \`gc', \`malloc', and \`byte-code'." fi (echo "$progname: Usage error:" echo " " "Valid types for the \`--$optname' option are: @@ -527,6 +569,7 @@ error_check_bufpos=$new_default error_check_gc=$new_default error_check_malloc=$new_default + error_check_byte_code=$new_default new_default= # reset this fi echeck_notfirst=true @@ -548,6 +591,14 @@ eval "$opt=\"$val\"" case "$opt" in + exec_prefix ) { test "$extra_verbose" = "yes" && cat << \EOF + Defining EXEC_PREFIX_USER_DEFINED +EOF +cat >> confdefs.h <<\EOF +#define EXEC_PREFIX_USER_DEFINED 1 +EOF +} + ;; lispdir ) { test "$extra_verbose" = "yes" && cat << \EOF Defining LISPDIR_USER_DEFINED EOF @@ -645,6 +696,14 @@ EOF } ;; + docdir ) { test "$extra_verbose" = "yes" && cat << \EOF + Defining DOCDIR_USER_DEFINED +EOF +cat >> confdefs.h <<\EOF +#define DOCDIR_USER_DEFINED 1 +EOF +} + ;; exec_prefix | libdir | archlibdir ) { test "$extra_verbose" = "yes" && cat << \EOF Defining ARCHLIBDIR_USER_DEFINED EOF @@ -662,22 +721,25 @@ "with_menubars" | \ "with_scrollbars" | \ - "with_dialogs" ) + "with_dialogs" | \ + "with_widgets" ) case "$val" in l | lu | luc | luci | lucid ) val=lucid ;; m | mo | mot | moti | motif ) val=motif ;; - athena3d | athena-3d ) val=athena3d ;; a | at | ath | athe | athen | athena ) val=athena ;; n | no | non | none ) val=no ;; * ) (echo "$progname: Usage error:" echo " " "The \`--$optname' option must have one of these values: - \`lucid', \`motif', \`athena', \`athena3d', or \`no'." + \`lucid', \`motif', \`athena', or \`no'." echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;; esac eval "$opt=\"$val\"" ;; - "run_in_place" | \ + "use_minimal_tagbits" | \ + "use_indexed_lrecord_implementation" | \ + "run_in_place" | \ + "const_is_losing" | \ "with_gnu_make" ) echo "configure: warning: Obsolete option \`--$optname' ignored." 1>&2 ;; @@ -714,19 +776,6 @@ test "$with_system_malloc" = "default" && with_system_malloc=yes fi -if test -n "$gung_ho"; then - test -z "$use_minimal_tagbits" && use_minimal_tagbits="$gung_ho" - test -z "$use_indexed_lrecord_implementation" && \ - use_indexed_lrecord_implementation="$gung_ho" -fi -if test "$use_minimal_tagbits" = "no"; then - test "$with_dlmalloc" = "yes" && \ - (echo "$progname: Usage error:" -echo " " "--with-dlmalloc requires --use-minimal-tagbits" -echo " Use \`$progname --help' to show usage.") >&2 && exit 1 - with_dlmalloc=no -fi - if test "$with_cde $with_tooltalk" = "yes no"; then @@ -783,7 +832,7 @@ fi echo $ac_n "checking whether ln -s works""... $ac_c" 1>&6 -echo "configure:787: checking whether ln -s works" >&5 +echo "configure:836: checking whether ln -s works" >&5 rm -f conftestdata if ln -s X conftestdata 2>/dev/null @@ -801,7 +850,7 @@ fi -for dir in lisp etc man info; do +for dir in lisp etc man info tests; do if test ! -d "$dir" ; then echo Making symbolic link to "$srcdir/$dir" ${LN_S} "$srcdir/$dir" "$dir" @@ -848,7 +897,7 @@ fi . "$srcdir/version.sh" || exit 1; -if test -n "$emacs_beta_version"; then beta=yes; else beta=no; fi +if test -n "$emacs_is_beta"; then beta=yes; else beta=no; fi : "${extra_verbose=$beta}" version="${emacs_major_version}.${emacs_minor_version}" { test "$extra_verbose" = "yes" && cat << EOF @@ -867,9 +916,10 @@ EOF } -if test -n "$emacs_beta_version"; then - version="${version}-b${emacs_beta_version}" - { test "$extra_verbose" = "yes" && cat << EOF +if test -n "$emacs_beta_version" ; then + if test "$beta" = "yes"; then + version="${version}-b${emacs_beta_version}" + { test "$extra_verbose" = "yes" && cat << EOF Defining EMACS_BETA_VERSION = $emacs_beta_version EOF cat >> confdefs.h <> confdefs.h <> confdefs.h <<\EOF +#define ERROR_CHECK_BYTE_CODE 1 +EOF +} + if test "${debug:=$beta}" = "yes"; then use_assertions=yes memory_usage_stats=yes extra_objs="$extra_objs debug.o" && if test "$extra_verbose" = "yes"; then echo " xemacs will be linked with \"debug.o\"" fi + extra_objs="$extra_objs tests.o" && if test "$extra_verbose" = "yes"; then + echo " xemacs will be linked with \"tests.o\"" + fi { test "$extra_verbose" = "yes" && cat << \EOF Defining DEBUG_XEMACS EOF @@ -1008,7 +1080,7 @@ echo $ac_n "checking "host system type"""... $ac_c" 1>&6 -echo "configure:1012: checking "host system type"" >&5 +echo "configure:1084: checking "host system type"" >&5 internal_configuration=`echo $configuration | sed 's/-\(workshop\)//'` canonical=`${CONFIG_SHELL-/bin/sh} $srcdir/config.sub "$internal_configuration"` configuration=`echo "$configuration" | sed 's/^\([^-][^-]*-[^-][^-]*-[^-][^-]*\)-.*$/\1/'` @@ -1026,7 +1098,9 @@ alpha*-*-* ) machine=alpha ;; vax-*-* ) machine=vax ;; mips-dec-* ) machine=pmax ;; + mips-sgi-irix6* ) machine=iris6d ;; mips-sgi-* ) machine=iris4d ;; + mips*-linux ) machine=mips ;; romp-ibm-* ) machine=ibmrt ;; rs6000-ibm-aix* ) machine=ibmrs6000 ;; powerpc-ibm-aix* ) machine=ibmrs6000 ;; @@ -1037,6 +1111,7 @@ mips-sony-* ) machine=news-risc ;; clipper-* ) machine=clipper ;; arm-* ) machine=arm ;; + armv34lb-* ) machine=arm ;; ns32k-* ) machine=ns32000 ;; esac @@ -1391,10 +1466,13 @@ else NON_GNU_CPP="/lib/cpp -D_XOPEN_SOURCE" ; fi ;; + *-sysv5* ) opsys=sco7 ;; *-386bsd* ) opsys=386bsd ;; *-freebsd* ) opsys=freebsd ;; *-nextstep* ) opsys=nextstep ;; - *-pc-cygwin32 ) opsys=cygwin32 ;; + *-pc-cygwin* ) opsys=cygwin32 ;; + *-pc-mingw* ) opsys=mingw32 ; + test -z "$with_tty" && with_tty="no";; esac ;; @@ -1498,7 +1576,7 @@ # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1502: checking for $ac_word" >&5 +echo "configure:1580: checking for $ac_word" >&5 if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1525,7 +1603,7 @@ # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1529: checking for $ac_word" >&5 +echo "configure:1607: checking for $ac_word" >&5 if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1573,7 +1651,7 @@ # Extract the first word of "cl", so it can be a program name with args. set dummy cl; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1577: checking for $ac_word" >&5 +echo "configure:1655: checking for $ac_word" >&5 if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1602,7 +1680,7 @@ fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 -echo "configure:1606: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 +echo "configure:1684: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c xe_cppflags='$CPPFLAGS $c_switch_site $c_switch_machine $c_switch_system $c_switch_x_site $X_CFLAGS' @@ -1615,12 +1693,12 @@ cat > conftest.$ac_ext << EOF -#line 1619 "configure" +#line 1697 "configure" #include "confdefs.h" main(){return(0);} EOF -if { (eval echo configure:1624: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1702: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then @@ -1648,19 +1726,19 @@ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 -echo "configure:1652: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 +echo "configure:1730: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:1657: checking whether we are using GNU C" >&5 +echo "configure:1735: checking whether we are using GNU C" >&5 cat > conftest.c <&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then +if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1742: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no @@ -1678,7 +1756,7 @@ ac_save_CFLAGS="$CFLAGS" CFLAGS= echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:1682: checking whether ${CC-cc} accepts -g" >&5 +echo "configure:1760: checking whether ${CC-cc} accepts -g" >&5 echo 'void f(){}' > conftest.c if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then @@ -1711,7 +1789,7 @@ # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1715: checking for $ac_word" >&5 +echo "configure:1793: checking for $ac_word" >&5 if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1738,7 +1816,7 @@ # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1742: checking for $ac_word" >&5 +echo "configure:1820: checking for $ac_word" >&5 if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1786,7 +1864,7 @@ # Extract the first word of "cl", so it can be a program name with args. set dummy cl; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1790: checking for $ac_word" >&5 +echo "configure:1868: checking for $ac_word" >&5 if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1815,7 +1893,7 @@ fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 -echo "configure:1819: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 +echo "configure:1897: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c xe_cppflags='$CPPFLAGS $c_switch_site $c_switch_machine $c_switch_system $c_switch_x_site $X_CFLAGS' @@ -1828,12 +1906,12 @@ cat > conftest.$ac_ext << EOF -#line 1832 "configure" +#line 1910 "configure" #include "confdefs.h" main(){return(0);} EOF -if { (eval echo configure:1837: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1915: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then @@ -1861,19 +1939,19 @@ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 -echo "configure:1865: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 +echo "configure:1943: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:1870: checking whether we are using GNU C" >&5 +echo "configure:1948: checking whether we are using GNU C" >&5 cat > conftest.c <&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then +if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1955: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no @@ -1891,7 +1969,7 @@ ac_save_CFLAGS="$CFLAGS" CFLAGS= echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:1895: checking whether ${CC-cc} accepts -g" >&5 +echo "configure:1973: checking whether ${CC-cc} accepts -g" >&5 echo 'void f(){}' > conftest.c if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then @@ -1924,7 +2002,7 @@ # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1928: checking for $ac_word" >&5 +echo "configure:2006: checking for $ac_word" >&5 if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1951,7 +2029,7 @@ # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1955: checking for $ac_word" >&5 +echo "configure:2033: checking for $ac_word" >&5 if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1999,7 +2077,7 @@ # Extract the first word of "cl", so it can be a program name with args. set dummy cl; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2003: checking for $ac_word" >&5 +echo "configure:2081: checking for $ac_word" >&5 if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -2028,7 +2106,7 @@ fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 -echo "configure:2032: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 +echo "configure:2110: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c xe_cppflags='$CPPFLAGS $c_switch_site $c_switch_machine $c_switch_system $c_switch_x_site $X_CFLAGS' @@ -2041,12 +2119,12 @@ cat > conftest.$ac_ext << EOF -#line 2045 "configure" +#line 2123 "configure" #include "confdefs.h" main(){return(0);} EOF -if { (eval echo configure:2050: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:2128: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then @@ -2074,19 +2152,19 @@ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 -echo "configure:2078: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 +echo "configure:2156: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:2083: checking whether we are using GNU C" >&5 +echo "configure:2161: checking whether we are using GNU C" >&5 cat > conftest.c <&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then +if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:2168: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no @@ -2104,7 +2182,7 @@ ac_save_CFLAGS="$CFLAGS" CFLAGS= echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:2108: checking whether ${CC-cc} accepts -g" >&5 +echo "configure:2186: checking whether ${CC-cc} accepts -g" >&5 echo 'void f(){}' > conftest.c if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then @@ -2141,7 +2219,7 @@ test -n "$NON_GNU_CPP" -a "$GCC" != "yes" -a -z "$CPP" && CPP="$NON_GNU_CPP" echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 -echo "configure:2145: checking how to run the C preprocessor" >&5 +echo "configure:2223: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= @@ -2154,13 +2232,13 @@ # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2164: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2242: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -2171,13 +2249,13 @@ rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2181: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2259: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -2188,13 +2266,13 @@ rm -rf conftest* CPP="${CC-cc} -nologo -E" cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2198: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2276: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : @@ -2218,10 +2296,12 @@ echo "$ac_t""$CPP" 1>&6 + + echo $ac_n "checking for AIX""... $ac_c" 1>&6 -echo "configure:2223: checking for AIX" >&5 -cat > conftest.$ac_ext <&5 +cat > conftest.$ac_ext <&6 -echo "configure:2252: checking for GNU libc" >&5 -cat > conftest.$ac_ext <&5 +cat > conftest.$ac_ext < int main() { @@ -2262,7 +2341,7 @@ ; return 0; } EOF -if { (eval echo configure:2266: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2345: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* have_glibc=yes else @@ -2282,9 +2361,64 @@ } - -cat > conftest.$ac_ext <> confdefs.h <<\EOF +#define __EXTENSIONS__ 1 +EOF +} + + if test "$os_release" -ge 55; then + { test "$extra_verbose" = "yes" && cat << \EOF + Defining _XOPEN_SOURCE = 500 +EOF +cat >> confdefs.h <<\EOF +#define _XOPEN_SOURCE 500 +EOF +} + + { test "$extra_verbose" = "yes" && cat << \EOF + Defining _XOPEN_SOURCE_EXTENDED +EOF +cat >> confdefs.h <<\EOF +#define _XOPEN_SOURCE_EXTENDED 1 +EOF +} + + fi ;; + linux) + { test "$extra_verbose" = "yes" && cat << \EOF + Defining _POSIX_C_SOURCE = 199506L +EOF +cat >> confdefs.h <<\EOF +#define _POSIX_C_SOURCE 199506L +EOF +} + + { test "$extra_verbose" = "yes" && cat << \EOF + Defining _XOPEN_SOURCE = 500 +EOF +cat >> confdefs.h <<\EOF +#define _XOPEN_SOURCE 500 +EOF +} + + { test "$extra_verbose" = "yes" && cat << \EOF + Defining _XOPEN_SOURCE_EXTENDED +EOF +cat >> confdefs.h <<\EOF +#define _XOPEN_SOURCE_EXTENDED 1 +EOF +} + + ;; +esac + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 +if { (eval echo configure:2434: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 then : else @@ -2469,6 +2603,18 @@ configure___ mail_use_lockf=no #endif +#ifdef MAIL_USE_LOCKING +configure___ mail_use_locking=yes +#else +configure___ mail_use_locking=no +#endif + +#ifdef HAVE_WIN32_PROCESSES +configure___ win32_processes=yes +#else +configure___ win32_processes=no +#endif + EOF CPP=`eval "echo $CPP $CPPFLAGS"` @@ -2480,14 +2626,20 @@ test "$extra_verbose" = "yes" && \ for var in libs_machine libs_system libs_termcap libs_standard objects_machine objects_system c_switch_machine c_switch_system ld_switch_machine ld_switch_system unexec ld_switch_shared ld lib_gcc ld_text_start_addr start_files ordinary_link have_terminfo mail_use_flock mail_use_lockf; do eval "echo \"$var = '\$$var'\""; done && echo "" +case "$opsys" in mingw*) mingw_include=`eval "gcc -print-file-name=libc.a"` ; + mingw_include=`eval "dirname $mingw_include"` ; + mingw_include="-I$mingw_include/../include/mingw32" ; + c_switch_system="$c_switch_system $mingw_include" && if test "$extra_verbose" = "yes"; then echo " Appending \"$mingw_include\" to \$c_switch_system"; fi ;; +esac + test "$ordinary_link" = "no" -a -z "$libs_standard" && libs_standard="-lc" test "$__DECC" = "yes" && c_switch_site="$c_switch_site -std" && if test "$extra_verbose" = "yes"; then echo " Appending \"-std\" to \$c_switch_site"; fi if test "$cflags_specified" = "no"; then if test "$GCC" = "yes"; then - CFLAGS="-g -O3 -Wall -Wno-switch" - elif test "$__SUNPRO_C" = "yes"; then + CFLAGS="-g -O3 -Wall -Wno-switch -Wpointer-arith -Winline -Wmissing-prototypes -Wshadow" + elif test "$__SUNPRO_C" = "yes"; then case "$opsys" in sol2 ) CFLAGS="-v -xO4" ;; sunos4* ) CFLAGS="-xO2";; @@ -2564,7 +2716,7 @@ fi echo $ac_n "checking for dynodump""... $ac_c" 1>&6 -echo "configure:2568: checking for dynodump" >&5 +echo "configure:2720: checking for dynodump" >&5 if test "$unexec" != "unexsol2.o"; then echo "$ac_t""no" 1>&6 else @@ -2602,12 +2754,12 @@ done echo $ac_n "checking for terminateAndUnload in -lC""... $ac_c" 1>&6 -echo "configure:2606: checking for terminateAndUnload in -lC" >&5 +echo "configure:2758: checking for terminateAndUnload in -lC" >&5 ac_lib_var=`echo C'_'terminateAndUnload | sed 'y%./+-%__p_%'` xe_check_libs=" -lC " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:2774: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -2685,16 +2837,16 @@ case "$site_prefixes" in *:* ) site_prefixes="`echo '' $site_prefixes | sed -e 's/^ //' -e 's/:/ /g'`";; esac if test -n "$site_prefixes"; then for dir in $site_prefixes; do + lib_dir="${dir}/lib" inc_dir="${dir}/include" - lib_dir="${dir}/lib" if test ! -d "$dir"; then { echo "Error:" "Invalid site prefix \`$dir': no such directory" >&2; exit 1; } - elif test ! -d "$inc_dir"; then - { echo "Error:" "Invalid site prefix \`$dir': no such directory \`$inc_dir'" >&2; exit 1; } elif test ! -d "$lib_dir"; then { echo "Error:" "Invalid site prefix \`$dir': no such directory \`$lib_dir'" >&2; exit 1; } else - c_switch_site="$c_switch_site "-I$inc_dir"" && if test "$extra_verbose" = "yes"; then echo " Appending \""-I$inc_dir"\" to \$c_switch_site"; fi + if test -d "$inc_dir"; then + c_switch_site="$c_switch_site "-I$inc_dir"" && if test "$extra_verbose" = "yes"; then echo " Appending \""-I$inc_dir"\" to \$c_switch_site"; fi + fi ld_switch_site="$ld_switch_site "-L$lib_dir"" && if test "$extra_verbose" = "yes"; then echo " Appending \""-L$lib_dir"\" to \$ld_switch_site"; fi fi done @@ -2702,7 +2854,7 @@ for dir in "/usr/ccs/lib"; do - test -d "$dir" && ld_switch_site="$ld_switch_site -L${dir}" && if test "$extra_verbose" = "yes"; then echo " Appending \"-L${dir}\" to \$ld_switch_site"; fi + test -d "$dir" && ld_switch_system="$ld_switch_system -L${dir}" && if test "$extra_verbose" = "yes"; then echo " Appending \"-L${dir}\" to \$ld_switch_system"; fi done case "$site_runtime_libraries" in *:* ) site_runtime_libraries="`echo '' $site_runtime_libraries | sed -e 's/^ //' -e 's/:/ /g'`";; esac @@ -2712,7 +2864,11 @@ fi -if test "$dynamic" = "no"; then add_runtime_path=no + + + +if test -n "$add_runtime_path"; then :; +elif test "$dynamic" = "no"; then add_runtime_path=no elif test -n "$LD_RUN_PATH"; then add_runtime_path=yes else case "$opsys" in sol2 | irix* | *bsd* | decosf* ) add_runtime_path=yes ;; @@ -2722,7 +2878,7 @@ if test "$add_runtime_path" = "yes"; then echo $ac_n "checking "for runtime libraries flag"""... $ac_c" 1>&6 -echo "configure:2726: checking "for runtime libraries flag"" >&5 +echo "configure:2882: checking "for runtime libraries flag"" >&5 case "$opsys" in sol2 ) dash_r="-R" ;; decosf* | linux* | irix*) dash_r="-rpath " ;; @@ -2744,14 +2900,14 @@ done fi cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +#line 2904 "configure" +#include "confdefs.h" + +int main() { + +; return 0; } +EOF +if { (eval echo configure:2911: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* dash_r="$try_dash_r" else @@ -2853,10 +3009,10 @@ fi after_morecore_hook_exists=yes echo $ac_n "checking for malloc_get_state""... $ac_c" 1>&6 -echo "configure:2857: checking for malloc_get_state" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3039: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_malloc_get_state=yes" else @@ -2899,10 +3055,10 @@ fi echo $ac_n "checking for malloc_set_state""... $ac_c" 1>&6 -echo "configure:2903: checking for malloc_set_state" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3085: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_malloc_set_state=yes" else @@ -2945,16 +3101,16 @@ fi echo $ac_n "checking whether __after_morecore_hook exists""... $ac_c" 1>&6 -echo "configure:2949: checking whether __after_morecore_hook exists" >&5 -cat > conftest.$ac_ext <&5 +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3114: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* echo "$ac_t""yes" 1>&6 else @@ -3013,7 +3169,7 @@ # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:3017: checking for $ac_word" >&5 +echo "configure:3173: checking for $ac_word" >&5 if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. @@ -3068,7 +3224,7 @@ # SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" # ./install, which can be erroneously created by make from ./install.sh. echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6 -echo "configure:3072: checking for a BSD compatible install" >&5 +echo "configure:3228: checking for a BSD compatible install" >&5 if test -z "$INSTALL"; then IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":" @@ -3122,7 +3278,7 @@ # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:3126: checking for $ac_word" >&5 +echo "configure:3282: checking for $ac_word" >&5 if test -n "$YACC"; then ac_cv_prog_YACC="$YACC" # Let the user override the test. @@ -3154,15 +3310,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:3158: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3166: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:3322: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -3195,15 +3351,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:3199: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3207: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:3363: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -3236,15 +3392,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:3240: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3248: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:3404: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -3274,10 +3430,10 @@ done echo $ac_n "checking for sys/wait.h that is POSIX.1 compatible""... $ac_c" 1>&6 -echo "configure:3278: checking for sys/wait.h that is POSIX.1 compatible" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #include @@ -3293,7 +3449,7 @@ s = WIFEXITED (s) ? WEXITSTATUS (s) : 1; ; return 0; } EOF -if { (eval echo configure:3297: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3453: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_header_sys_wait_h=yes else @@ -3317,10 +3473,10 @@ fi echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 -echo "configure:3321: checking for ANSI C header files" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #include @@ -3328,7 +3484,7 @@ #include EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3332: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:3488: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -3345,7 +3501,7 @@ if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext < EOF @@ -3363,7 +3519,7 @@ if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext < EOF @@ -3381,7 +3537,7 @@ if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. cat > conftest.$ac_ext < #define ISLOWER(c) ('a' <= (c) && (c) <= 'z') @@ -3392,7 +3548,7 @@ exit (0); } EOF -if { (eval echo configure:3396: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 +if { (eval echo configure:3552: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 then : else @@ -3418,10 +3574,10 @@ fi echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6 -echo "configure:3422: checking whether time.h and sys/time.h may both be included" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #include @@ -3430,7 +3586,7 @@ struct tm *tp; ; return 0; } EOF -if { (eval echo configure:3434: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3590: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_header_time=yes else @@ -3454,10 +3610,10 @@ fi echo $ac_n "checking for sys_siglist declaration in signal.h or unistd.h""... $ac_c" 1>&6 -echo "configure:3458: checking for sys_siglist declaration in signal.h or unistd.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #include @@ -3469,7 +3625,7 @@ char *msg = *(sys_siglist + 1); ; return 0; } EOF -if { (eval echo configure:3473: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3629: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_decl_sys_siglist=yes else @@ -3494,9 +3650,9 @@ echo $ac_n "checking for struct utimbuf""... $ac_c" 1>&6 -echo "configure:3498: checking for struct utimbuf" >&5 -cat > conftest.$ac_ext <&5 +cat > conftest.$ac_ext < @@ -3515,7 +3671,7 @@ static struct utimbuf x; x.actime = x.modtime; ; return 0; } EOF -if { (eval echo configure:3519: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3675: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* echo "$ac_t""yes" 1>&6 { test "$extra_verbose" = "yes" && cat << \EOF @@ -3535,10 +3691,10 @@ rm -f conftest* echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6 -echo "configure:3539: checking return type of signal handlers" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #include @@ -3555,7 +3711,7 @@ int i; ; return 0; } EOF -if { (eval echo configure:3559: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3715: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_type_signal=void else @@ -3577,10 +3733,10 @@ echo $ac_n "checking for size_t""... $ac_c" 1>&6 -echo "configure:3581: checking for size_t" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #if STDC_HEADERS @@ -3611,10 +3767,10 @@ fi echo $ac_n "checking for pid_t""... $ac_c" 1>&6 -echo "configure:3615: checking for pid_t" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #if STDC_HEADERS @@ -3645,10 +3801,10 @@ fi echo $ac_n "checking for uid_t in sys/types.h""... $ac_c" 1>&6 -echo "configure:3649: checking for uid_t in sys/types.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF @@ -3684,10 +3840,10 @@ fi echo $ac_n "checking for mode_t""... $ac_c" 1>&6 -echo "configure:3688: checking for mode_t" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #if STDC_HEADERS @@ -3718,10 +3874,10 @@ fi echo $ac_n "checking for off_t""... $ac_c" 1>&6 -echo "configure:3722: checking for off_t" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #if STDC_HEADERS @@ -3751,11 +3907,45 @@ fi +echo $ac_n "checking for ssize_t""... $ac_c" 1>&6 +echo "configure:3912: checking for ssize_t" >&5 + +cat > conftest.$ac_ext < +#if STDC_HEADERS +#include +#include +#endif +EOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + egrep "(^|[^a-zA-Z_0-9])ssize_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then + rm -rf conftest* + ac_cv_type_ssize_t=yes +else + rm -rf conftest* + ac_cv_type_ssize_t=no +fi +rm -f conftest* + +echo "$ac_t""$ac_cv_type_ssize_t" 1>&6 +if test $ac_cv_type_ssize_t = no; then + { test "$extra_verbose" = "yes" && cat << \EOF + Defining ssize_t = int +EOF +cat >> confdefs.h <<\EOF +#define ssize_t int +EOF +} + +fi + echo $ac_n "checking for struct timeval""... $ac_c" 1>&6 -echo "configure:3757: checking for struct timeval" >&5 -cat > conftest.$ac_ext <&5 +cat > conftest.$ac_ext < @@ -3771,7 +3961,7 @@ static struct timeval x; x.tv_sec = x.tv_usec; ; return 0; } EOF -if { (eval echo configure:3775: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3965: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* echo "$ac_t""yes" 1>&6 HAVE_TIMEVAL=yes @@ -3793,10 +3983,10 @@ rm -f conftest* echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6 -echo "configure:3797: checking whether struct tm is in sys/time.h or time.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #include @@ -3804,7 +3994,7 @@ struct tm *tp; tp->tm_sec; ; return 0; } EOF -if { (eval echo configure:3808: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3998: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_tm=time.h else @@ -3828,10 +4018,10 @@ fi echo $ac_n "checking for tm_zone in struct tm""... $ac_c" 1>&6 -echo "configure:3832: checking for tm_zone in struct tm" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #include <$ac_cv_struct_tm> @@ -3839,7 +4029,7 @@ struct tm tm; tm.tm_zone; ; return 0; } EOF -if { (eval echo configure:3843: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:4033: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_tm_zone=yes else @@ -3862,10 +4052,10 @@ else echo $ac_n "checking for tzname""... $ac_c" 1>&6 -echo "configure:3866: checking for tzname" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #ifndef tzname /* For SGI. */ @@ -3875,7 +4065,7 @@ atoi(*tzname); ; return 0; } EOF -if { (eval echo configure:3879: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:4069: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* ac_cv_var_tzname=yes else @@ -3901,10 +4091,10 @@ echo $ac_n "checking for working const""... $ac_c" 1>&6 -echo "configure:3905: checking for working const" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:4147: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_const=yes else @@ -3978,7 +4168,7 @@ echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 -echo "configure:3982: checking whether ${MAKE-make} sets \${MAKE}" >&5 +echo "configure:4172: checking whether ${MAKE-make} sets \${MAKE}" >&5 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` cat > conftestmake <<\EOF @@ -4003,12 +4193,12 @@ echo $ac_n "checking whether byte ordering is bigendian""... $ac_c" 1>&6 -echo "configure:4007: checking whether byte ordering is bigendian" >&5 +echo "configure:4197: checking whether byte ordering is bigendian" >&5 ac_cv_c_bigendian=unknown # See if sys/param.h defines the BYTE_ORDER macro. cat > conftest.$ac_ext < #include @@ -4019,11 +4209,11 @@ #endif ; return 0; } EOF -if { (eval echo configure:4023: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:4213: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* # It does; now see whether it defined to BIG_ENDIAN or not. cat > conftest.$ac_ext < #include @@ -4034,7 +4224,7 @@ #endif ; return 0; } EOF -if { (eval echo configure:4038: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:4228: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_bigendian=yes else @@ -4051,7 +4241,7 @@ rm -f conftest* if test $ac_cv_c_bigendian = unknown; then cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 +if { (eval echo configure:4258: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 then ac_cv_c_bigendian=no else @@ -4091,10 +4281,10 @@ echo $ac_n "checking size of short""... $ac_c" 1>&6 -echo "configure:4095: checking size of short" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < main() @@ -4105,7 +4295,7 @@ exit(0); } EOF -if { (eval echo configure:4109: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 +if { (eval echo configure:4299: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 then ac_cv_sizeof_short=`cat conftestval` else @@ -4133,10 +4323,10 @@ exit 1 fi echo $ac_n "checking size of int""... $ac_c" 1>&6 -echo "configure:4137: checking size of int" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < main() @@ -4147,7 +4337,7 @@ exit(0); } EOF -if { (eval echo configure:4151: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 +if { (eval echo configure:4341: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 then ac_cv_sizeof_int=`cat conftestval` else @@ -4169,10 +4359,10 @@ echo $ac_n "checking size of long""... $ac_c" 1>&6 -echo "configure:4173: checking size of long" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < main() @@ -4183,7 +4373,7 @@ exit(0); } EOF -if { (eval echo configure:4187: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 +if { (eval echo configure:4377: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 then ac_cv_sizeof_long=`cat conftestval` else @@ -4205,10 +4395,10 @@ echo $ac_n "checking size of long long""... $ac_c" 1>&6 -echo "configure:4209: checking size of long long" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < main() @@ -4219,7 +4409,7 @@ exit(0); } EOF -if { (eval echo configure:4223: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 +if { (eval echo configure:4413: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 then ac_cv_sizeof_long_long=`cat conftestval` else @@ -4241,10 +4431,10 @@ echo $ac_n "checking size of void *""... $ac_c" 1>&6 -echo "configure:4245: checking size of void *" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < main() @@ -4255,7 +4445,7 @@ exit(0); } EOF -if { (eval echo configure:4259: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 +if { (eval echo configure:4449: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 then ac_cv_sizeof_void_p=`cat conftestval` else @@ -4278,7 +4468,7 @@ echo $ac_n "checking for long file names""... $ac_c" 1>&6 -echo "configure:4282: checking for long file names" >&5 +echo "configure:4472: checking for long file names" >&5 ac_cv_sys_long_file_names=yes # Test for long file names in all the places we know might matter: @@ -4323,14 +4513,57 @@ fi +echo $ac_n "checking for sin""... $ac_c" 1>&6 +echo "configure:4518: checking for sin" >&5 + +cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char sin(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_sin) || defined (__stub___sin) +choke me +#else +sin(); +#endif + +; return 0; } +EOF +if { (eval echo configure:4544: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_sin=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_sin=no" +fi +rm -f conftest* + +if eval "test \"`echo '$ac_cv_func_'sin`\" = yes"; then + echo "$ac_t""yes" 1>&6 + : +else + echo "$ac_t""no" 1>&6 echo $ac_n "checking for sin in -lm""... $ac_c" 1>&6 -echo "configure:4329: checking for sin in -lm" >&5 +echo "configure:4562: checking for sin in -lm" >&5 ac_lib_var=`echo m'_'sin | sed 'y%./+-%__p_%'` xe_check_libs=" -lm " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:4578: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4355,7 +4588,7 @@ if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then echo "$ac_t""yes" 1>&6 - ac_tr_lib=HAVE_LIB`echo m | sed -e 's/[^a-zA-Z0-9_]/_/g' \ + ac_tr_lib=HAVE_LIB`echo m | sed -e 's/^a-zA-Z0-9_/_/g' \ -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` { test "$extra_verbose" = "yes" && cat << EOF Defining $ac_tr_lib @@ -4372,6 +4605,8 @@ fi +fi + { test "$extra_verbose" = "yes" && cat << \EOF Defining LISP_FLOAT_TYPE @@ -4383,14 +4618,14 @@ cat > conftest.$ac_ext < int main() { return atanh(1.0) + asinh(1.0) + acosh(1.0); ; return 0; } EOF -if { (eval echo configure:4394: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:4629: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_INVERSE_HYPERBOLIC @@ -4407,137 +4642,115 @@ rm -f conftest* echo "checking type of mail spool file locking" 1>&6 -echo "configure:4411: checking type of mail spool file locking" >&5 +echo "configure:4646: checking type of mail spool file locking" >&5 +for ac_func in lockf flock +do +echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 +echo "configure:4650: checking for $ac_func" >&5 + +cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char $ac_func(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +choke me +#else +$ac_func(); +#endif + +; return 0; } +EOF +if { (eval echo configure:4676: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_$ac_func=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_$ac_func=no" +fi +rm -f conftest* + +if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then + echo "$ac_t""yes" 1>&6 + ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` + { test "$extra_verbose" = "yes" && cat << EOF + Defining $ac_tr_func +EOF +cat >> confdefs.h <&6 +fi +done + test -z "$mail_locking" -a "$mail_use_flock" = "yes" && mail_locking=flock test -z "$mail_locking" -a "$mail_use_lockf" = "yes" && mail_locking=lockf +test -z "$mail_locking" -a "$mail_use_locking" = "yes" && mail_locking=locking if test "$mail_locking" = "lockf"; then { test "$extra_verbose" = "yes" && cat << \EOF - Defining REAL_MAIL_USE_LOCKF -EOF -cat >> confdefs.h <<\EOF -#define REAL_MAIL_USE_LOCKF 1 + Defining MAIL_LOCK_LOCKF +EOF +cat >> confdefs.h <<\EOF +#define MAIL_LOCK_LOCKF 1 EOF } elif test "$mail_locking" = "flock"; then { test "$extra_verbose" = "yes" && cat << \EOF - Defining REAL_MAIL_USE_FLOCK -EOF -cat >> confdefs.h <<\EOF -#define REAL_MAIL_USE_FLOCK 1 -EOF -} - -else mail_locking="dot-locking" -fi - - -echo $ac_n "checking for kstat_open in -lkstat""... $ac_c" 1>&6 -echo "configure:4435: checking for kstat_open in -lkstat" >&5 -ac_lib_var=`echo kstat'_'kstat_open | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lkstat " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - ac_tr_lib=HAVE_LIB`echo kstat | sed -e 's/[^a-zA-Z0-9_]/_/g' \ - -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_lib -EOF -cat >> confdefs.h <&6 -fi - - - - -echo $ac_n "checking for kvm_read in -lkvm""... $ac_c" 1>&6 -echo "configure:4485: checking for kvm_read in -lkvm" >&5 -ac_lib_var=`echo kvm'_'kvm_read | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lkvm " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - ac_tr_lib=HAVE_LIB`echo kvm | sed -e 's/[^a-zA-Z0-9_]/_/g' \ - -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_lib -EOF -cat >> confdefs.h <&6 -fi - - + Defining MAIL_LOCK_FLOCK +EOF +cat >> confdefs.h <<\EOF +#define MAIL_LOCK_FLOCK 1 +EOF +} + +elif test "$mail_locking" = "locking"; then { test "$extra_verbose" = "yes" && cat << \EOF + Defining MAIL_LOCK_LOCKING +EOF +cat >> confdefs.h <<\EOF +#define MAIL_LOCK_LOCKING 1 +EOF +} + +else mail_locking="dot-locking"; { test "$extra_verbose" = "yes" && cat << \EOF + Defining MAIL_LOCK_DOT +EOF +cat >> confdefs.h <<\EOF +#define MAIL_LOCK_DOT 1 +EOF +} + +fi +test "$mail_locking" = "lockf" -a "$ac_cv_func_lockf" != "yes" && \ + { echo "Error:" "lockf mail locking requested but not available." >&2; exit 1; } +test "$mail_locking" = "flock" -a "$ac_cv_func_flock" != "yes" && \ + { echo "Error:" "flock mail locking requested but not available." >&2; exit 1; } +test "$mail_locking" = "locking" -a "$ac_cv_func_locking" != "yes" && \ + { echo "Error:" "locking mail locking requested but not available." >&2; exit 1; } case "$opsys" in decosf*) echo $ac_n "checking for cma_open in -lpthreads""... $ac_c" 1>&6 -echo "configure:4536: checking for cma_open in -lpthreads" >&5 +echo "configure:4749: checking for cma_open in -lpthreads" >&5 ac_lib_var=`echo pthreads'_'cma_open | sed 'y%./+-%__p_%'` xe_check_libs=" -lpthreads " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:4765: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4584,7 +4797,7 @@ esac echo $ac_n "checking whether the -xildoff compiler flag is required""... $ac_c" 1>&6 -echo "configure:4588: checking whether the -xildoff compiler flag is required" >&5 +echo "configure:4801: checking whether the -xildoff compiler flag is required" >&5 if ${CC-cc} '-###' -xildon no_such_file.c 2>&1 | grep '^[^ ]*/ild ' > /dev/null ; then if ${CC-cc} '-###' -xildoff no_such_file.c 2>&1 | grep '^[^ ]*/ild ' > /dev/null ; then echo "$ac_t""no" 1>&6; @@ -4593,9 +4806,9 @@ else echo "$ac_t""no" 1>&6 fi -if test "$opsys" = "sol2" && test "$OS_RELEASE" -ge 56; then +if test "$opsys" = "sol2" -a "$os_release" -ge 56; then echo $ac_n "checking for \"-z ignore\" linker flag""... $ac_c" 1>&6 -echo "configure:4599: checking for \"-z ignore\" linker flag" >&5 +echo "configure:4812: checking for \"-z ignore\" linker flag" >&5 case "`ld -h 2>&1`" in *-z\ ignore\|record* ) echo "$ac_t""yes" 1>&6 ld_switch_site="-z ignore $ld_switch_site" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-z ignore\" to \$ld_switch_site"; fi ;; @@ -4605,7 +4818,7 @@ echo "checking "for specified window system"" 1>&6 -echo "configure:4609: checking "for specified window system"" >&5 +echo "configure:4822: checking "for specified window system"" >&5 if test "$with_x11" != "no"; then test "$x_includes $x_libraries" != "NONE NONE" && \ @@ -4638,7 +4851,7 @@ # Uses ac_ vars as temps to allow command line to override cache and checks. # --without-x overrides everything else, but does not touch the cache. echo $ac_n "checking for X""... $ac_c" 1>&6 -echo "configure:4642: checking for X" >&5 +echo "configure:4855: checking for X" >&5 # Check whether --with-x or --without-x was given. if test "${with_x+set}" = set; then @@ -4698,12 +4911,12 @@ # First, try using that file with no special directory specified. cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:4707: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:4920: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -4772,14 +4985,14 @@ ac_save_LIBS="$LIBS" LIBS="-l$x_direct_test_library $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:4996: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* LIBS="$ac_save_LIBS" # We can link X programs with no special library path. @@ -4888,17 +5101,17 @@ case "`(uname -sr) 2>/dev/null`" in "SunOS 5"*) echo $ac_n "checking whether -R must be followed by a space""... $ac_c" 1>&6 -echo "configure:4892: checking whether -R must be followed by a space" >&5 +echo "configure:5105: checking whether -R must be followed by a space" >&5 ac_xsave_LIBS="$LIBS"; LIBS="$LIBS -R$x_libraries" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +#line 5108 "configure" +#include "confdefs.h" + +int main() { + +; return 0; } +EOF +if { (eval echo configure:5115: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* ac_R_nospace=yes else @@ -4914,14 +5127,14 @@ else LIBS="$ac_xsave_LIBS -R $x_libraries" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +#line 5131 "configure" +#include "confdefs.h" + +int main() { + +; return 0; } +EOF +if { (eval echo configure:5138: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* ac_R_space=yes else @@ -4957,12 +5170,12 @@ else echo $ac_n "checking for dnet_ntoa in -ldnet""... $ac_c" 1>&6 -echo "configure:4961: checking for dnet_ntoa in -ldnet" >&5 +echo "configure:5174: checking for dnet_ntoa in -ldnet" >&5 ac_lib_var=`echo dnet'_'dnet_ntoa | sed 'y%./+-%__p_%'` xe_check_libs=" -ldnet " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:5190: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4997,12 +5210,12 @@ if test $ac_cv_lib_dnet_dnet_ntoa = no; then echo $ac_n "checking for dnet_ntoa in -ldnet_stub""... $ac_c" 1>&6 -echo "configure:5001: checking for dnet_ntoa in -ldnet_stub" >&5 +echo "configure:5214: checking for dnet_ntoa in -ldnet_stub" >&5 ac_lib_var=`echo dnet_stub'_'dnet_ntoa | sed 'y%./+-%__p_%'` xe_check_libs=" -ldnet_stub " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:5230: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5042,10 +5255,10 @@ # The nsl library prevents programs from opening the X display # on Irix 5.2, according to dickey@clark.net. echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6 -echo "configure:5046: checking for gethostbyname" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:5285: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_gethostbyname=yes" else @@ -5089,12 +5302,12 @@ if test $ac_cv_func_gethostbyname = no; then echo $ac_n "checking for gethostbyname in -lnsl""... $ac_c" 1>&6 -echo "configure:5093: checking for gethostbyname in -lnsl" >&5 +echo "configure:5306: checking for gethostbyname in -lnsl" >&5 ac_lib_var=`echo nsl'_'gethostbyname | sed 'y%./+-%__p_%'` xe_check_libs=" -lnsl " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:5322: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5135,10 +5348,10 @@ # -lsocket must be given before -lnsl if both are needed. # We assume that if connect needs -lnsl, so does gethostbyname. echo $ac_n "checking for connect""... $ac_c" 1>&6 -echo "configure:5139: checking for connect" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:5378: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_connect=yes" else @@ -5184,12 +5397,12 @@ xe_msg_checking="for connect in -lsocket" test -n "$X_EXTRA_LIBS" && xe_msg_checking="$xe_msg_checking using extra libs $X_EXTRA_LIBS" echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:5188: checking "$xe_msg_checking"" >&5 +echo "configure:5401: checking "$xe_msg_checking"" >&5 ac_lib_var=`echo socket'_'connect | sed 'y%./+-%__p_%'` xe_check_libs=" -lsocket $X_EXTRA_LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:5417: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5224,10 +5437,10 @@ # gomez@mi.uni-erlangen.de says -lposix is necessary on A/UX. echo $ac_n "checking for remove""... $ac_c" 1>&6 -echo "configure:5228: checking for remove" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:5467: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_remove=yes" else @@ -5271,12 +5484,12 @@ if test $ac_cv_func_remove = no; then echo $ac_n "checking for remove in -lposix""... $ac_c" 1>&6 -echo "configure:5275: checking for remove in -lposix" >&5 +echo "configure:5488: checking for remove in -lposix" >&5 ac_lib_var=`echo posix'_'remove | sed 'y%./+-%__p_%'` xe_check_libs=" -lposix " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:5504: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5311,10 +5524,10 @@ # BSDI BSD/OS 2.1 needs -lipc for XOpenDisplay. echo $ac_n "checking for shmat""... $ac_c" 1>&6 -echo "configure:5315: checking for shmat" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:5554: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_shmat=yes" else @@ -5358,12 +5571,12 @@ if test $ac_cv_func_shmat = no; then echo $ac_n "checking for shmat in -lipc""... $ac_c" 1>&6 -echo "configure:5362: checking for shmat in -lipc" >&5 +echo "configure:5575: checking for shmat in -lipc" >&5 ac_lib_var=`echo ipc'_'shmat | sed 'y%./+-%__p_%'` xe_check_libs=" -lipc " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:5591: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5410,12 +5623,12 @@ xe_msg_checking="for IceConnectionNumber in -lICE" test -n "$X_EXTRA_LIBS" && xe_msg_checking="$xe_msg_checking using extra libs $X_EXTRA_LIBS" echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:5414: checking "$xe_msg_checking"" >&5 +echo "configure:5627: checking "$xe_msg_checking"" >&5 ac_lib_var=`echo ICE'_'IceConnectionNumber | sed 'y%./+-%__p_%'` xe_check_libs=" -lICE $X_EXTRA_LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:5643: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5595,7 +5808,7 @@ echo "checking for X defines extracted by xmkmf" 1>&6 -echo "configure:5599: checking for X defines extracted by xmkmf" >&5 +echo "configure:5812: checking for X defines extracted by xmkmf" >&5 rm -fr conftestdir if mkdir conftestdir; then cd conftestdir @@ -5627,15 +5840,15 @@ ac_safe=`echo "X11/Intrinsic.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for X11/Intrinsic.h""... $ac_c" 1>&6 -echo "configure:5631: checking for X11/Intrinsic.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5639: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5852: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -5659,12 +5872,12 @@ echo $ac_n "checking for XOpenDisplay in -lX11""... $ac_c" 1>&6 -echo "configure:5663: checking for XOpenDisplay in -lX11" >&5 +echo "configure:5876: checking for XOpenDisplay in -lX11" >&5 ac_lib_var=`echo X11'_'XOpenDisplay | sed 'y%./+-%__p_%'` xe_check_libs=" -lX11 " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:5892: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5700,12 +5913,12 @@ xe_msg_checking="for XGetFontProperty in -lX11" test -n "-b i486-linuxaout" && xe_msg_checking="$xe_msg_checking using extra libs -b i486-linuxaout" echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:5704: checking "$xe_msg_checking"" >&5 +echo "configure:5917: checking "$xe_msg_checking"" >&5 ac_lib_var=`echo X11'_'XGetFontProperty | sed 'y%./+-%__p_%'` xe_check_libs=" -lX11 -b i486-linuxaout" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:5933: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5743,12 +5956,12 @@ echo $ac_n "checking for XShapeSelectInput in -lXext""... $ac_c" 1>&6 -echo "configure:5747: checking for XShapeSelectInput in -lXext" >&5 +echo "configure:5960: checking for XShapeSelectInput in -lXext" >&5 ac_lib_var=`echo Xext'_'XShapeSelectInput | sed 'y%./+-%__p_%'` xe_check_libs=" -lXext " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:5976: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5782,12 +5995,12 @@ echo $ac_n "checking for XtOpenDisplay in -lXt""... $ac_c" 1>&6 -echo "configure:5786: checking for XtOpenDisplay in -lXt" >&5 +echo "configure:5999: checking for XtOpenDisplay in -lXt" >&5 ac_lib_var=`echo Xt'_'XtOpenDisplay | sed 'y%./+-%__p_%'` xe_check_libs=" -lXt " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:6015: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5821,14 +6034,14 @@ echo $ac_n "checking the version of X11 being used""... $ac_c" 1>&6 -echo "configure:5825: checking the version of X11 being used" >&5 +echo "configure:6038: checking the version of X11 being used" >&5 cat > conftest.$ac_ext < int main(int c, char *v[]) { return c>1 ? XlibSpecificationRelease : 0; } EOF -if { (eval echo configure:5832: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 +if { (eval echo configure:6045: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 then ./conftest foobar; x11_release=$? else @@ -5849,19 +6062,76 @@ } + for ac_func in XConvertCase +do +echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 +echo "configure:6069: checking for $ac_func" >&5 + +cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char $ac_func(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +choke me +#else +$ac_func(); +#endif + +; return 0; } +EOF +if { (eval echo configure:6095: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_$ac_func=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_$ac_func=no" +fi +rm -f conftest* + +if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then + echo "$ac_t""yes" 1>&6 + ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` + { test "$extra_verbose" = "yes" && cat << EOF + Defining $ac_tr_func +EOF +cat >> confdefs.h <&6 +fi +done + + for ac_hdr in X11/Xlocale.h do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:5857: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5865: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6135: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -5892,7 +6162,7 @@ echo $ac_n "checking for XFree86""... $ac_c" 1>&6 -echo "configure:5896: checking for XFree86" >&5 +echo "configure:6166: checking for XFree86" >&5 if test -d "/usr/X386/include" -o \ -f "/etc/XF86Config" -o \ -f "/etc/X11/XF86Config" -o \ @@ -5912,12 +6182,12 @@ test -z "$with_xmu" && { echo $ac_n "checking for XmuReadBitmapDataFromFile in -lXmu""... $ac_c" 1>&6 -echo "configure:5916: checking for XmuReadBitmapDataFromFile in -lXmu" >&5 +echo "configure:6186: checking for XmuReadBitmapDataFromFile in -lXmu" >&5 ac_lib_var=`echo Xmu'_'XmuReadBitmapDataFromFile | sed 'y%./+-%__p_%'` xe_check_libs=" -lXmu " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:6202: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5967,19 +6237,19 @@ echo $ac_n "checking for main in -lXbsd""... $ac_c" 1>&6 -echo "configure:5971: checking for main in -lXbsd" >&5 +echo "configure:6241: checking for main in -lXbsd" >&5 ac_lib_var=`echo Xbsd'_'main | sed 'y%./+-%__p_%'` xe_check_libs=" -lXbsd " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:6253: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6016,22 +6286,22 @@ fi if test "$with_msw" != "no"; then echo "checking for MS-Windows" 1>&6 -echo "configure:6020: checking for MS-Windows" >&5 +echo "configure:6290: checking for MS-Windows" >&5 echo $ac_n "checking for main in -lgdi32""... $ac_c" 1>&6 -echo "configure:6023: checking for main in -lgdi32" >&5 +echo "configure:6293: checking for main in -lgdi32" >&5 ac_lib_var=`echo gdi32'_'main | sed 'y%./+-%__p_%'` xe_check_libs=" -lgdi32 " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:6305: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6061,7 +6331,7 @@ } install_pp="$blddir/lib-src/installexe.sh" - libs_system="$libs_system -lshell32 -lgdi32 -luser32 -lcomctl32" && if test "$extra_verbose" = "yes"; then echo " Appending \"-lshell32 -lgdi32 -luser32 -lcomctl32\" to \$libs_system"; fi + libs_system="$libs_system -lshell32 -lgdi32 -luser32 -lcomctl32 -lwinspool" && if test "$extra_verbose" = "yes"; then echo " Appending \"-lshell32 -lgdi32 -luser32 -lcomctl32 -lwinspool\" to \$libs_system"; fi test "$with_dragndrop" != no && dragndrop_proto="$dragndrop_proto msw" && if test "$extra_verbose" = "yes"; then echo " Appending \"msw\" to \$dragndrop_proto"; fi if test "$window_system" != x11; then window_system=msw @@ -6081,6 +6351,7 @@ && extra_objs="$extra_objs dialog-msw.o" && if test "$extra_verbose" = "yes"; then echo " xemacs will be linked with \"dialog-msw.o\"" fi + test "$with_widgets" != "no" && with_widgets=msw else test "$with_scrollbars" != "no" && extra_objs="$extra_objs scrollbar-msw.o" && if test "$extra_verbose" = "yes"; then echo " xemacs will be linked with \"scrollbar-msw.o\"" @@ -6096,12 +6367,12 @@ fi fi cat > conftest.$ac_ext < int main() { return (open("/dev/windows", O_RDONLY, 0) > 0)? 0 : 1; } EOF -if { (eval echo configure:6105: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 +if { (eval echo configure:6376: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 then { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_MSG_SELECT @@ -6117,10 +6388,7 @@ cat conftest.$ac_ext >&5 fi rm -fr conftest* - const_is_losing=no with_file_coding=yes - use_minimal_tagbits=yes - use_indexed_lrecord_implementation=yes extra_objs="$extra_objs console-msw.o device-msw.o event-msw.o frame-msw.o objects-msw.o select-msw.o redisplay-msw.o glyphs-msw.o gui-msw.o" && if test "$extra_verbose" = "yes"; then echo " xemacs will be linked with \"console-msw.o device-msw.o event-msw.o frame-msw.o objects-msw.o select-msw.o redisplay-msw.o glyphs-msw.o gui-msw.o\"" fi @@ -6156,7 +6424,7 @@ fi if test "$with_x11" != "yes"; then - for feature in tooltalk cde offix session xim xmu + for feature in tooltalk cde offix wmcommand xim xmu nas_sound do if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then echo "configure: warning: --with-$feature ignored: Not valid without X support" 1>&2 @@ -6178,14 +6446,14 @@ test "$opsys" = "hpux9-shr" && opsysfile="s/hpux9shxr4.h" esac -echo "checking for session-management option" 1>&6 -echo "configure:6183: checking for session-management option" >&5; -if test "$with_session" != "no"; then +echo "checking for WM_COMMAND option" 1>&6 +echo "configure:6451: checking for WM_COMMAND option" >&5; +if test "$with_wmcommand" != "no"; then { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_SESSION -EOF -cat >> confdefs.h <<\EOF -#define HAVE_SESSION 1 + Defining HAVE_WMCOMMAND +EOF +cat >> confdefs.h <<\EOF +#define HAVE_WMCOMMAND 1 EOF } @@ -6194,15 +6462,15 @@ test -z "$with_xauth" && test "$window_system" = "none" && with_xauth=no test -z "$with_xauth" && { ac_safe=`echo "X11/Xauth.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for X11/Xauth.h""... $ac_c" 1>&6 -echo "configure:6198: checking for X11/Xauth.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6206: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6474: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -6225,12 +6493,12 @@ } test -z "$with_xauth" && { echo $ac_n "checking for XauGetAuthByAddr in -lXau""... $ac_c" 1>&6 -echo "configure:6229: checking for XauGetAuthByAddr in -lXau" >&5 +echo "configure:6497: checking for XauGetAuthByAddr in -lXau" >&5 ac_lib_var=`echo Xau'_'XauGetAuthByAddr | sed 'y%./+-%__p_%'` xe_check_libs=" -lXau " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:6513: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6286,15 +6554,15 @@ for dir in "" "Tt/" "desktop/" ; do ac_safe=`echo "${dir}tt_c.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ${dir}tt_c.h""... $ac_c" 1>&6 -echo "configure:6290: checking for ${dir}tt_c.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6298: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6566: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -6330,12 +6598,12 @@ xe_msg_checking="for tt_message_create in -ltt" test -n "$extra_libs" && xe_msg_checking="$xe_msg_checking using extra libs $extra_libs" echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:6334: checking "$xe_msg_checking"" >&5 +echo "configure:6602: checking "$xe_msg_checking"" >&5 ac_lib_var=`echo tt'_'tt_message_create | sed 'y%./+-%__p_%'` xe_check_libs=" -ltt $extra_libs" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:6618: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6403,15 +6671,15 @@ test -z "$with_cde" && { ac_safe=`echo "Dt/Dt.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for Dt/Dt.h""... $ac_c" 1>&6 -echo "configure:6407: checking for Dt/Dt.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6415: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6683: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -6434,12 +6702,12 @@ } test -z "$with_cde" && { echo $ac_n "checking for DtDndDragStart in -lDtSvc""... $ac_c" 1>&6 -echo "configure:6438: checking for DtDndDragStart in -lDtSvc" >&5 +echo "configure:6706: checking for DtDndDragStart in -lDtSvc" >&5 ac_lib_var=`echo DtSvc'_'DtDndDragStart | sed 'y%./+-%__p_%'` xe_check_libs=" -lDtSvc " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:6722: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6519,7 +6787,7 @@ fi echo $ac_n "checking if drag and drop API is needed""... $ac_c" 1>&6 -echo "configure:6523: checking if drag and drop API is needed" >&5 +echo "configure:6791: checking if drag and drop API is needed" >&5 if test "$with_dragndrop" != "no" ; then if test -n "$dragndrop_proto" ; then with_dragndrop=yes @@ -6540,18 +6808,18 @@ fi echo "checking for LDAP" 1>&6 -echo "configure:6544: checking for LDAP" >&5 +echo "configure:6812: checking for LDAP" >&5 test -z "$with_ldap" && { ac_safe=`echo "ldap.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ldap.h""... $ac_c" 1>&6 -echo "configure:6547: checking for ldap.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6555: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6823: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -6574,15 +6842,15 @@ } test -z "$with_ldap" && { ac_safe=`echo "lber.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for lber.h""... $ac_c" 1>&6 -echo "configure:6578: checking for lber.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6586: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6854: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -6604,16 +6872,55 @@ fi } if test "$with_ldap" != "no"; then - test -z "$with_umich_ldap" && { + +echo $ac_n "checking for ldap_search in -lldap""... $ac_c" 1>&6 +echo "configure:6878: checking for ldap_search in -lldap" >&5 +ac_lib_var=`echo ldap'_'ldap_search | sed 'y%./+-%__p_%'` + +xe_check_libs=" -lldap " +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=no" +fi +rm -f conftest* +xe_check_libs="" + +if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then + echo "$ac_t""yes" 1>&6 + with_ldap_nolber=yes +else + echo "$ac_t""no" 1>&6 +with_ldap_nolber=no +fi + + + test "$with_ldap_nolber" = "no" && { xe_msg_checking="for ldap_open in -lldap" test -n "-llber" && xe_msg_checking="$xe_msg_checking using extra libs -llber" echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:6612: checking "$xe_msg_checking"" >&5 +echo "configure:6919: checking "$xe_msg_checking"" >&5 ac_lib_var=`echo ldap'_'ldap_open | sed 'y%./+-%__p_%'` xe_check_libs=" -lldap -llber" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:6935: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6638,32 +6945,34 @@ if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then echo "$ac_t""yes" 1>&6 - with_umich_ldap=yes -else - echo "$ac_t""no" 1>&6 -with_umich_ldap=no + with_ldap_lber=yes +else + echo "$ac_t""no" 1>&6 +with_ldap_lber=no fi } - test "$with_umich_ldap" = "no" && { -echo $ac_n "checking for ldap_set_option in -lldap10""... $ac_c" 1>&6 -echo "configure:6651: checking for ldap_set_option in -lldap10" >&5 -ac_lib_var=`echo ldap10'_'ldap_set_option | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lldap10 " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + test "$with_ldap_nolber" = "no" -a "$with_ldap_lber" = "no" && { +xe_msg_checking="for ldap_open in -lldap" +test -n "-llber -lkrb" && xe_msg_checking="$xe_msg_checking using extra libs -llber -lkrb" +echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 +echo "configure:6960: checking "$xe_msg_checking"" >&5 +ac_lib_var=`echo ldap'_'ldap_open | sed 'y%./+-%__p_%'` + +xe_check_libs=" -lldap -llber -lkrb" +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6677,14 +6986,55 @@ if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then echo "$ac_t""yes" 1>&6 - with_ns_ldap=yes -else - echo "$ac_t""no" 1>&6 -with_ns_ldap=no + with_ldap_krb=yes +else + echo "$ac_t""no" 1>&6 +with_ldap_krb=no fi } - test -z "$with_ldap" -a \( "$with_umich_ldap" = "yes" -o "$with_ns_ldap" = "yes" \) && with_ldap=yes + test "$with_ldap_nolber" = "no" -a "$with_ldap_lber" = "no" -a "$with_ldap_krb" = "no" && { +xe_msg_checking="for ldap_open in -lldap" +test -n "-llber -lkrb -ldes" && xe_msg_checking="$xe_msg_checking using extra libs -llber -lkrb -ldes" +echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 +echo "configure:7001: checking "$xe_msg_checking"" >&5 +ac_lib_var=`echo ldap'_'ldap_open | sed 'y%./+-%__p_%'` + +xe_check_libs=" -lldap -llber -lkrb -ldes" +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=no" +fi +rm -f conftest* +xe_check_libs="" + +if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then + echo "$ac_t""yes" 1>&6 + with_ldap_krbdes=yes +else + echo "$ac_t""no" 1>&6 +with_ldap_krbdes=no +fi + + } + test -z "$with_ldap" -a \( "$with_ldap_lber" = "yes" -o "$with_ldap_nolber" = "yes" -o "$with_ldap_krb" = "yes" -o "$with_ldap_krbdes" = "yes" \) && with_ldap=yes fi if test "$with_ldap" = "yes"; then { test "$extra_verbose" = "yes" && cat << \EOF @@ -6698,52 +7048,98 @@ extra_objs="$extra_objs eldap.o" && if test "$extra_verbose" = "yes"; then echo " xemacs will be linked with \"eldap.o\"" fi - if test "$with_umich_ldap" = "yes" ; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_UMICH_LDAP -EOF -cat >> confdefs.h <<\EOF -#define HAVE_UMICH_LDAP 1 -EOF -} - + if test "$with_ldap_nolber" = "yes" ; then + LIBS="-lldap $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lldap\" to \$LIBS"; fi + else + if test "$with_ldap_krb" = "yes" ; then + LIBS="-lkrb $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lkrb\" to \$LIBS"; fi + fi + if test "$with_ldap_krbdes" = "yes" ; then + LIBS="-ldes $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-ldes\" to \$LIBS"; fi + LIBS="-lkrb $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lkrb\" to \$LIBS"; fi + fi LIBS="-llber $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-llber\" to \$LIBS"; fi LIBS="-lldap $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lldap\" to \$LIBS"; fi - elif test "$with_ldap" = "yes" -a "$with_ns_ldap" = "yes" ; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_NS_LDAP -EOF -cat >> confdefs.h <<\EOF -#define HAVE_NS_LDAP 1 -EOF -} - - LIBS="-lldap10 $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lldap10\" to \$LIBS"; fi - elif test "$with_ldap" = "yes" ; then - LIBS="-lldap $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lldap\" to \$LIBS"; fi - fi + fi + for ac_func in ldap_set_option ldap_get_lderrno ldap_result2error ldap_parse_result +do +echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 +echo "configure:7068: checking for $ac_func" >&5 + +cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char $ac_func(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +choke me +#else +$ac_func(); +#endif + +; return 0; } +EOF +if { (eval echo configure:7094: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_$ac_func=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_$ac_func=no" +fi +rm -f conftest* + +if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then + echo "$ac_t""yes" 1>&6 + ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` + { test "$extra_verbose" = "yes" && cat << EOF + Defining $ac_tr_func +EOF +cat >> confdefs.h <&6 +fi +done + fi if test "$window_system" != "none"; then echo "checking for graphics libraries" 1>&6 -echo "configure:6731: checking for graphics libraries" >&5 +echo "configure:7126: checking for graphics libraries" >&5 xpm_problem="" if test -z "$with_xpm"; then echo $ac_n "checking for Xpm - no older than 3.4f""... $ac_c" 1>&6 -echo "configure:6736: checking for Xpm - no older than 3.4f" >&5 +echo "configure:7131: checking for Xpm - no older than 3.4f" >&5 xe_check_libs=-lXpm cat > conftest.$ac_ext < int main(int c, char **v) { return c == 1 ? 0 : XpmIncludeVersion != XpmLibraryVersion() ? 1 : XpmIncludeVersion < 30406 ? 2 : 0 ;} EOF -if { (eval echo configure:6747: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 +if { (eval echo configure:7143: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 then ./conftest dummy_arg; xpm_status=$?; if test "$xpm_status" = "0"; then @@ -6785,17 +7181,17 @@ libs_x="-lXpm $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lXpm\" to \$libs_x"; fi echo $ac_n "checking for \"FOR_MSW\" xpm""... $ac_c" 1>&6 -echo "configure:6789: checking for \"FOR_MSW\" xpm" >&5 +echo "configure:7185: checking for \"FOR_MSW\" xpm" >&5 xe_check_libs=-lXpm cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:7195: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* xpm_for_msw=no else @@ -6821,15 +7217,15 @@ test -z "$with_xface" && { ac_safe=`echo "compface.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for compface.h""... $ac_c" 1>&6 -echo "configure:6825: checking for compface.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6833: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:7229: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -6852,12 +7248,12 @@ } test -z "$with_xface" && { echo $ac_n "checking for UnGenFace in -lcompface""... $ac_c" 1>&6 -echo "configure:6856: checking for UnGenFace in -lcompface" >&5 +echo "configure:7252: checking for UnGenFace in -lcompface" >&5 ac_lib_var=`echo compface'_'UnGenFace | sed 'y%./+-%__p_%'` xe_check_libs=" -lcompface " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:7268: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6920,12 +7316,12 @@ if test "$with_png $with_tiff" != "no no"; then echo $ac_n "checking for inflate in -lc""... $ac_c" 1>&6 -echo "configure:6924: checking for inflate in -lc" >&5 +echo "configure:7320: checking for inflate in -lc" >&5 ac_lib_var=`echo c'_'inflate | sed 'y%./+-%__p_%'` xe_check_libs=" -lc " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:7336: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6955,12 +7351,12 @@ echo "$ac_t""no" 1>&6 echo $ac_n "checking for inflate in -lz""... $ac_c" 1>&6 -echo "configure:6959: checking for inflate in -lz" >&5 +echo "configure:7355: checking for inflate in -lz" >&5 ac_lib_var=`echo z'_'inflate | sed 'y%./+-%__p_%'` xe_check_libs=" -lz " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:7371: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6990,12 +7386,12 @@ echo "$ac_t""no" 1>&6 echo $ac_n "checking for inflate in -lgz""... $ac_c" 1>&6 -echo "configure:6994: checking for inflate in -lgz" >&5 +echo "configure:7390: checking for inflate in -lgz" >&5 ac_lib_var=`echo gz'_'inflate | sed 'y%./+-%__p_%'` xe_check_libs=" -lgz " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:7406: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -7036,15 +7432,15 @@ test -z "$with_jpeg" && { ac_safe=`echo "jpeglib.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for jpeglib.h""... $ac_c" 1>&6 -echo "configure:7040: checking for jpeglib.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:7048: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:7444: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -7067,12 +7463,12 @@ } test -z "$with_jpeg" && { echo $ac_n "checking for jpeg_destroy_decompress in -ljpeg""... $ac_c" 1>&6 -echo "configure:7071: checking for jpeg_destroy_decompress in -ljpeg" >&5 +echo "configure:7467: checking for jpeg_destroy_decompress in -ljpeg" >&5 ac_lib_var=`echo jpeg'_'jpeg_destroy_decompress | sed 'y%./+-%__p_%'` xe_check_libs=" -ljpeg " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:7483: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -7119,10 +7515,10 @@ png_problem="" test -z "$with_png" && { echo $ac_n "checking for pow""... $ac_c" 1>&6 -echo "configure:7123: checking for pow" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:7545: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_pow=yes" else @@ -7166,15 +7562,15 @@ } test -z "$with_png" && { ac_safe=`echo "png.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for png.h""... $ac_c" 1>&6 -echo "configure:7170: checking for png.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:7178: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:7574: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -7197,12 +7593,12 @@ } test -z "$with_png" && { echo $ac_n "checking for png_read_image in -lpng""... $ac_c" 1>&6 -echo "configure:7201: checking for png_read_image in -lpng" >&5 +echo "configure:7597: checking for png_read_image in -lpng" >&5 ac_lib_var=`echo png'_'png_read_image | sed 'y%./+-%__p_%'` xe_check_libs=" -lpng " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:7613: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -7236,10 +7632,10 @@ } if test -z "$with_png"; then echo $ac_n "checking for workable png version information""... $ac_c" 1>&6 -echo "configure:7240: checking for workable png version information" >&5 +echo "configure:7636: checking for workable png version information" >&5 xe_check_libs="-lpng -lz" cat > conftest.$ac_ext < int main(int c, char **v) { @@ -7247,7 +7643,7 @@ if (strcmp(png_libpng_ver, PNG_LIBPNG_VER_STRING) != 0) return 1; return (PNG_LIBPNG_VER < 10002) ? 2 : 0 ;} EOF -if { (eval echo configure:7251: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 +if { (eval echo configure:7647: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 then ./conftest dummy_arg; png_status=$?; if test "$png_status" = "0"; then @@ -7290,15 +7686,15 @@ test -z "$with_tiff" && { ac_safe=`echo "tiffio.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for tiffio.h""... $ac_c" 1>&6 -echo "configure:7294: checking for tiffio.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:7302: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:7698: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -7321,12 +7717,12 @@ } test -z "$with_tiff" && { echo $ac_n "checking for TIFFClientOpen in -ltiff""... $ac_c" 1>&6 -echo "configure:7325: checking for TIFFClientOpen in -ltiff" >&5 +echo "configure:7721: checking for TIFFClientOpen in -ltiff" >&5 ac_lib_var=`echo tiff'_'TIFFClientOpen | sed 'y%./+-%__p_%'` xe_check_libs=" -ltiff " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:7737: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -7376,16 +7772,29 @@ if test "$with_x11" = "yes"; then echo "checking for X11 graphics libraries" 1>&6 -echo "configure:7380: checking for X11 graphics libraries" >&5 - +echo "configure:7776: checking for X11 graphics libraries" >&5 + + echo "checking for the Athena widgets" 1>&6 +echo "configure:7779: checking for the Athena widgets" >&5 + + case "$with_athena" in + "xaw" | "") athena_variant=Xaw athena_3d=no ;; + "3d") athena_variant=Xaw3d athena_3d=yes ;; + "next") athena_variant=neXtaw athena_3d=yes ;; + "95") athena_variant=Xaw95 athena_3d=yes ;; + "xpm") athena_variant=XawXpm athena_3d=yes ;; + *) { echo "Error:" "Unknown Athena widget set \`$with_athena'. This should not happen." >&2; exit 1; } ;; + esac + + if test "$athena_3d" = "no"; then -echo $ac_n "checking for XawScrollbarSetThumb in -lXaw""... $ac_c" 1>&6 -echo "configure:7384: checking for XawScrollbarSetThumb in -lXaw" >&5 -ac_lib_var=`echo Xaw'_'XawScrollbarSetThumb | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lXaw " -cat > conftest.$ac_ext <&6 +echo "configure:7793: checking for XawScrollbarSetThumb in -l$athena_variant" >&5 +ac_lib_var=`echo $athena_variant'_'XawScrollbarSetThumb | sed 'y%./+-%__p_%'` + +xe_check_libs=" -l$athena_variant " +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:7809: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=no" +fi +rm -f conftest* +xe_check_libs="" + +if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then + echo "$ac_t""yes" 1>&6 + +echo $ac_n "checking for threeDClassRec in -l$athena_variant""... $ac_c" 1>&6 +echo "configure:7825: checking for threeDClassRec in -l$athena_variant" >&5 +ac_lib_var=`echo $athena_variant'_'threeDClassRec | sed 'y%./+-%__p_%'` + +xe_check_libs=" -l$athena_variant " +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=no" +fi +rm -f conftest* +xe_check_libs="" + +if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then + echo "$ac_t""yes" 1>&6 + echo "configure: warning: "Could not find a non-3d Athena widget library."" 1>&2 +else + echo "$ac_t""no" 1>&6 +athena_lib=$athena_variant +fi + + + +else + echo "$ac_t""no" 1>&6 +echo "configure: warning: "Could not find an Athena widget library."" 1>&2 +fi + + + else + +echo $ac_n "checking for threeDClassRec in -l$athena_variant""... $ac_c" 1>&6 +echo "configure:7872: checking for threeDClassRec in -l$athena_variant" >&5 +ac_lib_var=`echo $athena_variant'_'threeDClassRec | sed 'y%./+-%__p_%'` + +xe_check_libs=" -l$athena_variant " +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=no" +fi +rm -f conftest* +xe_check_libs="" + +if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then + echo "$ac_t""yes" 1>&6 + athena_lib=$athena_variant +else + echo "$ac_t""no" 1>&6 +echo $ac_n "checking for threeDClassRec in -lXaw""... $ac_c" 1>&6 +echo "configure:7906: checking for threeDClassRec in -lXaw" >&5 +ac_lib_var=`echo Xaw'_'threeDClassRec | sed 'y%./+-%__p_%'` + +xe_check_libs=" -lXaw " +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -7410,25 +7932,390 @@ if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then echo "$ac_t""yes" 1>&6 - have_xaw=yes -else - echo "$ac_t""no" 1>&6 -have_xaw=no -fi - - - + athena_lib=Xaw; + echo "configure: warning: "Assuming that libXaw is actually $athena_variant."" 1>&2; + +else + echo "$ac_t""no" 1>&6 +echo "configure: warning: "Could not find a 3d Athena widget library that looked like $athena_variant."" 1>&2 +fi + + +fi + + + fi + + if test "$athena_3d" = "no"; then + ac_safe=`echo "X11/Xaw/ThreeD.h" | sed 'y%./+-%__p_%'` +echo $ac_n "checking for X11/Xaw/ThreeD.h""... $ac_c" 1>&6 +echo "configure:7953: checking for X11/Xaw/ThreeD.h" >&5 + +cat > conftest.$ac_ext < +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:7961: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + rm -rf conftest* + eval "ac_cv_header_$ac_safe=yes" +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_header_$ac_safe=no" +fi +rm -f conftest* +if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then + echo "$ac_t""yes" 1>&6 + echo "configure: warning: "Could not find a non-3d Athena header set."" 1>&2 +else + echo "$ac_t""no" 1>&6 +ac_safe=`echo "X11/Xaw/XawInit.h" | sed 'y%./+-%__p_%'` +echo $ac_n "checking for X11/Xaw/XawInit.h""... $ac_c" 1>&6 +echo "configure:7981: checking for X11/Xaw/XawInit.h" >&5 + +cat > conftest.$ac_ext < +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:7989: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + rm -rf conftest* + eval "ac_cv_header_$ac_safe=yes" +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_header_$ac_safe=no" +fi +rm -f conftest* +if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then + echo "$ac_t""yes" 1>&6 + athena_h_path=X11/Xaw +else + echo "$ac_t""no" 1>&6 +echo "configure: warning: "Could not find a non-3d Athena header set."" 1>&2 +fi + +fi + + else + ac_safe=`echo "X11/$athena_variant/XawInit.h" | sed 'y%./+-%__p_%'` +echo $ac_n "checking for X11/$athena_variant/XawInit.h""... $ac_c" 1>&6 +echo "configure:8015: checking for X11/$athena_variant/XawInit.h" >&5 + +cat > conftest.$ac_ext < +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:8023: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + rm -rf conftest* + eval "ac_cv_header_$ac_safe=yes" +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_header_$ac_safe=no" +fi +rm -f conftest* +if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then + echo "$ac_t""yes" 1>&6 + ac_safe=`echo "X11/$athena_variant/ThreeD.h" | sed 'y%./+-%__p_%'` +echo $ac_n "checking for X11/$athena_variant/ThreeD.h""... $ac_c" 1>&6 +echo "configure:8040: checking for X11/$athena_variant/ThreeD.h" >&5 + +cat > conftest.$ac_ext < +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:8048: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + rm -rf conftest* + eval "ac_cv_header_$ac_safe=yes" +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_header_$ac_safe=no" +fi +rm -f conftest* +if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then + echo "$ac_t""yes" 1>&6 + athena_h_path=X11/$athena_variant +else + echo "$ac_t""no" 1>&6 +fi + +else + echo "$ac_t""no" 1>&6 +fi + + + if test -z "$athena_h_path"; then + ac_safe=`echo "$athena_variant/XawInit.h" | sed 'y%./+-%__p_%'` +echo $ac_n "checking for $athena_variant/XawInit.h""... $ac_c" 1>&6 +echo "configure:8076: checking for $athena_variant/XawInit.h" >&5 + +cat > conftest.$ac_ext < +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:8084: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + rm -rf conftest* + eval "ac_cv_header_$ac_safe=yes" +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_header_$ac_safe=no" +fi +rm -f conftest* +if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then + echo "$ac_t""yes" 1>&6 + ac_safe=`echo "$athena_variant/ThreeD.h" | sed 'y%./+-%__p_%'` +echo $ac_n "checking for $athena_variant/ThreeD.h""... $ac_c" 1>&6 +echo "configure:8101: checking for $athena_variant/ThreeD.h" >&5 + +cat > conftest.$ac_ext < +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:8109: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + rm -rf conftest* + eval "ac_cv_header_$ac_safe=yes" +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_header_$ac_safe=no" +fi +rm -f conftest* +if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then + echo "$ac_t""yes" 1>&6 + athena_h_path=$athena_variant +else + echo "$ac_t""no" 1>&6 +fi + +else + echo "$ac_t""no" 1>&6 +fi + + fi + + if test -z "$athena_h_path" -a "$athena_variant" != "Xaw3d"; then + ac_safe=`echo "X11/Xaw3d/XawInit.h" | sed 'y%./+-%__p_%'` +echo $ac_n "checking for X11/Xaw3d/XawInit.h""... $ac_c" 1>&6 +echo "configure:8138: checking for X11/Xaw3d/XawInit.h" >&5 + +cat > conftest.$ac_ext < +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:8146: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + rm -rf conftest* + eval "ac_cv_header_$ac_safe=yes" +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_header_$ac_safe=no" +fi +rm -f conftest* +if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then + echo "$ac_t""yes" 1>&6 + ac_safe=`echo "X11/Xaw3d/ThreeD.h" | sed 'y%./+-%__p_%'` +echo $ac_n "checking for X11/Xaw3d/ThreeD.h""... $ac_c" 1>&6 +echo "configure:8163: checking for X11/Xaw3d/ThreeD.h" >&5 + +cat > conftest.$ac_ext < +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:8171: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + rm -rf conftest* + eval "ac_cv_header_$ac_safe=yes" +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_header_$ac_safe=no" +fi +rm -f conftest* +if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then + echo "$ac_t""yes" 1>&6 + + echo "configure: warning: "Assuming that X11/Xaw3d headers are suitable for $athena_variant."" 1>&2 + athena_h_path=X11/Xaw3d + +else + echo "$ac_t""no" 1>&6 +fi + +else + echo "$ac_t""no" 1>&6 +fi + + fi + + if test -z "$athena_h_path" -a "$athena_variant" != "Xaw3d"; then + ac_safe=`echo "Xaw3d/XawInit.h" | sed 'y%./+-%__p_%'` +echo $ac_n "checking for Xaw3d/XawInit.h""... $ac_c" 1>&6 +echo "configure:8203: checking for Xaw3d/XawInit.h" >&5 + +cat > conftest.$ac_ext < +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:8211: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + rm -rf conftest* + eval "ac_cv_header_$ac_safe=yes" +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_header_$ac_safe=no" +fi +rm -f conftest* +if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then + echo "$ac_t""yes" 1>&6 + ac_safe=`echo "Xaw3d/ThreeD.h" | sed 'y%./+-%__p_%'` +echo $ac_n "checking for Xaw3d/ThreeD.h""... $ac_c" 1>&6 +echo "configure:8228: checking for Xaw3d/ThreeD.h" >&5 + +cat > conftest.$ac_ext < +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:8236: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + rm -rf conftest* + eval "ac_cv_header_$ac_safe=yes" +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_header_$ac_safe=no" +fi +rm -f conftest* +if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then + echo "$ac_t""yes" 1>&6 + + echo "configure: warning: "Assuming that Xaw3d headers are suitable for $athena_variant."" 1>&2 + athena_h_path=Xaw3d + +else + echo "$ac_t""no" 1>&6 +fi + +else + echo "$ac_t""no" 1>&6 +fi + + fi + + if test -z "$athena_h_path"; then + ac_safe=`echo "X11/Xaw/ThreeD.h" | sed 'y%./+-%__p_%'` +echo $ac_n "checking for X11/Xaw/ThreeD.h""... $ac_c" 1>&6 +echo "configure:8268: checking for X11/Xaw/ThreeD.h" >&5 + +cat > conftest.$ac_ext < +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:8276: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + rm -rf conftest* + eval "ac_cv_header_$ac_safe=yes" +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_header_$ac_safe=no" +fi +rm -f conftest* +if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then + echo "$ac_t""yes" 1>&6 + + echo "configure: warning: "Assuming that X11/Xaw headers are suitable for $athena_variant."" 1>&2 + athena_h_path=X11/Xaw + +else + echo "$ac_t""no" 1>&6 +echo "configure: warning: "Could not find a suitable 3d Athena header set."" 1>&2 +fi + + fi + fi + + if test -n "$athena_lib" -a -n "$athena_h_path"; then + have_xaw=yes + else + have_xaw=no + fi + ac_safe=`echo "Xm/Xm.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for Xm/Xm.h""... $ac_c" 1>&6 -echo "configure:7424: checking for Xm/Xm.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:7432: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8319: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -7445,12 +8332,12 @@ echo "$ac_t""yes" 1>&6 echo $ac_n "checking for XmStringFree in -lXm""... $ac_c" 1>&6 -echo "configure:7449: checking for XmStringFree in -lXm" >&5 +echo "configure:8336: checking for XmStringFree in -lXm" >&5 ac_lib_var=`echo Xm'_'XmStringFree | sed 'y%./+-%__p_%'` xe_check_libs=" -lXm " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:8352: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -7490,9 +8377,9 @@ if test "$have_motif" = "yes"; then echo $ac_n "checking for Lesstif""... $ac_c" 1>&6 -echo "configure:7494: checking for Lesstif" >&5 +echo "configure:8381: checking for Lesstif" >&5 cat > conftest.$ac_ext < #ifdef LESSTIF_VERSION @@ -7515,23 +8402,47 @@ fi -case "$with_menubars" in "" | "yes" | "athena" | "athena3d" ) +case "$with_menubars" in "" | "yes" | "athena" ) with_menubars="lucid" ;; esac case "$with_dialogs" in "" | "yes" | "lucid" ) - if test "$have_motif" = "yes"; then with_dialogs="motif" - elif test "$have_xaw" = "yes"; then with_dialogs="athena" + if test "$have_motif" = "yes"; then with_dialogs="motif" + elif test "$have_xaw" = "yes"; then with_dialogs="athena" else with_dialogs=no fi ;; esac case "$with_scrollbars" in "" | "yes" ) with_scrollbars="lucid" ;; esac - -all_widgets="$with_menubars $with_scrollbars $with_dialogs $with_toolbars" - -case "$all_widgets" in *athena* ) - { test "$extra_verbose" = "yes" && cat << \EOF +case "$with_widgets" in "" | "yes" | "lucid") + if test "$have_motif" = "yes"; then with_widgets="motif" + elif test "$have_xaw" = "yes"; then with_widgets="athena" + else with_widgets=no + fi ;; +esac + +all_widgets="$with_menubars $with_scrollbars $with_dialogs $with_toolbars $with_widgets" + +case "$all_widgets" in + *athena* ) + if test "$have_xaw" != "yes"; then + { echo "Error:" "Could not find a suitable Athena library to build with." >&2; exit 1; } + fi + + lwlib_objs="$lwlib_objs lwlib-Xaw.o" && if test "$extra_verbose" = "yes"; then echo " Appending \"lwlib-Xaw.o\" to \$lwlib_objs"; fi + + libs_x="-l$athena_lib $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-l$athena_lib\" to \$libs_x"; fi + + { test "$extra_verbose" = "yes" && cat << EOF + Defining ATHENA_H_PATH = $athena_h_path +EOF +cat >> confdefs.h <> confdefs.h <<\EOF @@ -7539,7 +8450,7 @@ EOF } - { test "$extra_verbose" = "yes" && cat << \EOF + { test "$extra_verbose" = "yes" && cat << \EOF Defining NEED_ATHENA EOF cat >> confdefs.h <<\EOF @@ -7547,8 +8458,18 @@ EOF } - lwlib_objs="$lwlib_objs lwlib-Xaw.o" && if test "$extra_verbose" = "yes"; then echo " Appending \"lwlib-Xaw.o\" to \$lwlib_objs"; fi - libs_x="-lXaw $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lXaw\" to \$libs_x"; fi ;; + + if test "$athena_3d" = "yes"; then + { test "$extra_verbose" = "yes" && cat << \EOF + Defining HAVE_ATHENA_3D +EOF +cat >> confdefs.h <<\EOF +#define HAVE_ATHENA_3D 1 +EOF +} + + fi + ;; esac case "$all_widgets" in *motif* ) @@ -7575,6 +8496,11 @@ test "$with_menubars" = "lucid" && lwlib_objs="$lwlib_objs xlwmenu.o" && if test "$extra_verbose" = "yes"; then echo " Appending \"xlwmenu.o\" to \$lwlib_objs"; fi test "$with_menubars" = "motif" && lwlib_objs="$lwlib_objs xlwmenu.o" && if test "$extra_verbose" = "yes"; then echo " Appending \"xlwmenu.o\" to \$lwlib_objs"; fi test "$with_scrollbars" = "lucid" && lwlib_objs="$lwlib_objs xlwscrollbar.o" && if test "$extra_verbose" = "yes"; then echo " Appending \"xlwscrollbar.o\" to \$lwlib_objs"; fi +test "$with_widgets" != "no" && test "$with_widgets" != "msw" && \ + lwlib_objs="$lwlib_objs xlwtabs.o xlwgcs.o" && if test "$extra_verbose" = "yes"; then echo " Appending \"xlwtabs.o xlwgcs.o\" to \$lwlib_objs"; fi +case "$with_widgets" in athena* ) + lwlib_objs="$lwlib_objs xlwradio.o xlwcheckbox.o xlwgauge.o" && if test "$extra_verbose" = "yes"; then echo " Appending \"xlwradio.o xlwcheckbox.o xlwgauge.o\" to \$lwlib_objs"; fi;; +esac case "$all_widgets" in *lucid* ) { test "$extra_verbose" = "yes" && cat << \EOF Defining NEED_LUCID @@ -7589,23 +8515,25 @@ -case "$with_scrollbars" in athena* ) { test "$extra_verbose" = "yes" && cat << \EOF +test "$with_scrollbars" = "athena" && { test "$extra_verbose" = "yes" && cat << \EOF Defining LWLIB_SCROLLBARS_ATHENA EOF cat >> confdefs.h <<\EOF #define LWLIB_SCROLLBARS_ATHENA 1 EOF } -;; esac -case "$with_dialogs" in athena* ) { test "$extra_verbose" = "yes" && cat << \EOF + +test "$with_dialogs" = "athena" && { test "$extra_verbose" = "yes" && cat << \EOF Defining LWLIB_DIALOGS_ATHENA EOF cat >> confdefs.h <<\EOF #define LWLIB_DIALOGS_ATHENA 1 EOF } - ;; esac -test "$with_scrollbars" = "athena3d" && { test "$extra_verbose" = "yes" && cat << \EOF + + +if test "$athena_3d" = "yes"; then + test "$with_scrollbars" = "athena" && { test "$extra_verbose" = "yes" && cat << \EOF Defining LWLIB_SCROLLBARS_ATHENA3D EOF cat >> confdefs.h <<\EOF @@ -7613,7 +8541,7 @@ EOF } -test "$with_dialogs" = "athena3d" && { test "$extra_verbose" = "yes" && cat << \EOF + test "$with_dialogs" = "athena" && { test "$extra_verbose" = "yes" && cat << \EOF Defining LWLIB_DIALOGS_ATHENA3D EOF cat >> confdefs.h <<\EOF @@ -7621,6 +8549,25 @@ EOF } +fi + +case "$with_widgets" in athena* ) { test "$extra_verbose" = "yes" && cat << \EOF + Defining LWLIB_WIDGETS_ATHENA +EOF +cat >> confdefs.h <<\EOF +#define LWLIB_WIDGETS_ATHENA 1 +EOF +} +;; esac +test "$with_widgets" != "no" && test "$with_widgets" != "msw" && \ + { test "$extra_verbose" = "yes" && cat << \EOF + Defining LWLIB_TABS_LUCID +EOF +cat >> confdefs.h <<\EOF +#define LWLIB_TABS_LUCID 1 +EOF +} + test "$with_menubars" != "no" && { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_MENUBARS @@ -7654,6 +8601,14 @@ EOF } +test "$with_widgets" != "no" && { test "$extra_verbose" = "yes" && cat << \EOF + Defining HAVE_WIDGETS +EOF +cat >> confdefs.h <<\EOF +#define HAVE_WIDGETS 1 +EOF +} + test "$with_menubars" = "lucid" && { test "$extra_verbose" = "yes" && cat << \EOF Defining LWLIB_MENUBARS_LUCID @@ -7696,61 +8651,45 @@ EOF } - -test "$with_menubars" != "no" && extra_objs="$extra_objs menubar.o" && if test "$extra_verbose" = "yes"; then +test "$with_widgets" = "motif" && { test "$extra_verbose" = "yes" && cat << \EOF + Defining LWLIB_WIDGETS_MOTIF +EOF +cat >> confdefs.h <<\EOF +#define LWLIB_WIDGETS_MOTIF 1 +EOF +} + + +test "$with_menubars" != "no" && extra_objs="$extra_objs menubar.o" && if test "$extra_verbose" = "yes"; then echo " xemacs will be linked with \"menubar.o\"" fi -test "$with_scrollbars" != "no" && extra_objs="$extra_objs scrollbar.o" && if test "$extra_verbose" = "yes"; then +test "$with_scrollbars" != "no" && extra_objs="$extra_objs scrollbar.o" && if test "$extra_verbose" = "yes"; then echo " xemacs will be linked with \"scrollbar.o\"" fi -test "$with_dialogs" != "no" && extra_objs="$extra_objs dialog.o" && if test "$extra_verbose" = "yes"; then +test "$with_dialogs" != "no" && extra_objs="$extra_objs dialog.o" && if test "$extra_verbose" = "yes"; then echo " xemacs will be linked with \"dialog.o\"" fi -test "$with_toolbars" != "no" && extra_objs="$extra_objs toolbar.o" && if test "$extra_verbose" = "yes"; then +test "$with_toolbars" != "no" && extra_objs="$extra_objs toolbar.o" && if test "$extra_verbose" = "yes"; then echo " xemacs will be linked with \"toolbar.o\"" fi if test "$with_x11" = "yes"; then - test "$with_menubars" != "no" && extra_objs="$extra_objs menubar-x.o" && if test "$extra_verbose" = "yes"; then + test "$with_menubars" != "no" && extra_objs="$extra_objs menubar-x.o" && if test "$extra_verbose" = "yes"; then echo " xemacs will be linked with \"menubar-x.o\"" fi - test "$with_scrollbars" != "no" && extra_objs="$extra_objs scrollbar-x.o" && if test "$extra_verbose" = "yes"; then + test "$with_scrollbars" != "no" && extra_objs="$extra_objs scrollbar-x.o" && if test "$extra_verbose" = "yes"; then echo " xemacs will be linked with \"scrollbar-x.o\"" fi - test "$with_dialogs" != "no" && extra_objs="$extra_objs dialog-x.o" && if test "$extra_verbose" = "yes"; then + test "$with_dialogs" != "no" && extra_objs="$extra_objs dialog-x.o" && if test "$extra_verbose" = "yes"; then echo " xemacs will be linked with \"dialog-x.o\"" fi - test "$with_toolbars" != "no" && extra_objs="$extra_objs toolbar-x.o" && if test "$extra_verbose" = "yes"; then + test "$with_toolbars" != "no" && extra_objs="$extra_objs toolbar-x.o" && if test "$extra_verbose" = "yes"; then echo " xemacs will be linked with \"toolbar-x.o\"" fi - test "$all_widgets" != "no no no no" && extra_objs="$extra_objs gui-x.o" && if test "$extra_verbose" = "yes"; then + test "$all_widgets" != "no no no no no" && extra_objs="$extra_objs gui-x.o" && if test "$extra_verbose" = "yes"; then echo " xemacs will be linked with \"gui-x.o\"" fi -else - if test \( "$with_sound" = "nas" \) -o \( "$with_sound" = "both" \); then - echo "Attempt to Build NAS sound without X" - echo "Please remove NAS configuration or build with X" - exit 1 - fi -fi - -test "$use_minimal_tagbits" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining USE_MINIMAL_TAGBITS -EOF -cat >> confdefs.h <<\EOF -#define USE_MINIMAL_TAGBITS 1 -EOF -} - -test "$use_indexed_lrecord_implementation" = "yes" && \ - { test "$extra_verbose" = "yes" && cat << \EOF - Defining USE_INDEXED_LRECORD_IMPLEMENTATION -EOF -cat >> confdefs.h <<\EOF -#define USE_INDEXED_LRECORD_IMPLEMENTATION 1 -EOF -} - +fi test -z "$with_mule" && with_mule=no @@ -7773,7 +8712,7 @@ if test "$with_mule" = "yes" ; then echo "checking for Mule-related features" 1>&6 -echo "configure:7777: checking for Mule-related features" >&5 +echo "configure:8716: checking for Mule-related features" >&5 { test "$extra_verbose" = "yes" && cat << \EOF Defining MULE EOF @@ -7790,23 +8729,23 @@ EOF } - extra_objs="$extra_objs mule.o mule-ccl.o mule-charset.o mule-coding.o file-coding.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"mule.o mule-ccl.o mule-charset.o mule-coding.o file-coding.o\"" + extra_objs="$extra_objs mule.o mule-ccl.o mule-charset.o file-coding.o" && if test "$extra_verbose" = "yes"; then + echo " xemacs will be linked with \"mule.o mule-ccl.o mule-charset.o file-coding.o\"" fi for ac_hdr in libintl.h do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:7802: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:7810: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8749: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -7837,12 +8776,12 @@ echo $ac_n "checking for strerror in -lintl""... $ac_c" 1>&6 -echo "configure:7841: checking for strerror in -lintl" >&5 +echo "configure:8780: checking for strerror in -lintl" >&5 ac_lib_var=`echo intl'_'strerror | sed 'y%./+-%__p_%'` xe_check_libs=" -lintl " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:8796: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -7886,18 +8825,18 @@ echo "checking for Mule input methods" 1>&6 -echo "configure:7890: checking for Mule input methods" >&5 +echo "configure:8829: checking for Mule input methods" >&5 case "$with_xim" in "" | "yes" ) echo "checking for XIM" 1>&6 -echo "configure:7893: checking for XIM" >&5 +echo "configure:8832: checking for XIM" >&5 echo $ac_n "checking for XOpenIM in -lX11""... $ac_c" 1>&6 -echo "configure:7896: checking for XOpenIM in -lX11" >&5 +echo "configure:8835: checking for XOpenIM in -lX11" >&5 ac_lib_var=`echo X11'_'XOpenIM | sed 'y%./+-%__p_%'` xe_check_libs=" -lX11 " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:8851: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -7932,12 +8871,12 @@ if test "$have_motif $have_lesstif" = "yes no"; then echo $ac_n "checking for XmImMbLookupString in -lXm""... $ac_c" 1>&6 -echo "configure:7936: checking for XmImMbLookupString in -lXm" >&5 +echo "configure:8875: checking for XmImMbLookupString in -lXm" >&5 ac_lib_var=`echo Xm'_'XmImMbLookupString | sed 'y%./+-%__p_%'` xe_check_libs=" -lXm " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:8891: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -8013,15 +8952,15 @@ if test "$with_xfs" = "yes" ; then echo "checking for XFontSet" 1>&6 -echo "configure:8017: checking for XFontSet" >&5 +echo "configure:8956: checking for XFontSet" >&5 echo $ac_n "checking for XmbDrawString in -lX11""... $ac_c" 1>&6 -echo "configure:8020: checking for XmbDrawString in -lX11" >&5 +echo "configure:8959: checking for XmbDrawString in -lX11" >&5 ac_lib_var=`echo X11'_'XmbDrawString | sed 'y%./+-%__p_%'` xe_check_libs=" -lX11 " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:8975: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -8072,15 +9011,15 @@ test "$with_wnn6" = "yes" && with_wnn=yes # wnn6 implies wnn support test -z "$with_wnn" && { ac_safe=`echo "wnn/jllib.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for wnn/jllib.h""... $ac_c" 1>&6 -echo "configure:8076: checking for wnn/jllib.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8084: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9023: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -8105,10 +9044,10 @@ for ac_func in crypt do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:8109: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:9074: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -8160,12 +9099,12 @@ test "$ac_cv_func_crypt" != "yes" && { echo $ac_n "checking for crypt in -lcrypt""... $ac_c" 1>&6 -echo "configure:8164: checking for crypt in -lcrypt" >&5 +echo "configure:9103: checking for crypt in -lcrypt" >&5 ac_lib_var=`echo crypt'_'crypt | sed 'y%./+-%__p_%'` xe_check_libs=" -lcrypt " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:9119: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -8211,12 +9150,12 @@ if test -z "$with_wnn" -o "$with_wnn" = "yes"; then echo $ac_n "checking for jl_dic_list_e in -lwnn""... $ac_c" 1>&6 -echo "configure:8215: checking for jl_dic_list_e in -lwnn" >&5 +echo "configure:9154: checking for jl_dic_list_e in -lwnn" >&5 ac_lib_var=`echo wnn'_'jl_dic_list_e | sed 'y%./+-%__p_%'` xe_check_libs=" -lwnn " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:9170: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -8245,12 +9184,12 @@ else echo "$ac_t""no" 1>&6 echo $ac_n "checking for jl_dic_list_e in -lwnn4""... $ac_c" 1>&6 -echo "configure:8249: checking for jl_dic_list_e in -lwnn4" >&5 +echo "configure:9188: checking for jl_dic_list_e in -lwnn4" >&5 ac_lib_var=`echo wnn4'_'jl_dic_list_e | sed 'y%./+-%__p_%'` xe_check_libs=" -lwnn4 " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:9204: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -8279,12 +9218,12 @@ else echo "$ac_t""no" 1>&6 echo $ac_n "checking for jl_dic_list_e in -lwnn6""... $ac_c" 1>&6 -echo "configure:8283: checking for jl_dic_list_e in -lwnn6" >&5 +echo "configure:9222: checking for jl_dic_list_e in -lwnn6" >&5 ac_lib_var=`echo wnn6'_'jl_dic_list_e | sed 'y%./+-%__p_%'` xe_check_libs=" -lwnn6 " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:9238: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -8313,12 +9252,12 @@ else echo "$ac_t""no" 1>&6 echo $ac_n "checking for dic_list_e in -lwnn6_fromsrc""... $ac_c" 1>&6 -echo "configure:8317: checking for dic_list_e in -lwnn6_fromsrc" >&5 +echo "configure:9256: checking for dic_list_e in -lwnn6_fromsrc" >&5 ac_lib_var=`echo wnn6_fromsrc'_'dic_list_e | sed 'y%./+-%__p_%'` xe_check_libs=" -lwnn6_fromsrc " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:9272: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -8377,12 +9316,12 @@ if test "$with_wnn6" != "no"; then echo $ac_n "checking for jl_fi_dic_list in -l$libwnn""... $ac_c" 1>&6 -echo "configure:8381: checking for jl_fi_dic_list in -l$libwnn" >&5 +echo "configure:9320: checking for jl_fi_dic_list in -l$libwnn" >&5 ac_lib_var=`echo $libwnn'_'jl_fi_dic_list | sed 'y%./+-%__p_%'` xe_check_libs=" -l$libwnn " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:9336: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -8428,15 +9367,15 @@ if test "$with_canna" != "no"; then ac_safe=`echo "canna/jrkanji.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for canna/jrkanji.h""... $ac_c" 1>&6 -echo "configure:8432: checking for canna/jrkanji.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8440: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9379: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -8463,15 +9402,15 @@ c_switch_site="$c_switch_site -I/usr/local/canna/include" ac_safe=`echo "canna/jrkanji.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for canna/jrkanji.h""... $ac_c" 1>&6 -echo "configure:8467: checking for canna/jrkanji.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8475: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9414: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -8499,15 +9438,15 @@ test -z "$with_canna" && { ac_safe=`echo "canna/RK.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for canna/RK.h""... $ac_c" 1>&6 -echo "configure:8503: checking for canna/RK.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8511: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9450: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -8530,12 +9469,12 @@ } test -z "$with_canna" && { echo $ac_n "checking for RkBgnBun in -lRKC""... $ac_c" 1>&6 -echo "configure:8534: checking for RkBgnBun in -lRKC" >&5 +echo "configure:9473: checking for RkBgnBun in -lRKC" >&5 ac_lib_var=`echo RKC'_'RkBgnBun | sed 'y%./+-%__p_%'` xe_check_libs=" -lRKC " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:9489: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -8569,12 +9508,12 @@ } test -z "$with_canna" && { echo $ac_n "checking for jrKanjiControl in -lcanna""... $ac_c" 1>&6 -echo "configure:8573: checking for jrKanjiControl in -lcanna" >&5 +echo "configure:9512: checking for jrKanjiControl in -lcanna" >&5 ac_lib_var=`echo canna'_'jrKanjiControl | sed 'y%./+-%__p_%'` xe_check_libs=" -lcanna " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:9528: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -8634,12 +9573,12 @@ libs_x="-lXm $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lXm\" to \$libs_x"; fi echo $ac_n "checking for layout_object_getvalue in -li18n""... $ac_c" 1>&6 -echo "configure:8638: checking for layout_object_getvalue in -li18n" >&5 +echo "configure:9577: checking for layout_object_getvalue in -li18n" >&5 ac_lib_var=`echo i18n'_'layout_object_getvalue | sed 'y%./+-%__p_%'` xe_check_libs=" -li18n " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:9593: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -8733,13 +9672,13 @@ fi -for ac_func in cbrt closedir dup2 eaccess fmod fpathconf frexp ftime gethostname getpagesize gettimeofday getcwd getwd logb lrand48 matherr mkdir mktime perror poll random rename res_init rint rmdir select setitimer setpgid setlocale setsid sigblock sighold sigprocmask snprintf strcasecmp strerror tzset ulimit usleep utimes waitpid vsnprintf +for ac_func in cbrt closedir dup2 eaccess fmod fpathconf frexp ftime getaddrinfo gethostname getnameinfo getpagesize gettimeofday getcwd getpt getwd logb lrand48 matherr mkdir mktime perror poll random rename res_init rint rmdir select setitimer setpgid setlocale setsid sigblock sighold sigprocmask snprintf stpcpy strcasecmp strerror tzset ulimit usleep utimes waitpid vsnprintf fsync ftruncate umask do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:8740: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:9705: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_$ac_func=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_$ac_func=no" +fi +rm -f conftest* + +if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then + echo "$ac_t""yes" 1>&6 + ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` + { test "$extra_verbose" = "yes" && cat << EOF + Defining $ac_tr_func +EOF +cat >> confdefs.h <&6 +fi +done + + +extra_objs="$extra_objs realpath.o" && if test "$extra_verbose" = "yes"; then + echo " xemacs will be linked with \"realpath.o\"" + fi + +for ac_func in getloadavg +do +echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 +echo "configure:9740: checking for $ac_func" >&5 + +cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char $ac_func(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +choke me +#else +$ac_func(); +#endif + +; return 0; } +EOF +if { (eval echo configure:9766: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -8790,89 +9790,124 @@ done - -case "$opsys" in - linuxaout* | bsdos3* | freebsd* | decosf4-0* | aix4* ) extra_objs="$extra_objs realpath.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"realpath.o\"" - fi ;; - * ) - case "$canonical" in - *-*-sysv4.2uw2* ) extra_objs="$extra_objs realpath.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"realpath.o\"" - fi ;; - * ) for ac_func in realpath -do -echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:8807: checking for $ac_func" >&5 - -cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -$ac_func(); -#endif - -; return 0; } -EOF -if { (eval echo configure:8833: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_func_$ac_func=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_$ac_func=no" -fi -rm -f conftest* - -if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` +if test "$ac_cv_func_getloadavg" != "yes" +then + extra_objs="$extra_objs getloadavg.o" && if test "$extra_verbose" = "yes"; then + echo " xemacs will be linked with \"getloadavg.o\"" + fi + + +echo $ac_n "checking for kstat_open in -lkstat""... $ac_c" 1>&6 +echo "configure:9802: checking for kstat_open in -lkstat" >&5 +ac_lib_var=`echo kstat'_'kstat_open | sed 'y%./+-%__p_%'` + +xe_check_libs=" -lkstat " +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=no" +fi +rm -f conftest* +xe_check_libs="" + +if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then + echo "$ac_t""yes" 1>&6 + ac_tr_lib=HAVE_LIB`echo kstat | sed -e 's/[^a-zA-Z0-9_]/_/g' \ + -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_func + Defining $ac_tr_lib EOF cat >> confdefs.h <&6 -fi -done - - test "$ac_cv_func_realpath" != "yes" && extra_objs="$extra_objs realpath.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"realpath.o\"" - fi ;; - esac ;; -esac +#define $ac_tr_lib 1 +EOF +} + + LIBS="-lkstat $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lkstat\" to \$LIBS"; fi + +else + echo "$ac_t""no" 1>&6 +fi + + + + +echo $ac_n "checking for kvm_read in -lkvm""... $ac_c" 1>&6 +echo "configure:9852: checking for kvm_read in -lkvm" >&5 +ac_lib_var=`echo kvm'_'kvm_read | sed 'y%./+-%__p_%'` + +xe_check_libs=" -lkvm " +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=no" +fi +rm -f conftest* +xe_check_libs="" + +if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then + echo "$ac_t""yes" 1>&6 + ac_tr_lib=HAVE_LIB`echo kvm | sed -e 's/[^a-zA-Z0-9_]/_/g' \ + -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` + { test "$extra_verbose" = "yes" && cat << EOF + Defining $ac_tr_lib +EOF +cat >> confdefs.h <&6 +fi + + +fi echo $ac_n "checking whether netdb declares h_errno""... $ac_c" 1>&6 -echo "configure:8867: checking whether netdb declares h_errno" >&5 -cat > conftest.$ac_ext <&5 +cat > conftest.$ac_ext < int main() { return h_errno; ; return 0; } EOF -if { (eval echo configure:8876: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:9911: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* echo "$ac_t""yes" 1>&6 { test "$extra_verbose" = "yes" && cat << \EOF @@ -8892,16 +9927,16 @@ rm -f conftest* echo $ac_n "checking for sigsetjmp""... $ac_c" 1>&6 -echo "configure:8896: checking for sigsetjmp" >&5 -cat > conftest.$ac_ext <&5 +cat > conftest.$ac_ext < int main() { sigjmp_buf bar; sigsetjmp (bar, 0); ; return 0; } EOF -if { (eval echo configure:8905: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:9940: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* echo "$ac_t""yes" 1>&6 { test "$extra_verbose" = "yes" && cat << \EOF @@ -8921,11 +9956,11 @@ rm -f conftest* echo $ac_n "checking whether localtime caches TZ""... $ac_c" 1>&6 -echo "configure:8925: checking whether localtime caches TZ" >&5 +echo "configure:9960: checking whether localtime caches TZ" >&5 if test "$ac_cv_func_tzset" = "yes"; then cat > conftest.$ac_ext < #if STDC_HEADERS @@ -8960,7 +9995,7 @@ exit (0); } EOF -if { (eval echo configure:8964: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 +if { (eval echo configure:9999: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 then emacs_cv_localtime_cache=no else @@ -8990,9 +10025,9 @@ if test "$HAVE_TIMEVAL" = "yes"; then echo $ac_n "checking whether gettimeofday accepts one or two arguments""... $ac_c" 1>&6 -echo "configure:8994: checking whether gettimeofday accepts one or two arguments" >&5 -cat > conftest.$ac_ext <&5 +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + gettimeofday (&time, 0); + +; return 0; } +EOF +if { (eval echo configure:10052: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* echo "$ac_t""two" 1>&6 else @@ -9036,19 +10070,19 @@ echo $ac_n "checking for inline""... $ac_c" 1>&6 -echo "configure:9040: checking for inline" >&5 +echo "configure:10074: checking for inline" >&5 ac_cv_c_inline=no for ac_kw in inline __inline__ __inline; do cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:10086: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_inline=$ac_kw; break else @@ -9098,17 +10132,17 @@ # The Ultrix 4.2 mips builtin alloca declared by alloca.h only works # for constant arguments. Useless! echo $ac_n "checking for working alloca.h""... $ac_c" 1>&6 -echo "configure:9102: checking for working alloca.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < int main() { char *p = alloca(2 * sizeof(int)); ; return 0; } EOF -if { (eval echo configure:9112: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:10146: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* ac_cv_header_alloca_h=yes else @@ -9132,10 +10166,10 @@ fi echo $ac_n "checking for alloca""... $ac_c" 1>&6 -echo "configure:9136: checking for alloca" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:10201: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* ac_cv_func_alloca_works=yes else @@ -9202,10 +10236,10 @@ echo $ac_n "checking whether alloca needs Cray hooks""... $ac_c" 1>&6 -echo "configure:9206: checking whether alloca needs Cray hooks" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&6 -echo "configure:9233: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:10293: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -9285,10 +10319,10 @@ fi echo $ac_n "checking stack direction for C alloca""... $ac_c" 1>&6 -echo "configure:9289: checking stack direction for C alloca" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 +if { (eval echo configure:10345: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 then ac_cv_c_stack_direction=1 else @@ -9336,15 +10370,15 @@ ac_safe=`echo "vfork.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for vfork.h""... $ac_c" 1>&6 -echo "configure:9340: checking for vfork.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9348: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:10382: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -9372,10 +10406,10 @@ fi echo $ac_n "checking for working vfork""... $ac_c" 1>&6 -echo "configure:9376: checking for working vfork" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < @@ -9470,7 +10504,7 @@ } } EOF -if { (eval echo configure:9474: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 +if { (eval echo configure:10508: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 then ac_cv_func_vfork_works=yes else @@ -9496,10 +10530,10 @@ echo $ac_n "checking for working strcoll""... $ac_c" 1>&6 -echo "configure:9500: checking for working strcoll" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < main () @@ -9509,7 +10543,7 @@ strcoll ("123", "456") >= 0); } EOF -if { (eval echo configure:9513: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 +if { (eval echo configure:10547: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 then ac_cv_func_strcoll_works=yes else @@ -9537,10 +10571,10 @@ for ac_func in getpgrp do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:9541: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:10601: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -9591,10 +10625,10 @@ done echo $ac_n "checking whether getpgrp takes no argument""... $ac_c" 1>&6 -echo "configure:9595: checking whether getpgrp takes no argument" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 +if { (eval echo configure:10687: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 then ac_cv_func_getpgrp_void=yes else @@ -9676,10 +10710,10 @@ echo $ac_n "checking for working mmap""... $ac_c" 1>&6 -echo "configure:9680: checking for working mmap" >&5 +echo "configure:10714: checking for working mmap" >&5 case "$opsys" in ultrix* ) have_mmap=no ;; *) cat > conftest.$ac_ext < #include @@ -9712,7 +10746,7 @@ return 1; } EOF -if { (eval echo configure:9716: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 +if { (eval echo configure:10750: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 then have_mmap=yes else @@ -9733,274 +10767,39 @@ EOF } -for ac_hdr in unistd.h -do -ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:9741: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9749: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_hdr -EOF -cat >> confdefs.h <&6 -fi -done - -for ac_func in getpagesize -do -echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:9781: checking for $ac_func" >&5 - -cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -$ac_func(); -#endif - -; return 0; } -EOF -if { (eval echo configure:9807: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_func_$ac_func=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_$ac_func=no" -fi -rm -f conftest* - -if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_func -EOF -cat >> confdefs.h <&6 -fi -done - -echo $ac_n "checking for working mmap""... $ac_c" 1>&6 -echo "configure:9835: checking for working mmap" >&5 - -cat > conftest.$ac_ext < -#include -#include - -/* This mess was copied from the GNU getpagesize.h. */ -#ifndef HAVE_GETPAGESIZE -# ifdef HAVE_UNISTD_H -# include -# endif - -/* Assume that all systems that can run configure have sys/param.h. */ -# ifndef HAVE_SYS_PARAM_H -# define HAVE_SYS_PARAM_H 1 -# endif - -# ifdef _SC_PAGESIZE -# define getpagesize() sysconf(_SC_PAGESIZE) -# else /* no _SC_PAGESIZE */ -# ifdef HAVE_SYS_PARAM_H -# include -# ifdef EXEC_PAGESIZE -# define getpagesize() EXEC_PAGESIZE -# else /* no EXEC_PAGESIZE */ -# ifdef NBPG -# define getpagesize() NBPG * CLSIZE -# ifndef CLSIZE -# define CLSIZE 1 -# endif /* no CLSIZE */ -# else /* no NBPG */ -# ifdef NBPC -# define getpagesize() NBPC -# else /* no NBPC */ -# ifdef PAGESIZE -# define getpagesize() PAGESIZE -# endif /* PAGESIZE */ -# endif /* no NBPC */ -# endif /* no NBPG */ -# endif /* no EXEC_PAGESIZE */ -# else /* no HAVE_SYS_PARAM_H */ -# define getpagesize() 8192 /* punt totally */ -# endif /* no HAVE_SYS_PARAM_H */ -# endif /* no _SC_PAGESIZE */ - -#endif /* no HAVE_GETPAGESIZE */ - -#ifdef __cplusplus -extern "C" { void *malloc(unsigned); } -#else -char *malloc(); -#endif - -int -main() -{ - char *data, *data2, *data3; - int i, pagesize; - int fd; - - pagesize = getpagesize(); - - /* - * First, make a file with some known garbage in it. - */ - data = malloc(pagesize); - if (!data) - exit(1); - for (i = 0; i < pagesize; ++i) - *(data + i) = rand(); - umask(0); - fd = creat("conftestmmap", 0600); - if (fd < 0) - exit(1); - if (write(fd, data, pagesize) != pagesize) - exit(1); - close(fd); - - /* - * Next, try to mmap the file at a fixed address which - * already has something else allocated at it. If we can, - * also make sure that we see the same garbage. - */ - fd = open("conftestmmap", O_RDWR); - if (fd < 0) - exit(1); - data2 = malloc(2 * pagesize); - if (!data2) - exit(1); - data2 += (pagesize - ((int) data2 & (pagesize - 1))) & (pagesize - 1); - if (data2 != mmap(data2, pagesize, PROT_READ | PROT_WRITE, - MAP_PRIVATE | MAP_FIXED, fd, 0L)) - exit(1); - for (i = 0; i < pagesize; ++i) - if (*(data + i) != *(data2 + i)) - exit(1); - - /* - * Finally, make sure that changes to the mapped area - * do not percolate back to the file as seen by read(). - * (This is a bug on some variants of i386 svr4.0.) - */ - for (i = 0; i < pagesize; ++i) - *(data2 + i) = *(data2 + i) + 1; - data3 = malloc(pagesize); - if (!data3) - exit(1); - if (read(fd, data3, pagesize) != pagesize) - exit(1); - for (i = 0; i < pagesize; ++i) - if (*(data + i) != *(data3 + i)) - exit(1); - close(fd); - unlink("conftestmmap"); - exit(0); -} - -EOF -if { (eval echo configure:9978: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 -then - ac_cv_func_mmap_fixed_mapped=yes -else - conftest_rc="$?" - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - ac_cv_func_mmap_fixed_mapped=no -fi -rm -fr conftest* - -echo "$ac_t""$ac_cv_func_mmap_fixed_mapped" 1>&6 -if test $ac_cv_func_mmap_fixed_mapped = yes; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_MMAP -EOF -cat >> confdefs.h <<\EOF -#define HAVE_MMAP 1 -EOF -} - -fi - - -test "$GNU_MALLOC" != "yes" -a "$have_mmap" != "yes" && rel_alloc=no -test "$rel_alloc" = "default" -a "$have_mmap" = "yes" && rel_alloc=yes + +test "$GNU_MALLOC" != "yes" -a "$have_mmap" != "yes" && rel_alloc=no +if test "$rel_alloc $have_mmap" = "default yes"; then + if test "$doug_lea_malloc" = "yes"; then + echo $ac_n "checking for M_MMAP_THRESHOLD""... $ac_c" 1>&6 +echo "configure:10776: checking for M_MMAP_THRESHOLD" >&5 + cat > conftest.$ac_ext < +int main() { + +#ifndef M_MMAP_THRESHOLD +#error No M_MMAP_THRESHOLD :-( +!@+$%^&*_)(_ - unlikely to compile... +#endif + +; return 0; } +EOF +if { (eval echo configure:10790: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + rel_alloc=no; echo "$ac_t""yes" 1>&6; +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + rel_alloc=yes; echo "$ac_t""no" 1>&6; +fi +rm -f conftest* + else + rel_alloc=yes + fi +fi test "$rel_alloc" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF Defining REL_ALLOC EOF @@ -10012,15 +10811,15 @@ ac_safe=`echo "termios.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for termios.h""... $ac_c" 1>&6 -echo "configure:10016: checking for termios.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10024: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:10823: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -10063,15 +10862,15 @@ echo "$ac_t""no" 1>&6 ac_safe=`echo "termio.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for termio.h""... $ac_c" 1>&6 -echo "configure:10067: checking for termio.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10075: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:10874: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -10103,10 +10902,10 @@ echo $ac_n "checking for socket""... $ac_c" 1>&6 -echo "configure:10107: checking for socket" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:10932: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_socket=yes" else @@ -10144,15 +10943,15 @@ echo "$ac_t""yes" 1>&6 ac_safe=`echo "netinet/in.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for netinet/in.h""... $ac_c" 1>&6 -echo "configure:10148: checking for netinet/in.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10156: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:10955: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -10169,15 +10968,15 @@ echo "$ac_t""yes" 1>&6 ac_safe=`echo "arpa/inet.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for arpa/inet.h""... $ac_c" 1>&6 -echo "configure:10173: checking for arpa/inet.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10181: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:10980: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -10202,9 +11001,9 @@ } echo $ac_n "checking "for sun_len member in struct sockaddr_un"""... $ac_c" 1>&6 -echo "configure:10206: checking "for sun_len member in struct sockaddr_un"" >&5 +echo "configure:11005: checking "for sun_len member in struct sockaddr_un"" >&5 cat > conftest.$ac_ext < @@ -10215,7 +11014,7 @@ static struct sockaddr_un x; x.sun_len = 1; ; return 0; } EOF -if { (eval echo configure:10219: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:11018: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* echo "$ac_t""yes" 1>&6; { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_SOCKADDR_SUN_LEN @@ -10233,9 +11032,9 @@ fi rm -f conftest* echo $ac_n "checking "for ip_mreq struct in netinet/in.h"""... $ac_c" 1>&6 -echo "configure:10237: checking "for ip_mreq struct in netinet/in.h"" >&5 +echo "configure:11036: checking "for ip_mreq struct in netinet/in.h"" >&5 cat > conftest.$ac_ext < @@ -10245,7 +11044,7 @@ static struct ip_mreq x; ; return 0; } EOF -if { (eval echo configure:10249: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:11048: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* echo "$ac_t""yes" 1>&6; { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_MULTICAST @@ -10276,10 +11075,10 @@ echo $ac_n "checking for msgget""... $ac_c" 1>&6 -echo "configure:10280: checking for msgget" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:11105: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_msgget=yes" else @@ -10317,15 +11116,15 @@ echo "$ac_t""yes" 1>&6 ac_safe=`echo "sys/ipc.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/ipc.h""... $ac_c" 1>&6 -echo "configure:10321: checking for sys/ipc.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10329: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:11128: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -10342,15 +11141,15 @@ echo "$ac_t""yes" 1>&6 ac_safe=`echo "sys/msg.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/msg.h""... $ac_c" 1>&6 -echo "configure:10346: checking for sys/msg.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10354: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:11153: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -10388,15 +11187,15 @@ ac_safe=`echo "dirent.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for dirent.h""... $ac_c" 1>&6 -echo "configure:10392: checking for dirent.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10400: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:11199: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -10423,15 +11222,15 @@ echo "$ac_t""no" 1>&6 ac_safe=`echo "sys/dir.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/dir.h""... $ac_c" 1>&6 -echo "configure:10427: checking for sys/dir.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10435: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:11234: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -10464,15 +11263,15 @@ ac_safe=`echo "nlist.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for nlist.h""... $ac_c" 1>&6 -echo "configure:10468: checking for nlist.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10476: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:11275: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -10502,26 +11301,22 @@ echo "checking "for sound support"" 1>&6 -echo "configure:10506: checking "for sound support"" >&5 -case "$with_sound" in - native | both ) with_native_sound=yes;; - nas | no ) with_native_sound=no;; -esac +echo "configure:11305: checking "for sound support"" >&5 test -z "$with_native_sound" -a -n "$native_sound_lib" && with_native_sound=yes if test "$with_native_sound" != "no"; then if test -n "$native_sound_lib"; then ac_safe=`echo "multimedia/audio_device.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for multimedia/audio_device.h""... $ac_c" 1>&6 -echo "configure:10517: checking for multimedia/audio_device.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10525: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:11320: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -10569,12 +11364,12 @@ if test -z "$native_sound_lib"; then echo $ac_n "checking for ALopenport in -laudio""... $ac_c" 1>&6 -echo "configure:10573: checking for ALopenport in -laudio" >&5 +echo "configure:11368: checking for ALopenport in -laudio" >&5 ac_lib_var=`echo audio'_'ALopenport | sed 'y%./+-%__p_%'` xe_check_libs=" -laudio " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:11384: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -10616,12 +11411,12 @@ if test -z "$native_sound_lib"; then echo $ac_n "checking for AOpenAudio in -lAlib""... $ac_c" 1>&6 -echo "configure:10620: checking for AOpenAudio in -lAlib" >&5 +echo "configure:11415: checking for AOpenAudio in -lAlib" >&5 ac_lib_var=`echo Alib'_'AOpenAudio | sed 'y%./+-%__p_%'` xe_check_libs=" -lAlib " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:11431: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -10670,15 +11465,15 @@ for dir in "machine" "sys" "linux"; do ac_safe=`echo "${dir}/soundcard.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ${dir}/soundcard.h""... $ac_c" 1>&6 -echo "configure:10674: checking for ${dir}/soundcard.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10682: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:11477: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -10694,6 +11489,7 @@ if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then echo "$ac_t""yes" 1>&6 sound_found=yes + need_miscplay=yes extra_objs="$extra_objs linuxplay.o" && if test "$extra_verbose" = "yes"; then echo " xemacs will be linked with \"linuxplay.o\"" fi @@ -10716,12 +11512,6 @@ test "$sound_found" = "yes" && with_native_sound=yes fi -if test -z "$with_sound"; then - if test "$with_native_sound" = "yes" -o -n "$native_sound_lib"; then - with_sound=native - fi -fi - if test "$with_native_sound" = "yes"; then { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_NATIVE_SOUND @@ -10734,8 +11524,78 @@ test -n "$native_sound_lib" && LIBS="$native_sound_lib $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"$native_sound_lib\" to \$LIBS"; fi fi -case "$with_sound" in both | nas ) - { test "$extra_verbose" = "yes" && cat << \EOF +if test "$with_nas_sound" != "no"; then + ac_safe=`echo "audio/audiolib.h" | sed 'y%./+-%__p_%'` +echo $ac_n "checking for audio/audiolib.h""... $ac_c" 1>&6 +echo "configure:11531: checking for audio/audiolib.h" >&5 + +cat > conftest.$ac_ext < +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:11539: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + rm -rf conftest* + eval "ac_cv_header_$ac_safe=yes" +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_header_$ac_safe=no" +fi +rm -f conftest* +if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then + echo "$ac_t""yes" 1>&6 + + +echo $ac_n "checking for AuOpenServer in -laudio""... $ac_c" 1>&6 +echo "configure:11557: checking for AuOpenServer in -laudio" >&5 +ac_lib_var=`echo audio'_'AuOpenServer | sed 'y%./+-%__p_%'` + +xe_check_libs=" -laudio " +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=no" +fi +rm -f conftest* +xe_check_libs="" + +if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then + echo "$ac_t""yes" 1>&6 + have_nas_sound=yes +else + echo "$ac_t""no" 1>&6 +fi + + +else + echo "$ac_t""no" 1>&6 +fi + + if test "$have_nas_sound" = "yes"; then + with_nas_sound=yes + { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_NAS_SOUND EOF cat >> confdefs.h <<\EOF @@ -10743,12 +11603,12 @@ EOF } - extra_objs="$extra_objs nas.o" && if test "$extra_verbose" = "yes"; then + extra_objs="$extra_objs nas.o" && if test "$extra_verbose" = "yes"; then echo " xemacs will be linked with \"nas.o\"" fi - libs_x="-laudio $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-laudio\" to \$libs_x"; fi - cat > conftest.$ac_ext < conftest.$ac_ext < EOF @@ -10757,7 +11617,7 @@ : else rm -rf conftest* - { test "$extra_verbose" = "yes" && cat << \EOF + old_nas=yes; { test "$extra_verbose" = "yes" && cat << \EOF Defining NAS_NO_ERROR_JUMP EOF cat >> confdefs.h <<\EOF @@ -10768,14 +11628,124 @@ fi rm -f conftest* -esac + else + test "$with_nas_sound" = "yes" && \ + { echo "Error:" "Required NAS sound support cannot be provided." >&2; exit 1; } + with_nas_sound=no + fi +fi + +if test "$with_esd_sound" != "no"; then + # Extract the first word of "esd-config", so it can be a program name with args. +set dummy esd-config; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +echo "configure:11643: checking for $ac_word" >&5 + +if test -n "$have_esd_config"; then + ac_cv_prog_have_esd_config="$have_esd_config" # Let the user override the test. +else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_have_esd_config="yes" + break + fi + done + IFS="$ac_save_ifs" + test -z "$ac_cv_prog_have_esd_config" && ac_cv_prog_have_esd_config="no" +fi +have_esd_config="$ac_cv_prog_have_esd_config" +if test -n "$have_esd_config"; then + echo "$ac_t""$have_esd_config" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + + if test "$have_esd_config" = "yes"; then + save_c_switch_site="$c_switch_site" save_LIBS="$LIBS" + c_switch_site="$c_switch_site `esd-config --cflags`" && if test "$extra_verbose" = "yes"; then echo " Appending \"`esd-config --cflags`\" to \$c_switch_site"; fi + LIBS="`esd-config --libs` $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"`esd-config --libs`\" to \$LIBS"; fi + echo $ac_n "checking for esd_play_stream""... $ac_c" 1>&6 +echo "configure:11672: checking for esd_play_stream" >&5 + +cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char esd_play_stream(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_esd_play_stream) || defined (__stub___esd_play_stream) +choke me +#else +esd_play_stream(); +#endif + +; return 0; } +EOF +if { (eval echo configure:11698: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_esd_play_stream=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_esd_play_stream=no" +fi +rm -f conftest* + +if eval "test \"`echo '$ac_cv_func_'esd_play_stream`\" = yes"; then + echo "$ac_t""yes" 1>&6 + have_esd_sound=yes +else + echo "$ac_t""no" 1>&6 +c_switch_site="$save_c_switch_site" LIBS="$save_LIBS" +fi + + fi + + if test "$have_esd_sound" = "yes"; then + with_esd_sound=yes + need_miscplay=yes + extra_objs="$extra_objs esd.o" && if test "$extra_verbose" = "yes"; then + echo " xemacs will be linked with \"esd.o\"" + fi + { test "$extra_verbose" = "yes" && cat << \EOF + Defining HAVE_ESD_SOUND +EOF +cat >> confdefs.h <<\EOF +#define HAVE_ESD_SOUND 1 +EOF +} + + else + test "$with_esd_sound" = "yes" && \ + { echo "Error:" "Required ESD sound support cannot be provided." >&2; exit 1; } + with_esd_sound=no + fi +fi + +test "$need_miscplay" = "yes" && extra_objs="$extra_objs miscplay.o" && if test "$extra_verbose" = "yes"; then + echo " xemacs will be linked with \"miscplay.o\"" + fi test -z "$with_tty" && with_tty=yes if test "$with_tty" = "yes" ; then echo "checking for TTY-related features" 1>&6 -echo "configure:10779: checking for TTY-related features" >&5 +echo "configure:11749: checking for TTY-related features" >&5 { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_TTY EOF @@ -10791,12 +11761,12 @@ if test -z "$with_ncurses"; then echo $ac_n "checking for tgetent in -lncurses""... $ac_c" 1>&6 -echo "configure:10795: checking for tgetent in -lncurses" >&5 +echo "configure:11765: checking for tgetent in -lncurses" >&5 ac_lib_var=`echo ncurses'_'tgetent | sed 'y%./+-%__p_%'` xe_check_libs=" -lncurses " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:11781: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -10840,15 +11810,15 @@ ac_safe=`echo "ncurses/curses.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ncurses/curses.h""... $ac_c" 1>&6 -echo "configure:10844: checking for ncurses/curses.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10852: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:11822: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -10870,15 +11840,15 @@ ac_safe=`echo "ncurses/term.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ncurses/term.h""... $ac_c" 1>&6 -echo "configure:10874: checking for ncurses/term.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10882: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:11852: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -10908,15 +11878,15 @@ c_switch_site="$c_switch_site -I/usr/include/ncurses" ac_safe=`echo "ncurses/curses.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ncurses/curses.h""... $ac_c" 1>&6 -echo "configure:10912: checking for ncurses/curses.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10920: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:11890: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -10951,12 +11921,12 @@ for lib in curses termlib termcap; do echo $ac_n "checking for tgetent in -l$lib""... $ac_c" 1>&6 -echo "configure:10955: checking for tgetent in -l$lib" >&5 +echo "configure:11925: checking for tgetent in -l$lib" >&5 ac_lib_var=`echo $lib'_'tgetent | sed 'y%./+-%__p_%'` xe_check_libs=" -l$lib " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:11941: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -10998,12 +11968,12 @@ else echo $ac_n "checking for tgetent in -lcurses""... $ac_c" 1>&6 -echo "configure:11002: checking for tgetent in -lcurses" >&5 +echo "configure:11972: checking for tgetent in -lcurses" >&5 ac_lib_var=`echo curses'_'tgetent | sed 'y%./+-%__p_%'` xe_check_libs=" -lcurses " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:11988: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -11032,12 +12002,12 @@ else echo "$ac_t""no" 1>&6 echo $ac_n "checking for tgetent in -ltermcap""... $ac_c" 1>&6 -echo "configure:11036: checking for tgetent in -ltermcap" >&5 +echo "configure:12006: checking for tgetent in -ltermcap" >&5 ac_lib_var=`echo termcap'_'tgetent | sed 'y%./+-%__p_%'` xe_check_libs=" -ltermcap " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:12022: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -11096,15 +12066,15 @@ test -z "$with_gpm" && { ac_safe=`echo "gpm.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for gpm.h""... $ac_c" 1>&6 -echo "configure:11100: checking for gpm.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:11108: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:12078: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -11127,12 +12097,12 @@ } test -z "$with_gpm" && { echo $ac_n "checking for Gpm_Open in -lgpm""... $ac_c" 1>&6 -echo "configure:11131: checking for Gpm_Open in -lgpm" >&5 +echo "configure:12101: checking for Gpm_Open in -lgpm" >&5 ac_lib_var=`echo gpm'_'Gpm_Open | sed 'y%./+-%__p_%'` xe_check_libs=" -lgpm " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:12117: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -11191,22 +12161,22 @@ fi -test "$with_database_gnudbm $with_database_dbm $with_database_berkdb" \ +test "$with_database_gdbm $with_database_dbm $with_database_berkdb" \ != "no no no" && echo "checking for database support" 1>&6 -echo "configure:11197: checking for database support" >&5 - -if test "$with_database_gnudbm $with_database_dbm" != "no no"; then +echo "configure:12167: checking for database support" >&5 + +if test "$with_database_gdbm $with_database_dbm" != "no no"; then ac_safe=`echo "ndbm.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ndbm.h""... $ac_c" 1>&6 -echo "configure:11202: checking for ndbm.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:11210: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:12180: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -11225,23 +12195,23 @@ else echo "$ac_t""no" 1>&6 - test "$with_database_gnudbm" = "yes" -o \ - "$with_database_dbm" = "yes" && \ + test "$with_database_gdbm" = "yes" -o \ + "$with_database_dbm" = "yes" && \ { echo "Error:" "Required DBM support cannot be provided." >&2; exit 1; } - with_database_gnudbm=no with_database_dbm=no -fi - -fi - -if test "$with_database_gnudbm" != "no"; then + with_database_gdbm=no with_database_dbm=no +fi + +fi + +if test "$with_database_gdbm" != "no"; then echo $ac_n "checking for dbm_open in -lgdbm""... $ac_c" 1>&6 -echo "configure:11240: checking for dbm_open in -lgdbm" >&5 +echo "configure:12210: checking for dbm_open in -lgdbm" >&5 ac_lib_var=`echo gdbm'_'dbm_open | sed 'y%./+-%__p_%'` xe_check_libs=" -lgdbm " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:12226: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -11266,13 +12236,13 @@ if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then echo "$ac_t""yes" 1>&6 - with_database_gnudbm=yes with_database_dbm=no libdbm=-lgdbm -else - echo "$ac_t""no" 1>&6 -if test "$with_database_gnudbm" = "yes"; then + with_database_gdbm=yes with_database_dbm=no libdbm=-lgdbm +else + echo "$ac_t""no" 1>&6 +if test "$with_database_gdbm" = "yes"; then { echo "Error:" "Required GNU DBM support cannot be provided." >&2; exit 1; } fi - with_database_gnudbm=no + with_database_gdbm=no fi @@ -11280,10 +12250,10 @@ if test "$with_database_dbm" != "no"; then echo $ac_n "checking for dbm_open""... $ac_c" 1>&6 -echo "configure:11284: checking for dbm_open" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:12280: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_dbm_open=yes" else @@ -11325,12 +12295,12 @@ echo $ac_n "checking for dbm_open in -ldbm""... $ac_c" 1>&6 -echo "configure:11329: checking for dbm_open in -ldbm" >&5 +echo "configure:12299: checking for dbm_open in -ldbm" >&5 ac_lib_var=`echo dbm'_'dbm_open | sed 'y%./+-%__p_%'` xe_check_libs=" -ldbm " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:12315: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -11369,8 +12339,8 @@ fi test -n "$libdbm" && LIBS=""$libdbm" $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \""$libdbm"\" to \$LIBS"; fi -test "$with_database_gnudbm" = "yes" -o \ - "$with_database_dbm" = "yes" && \ +test "$with_database_gdbm" = "yes" -o \ + "$with_database_dbm" = "yes" && \ { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_DBM EOF @@ -11382,11 +12352,14 @@ if test "$with_database_berkdb" != "no"; then echo $ac_n "checking for Berkeley db.h""... $ac_c" 1>&6 -echo "configure:11386: checking for Berkeley db.h" >&5 +echo "configure:12356: checking for Berkeley db.h" >&5 for path in "db/db.h" "db.h"; do cat > conftest.$ac_ext < +#if !(defined __GLIBC__ && __GLIBC_MINOR__ >= 1) #ifdef HAVE_INTTYPES_H #define __BIT_TYPES_DEFINED__ #include @@ -11397,13 +12370,14 @@ typedef uint64_t u_int64_t; #endif #endif +#endif #include <$path> int main() { ; return 0; } EOF -if { (eval echo configure:11407: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:12381: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* db_h_path="$path"; break else @@ -11419,9 +12393,9 @@ if test "$with_database_berkdb" != "no"; then echo $ac_n "checking for Berkeley DB version""... $ac_c" 1>&6 -echo "configure:11423: checking for Berkeley DB version" >&5 +echo "configure:12397: checking for Berkeley DB version" >&5 cat > conftest.$ac_ext < #if DB_VERSION_MAJOR > 1 @@ -11440,10 +12414,10 @@ rm -f conftest* echo $ac_n "checking for $dbfunc""... $ac_c" 1>&6 -echo "configure:11444: checking for $dbfunc" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:12444: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$dbfunc=yes" else @@ -11485,12 +12459,12 @@ echo $ac_n "checking for $dbfunc in -ldb""... $ac_c" 1>&6 -echo "configure:11489: checking for $dbfunc in -ldb" >&5 +echo "configure:12463: checking for $dbfunc in -ldb" >&5 ac_lib_var=`echo db'_'$dbfunc | sed 'y%./+-%__p_%'` xe_check_libs=" -ldb " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:12479: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -11547,7 +12521,7 @@ fi fi -if test "$with_database_gnudbm $with_database_dbm $with_database_berkdb" \ +if test "$with_database_gdbm $with_database_dbm $with_database_berkdb" \ != "no no no"; then { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_DATABASE @@ -11565,12 +12539,12 @@ if test "$with_socks" = "yes"; then echo $ac_n "checking for SOCKSinit in -lsocks""... $ac_c" 1>&6 -echo "configure:11569: checking for SOCKSinit in -lsocks" >&5 +echo "configure:12543: checking for SOCKSinit in -lsocks" >&5 ac_lib_var=`echo socks'_'SOCKSinit | sed 'y%./+-%__p_%'` xe_check_libs=" -lsocks " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:12559: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -11634,19 +12608,21 @@ LIBS="-Bstatic -lut -Bdynamic $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-Bstatic -lut -Bdynamic\" to \$LIBS"; fi fi -for ac_hdr in dlfcn.h -do -ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:11642: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext < +if test "$with_modules" != "no"; then + echo "checking for module support" 1>&6 +echo "configure:12614: checking for module support" >&5 + + ac_safe=`echo "dlfcn.h" | sed 'y%./+-%__p_%'` +echo $ac_n "checking for dlfcn.h""... $ac_c" 1>&6 +echo "configure:12618: checking for dlfcn.h" >&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:11650: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:12626: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -11661,36 +12637,15 @@ rm -f conftest* if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then echo "$ac_t""yes" 1>&6 - ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_hdr -EOF -cat >> confdefs.h <> confdefs.h <<\EOF -#define HAVE_DLFCN_H 1 -EOF -} - -else - echo "$ac_t""no" 1>&6 -fi -done - -test -z "$with_shlib" && test ! -z "$have_dlfcn" && { + + echo $ac_n "checking for dlopen in -ldl""... $ac_c" 1>&6 -echo "configure:11689: checking for dlopen in -ldl" >&5 +echo "configure:12644: checking for dlopen in -ldl" >&5 ac_lib_var=`echo dl'_'dlopen | sed 'y%./+-%__p_%'` xe_check_libs=" -ldl " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:12660: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -11715,38 +12670,28 @@ if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_DLOPEN -EOF -cat >> confdefs.h <<\EOF -#define HAVE_DLOPEN 1 -EOF -} - DLL_LIB=dl; with_shlib=yes -else - echo "$ac_t""no" 1>&6 -fi - - } -test -z "$with_shlib" && test ! -z "$have_dlfcn" && { -echo $ac_n "checking for _dlopen in -lc""... $ac_c" 1>&6 -echo "configure:11734: checking for _dlopen in -lc" >&5 -ac_lib_var=`echo c'_'_dlopen | sed 'y%./+-%__p_%'` + have_dl=yes libdl=dl +else + echo "$ac_t""no" 1>&6 + +echo $ac_n "checking for dlopen in -lc""... $ac_c" 1>&6 +echo "configure:12679: checking for dlopen in -lc" >&5 +ac_lib_var=`echo c'_'dlopen | sed 'y%./+-%__p_%'` xe_check_libs=" -lc " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +#line 12684 "configure" +#include "confdefs.h" +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char dlopen(); + +int main() { +dlopen() +; return 0; } +EOF +if { (eval echo configure:12695: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -11760,38 +12705,48 @@ if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF + have_dl=yes +else + echo "$ac_t""no" 1>&6 +fi + + +fi + + +else + echo "$ac_t""no" 1>&6 +fi + + if test -n "$have_dl"; then + { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_DLOPEN EOF cat >> confdefs.h <<\EOF #define HAVE_DLOPEN 1 EOF } - DLL_LIB=; with_shlib=yes -else - echo "$ac_t""no" 1>&6 -fi - - } -test -z "$with_shlib" && test ! -z "$have_dlfcn" && { -echo $ac_n "checking for dlopen in -lc""... $ac_c" 1>&6 -echo "configure:11779: checking for dlopen in -lc" >&5 -ac_lib_var=`echo c'_'dlopen | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lc " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + + else + +echo $ac_n "checking for shl_load in -ldld""... $ac_c" 1>&6 +echo "configure:12734: checking for shl_load in -ldld" >&5 +ac_lib_var=`echo dld'_'shl_load | sed 'y%./+-%__p_%'` + +xe_check_libs=" -ldld " +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -11805,38 +12760,36 @@ if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_DLOPEN -EOF -cat >> confdefs.h <<\EOF -#define HAVE_DLOPEN 1 -EOF -} - DLL_LIB=; with_shlib=yes -else - echo "$ac_t""no" 1>&6 -fi - - } -test -z "$with_shlib" && { -echo $ac_n "checking for shl_load in -ldld""... $ac_c" 1>&6 -echo "configure:11824: checking for shl_load in -ldld" >&5 -ac_lib_var=`echo dld'_'shl_load | sed 'y%./+-%__p_%'` + libdl=dld have_dl=yes; + { test "$extra_verbose" = "yes" && cat << \EOF + Defining HAVE_SHL_LOAD +EOF +cat >> confdefs.h <<\EOF +#define HAVE_SHL_LOAD 1 +EOF +} + +else + echo "$ac_t""no" 1>&6 + +echo $ac_n "checking for dld_init in -ldld""... $ac_c" 1>&6 +echo "configure:12777: checking for dld_init in -ldld" >&5 +ac_lib_var=`echo dld'_'dld_init | sed 'y%./+-%__p_%'` xe_check_libs=" -ldld " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +#line 12782 "configure" +#include "confdefs.h" +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char dld_init(); + +int main() { +dld_init() +; return 0; } +EOF +if { (eval echo configure:12793: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -11850,66 +12803,27 @@ if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_SHL_LOAD -EOF -cat >> confdefs.h <<\EOF -#define HAVE_SHL_LOAD 1 -EOF -} - DLL_LIB=dld; with_shlib=yes -else - echo "$ac_t""no" 1>&6 -fi - - } -test -z "$with_shlib" && { -echo $ac_n "checking for dld_init in -ldld""... $ac_c" 1>&6 -echo "configure:11869: checking for dld_init in -ldld" >&5 -ac_lib_var=`echo dld'_'dld_init | sed 'y%./+-%__p_%'` - -xe_check_libs=" -ldld " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF + libdl=dld have_dl=yes; + { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_DLD_INIT EOF cat >> confdefs.h <<\EOF #define HAVE_DLD_INIT 1 EOF } - DLL_LIB=dld; with_shlib=yes -else - echo "$ac_t""no" 1>&6 -fi - - } -if test "$with_shlib" = "yes"; then - + +else + echo "$ac_t""no" 1>&6 +fi + + +fi + + + fi + + if test -n "$have_dl"; then + dll_ld= dll_ldflags= dll_cflags= @@ -11920,7 +12834,7 @@ xealias=$internal_configuration echo "checking how to build dynamic libraries for ${xehost}" 1>&6 -echo "configure:11924: checking how to build dynamic libraries for ${xehost}" >&5 +echo "configure:12838: checking how to build dynamic libraries for ${xehost}" >&5 # Transform *-*-linux* to *-*-linux-gnu*, to support old configure scripts. case "$xehost" in *-*-linux-gnu*) ;; @@ -11948,9 +12862,9 @@ XEGCC=yes else echo $ac_n "checking checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:11952: checking checking whether we are using GNU C" >&5 +echo "configure:12866: checking checking whether we are using GNU C" >&5 cat > conftest.$ac_ext <&6 -echo "configure:11976: checking how to produce PIC code" >&5 +echo "configure:12890: checking how to produce PIC code" >&5 wl= can_build_shared=yes @@ -11984,7 +12898,7 @@ # PIC is the default for these OSes. ;; - os2*) + aix3* | aix4* | os2*) # We can build DLLs from non-PIC. ;; amigaos*) @@ -12000,7 +12914,7 @@ else # PORTME Check for PIC flags for the system compiler. case "$xehost_os" in - hpux9* | hpux10*) + hpux9* | hpux1[0-9]*) # Is there a better link_static_flag that works with the bundled CC? wl='-Wl,' dll_cflags='+Z' @@ -12065,18 +12979,18 @@ # Check to make sure the dll_cflags actually works. echo $ac_n "checking if PIC flag ${dll_cflags} really works""... $ac_c" 1>&6 -echo "configure:12069: checking if PIC flag ${dll_cflags} really works" >&5 +echo "configure:12983: checking if PIC flag ${dll_cflags} really works" >&5 save_CFLAGS="$CFLAGS" CFLAGS="$CFLAGS $dll_cflags -DPIC" cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:12994: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* # On HP-UX, the stripped-down bundled CC doesn't accept +Z, but also @@ -12107,7 +13021,7 @@ xldf= xcldf= echo $ac_n "checking if C compiler can produce shared libraries""... $ac_c" 1>&6 -echo "configure:12111: checking if C compiler can produce shared libraries" >&5 +echo "configure:13025: checking if C compiler can produce shared libraries" >&5 if test "$XEGCC" = yes; then xcldf="-shared" xldf="-shared" @@ -12158,14 +13072,14 @@ xe_libs= ac_link='${CC-cc} -o conftest $CFLAGS '"$xe_cppflags $xe_ldflags"' conftest.$ac_ext '"$xe_libs"' 1>&5' cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:13083: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* cc_produces_so=yes else @@ -12190,7 +13104,7 @@ if test "$XEGCC" = yes; then # Check if gcc -print-prog-name=ld gives a path. echo $ac_n "checking for ld used by GCC""... $ac_c" 1>&6 -echo "configure:12194: checking for ld used by GCC" >&5 +echo "configure:13108: checking for ld used by GCC" >&5 ac_prog=`($CC -print-prog-name=ld) 2>&5` case "$ac_prog" in # Accept absolute paths. @@ -12215,7 +13129,7 @@ esac else echo $ac_n "checking for GNU ld""... $ac_c" 1>&6 -echo "configure:12219: checking for GNU ld" >&5 +echo "configure:13133: checking for GNU ld" >&5 fi if test -z "$LTLD"; then @@ -12253,7 +13167,7 @@ # Check to see if it really is or isn't GNU ld. echo $ac_n "checking if the linker is GNU ld""... $ac_c" 1>&6 -echo "configure:12257: checking if the linker is GNU ld" >&5 +echo "configure:13171: checking if the linker is GNU ld" >&5 # I'd rather use --version here, but apparently some GNU ld's only accept -v. if $LTLD -v 2>&1 &5; then xe_gnu_ld=yes @@ -12280,7 +13194,7 @@ # OK - only NOW do we futz about with ld. # See if the linker supports building shared libraries. echo $ac_n "checking whether the linker supports shared libraries""... $ac_c" 1>&6 -echo "configure:12284: checking whether the linker supports shared libraries" >&5 +echo "configure:13198: checking whether the linker supports shared libraries" >&5 dll_ld=$CC dll_ldflags=$LDFLAGS ld_shlibs=yes @@ -12445,7 +13359,11 @@ ld_dynamic_link_flags= ;; - sco3.2v5* | unixware* | sysv5* | sysv4* | solaris2* | solaris7*) + solaris2* | solaris7*) + ld_dynamic_link_flags= + ;; + + sco3.2v5* | unixware* | sysv5* | sysv4*) ld_dynamic_link_flags="${wl}-Bexport" ;; @@ -12472,6 +13390,8 @@ + fi + if test "$can_build_shared" = "yes"; then { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_SHLIB @@ -12481,21 +13401,18 @@ EOF } - extra_objs="$extra_objs sysdll.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"sysdll.o\"" - fi - extra_objs="$extra_objs emodules.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"emodules.o\"" + extra_objs="$extra_objs sysdll.o emodules.o" && if test "$extra_verbose" = "yes"; then + echo " xemacs will be linked with \"sysdll.o emodules.o\"" fi INSTALL_ARCH_DEP_SUBDIR="$INSTALL_ARCH_DEP_SUBDIR src" && if test "$extra_verbose" = "yes"; then echo " Appending \"src\" to \$INSTALL_ARCH_DEP_SUBDIR"; fi - test ! -z "$DLL_LIB" && LIBS="-l${DLL_LIB} $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-l${DLL_LIB}\" to \$LIBS"; fi + test -n "$libdl" && LIBS="-l${libdl} $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-l${libdl}\" to \$LIBS"; fi for ac_func in dlerror _dlerror do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:12496: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:13439: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -12545,18 +13462,23 @@ fi done + with_modules=yes else - echo "configure: warning: disabling shared library support" 1>&2 - with_shlib=no - fi -fi - -cat > conftest.$ac_ext <&2; exit 1; } + else + echo "configure: warning: "Module support cannot be provided."" 1>&2 + fi + with_modules=no + fi +fi + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 +if { (eval echo configure:13482: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 then : else @@ -12583,8 +13505,12 @@ fi rm -fr conftest* - -{ test "$extra_verbose" = "yes" && cat << \EOF +if test "$win32_processes" = "yes"; then + extra_objs="$extra_objs process-nt.o" && if test "$extra_verbose" = "yes"; then + echo " xemacs will be linked with \"process-nt.o\"" + fi +else + { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_UNIX_PROCESSES EOF cat >> confdefs.h <<\EOF @@ -12592,9 +13518,10 @@ EOF } -extra_objs="$extra_objs process-unix.o" && if test "$extra_verbose" = "yes"; then + extra_objs="$extra_objs process-unix.o" && if test "$extra_verbose" = "yes"; then echo " xemacs will be linked with \"process-unix.o\"" fi +fi @@ -12692,13 +13619,25 @@ echo "" fi -if test -f $srcdir/src/gdbinit -a ! -f src/gdbinit ; then - echo "creating src/gdbinit"; echo "" - echo "source $srcdir/src/gdbinit" > src/gdbinit + +if test -f "$srcdir/src/.gdbinit" -a ! -f "src/.gdbinit"; then + test "$extra_verbose" = "yes" && echo "creating src/.gdbinit" + echo "source $srcdir/src/.gdbinit" > "src/.gdbinit" +fi + +if test -f "$srcdir/src/.dbxrc" -a ! -f "src/.dbxrc"; then + test "$extra_verbose" = "yes" && echo "creating src/.dbxrc" + echo ". $srcdir/src/.dbxrc" > "src/.dbxrc" +fi + +if test -f "$srcdir/TAGS" -a ! -f "TAGS"; then + test "$extra_verbose" = "yes" && echo "creating TAGS" + echo " +$srcdir/TAGS,include" > "TAGS" fi if test "$__SUNPRO_C" = "yes"; then - echo "creating .sbinit"; echo "" + test "$extra_verbose" = "yes" && echo "creating .sbinit" ( echo "# For use with Sun WorkShop's Source browser." echo "# See sbquery(1) and sbinit(4) for more information" for dir in $MAKE_SUBDIR; do echo "import $dir"; done @@ -12722,6 +13661,9 @@ + + + PREFIX=$prefix while true; do case "$PREFIX" in @@ -12732,6 +13674,7 @@ + EXEC_PREFIX=$exec_prefix while true; do case "$EXEC_PREFIX" in @@ -12842,6 +13785,17 @@ +DOCDIR=$docdir +while true; do + case "$DOCDIR" in + *\$* ) eval "DOCDIR=$DOCDIR" ;; + *) break ;; + esac +done + + + + ARCHLIBDIR=$archlibdir while true; do case "$ARCHLIBDIR" in @@ -12880,6 +13834,16 @@ : ${XEMACS_CC:=$CC} +if test "$with_prefix" = "yes"; then + { test "$extra_verbose" = "yes" && cat << \EOF + Defining PREFIX_USER_DEFINED +EOF +cat >> confdefs.h <<\EOF +#define PREFIX_USER_DEFINED 1 +EOF +} + +fi if test "$with_site_lisp" = "no"; then { test "$extra_verbose" = "yes" && cat << \EOF @@ -12908,10 +13872,10 @@ ac_configure_args="$T" { test "$extra_verbose" = "yes" && cat << EOF - Defining EMACS_CONFIGURATION = "$canonical" + Defining EMACS_CONFIGURATION = "$configuration" EOF cat >> confdefs.h <> confdefs.h <> confdefs.h <<\EOF +#define PDUMP 1 +EOF +} + ( @@ -13117,8 +14080,15 @@ echo "$0 $quoted_arguments" ) > Installation -xemacs_betaname="" -test ! -z "${emacs_beta_version}" && xemacs_betaname="-b${emacs_beta_version}" +if test ! -z ${emacs_beta_version} ; then + if test -z "${emacs_is_beta}" ; then + xemacs_betaname=".${emacs_beta_version}" + else + xemacs_betaname="-b${emacs_beta_version}" + fi +else + xemacs_betaname="" +fi ( echo " @@ -13149,6 +14119,10 @@ if test -n "$runpath"; then echo " Runtime library search path: $runpath" fi +if test "$have_xaw" = "yes"; then + echo " Athena library to link: $athena_lib" + echo " Athena header include path: $athena_h_path" +fi test "$with_dnet" = yes && echo " Compiling in support for DNET." test "$with_socks" = yes && echo " Compiling in support for SOCKS." test "$with_xauth" = yes && echo " Compiling in support for XAUTH." @@ -13186,20 +14160,17 @@ test "$with_jpeg" = yes && echo " Compiling in support for JPEG image handling." test "$with_tiff" = yes && echo " Compiling in support for TIFF image handling." test "$with_xface" = yes && echo " Compiling in support for X-Face message headers." -case "$with_sound" in - nas ) echo " Compiling in network sound (NAS) support." ;; - native ) echo " Compiling in native sound support." ;; - both ) echo " Compiling in both network and native sound support." ;; -esac -test "$old_nas" = yes && echo " nas library lacks error trapping, will play synchronously." + +test "$with_native_sound" = yes && echo " Compiling in native sound support." +test "$with_nas_sound" = yes && echo " Compiling in network sound (NAS) support." +test "$old_nas" = yes && echo " nas library lacks error trapping, will play synchronously." +test "$with_esd_sound" = yes && echo " Compiling in support for Enlightened Sound Daemon (ESD)." test "$with_database_berkdb" = yes && echo " Compiling in support for Berkeley DB." test "$with_database_dbm" = yes && echo " Compiling in support for DBM." -test "$with_database_gnudbm" = yes && echo " Compiling in support for GNU DBM." - -test "$with_umich_ldap" = yes && echo " Compiling in support for LDAP (UMich libs)." -test "$with_ns_ldap" = yes && echo " Compiling in support for LDAP (Netscape SDK)." -test "$with_ldap" = yes -a "$with_umich_ldap" = no -a "$with_ns_ldap" = no && echo " Compiling in support for LDAP (Generic)." +test "$with_database_gdbm" = yes && echo " Compiling in support for GNU DBM." + +test "$with_ldap" = yes && echo " Compiling in support for LDAP." test "$with_ncurses" = yes && echo " Compiling in support for ncurses." test "$with_gpm" = yes && echo " Compiling in support for GPM (General Purpose Mouse)." @@ -13222,19 +14193,25 @@ test "$with_offix" = yes && echo " Compiling in support for OffiX." test "$with_dragndrop" = yes && echo " Compiling in EXPERIMENTAL support for Drag'n'Drop ($dragndrop_proto )." test "$with_workshop" = yes && echo " Compiling in support for Sun WorkShop." -test "$with_session" != no && echo " Compiling in support for proper session-management." +test "$with_wmcommand" != no && echo " Compiling in support for proper WM_COMMAND handling." case "$with_menubars" in lucid ) echo " Using Lucid menubars." ;; motif ) echo " Using Motif menubars." echo " *WARNING* The Motif menubar implementation is currently buggy." echo " We recommend using the Lucid menubar instead." echo " Re-run configure with --with-menubars='lucid'." ;; + msw ) echo " Using MS-Windows menubars." ;; esac case "$with_scrollbars" in lucid ) echo " Using Lucid scrollbars." ;; motif ) echo " Using Motif scrollbars." ;; athena ) echo " Using Athena scrollbars." ;; - athena3d ) echo " Using Athena-3d scrollbars." ;; + msw ) echo " Using MS-Windows scrollbars." ;; +esac +case "$with_widgets" in + motif ) echo " Using Motif native widgets." ;; + athena ) echo " Using Athena native widgets." ;; + msw ) echo " Using MS-Windows native widgets." ;; esac case "$with_dialogs" in motif ) @@ -13247,9 +14224,9 @@ fi; fi ;; athena ) echo " Using Athena dialog boxes." ;; - athena3d ) echo " Using Athena-3d dialog boxes." ;; + msw ) echo " Using MS-Windows dialog boxes." ;; esac -test "$with_shlib" = "yes" && echo " Compiling in DLL support." +test "$with_modules" = "yes" && echo " Compiling in dynamic shared object module support." test "$with_clash_detection" = yes && \ echo " Clash detection will use \"$lockdir\" for locking files." echo " movemail will use \"$mail_locking\" for locking mail spool files." @@ -13257,11 +14234,9 @@ test "$with_kerberos" = yes && echo " Using Kerberos for POP authentication." test "$with_hesiod" = yes && echo " Using Hesiod to get POP server host." test "$use_union_type" = yes && echo " Using the union type for Lisp_Objects." -test "$use_minimal_tagbits" = yes && echo " Using Lisp_Objects with minimal tagbits." -test "$use_indexed_lrecord_implementation" = yes && echo " Using indexed lrecord implementation." -test "$debug" = yes && echo " Compiling in extra code for debugging." -test "$memory_usage_stats" = yes && echo " Compiling in code for checking XEmacs memory usage." -test "$usage_tracking" = yes && echo " Compiling with usage tracking active (Sun internal)." +test "$pdump" = yes && echo " Using the new portable dumper (wishful thinking)." +test "$debug" = yes && echo " Compiling in extra code for debugging." +test "$usage_tracking" = yes && echo " Compiling with usage tracking active (Sun internal)." if test "$error_check_extents $error_check_typecheck $error_check_bufpos $error_check_gc $error_check_malloc" \ != "no no no no no"; then echo " WARNING: ---------------------------------------------------------" @@ -13274,10 +14249,6 @@ ) | tee -a Installation echo "" -echo '(setq Installation-string "' > Installation.el -sed 's/"/\\"/g' Installation >> Installation.el -echo '")' >> Installation.el - # Remove any trailing slashes in these variables. test -n "$prefix" && @@ -13289,12 +14260,10 @@ for file in $internal_makefile_list; do test "$file" = src/Makefile.in && \ file="src/Makefile.in:src/Makefile.in.in:src/depend" - ac_output_files="${ac_output_files+$ac_output_files }$file" + ac_output_files="$ac_output_files $file" && if test "$extra_verbose" = "yes"; then echo " Appending \"$file\" to \$ac_output_files"; fi done ac_output_files="$ac_output_files src/paths.h lib-src/config.values" -if test "$with_shlib" = "yes"; then - ac_output_files="$ac_output_files lib-src/ellcc.h" -fi +test "$with_modules" = "yes" && ac_output_files="$ac_output_files lib-src/ellcc.h" && if test "$extra_verbose" = "yes"; then echo " Appending \"lib-src/ellcc.h\" to \$ac_output_files"; fi trap '' 1 2 15 @@ -13407,6 +14376,7 @@ s%@dnd_objs@%$dnd_objs%g s%@lwlib_objs@%$lwlib_objs%g s%@ALLOCA@%$ALLOCA%g +s%@have_esd_config@%$have_esd_config%g s%@dll_ld@%$dll_ld%g s%@dll_cflags@%$dll_cflags%g s%@dll_ldflags@%$dll_ldflags%g @@ -13421,10 +14391,14 @@ s%@version@%$version%g s%@configuration@%$configuration%g s%@canonical@%$canonical%g +s%@inststaticdir@%$inststaticdir%g +s%@instvardir@%$instvardir%g s%@srcdir@%$srcdir%g s%@pkgdir@%$pkgdir%g s%@statedir@%$statedir%g +s%@PREFIX_USER_DEFINED@%$PREFIX_USER_DEFINED%g s%@PREFIX@%$PREFIX%g +s%@EXEC_PREFIX_USER_DEFINED@%$EXEC_PREFIX_USER_DEFINED%g s%@EXEC_PREFIX@%$EXEC_PREFIX%g s%@INFODIR_USER_DEFINED@%$INFODIR_USER_DEFINED%g s%@INFODIR@%$INFODIR%g @@ -13452,10 +14426,12 @@ s%@lockdir@%$lockdir%g s%@LOCKDIR_USER_DEFINED@%$LOCKDIR_USER_DEFINED%g s%@LOCKDIR@%$LOCKDIR%g +s%@docdir@%$docdir%g +s%@DOCDIR_USER_DEFINED@%$DOCDIR_USER_DEFINED%g +s%@DOCDIR@%$DOCDIR%g s%@archlibdir@%$archlibdir%g s%@ARCHLIBDIR_USER_DEFINED@%$ARCHLIBDIR_USER_DEFINED%g s%@ARCHLIBDIR@%$ARCHLIBDIR%g -s%@docdir@%$docdir%g s%@bitmapdir@%$bitmapdir%g s%@extra_objs@%$extra_objs%g s%@machfile@%$machfile%g diff -r f4aeb21a5bad -r 74fd4e045ea6 configure.in --- a/configure.in Mon Aug 13 11:12:06 2007 +0200 +++ b/configure.in Mon Aug 13 11:13:30 2007 +0200 @@ -345,28 +345,29 @@ statedir='${prefix}/lib' libdir='${exec_prefix}/lib' mandir='${prefix}/man/man1' -infodir='${datadir}/${PROGNAME}-${version}/info' +inststaticdir='${PROGNAME}' +instvardir='${PROGNAME}-${version}' +infodir='${datadir}/${instvardir}/info' infopath='' install_pp='' -lispdir='${datadir}/${PROGNAME}-${version}/lisp' -moduledir='${datadir}/${PROGNAME}-${version}/${configuration}/modules' -sitelispdir='${datadir}/xemacs/site-lisp' -sitemoduledir='${datadir}/xemacs/site-modules' -pkgdir='${datadir}/${PROGNAME}-${version}/lisp' +lispdir='${datadir}/${instvardir}/lisp' +moduledir='${datadir}/${instvardir}/${configuration}/modules' +sitelispdir='${datadir}/${inststaticdir}/site-lisp' +sitemoduledir='${datadir}/${inststaticdir}/site-modules' +pkgdir='${datadir}/${instvardir}/lisp' package_path='' -etcdir='${datadir}/${PROGNAME}-${version}/etc' -lockdir='${statedir}/${PROGNAME}/lock' -archlibdir='${datadir}/${PROGNAME}-${version}/${configuration}' +etcdir='${datadir}/${instvardir}/etc' +lockdir='${statedir}/${inststaticdir}/lock' +archlibdir='${datadir}/${instvardir}/${configuration}' +docdir='${archlibdir}' +with_prefix='yes' with_site_lisp='no' with_site_modules='yes' with_menubars='' with_scrollbars='' +with_widgets='' with_dialogs='' with_file_coding='' -dnl const_is_losing is removed - we rely on AC_C_CONST instead. -dnl We accept (and ignore) the --const-is-losing option for compatibility. -dnl const_is_losing='yes' -puresize='' cpp='' cppflags='' libs='' ldflags='' dynamic='' with_x11='' @@ -384,6 +385,9 @@ with_tty="" use_union_type="no" with_dnet="" +pdump="no" +dnl dragndrop is still experimental. When it is stable, comment out the following line: +with_dragndrop="no" dnl ------------------ dnl Options Processing @@ -464,7 +468,8 @@ dnl Process (many) boolean options with_site_lisp | \ - with_site_modules | \ + with_prefix | \ + with_site_modules | \ with_x | \ with_x11 | \ with_msw | \ @@ -483,7 +488,7 @@ with_jpeg | \ with_png | \ with_tiff | \ - with_session | \ + with_wmcommand | \ with_xmu | \ with_purify | \ with_quantify | \ @@ -508,17 +513,14 @@ external_widget | \ verbose | \ extra_verbose | \ - const_is_losing | \ usage_tracking | \ use_union_type | \ + pdump | \ debug | \ use_assertions | \ - gung_ho | \ - use_minimal_tagbits | \ - use_indexed_lrecord_implementation | \ memory_usage_stats | \ with_clash_detection | \ - with_shlib | \ + with_modules | \ no_doc_file ) dnl Make sure the value given was either "yes" or "no". case "$val" in @@ -529,7 +531,7 @@ eval "$opt=\"$val\"" ;; - dnl Options that take a user-supplied value, as in --puresize=8000000 + dnl Options that take a user-supplied value, as in --x-includes=/usr/X11R6/include dnl The cache-file option is ignored (for compatibility with other configures) srcdir | \ compiler | \ @@ -538,7 +540,6 @@ cppflags | \ libs | \ ldflags | \ - puresize | \ cache_file | \ native_sound_lib| \ site_lisp | \ @@ -579,20 +580,20 @@ "with_database" ) with_database_berkdb=no with_database_dbm=no - with_database_gnudbm=no + with_database_gdbm=no for x in `echo "$val" | sed -e 's/,/ /g'` ; do case "$x" in - no ) ;; - b | be | ber | berk | berkd | berkdb ) with_database_berkdb=yes ;; - d | db | dbm ) with_database_dbm=yes ;; - g | gn | gnu | gnud | gnudb | gnudbm ) with_database_gnudbm=yes ;; - * ) USAGE_ERROR(["The \`--$optname' option value + no ) ;; + b | be | ber | berk | berkd | berkdb ) with_database_berkdb=yes ;; + d | db | dbm ) with_database_dbm=yes ;; + g | gn | gnu | gnud | gnudb | gnudbm | gdbm) with_database_gdbm=yes ;; + * ) USAGE_ERROR(["The \`--$optname' option value must be either \`no' or a comma-separated list of one or more of \`berkdb' and either \`dbm' or \`gnudbm'."]) ;; esac done - if test "$with_database_dbm" = "yes" -a \ - "$with_database_gnudbm" = "yes"; then + if test "$with_database_dbm" = "yes" -a \ + "$with_database_gdbm" = "yes"; then USAGE_ERROR("Only one of \`dbm' and \`gnudbm' may be specified with the \`--$optname' option.") fi @@ -600,16 +601,54 @@ dnl Has the user requested sound support? "with_sound" ) - dnl value can be native, nas or both. yes is allowed - dnl as a backwards compatible synonym for native + dnl values is a subset of all,native,nas,esd + dnl or their negatives: none,nonative,nonas,noesd + for x in `echo "$val" | sed -e 's/,/ /g'` ; do + case "$x" in + dnl all and none are only permitted as the first in the list. + n | no | non | none ) new_sdefault=no ;; + a | al | all | both ) new_sdefault=yes ;; + + native ) with_native_sound=yes ;; + nonative ) with_native_sound=no ;; + + nas ) with_nas_sound=yes ;; + nonas ) with_nas_sound=no ;; + + esd ) with_esd_sound=yes ;; + noesd ) with_esd_sound=no ;; + + * ) bogus_sound=yes ;; + esac + if test "$bogus_sound" -o \ + \( -n "$new_sdefault" -a -n "$sound_notfirst" \) ; then + types="\`all', \`none', \`(no)native', \`no(nas)', \`(no)esd'." + USAGE_ERROR(["Valid types for the \`--$optname' option are: + $types. +The default is to autodetect all sound support."]) + elif test -n "$new_sdefault" ; then + with_native_sound=$new_sdefault + with_nas_sound=$new_sdefault + with_esd_sound=$new_sdefault + new_sdefault= # reset this + fi + sound_notfirst=true + done + ;; + + dnl Has the user specified a prefered Athena widget set? + dnl This bit expands any alias names out for us... + "with_athena" ) case "$val" in - y | ye | yes ) val=native ;; - n | no | non | none ) val=no;; - na | nat | nati | nativ | native ) val=native ;; - ne | net | neta | netau | netaud | netaudi | netaudio | nas ) val=nas ;; - b | bo | bot | both ) val=both;; + xa | xaw ) val=xaw ;; + 3 | 3d | xaw3d ) val=3d ;; + dnl No `n' for next, someone may try `no' + ne | nex | next | naxtaw) val=next ;; + dnl Have not tested the next two... + 9 | 95 | xaw95 ) val=95 ;; + xp | xpm | xawxpm ) val=xpm ;; * ) USAGE_ERROR(["The \`--$optname' option must have one of these values: - \`native', \`nas', \`both', or \`none'."]) ;; + \`xaw', \`3d', \`next', \`95', or \`xpm'."]) ;; esac eval "$opt=\"$val\"" ;; @@ -632,9 +671,10 @@ case "$val" in lockf ) val=lockf ;; flock ) val=flock ;; - file ) val=file ;; + file | dot ) val=file ;; + locking ) val=locking ;; * ) USAGE_ERROR(["The \`--$optname' option must have one of these values: - \`lockf', \`flock', or \`file'."]) ;; + \`lockf', \`flock', \`file', \`locking', or \`mmdf'."]) ;; esac eval "$opt=\"$val\"" ;; @@ -666,14 +706,17 @@ malloc ) error_check_malloc=yes ;; nomalloc ) error_check_malloc=no ;; + byte_code ) error_check_byte_code=yes ;; + nobyte_code ) error_check_byte_code=no ;; + * ) bogus_error_check=yes ;; esac if test "$bogus_error_check" -o \ \( -n "$new_default" -a -n "$echeck_notfirst" \) ; then if test "$error_check_default" = yes ; then - types="\`all' (default), \`none', \`noextents', \`notypecheck', \`nobufpos', \`nogc', and \`nomalloc'." + types="\`all' (default), \`none', \`noextents', \`notypecheck', \`nobufpos', \`nogc', \`nomalloc', and \`nobyte-code'." else - types="\`all', \`none' (default), \`extents', \`typecheck', \`bufpos', \`gc', and \`malloc'." + types="\`all', \`none' (default), \`extents', \`typecheck', \`bufpos', \`gc', \`malloc', and \`byte-code'." fi USAGE_ERROR(["Valid types for the \`--$optname' option are: $types."]) @@ -683,6 +726,7 @@ error_check_bufpos=$new_default error_check_gc=$new_default error_check_malloc=$new_default + error_check_byte_code=$new_default new_default= # reset this fi echeck_notfirst=true @@ -710,6 +754,8 @@ dnl You need to synchronize this with the way the dnl default values are built. case "$opt" in + dnl prefix is taken care of by --with-prefix + exec_prefix ) AC_DEFINE(EXEC_PREFIX_USER_DEFINED) ;; lispdir ) AC_DEFINE(LISPDIR_USER_DEFINED) ;; sitelispdir ) AC_DEFINE(SITELISPDIR_USER_DEFINED) ;; moduledir ) AC_DEFINE(MODULEDIR_USER_DEFINED) ;; @@ -723,6 +769,7 @@ AC_DEFINE(MODULEDIR_USER_DEFINED) AC_DEFINE(ETCDIR_USER_DEFINED) ;; statedir | lockdir ) AC_DEFINE(LOCKDIR_USER_DEFINED) ;; + docdir ) AC_DEFINE(DOCDIR_USER_DEFINED) ;; exec_prefix | libdir | archlibdir ) AC_DEFINE(ARCHLIBDIR_USER_DEFINED) ;; esac ;; @@ -736,21 +783,24 @@ dnl Has the user specified the toolkit(s) to use for GUI elements? "with_menubars" | \ "with_scrollbars" | \ - "with_dialogs" ) + "with_dialogs" | \ + "with_widgets" ) case "$val" in l | lu | luc | luci | lucid ) val=lucid ;; m | mo | mot | moti | motif ) val=motif ;; - athena3d | athena-3d ) val=athena3d ;; a | at | ath | athe | athen | athena ) val=athena ;; n | no | non | none ) val=no ;; * ) USAGE_ERROR(["The \`--$optname' option must have one of these values: - \`lucid', \`motif', \`athena', \`athena3d', or \`no'."]) ;; + \`lucid', \`motif', \`athena', or \`no'."]) ;; esac eval "$opt=\"$val\"" ;; dnl Obsolete legacy argument? Warn, but otherwise ignore. + "use_minimal_tagbits" | \ + "use_indexed_lrecord_implementation" | \ "run_in_place" | \ + "const_is_losing" | \ "with_gnu_make" ) AC_MSG_WARN([Obsolete option \`--$optname' ignored.]) ;; @@ -794,19 +844,6 @@ test "$with_system_malloc" = "default" && with_system_malloc=yes fi -dnl --gung-ho=val is a synonym for -dnl --use-minimal-tagbits=val --use-indexed-lrecord-implementation=val -if test -n "$gung_ho"; then - test -z "$use_minimal_tagbits" && use_minimal_tagbits="$gung_ho" - test -z "$use_indexed_lrecord_implementation" && \ - use_indexed_lrecord_implementation="$gung_ho" -fi -if test "$use_minimal_tagbits" = "no"; then - test "$with_dlmalloc" = "yes" && \ - USAGE_ERROR("--with-dlmalloc requires --use-minimal-tagbits") - with_dlmalloc=no -fi - dnl XE_CHECK_FEATURE_DEPENDENCY(feature1, feature2) define([XE_CHECK_FEATURE_DEPENDENCY], [if test "$with_$1 $with_$2" = "yes no"; then @@ -869,7 +906,7 @@ dnl have stuck the source on a read-only partition. Instead we dnl create it as an actual directory later on if it does not already dnl exist. -for dir in lisp etc man info; do +for dir in lisp etc man info tests; do if test ! -d "$dir" ; then echo Making symbolic link to "$srcdir/$dir" ${LN_S} "$srcdir/$dir" "$dir" @@ -927,20 +964,25 @@ dnl ---------------------------------------- . "$srcdir/version.sh" || exit 1; dnl Must do the following first to determine verbosity for AC_DEFINE -if test -n "$emacs_beta_version"; then beta=yes; else beta=no; fi +if test -n "$emacs_is_beta"; then beta=yes; else beta=no; fi : "${extra_verbose=$beta}" version="${emacs_major_version}.${emacs_minor_version}" AC_DEFINE_UNQUOTED(EMACS_MAJOR_VERSION, $emacs_major_version) AC_DEFINE_UNQUOTED(EMACS_MINOR_VERSION, $emacs_minor_version) -if test -n "$emacs_beta_version"; then - version="${version}-b${emacs_beta_version}" - AC_DEFINE_UNQUOTED(EMACS_BETA_VERSION, $emacs_beta_version) +if test -n "$emacs_beta_version" ; then + if test "$beta" = "yes"; then + version="${version}-b${emacs_beta_version}" + AC_DEFINE_UNQUOTED(EMACS_BETA_VERSION, $emacs_beta_version) + else + version="${version}.${emacs_beta_version}" + AC_DEFINE_UNQUOTED(EMACS_PATCH_LEVEL, $emacs_beta_version) + fi fi AC_DEFINE_UNQUOTED(XEMACS_CODENAME, "$xemacs_codename") AC_DEFINE_UNQUOTED(EMACS_VERSION, "$version") if test "$with_infodock" = "yes"; then - if test ! -f ../ID-INSTALL; then + if test ! -f ../../ID-INSTALL; then echo "Cannot build InfoDock without InfoDock sources" with_infodock=no fi @@ -964,18 +1006,20 @@ dnl ---------------------------------- dnl Error checking default to "yes" in beta versions, to "no" in releases. dnl Same goes for --debug and --extra-verbosity. -if test -n "$emacs_beta_version"; then beta=yes; else beta=no; fi +if test -n "$emacs_is_beta"; then beta=yes; else beta=no; fi test "${error_check_extents=$beta}" = yes && AC_DEFINE(ERROR_CHECK_EXTENTS) test "${error_check_typecheck=$beta}" = yes && AC_DEFINE(ERROR_CHECK_TYPECHECK) test "${error_check_bufpos=$beta}" = yes && AC_DEFINE(ERROR_CHECK_BUFPOS) test "${error_check_gc=$beta}" = yes && AC_DEFINE(ERROR_CHECK_GC) test "${error_check_malloc=$beta}" = yes && AC_DEFINE(ERROR_CHECK_MALLOC) +test "${error_check_byte_code=$beta}" = yes && AC_DEFINE(ERROR_CHECK_BYTE_CODE) dnl debug=yes must be set when error checking is present. This should be dnl fixed up. dnl debug implies other options if test "${debug:=$beta}" = "yes"; then use_assertions=yes memory_usage_stats=yes XE_ADD_OBJS(debug.o) + XE_ADD_OBJS(tests.o) AC_DEFINE(DEBUG_XEMACS) fi test "$use_assertions" = "yes" && AC_DEFINE(USE_ASSERTIONS) @@ -1027,7 +1071,9 @@ alpha*-*-* ) machine=alpha ;; vax-*-* ) machine=vax ;; mips-dec-* ) machine=pmax ;; + mips-sgi-irix6* ) machine=iris6d ;; mips-sgi-* ) machine=iris4d ;; + mips*-linux ) machine=mips ;; romp-ibm-* ) machine=ibmrt ;; rs6000-ibm-aix* ) machine=ibmrs6000 ;; powerpc-ibm-aix* ) machine=ibmrs6000 ;; @@ -1038,6 +1084,7 @@ mips-sony-* ) machine=news-risc ;; clipper-* ) machine=clipper ;; arm-* ) machine=arm ;; + armv[34][lb]-* ) machine=arm ;; ns32k-* ) machine=ns32000 ;; esac @@ -1481,10 +1528,13 @@ else NON_GNU_CPP="/lib/cpp -D_XOPEN_SOURCE" ; fi ;; + *-sysv5* ) opsys=sco7 ;; *-386bsd* ) opsys=386bsd ;; *-freebsd* ) opsys=freebsd ;; *-nextstep* ) opsys=nextstep ;; - *-pc-cygwin32 ) opsys=cygwin32 ;; + *-pc-cygwin* ) opsys=cygwin32 ;; + *-pc-mingw* ) opsys=mingw32 ; + test -z "$with_tty" && with_tty="no";; dnl Otherwise, we fall through to the generic opsys code at the bottom. esac ;; @@ -1591,7 +1641,14 @@ AC_PROG_CPP -AC_AIX +dnl -------------------------------------------------------------------- +dnl Compiler feature macros +dnl -------------------------------------------------------------------- + +dnl We want feature macros defined here and in config.h.in, so that +dnl the compilation environment at configure time and compile time agree. + +AC_AIX dnl Defines _ALL_SOURCE on AIX. AC_MSG_CHECKING(for GNU libc) AC_TRY_COMPILE([#include ],[ @@ -1605,6 +1662,23 @@ dnl Well. then why not fix fucking pop? test "$have_glibc" = "yes" && AC_DEFINE(_GNU_SOURCE) +dnl We'd like to use vendor extensions, where available. +dnl We'd like to use functions from the latest Unix98 standards. +dnl See http://www.opengroup.org/onlinepubs/007908799/xsh/compilation.html +case "$opsys" in + sol2) + AC_DEFINE(__EXTENSIONS__) + dnl Solaris 2 before 2.5 had some bugs with feature test macro interaction. + if test "$os_release" -ge 55; then + AC_DEFINE(_XOPEN_SOURCE,500) + AC_DEFINE(_XOPEN_SOURCE_EXTENDED) + fi ;; + linux) + AC_DEFINE(_POSIX_C_SOURCE,199506L) + AC_DEFINE(_XOPEN_SOURCE,500) + AC_DEFINE(_XOPEN_SOURCE_EXTENDED) + ;; +esac dnl Identify compilers to enable compiler-specific hacks. dnl Add support for other compilers HERE! @@ -1722,8 +1796,11 @@ CPP_boolean_to_sh(ORDINARY_LINK, ordinary_link) CPP_boolean_to_sh(SYSTEM_MALLOC, system_malloc) CPP_boolean_to_sh(TERMINFO, have_terminfo) +dnl The MAIL_USE_xxx variables come from the s&m headers CPP_boolean_to_sh(MAIL_USE_FLOCK, mail_use_flock) CPP_boolean_to_sh(MAIL_USE_LOCKF, mail_use_lockf) +CPP_boolean_to_sh(MAIL_USE_LOCKING, mail_use_locking) +CPP_boolean_to_sh(HAVE_WIN32_PROCESSES, win32_processes) EOF dnl The value of CPP is a quoted variable reference, so we need to do this @@ -1745,6 +1822,13 @@ ld lib_gcc ld_text_start_addr start_files ordinary_link have_terminfo mail_use_flock mail_use_lockf) && echo "" +dnl Pick up mingw32 include path +case "$opsys" in mingw*) mingw_include=`eval "gcc -print-file-name=libc.a"` ; + mingw_include=`eval "dirname $mingw_include"` ; + mingw_include="-I$mingw_include/../include/mingw32" ; + XE_APPEND($mingw_include, c_switch_system) ;; +esac + dnl Non-ordinary link usually requires -lc test "$ordinary_link" = "no" -a -z "$libs_standard" && libs_standard="-lc" @@ -1758,13 +1842,10 @@ dnl Following values of CFLAGS are known to work well. dnl Should we take debugging options into consideration? if test "$GCC" = "yes"; then - CFLAGS="-g -O3 -Wall -Wno-switch" + CFLAGS="-g -O3 -Wall -Wno-switch -Wpointer-arith -Winline -Wmissing-prototypes -Wshadow" dnl I'm not convinced this is a good idea any more. -sb dnl test "$opsys $machine" = "linux intel386" && \ dnl CFLAGS="$CFLAGS -fno-strength-reduce -malign-loops=2 -malign-jumps=2 -malign-functions=2" - dnl cygwin b19 can't cope with -O3, but most people use 20.1 or egcs now. - dnl test "$opsys $machine" = "cygwin32 intel386" && \ - dnl CFLAGS="-g -O2 -Wall -Wno-switch" elif test "$__SUNPRO_C" = "yes"; then case "$opsys" in sol2 ) CFLAGS="-v -xO4" ;; @@ -1900,16 +1981,16 @@ COLON_TO_SPACE(site_prefixes) if test -n "$site_prefixes"; then for dir in $site_prefixes; do + lib_dir="${dir}/lib" inc_dir="${dir}/include" - lib_dir="${dir}/lib" if test ! -d "$dir"; then XE_DIE("Invalid site prefix \`$dir': no such directory") - elif test ! -d "$inc_dir"; then - XE_DIE("Invalid site prefix \`$dir': no such directory \`$inc_dir'") elif test ! -d "$lib_dir"; then XE_DIE("Invalid site prefix \`$dir': no such directory \`$lib_dir'") else - XE_APPEND("-I$inc_dir", c_switch_site) + if test -d "$inc_dir"; then + XE_APPEND("-I$inc_dir", c_switch_site) + fi XE_APPEND("-L$lib_dir", ld_switch_site) fi done @@ -1923,7 +2004,7 @@ dnl Extra system-specific library directories - please add to list for dir in "/usr/ccs/lib"; do - test -d "$dir" && XE_APPEND(-L${dir}, ld_switch_site) + test -d "$dir" && XE_APPEND(-L${dir}, ld_switch_system) done dnl --site-runtime-libraries (multiple dirs) @@ -1933,11 +2014,31 @@ export LD_RUN_PATH fi +dnl Linux systems have dynamic runtime library directories listed in +dnl /etc/ld.so.conf. Since those are used at run time, it seems pretty +dnl safe to use them at link time, and less controversial than forcing +dnl the run-time to use the link-time libraries. This also helps avoid +dnl mismatches between the link-time and run-time libraries. + +dnl #### Unfortunately, there are horrible libc4 and libc5 libraries +dnl listed in /etc/ld.so.conf on some systems, and including them on +dnl the link path leads to linking in utterly broken libc's. +dnl There are many clever ways of approaching this problem, +dnl but finding out that actually works... + +dnl if test -z "$LD_RUN_PATH" -a -r "/etc/ld.so.conf"; then +dnl for dir in `cat /etc/ld.so.conf`; do +dnl test -d "$dir" && XE_APPEND(-L${dir}, ld_switch_system) +dnl done +dnl add_runtime_path=no +dnl fi + dnl ------------------------------------- dnl Compute runtime library path dnl ------------------------------------- -if test "$dynamic" = "no"; then add_runtime_path=no +if test -n "$add_runtime_path"; then :; +elif test "$dynamic" = "no"; then add_runtime_path=no elif test -n "$LD_RUN_PATH"; then add_runtime_path=yes else case "$opsys" in sol2 | irix* | *bsd* | decosf* ) add_runtime_path=yes ;; @@ -2150,6 +2251,7 @@ AC_TYPE_UID_T AC_TYPE_MODE_T AC_TYPE_OFF_T +AC_CHECK_TYPE(ssize_t, int) AC_MSG_CHECKING(for struct timeval) AC_TRY_COMPILE([#ifdef TIME_WITH_SYS_TIME @@ -2198,7 +2300,7 @@ AC_SYS_LONG_FILE_NAMES dnl -lm is required by LISP_FLOAT_TYPE, among other things -AC_CHECK_LIB(m, sin) +AC_CHECK_FUNC(sin, ,AC_CHECK_LIB(m, sin)) dnl Floating operation support is now unconditional AC_DEFINE(LISP_FLOAT_TYPE) @@ -2209,18 +2311,22 @@ dnl Determine type of mail locking from configure args and s&m headers AC_CHECKING(type of mail spool file locking) +AC_CHECK_FUNCS(lockf flock) +dnl The mail_use_xxx variables are set according to the s&m headers. test -z "$mail_locking" -a "$mail_use_flock" = "yes" && mail_locking=flock test -z "$mail_locking" -a "$mail_use_lockf" = "yes" && mail_locking=lockf -if test "$mail_locking" = "lockf"; then AC_DEFINE(REAL_MAIL_USE_LOCKF) -elif test "$mail_locking" = "flock"; then AC_DEFINE(REAL_MAIL_USE_FLOCK) -else mail_locking="dot-locking" +test -z "$mail_locking" -a "$mail_use_locking" = "yes" && mail_locking=locking +if test "$mail_locking" = "lockf"; then AC_DEFINE(MAIL_LOCK_LOCKF) +elif test "$mail_locking" = "flock"; then AC_DEFINE(MAIL_LOCK_FLOCK) +elif test "$mail_locking" = "locking"; then AC_DEFINE(MAIL_LOCK_LOCKING) +else mail_locking="dot-locking"; AC_DEFINE(MAIL_LOCK_DOT) fi - -dnl Used by getloadavg() - does not require root priveleges -AC_CHECK_LIB(kstat, kstat_open) - -dnl Another way to get the load average -AC_CHECK_LIB(kvm, kvm_read) +test "$mail_locking" = "lockf" -a "$ac_cv_func_lockf" != "yes" && \ + XE_DIE("lockf mail locking requested but not available.") +test "$mail_locking" = "flock" -a "$ac_cv_func_flock" != "yes" && \ + XE_DIE("flock mail locking requested but not available.") +test "$mail_locking" = "locking" -a "$ac_cv_func_locking" != "yes" && \ + XE_DIE("locking mail locking requested but not available.") case "$opsys" in decosf*) AC_CHECK_LIB(pthreads, cma_open) @@ -2238,7 +2344,7 @@ fi dnl Link with "-z ignore" on Solaris if supported -if test "$opsys" = "sol2" && test "$OS_RELEASE" -ge 56; then +if test "$opsys" = "sol2" -a "$os_release" -ge 56; then AC_MSG_CHECKING(for \"-z ignore\" linker flag) case "`ld -h 2>&1`" in *-z\ ignore\|record* ) AC_MSG_RESULT(yes) @@ -2426,6 +2532,8 @@ AC_MSG_RESULT(R${x11_release}) AC_DEFINE_UNQUOTED(THIS_IS_X11R${x11_release}) + AC_CHECK_FUNCS(XConvertCase) + AC_CHECK_HEADERS(X11/Xlocale.h) dnl remove this - we should avoid checking for specific OS @@ -2477,7 +2585,7 @@ if test "$with_msw" = "yes"; then AC_DEFINE(HAVE_MS_WINDOWS) install_pp="$blddir/lib-src/installexe.sh" - XE_APPEND(-lshell32 -lgdi32 -luser32 -lcomctl32, libs_system) + XE_APPEND(-lshell32 -lgdi32 -luser32 -lcomctl32 -lwinspool, libs_system) test "$with_dragndrop" != no && XE_APPEND(msw, dragndrop_proto) if test "$window_system" != x11; then window_system=msw @@ -2489,6 +2597,7 @@ && XE_ADD_OBJS(toolbar-msw.o) test "$with_dialogs" != "no" && with_dialogs=msw \ && XE_ADD_OBJS(dialog-msw.o) + test "$with_widgets" != "no" && with_widgets=msw else test "$with_scrollbars" != "no" && XE_ADD_OBJS(scrollbar-msw.o) test "$with_menubars" != "no" && XE_ADD_OBJS(menubar-msw.o) @@ -2499,10 +2608,7 @@ AC_TRY_RUN([#include int main() { return (open("/dev/windows", O_RDONLY, 0) > 0)? 0 : 1; }], [AC_DEFINE(HAVE_MSG_SELECT)]) - const_is_losing=no with_file_coding=yes - use_minimal_tagbits=yes - use_indexed_lrecord_implementation=yes XE_ADD_OBJS(console-msw.o device-msw.o event-msw.o frame-msw.o objects-msw.o select-msw.o redisplay-msw.o glyphs-msw.o gui-msw.o) fi fi @@ -2545,7 +2651,7 @@ dnl if test "$with_tty" = "no" ; then dnl AC_MSG_ERROR([No window system support and no TTY support - Unable to proceed.]) dnl fi - for feature in tooltalk cde offix session xim xmu + for feature in tooltalk cde offix wmcommand xim xmu nas_sound do if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then AC_MSG_WARN([--with-$feature ignored: Not valid without X support]) @@ -2568,11 +2674,11 @@ test "$opsys" = "hpux9-shr" && opsysfile="s/hpux9shxr4.h" esac -dnl Enable or disable proper session-management -AC_CHECKING(for session-management option); -dnl if test "$with_session" = "yes"; then -if test "$with_session" != "no"; then - AC_DEFINE(HAVE_SESSION) +dnl Enable or disable proper handling of WM_COMMAND +AC_CHECKING(for WM_COMMAND option); +dnl if test "$with_wmcommand" = "yes"; then +if test "$with_wmcommand" != "no"; then + AC_DEFINE(HAVE_WMCOMMAND) fi dnl Autodetect Xauth @@ -2686,23 +2792,29 @@ test -z "$with_ldap" && { AC_CHECK_HEADER(ldap.h, ,with_ldap=no) } test -z "$with_ldap" && { AC_CHECK_HEADER(lber.h, ,with_ldap=no) } if test "$with_ldap" != "no"; then - test -z "$with_umich_ldap" && { AC_CHECK_LIB(ldap, ldap_open, with_umich_ldap=yes, with_umich_ldap=no, -llber) } - test "$with_umich_ldap" = "no" && { AC_CHECK_LIB(ldap10, ldap_set_option, with_ns_ldap=yes, with_ns_ldap=no) } - test -z "$with_ldap" -a \( "$with_umich_ldap" = "yes" -o "$with_ns_ldap" = "yes" \) && with_ldap=yes + AC_CHECK_LIB(ldap, ldap_search, with_ldap_nolber=yes, with_ldap_nolber=no) + test "$with_ldap_nolber" = "no" && { AC_CHECK_LIB(ldap, ldap_open, with_ldap_lber=yes, with_ldap_lber=no, -llber) } + test "$with_ldap_nolber" = "no" -a "$with_ldap_lber" = "no" && { AC_CHECK_LIB(ldap, ldap_open, with_ldap_krb=yes, with_ldap_krb=no, -llber -lkrb) } + test "$with_ldap_nolber" = "no" -a "$with_ldap_lber" = "no" -a "$with_ldap_krb" = "no" && { AC_CHECK_LIB(ldap, ldap_open, with_ldap_krbdes=yes, with_ldap_krbdes=no, -llber -lkrb -ldes) } + test -z "$with_ldap" -a \( "$with_ldap_lber" = "yes" -o "$with_ldap_nolber" = "yes" -o "$with_ldap_krb" = "yes" -o "$with_ldap_krbdes" = "yes" \) && with_ldap=yes fi if test "$with_ldap" = "yes"; then AC_DEFINE(HAVE_LDAP) XE_ADD_OBJS(eldap.o) - if test "$with_umich_ldap" = "yes" ; then - AC_DEFINE(HAVE_UMICH_LDAP) + if test "$with_ldap_nolber" = "yes" ; then + XE_PREPEND(-lldap, LIBS) + else + if test "$with_ldap_krb" = "yes" ; then + XE_PREPEND(-lkrb, LIBS) + fi + if test "$with_ldap_krbdes" = "yes" ; then + XE_PREPEND(-ldes, LIBS) + XE_PREPEND(-lkrb, LIBS) + fi XE_PREPEND(-llber, LIBS) XE_PREPEND(-lldap, LIBS) - elif test "$with_ldap" = "yes" -a "$with_ns_ldap" = "yes" ; then - AC_DEFINE(HAVE_NS_LDAP) - XE_PREPEND(-lldap10, LIBS) - elif test "$with_ldap" = "yes" ; then - XE_PREPEND(-lldap, LIBS) fi + AC_CHECK_FUNCS(ldap_set_option ldap_get_lderrno ldap_result2error ldap_parse_result) fi dnl ---------------------- @@ -2717,7 +2829,8 @@ if test -z "$with_xpm"; then AC_MSG_CHECKING(for Xpm - no older than 3.4f) xe_check_libs=-lXpm - AC_TRY_RUN([#include + AC_TRY_RUN([#define XPM_NUMBERS +#include int main(int c, char **v) { return c == 1 ? 0 : XpmIncludeVersion != XpmLibraryVersion() ? 1 : @@ -2850,13 +2963,101 @@ AC_CHECKING(for X11 graphics libraries) - dnl Autodetect -lXaw - AC_CHECK_LIB(Xaw, XawScrollbarSetThumb, have_xaw=yes, have_xaw=no) - dnl if test "$have_xaw" = "yes"; then - dnl AC_CHECK_HEADER(X11/Xaw/Reports.h, [ - dnl XE_APPEND(pkg-src/tree-x, MAKE_SUBDIR) - dnl XE_APPEND(pkg-src/tree-x, INSTALL_ARCH_DEP_SUBDIR)]) - dnl fi + AC_CHECKING(for the Athena widgets) + + dnl What in heck did the user actually want? + case "$with_athena" in + dnl This is the default, old fashioned flat Athena. + "xaw" | "") athena_variant=Xaw athena_3d=no ;; + "3d") athena_variant=Xaw3d athena_3d=yes ;; + "next") athena_variant=neXtaw athena_3d=yes ;; + "95") athena_variant=Xaw95 athena_3d=yes ;; + "xpm") athena_variant=XawXpm athena_3d=yes ;; + *) XE_DIE("Unknown Athena widget set \`$with_athena'. This should not happen.") ;; + esac + + dnl Search for the Athena library... + if test "$athena_3d" = "no"; then + AC_CHECK_LIB($athena_variant, XawScrollbarSetThumb, + [ + dnl Must not be a 3d library... + AC_CHECK_LIB($athena_variant, threeDClassRec, + AC_MSG_WARN("Could not find a non-3d Athena widget library."), + athena_lib=$athena_variant) + ], + AC_MSG_WARN("Could not find an Athena widget library.")) + else + dnl The real configuration, need 3d library + AC_CHECK_LIB($athena_variant, threeDClassRec, athena_lib=$athena_variant, + dnl OK, couldn't find it with a proper name, try the standard Athena lib + dnl If that is 3d, presume the user asked for what they have installed. + AC_CHECK_LIB(Xaw, threeDClassRec, + [ + athena_lib=Xaw; + AC_MSG_WARN("Assuming that libXaw is actually $athena_variant."); + ], + AC_MSG_WARN("Could not find a 3d Athena widget library that looked like $athena_variant."))) + fi + + dnl Now we locate the Athena headers that we need. + if test "$athena_3d" = "no"; then + AC_CHECK_HEADER(X11/Xaw/ThreeD.h, + AC_MSG_WARN("Could not find a non-3d Athena header set."), + AC_CHECK_HEADER(X11/Xaw/XawInit.h, + athena_h_path=X11/Xaw, + AC_MSG_WARN("Could not find a non-3d Athena header set."))) + else + dnl The three-d Athena headers are so much more slippery. + dnl Curse this `Lets replace standard libraries' thing that they did. :/ + AC_CHECK_HEADER(X11/$athena_variant/XawInit.h, + AC_CHECK_HEADER(X11/$athena_variant/ThreeD.h, + athena_h_path=X11/$athena_variant,)) + + dnl Is the variant specific header directory directly under include? + if test -z "$athena_h_path"; then + AC_CHECK_HEADER($athena_variant/XawInit.h, + AC_CHECK_HEADER($athena_variant/ThreeD.h, + athena_h_path=$athena_variant,)) + fi + + dnl If we couldn't find the specific variant, try the generic Athena 3d headers + if test -z "$athena_h_path" -a "$athena_variant" != "Xaw3d"; then + AC_CHECK_HEADER(X11/Xaw3d/XawInit.h, + AC_CHECK_HEADER(X11/Xaw3d/ThreeD.h, + [ + AC_MSG_WARN("Assuming that X11/Xaw3d headers are suitable for $athena_variant.") + athena_h_path=X11/Xaw3d + ],)) + fi + + dnl Also generic 3d headers directly under include dir + if test -z "$athena_h_path" -a "$athena_variant" != "Xaw3d"; then + AC_CHECK_HEADER(Xaw3d/XawInit.h, + AC_CHECK_HEADER(Xaw3d/ThreeD.h, + [ + AC_MSG_WARN("Assuming that Xaw3d headers are suitable for $athena_variant.") + athena_h_path=Xaw3d + ],)) + fi + + dnl If nothing yet found, see if Xaw is a 3d header set... + dnl We AC_MSG_WARN if we fail because I am all out of ideas... + if test -z "$athena_h_path"; then + AC_CHECK_HEADER(X11/Xaw/ThreeD.h, + [ + AC_MSG_WARN("Assuming that X11/Xaw headers are suitable for $athena_variant.") + athena_h_path=X11/Xaw + ], + AC_MSG_WARN("Could not find a suitable 3d Athena header set.")) + fi + fi + + dnl Do we actually have a usable Athena widget set? Please? + if test -n "$athena_lib" -a -n "$athena_h_path"; then + have_xaw=yes + else + have_xaw=no + fi dnl autodetect Motif - but only add to libs_x later (if necessary) AC_CHECK_HEADER(Xm/Xm.h, @@ -2881,26 +3082,50 @@ dnl Not all toolkits support all widgets dnl if Motif is available we use it for the dialog boxes. -case "$with_menubars" in "" | "yes" | "athena" | "athena3d" ) +case "$with_menubars" in "" | "yes" | "athena" ) with_menubars="lucid" ;; esac case "$with_dialogs" in "" | "yes" | "lucid" ) - if test "$have_motif" = "yes"; then with_dialogs="motif" - elif test "$have_xaw" = "yes"; then with_dialogs="athena" + if test "$have_motif" = "yes"; then with_dialogs="motif" + elif test "$have_xaw" = "yes"; then with_dialogs="athena" else with_dialogs=no fi ;; esac case "$with_scrollbars" in "" | "yes" ) with_scrollbars="lucid" ;; esac - -all_widgets="$with_menubars $with_scrollbars $with_dialogs $with_toolbars" - -case "$all_widgets" in *athena* ) - AC_DEFINE(LWLIB_USES_ATHENA) - AC_DEFINE(NEED_ATHENA) - XE_APPEND(lwlib-Xaw.o, lwlib_objs) - XE_PREPEND(-lXaw, libs_x) ;; +case "$with_widgets" in "" | "yes" | "lucid") + if test "$have_motif" = "yes"; then with_widgets="motif" + elif test "$have_xaw" = "yes"; then with_widgets="athena" + else with_widgets=no + fi ;; +esac + +all_widgets="$with_menubars $with_scrollbars $with_dialogs $with_toolbars $with_widgets" + +case "$all_widgets" in + *athena* ) + if test "$have_xaw" != "yes"; then + XE_DIE("Could not find a suitable Athena library to build with.") + fi + + dnl Add the Lucid widget Athena code + XE_APPEND(lwlib-Xaw.o, lwlib_objs) + + dnl Add the Athena widget library we located earlier + XE_PREPEND(-l$athena_lib, libs_x) + + dnl Export the path for lwlib, used to build and include the headers + dnl from the right place later on. + AC_DEFINE_UNQUOTED(ATHENA_H_PATH, $athena_h_path) + + AC_DEFINE(LWLIB_USES_ATHENA) + AC_DEFINE(NEED_ATHENA) + + if test "$athena_3d" = "yes"; then + AC_DEFINE(HAVE_ATHENA_3D) + fi + ;; esac case "$all_widgets" in *motif* ) @@ -2913,6 +3138,11 @@ test "$with_menubars" = "lucid" && XE_APPEND(xlwmenu.o, lwlib_objs) test "$with_menubars" = "motif" && XE_APPEND(xlwmenu.o, lwlib_objs) test "$with_scrollbars" = "lucid" && XE_APPEND(xlwscrollbar.o, lwlib_objs) +test "$with_widgets" != "no" && test "$with_widgets" != "msw" && \ + XE_APPEND(xlwtabs.o xlwgcs.o, lwlib_objs) +case "$with_widgets" in athena* ) + XE_APPEND(xlwradio.o xlwcheckbox.o xlwgauge.o, lwlib_objs);; +esac case "$all_widgets" in *lucid* ) AC_DEFINE(NEED_LUCID) XE_APPEND(lwlib-Xlw.o, lwlib_objs) ;; @@ -2920,15 +3150,23 @@ AC_SUBST(lwlib_objs) -case "$with_scrollbars" in athena* ) AC_DEFINE(LWLIB_SCROLLBARS_ATHENA);; esac -case "$with_dialogs" in athena* ) AC_DEFINE(LWLIB_DIALOGS_ATHENA) ;; esac -test "$with_scrollbars" = "athena3d" && AC_DEFINE(LWLIB_SCROLLBARS_ATHENA3D) -test "$with_dialogs" = "athena3d" && AC_DEFINE(LWLIB_DIALOGS_ATHENA3D) +test "$with_scrollbars" = "athena" && AC_DEFINE(LWLIB_SCROLLBARS_ATHENA) +test "$with_dialogs" = "athena" && AC_DEFINE(LWLIB_DIALOGS_ATHENA) + +if test "$athena_3d" = "yes"; then + test "$with_scrollbars" = "athena" && AC_DEFINE(LWLIB_SCROLLBARS_ATHENA3D) + test "$with_dialogs" = "athena" && AC_DEFINE(LWLIB_DIALOGS_ATHENA3D) +fi + +case "$with_widgets" in athena* ) AC_DEFINE(LWLIB_WIDGETS_ATHENA);; esac +test "$with_widgets" != "no" && test "$with_widgets" != "msw" && \ + AC_DEFINE(LWLIB_TABS_LUCID) test "$with_menubars" != "no" && AC_DEFINE(HAVE_MENUBARS) test "$with_scrollbars" != "no" && AC_DEFINE(HAVE_SCROLLBARS) test "$with_dialogs" != "no" && AC_DEFINE(HAVE_DIALOGS) test "$with_toolbars" != "no" && AC_DEFINE(HAVE_TOOLBARS) +test "$with_widgets" != "no" && AC_DEFINE(HAVE_WIDGETS) test "$with_menubars" = "lucid" && AC_DEFINE(LWLIB_MENUBARS_LUCID) test "$with_scrollbars" = "lucid" && AC_DEFINE(LWLIB_SCROLLBARS_LUCID) @@ -2936,30 +3174,21 @@ test "$with_menubars" = "motif" && AC_DEFINE(LWLIB_MENUBARS_MOTIF) test "$with_scrollbars" = "motif" && AC_DEFINE(LWLIB_SCROLLBARS_MOTIF) test "$with_dialogs" = "motif" && AC_DEFINE(LWLIB_DIALOGS_MOTIF) - -test "$with_menubars" != "no" && XE_ADD_OBJS(menubar.o) -test "$with_scrollbars" != "no" && XE_ADD_OBJS(scrollbar.o) -test "$with_dialogs" != "no" && XE_ADD_OBJS(dialog.o) -test "$with_toolbars" != "no" && XE_ADD_OBJS(toolbar.o) +test "$with_widgets" = "motif" && AC_DEFINE(LWLIB_WIDGETS_MOTIF) + +test "$with_menubars" != "no" && XE_ADD_OBJS(menubar.o) +test "$with_scrollbars" != "no" && XE_ADD_OBJS(scrollbar.o) +test "$with_dialogs" != "no" && XE_ADD_OBJS(dialog.o) +test "$with_toolbars" != "no" && XE_ADD_OBJS(toolbar.o) if test "$with_x11" = "yes"; then - test "$with_menubars" != "no" && XE_ADD_OBJS(menubar-x.o) - test "$with_scrollbars" != "no" && XE_ADD_OBJS(scrollbar-x.o) - test "$with_dialogs" != "no" && XE_ADD_OBJS(dialog-x.o) - test "$with_toolbars" != "no" && XE_ADD_OBJS(toolbar-x.o) - test "$all_widgets" != "no no no no" && XE_ADD_OBJS(gui-x.o) -else - if test \( "$with_sound" = "nas" \) -o \( "$with_sound" = "both" \); then - echo "Attempt to Build NAS sound without X" - echo "Please remove NAS configuration or build with X" - exit 1 - fi + test "$with_menubars" != "no" && XE_ADD_OBJS(menubar-x.o) + test "$with_scrollbars" != "no" && XE_ADD_OBJS(scrollbar-x.o) + test "$with_dialogs" != "no" && XE_ADD_OBJS(dialog-x.o) + test "$with_toolbars" != "no" && XE_ADD_OBJS(toolbar-x.o) + test "$all_widgets" != "no no no no no" && XE_ADD_OBJS(gui-x.o) fi -test "$use_minimal_tagbits" = "yes" && AC_DEFINE(USE_MINIMAL_TAGBITS) -test "$use_indexed_lrecord_implementation" = "yes" && \ - AC_DEFINE(USE_INDEXED_LRECORD_IMPLEMENTATION) - dnl ---------------------- dnl Mule-dependent options dnl ---------------------- @@ -2983,7 +3212,7 @@ AC_CHECKING(for Mule-related features) AC_DEFINE(MULE) AC_DEFINE(FILE_CODING) - XE_ADD_OBJS(mule.o mule-ccl.o mule-charset.o mule-coding.o file-coding.o) + XE_ADD_OBJS(mule.o mule-ccl.o mule-charset.o file-coding.o) dnl Use -lintl to get internationalized strerror for Mule AC_CHECK_HEADERS(libintl.h) @@ -3099,25 +3328,24 @@ XE_COMPUTE_RUNPATH() fi -AC_CHECK_FUNCS(cbrt closedir dup2 eaccess fmod fpathconf frexp ftime gethostname getpagesize gettimeofday getcwd getwd logb lrand48 matherr mkdir mktime perror poll random rename res_init rint rmdir select setitimer setpgid setlocale setsid sigblock sighold sigprocmask snprintf strcasecmp strerror tzset ulimit usleep utimes waitpid vsnprintf) - -dnl realpath is buggy on linux, decosf and aix4 - -dnl The realpath() in linux libc (4.6.27) sometimes fails with ELOOP. -dnl The realpath in ELF linux libc's is O.K. -dnl For example, call realpath on a file thirty-five or so directories deep -dnl and you get ELOOP even if no symlinks at all are involved. -dnl Reports as of 11/1997 indicate BSDi has problems too. -dnl The realpath() in UnixWare2.1.3 could not get any pathname fragment in error condition. -case "$opsys" in - linuxaout* | bsdos3* | freebsd* | decosf4-0* | aix4* ) XE_ADD_OBJS(realpath.o) ;; - * ) - case "$canonical" in - *-*-sysv4.2uw2* ) XE_ADD_OBJS(realpath.o) ;; - * ) AC_CHECK_FUNCS(realpath) - test "$ac_cv_func_realpath" != "yes" && XE_ADD_OBJS(realpath.o) ;; - esac ;; -esac +AC_CHECK_FUNCS(cbrt closedir dup2 eaccess fmod fpathconf frexp ftime getaddrinfo gethostname getnameinfo getpagesize gettimeofday getcwd getpt getwd logb lrand48 matherr mkdir mktime perror poll random rename res_init rint rmdir select setitimer setpgid setlocale setsid sigblock sighold sigprocmask snprintf stpcpy strcasecmp strerror tzset ulimit usleep utimes waitpid vsnprintf fsync ftruncate umask) + +dnl Use our own realpath always. +XE_ADD_OBJS(realpath.o) + +dnl Check whether the system provides getloadavg (Solaris 7 has it) +AC_CHECK_FUNCS(getloadavg) + +if test "$ac_cv_func_getloadavg" != "yes" +then + XE_ADD_OBJS(getloadavg.o) + + dnl Used by getloadavg() - does not require root priveleges + AC_CHECK_LIB(kstat, kstat_open) + + dnl Another way to get the load average + AC_CHECK_LIB(kvm, kvm_read) +fi dnl If netdb.h does not declare h_errno, we must declare it by hand. AC_MSG_CHECKING(whether netdb declares h_errno) @@ -3197,8 +3425,7 @@ ], [ struct timeval time; - struct timezone dummy; - gettimeofday (&time, &dummy); + gettimeofday (&time, 0); ], [AC_MSG_RESULT(two)], [AC_MSG_RESULT(one) @@ -3272,12 +3499,24 @@ esac AC_MSG_RESULT($have_mmap) test "$have_mmap" = "yes" && AC_DEFINE(HAVE_MMAP) -AC_FUNC_MMAP dnl rel_alloc requires either GNU malloc or system malloc with mmap dnl We only turn rel_alloc on by default if mmap is available. -test "$GNU_MALLOC" != "yes" -a "$have_mmap" != "yes" && rel_alloc=no -test "$rel_alloc" = "default" -a "$have_mmap" = "yes" && rel_alloc=yes +test "$GNU_MALLOC" != "yes" -a "$have_mmap" != "yes" && rel_alloc=no +if test "$rel_alloc $have_mmap" = "default yes"; then + if test "$doug_lea_malloc" = "yes"; then + dnl Check if malloc() calls mmap(), making rel_alloc pointless. + AC_MSG_CHECKING(for M_MMAP_THRESHOLD) + AC_TRY_COMPILE([#include ],[ +#ifndef M_MMAP_THRESHOLD +#error No M_MMAP_THRESHOLD :-( +!@+$%^&*_)(_ - unlikely to compile... +#endif +], [rel_alloc=no; AC_MSG_RESULT(yes);], [rel_alloc=yes; AC_MSG_RESULT(no);]) + else + rel_alloc=yes + fi +fi test "$rel_alloc" = "yes" && AC_DEFINE(REL_ALLOC) dnl Check for terminal I/O variants @@ -3329,10 +3568,6 @@ dnl Autodetect native sound AC_CHECKING("for sound support") -case "$with_sound" in - native | both ) with_native_sound=yes;; - nas | no ) with_native_sound=no;; -esac test -z "$with_native_sound" -a -n "$native_sound_lib" && with_native_sound=yes if test "$with_native_sound" != "no"; then @@ -3390,6 +3625,7 @@ for dir in "machine" "sys" "linux"; do AC_CHECK_HEADER(${dir}/soundcard.h, sound_found=yes + need_miscplay=yes XE_ADD_OBJS(linuxplay.o) [AC_DEFINE_UNQUOTED(SOUNDCARD_H_PATH, "${dir}/soundcard.h")] break) @@ -3399,25 +3635,55 @@ test "$sound_found" = "yes" && with_native_sound=yes fi -if test -z "$with_sound"; then - if test "$with_native_sound" = "yes" -o -n "$native_sound_lib"; then - with_sound=native - fi -fi - if test "$with_native_sound" = "yes"; then AC_DEFINE(HAVE_NATIVE_SOUND) test -n "$native_sound_lib" && XE_PREPEND($native_sound_lib, LIBS) fi -case "$with_sound" in both | nas ) - AC_DEFINE(HAVE_NAS_SOUND) - XE_ADD_OBJS(nas.o) - XE_PREPEND(-laudio, libs_x) - dnl If the nas library does not contain the error jump point, - dnl then we force safer behavior. - AC_EGREP_HEADER(AuXtErrorJump,audio/Xtutil.h,,[AC_DEFINE(NAS_NO_ERROR_JUMP)]) -esac +dnl NAS Sound support +if test "$with_nas_sound" != "no"; then + AC_CHECK_HEADER(audio/audiolib.h, [ + AC_CHECK_LIB(audio, AuOpenServer, have_nas_sound=yes)]) + if test "$have_nas_sound" = "yes"; then + with_nas_sound=yes + AC_DEFINE(HAVE_NAS_SOUND) + XE_ADD_OBJS(nas.o) + XE_PREPEND(-laudio, libs_x) + dnl If the nas library does not contain the error jump point, + dnl then we force safer behavior. + AC_EGREP_HEADER(AuXtErrorJump,audio/Xtutil.h,,[old_nas=yes; AC_DEFINE(NAS_NO_ERROR_JUMP)]) + else + test "$with_nas_sound" = "yes" && \ + XE_DIE("Required NAS sound support cannot be provided.") + with_nas_sound=no + fi +fi + +dnl ESD Sound support +if test "$with_esd_sound" != "no"; then + AC_CHECK_PROG(have_esd_config, esd-config, yes, no) + if test "$have_esd_config" = "yes"; then + save_c_switch_site="$c_switch_site" save_LIBS="$LIBS" + XE_APPEND(`esd-config --cflags`, c_switch_site) + XE_PREPEND(`esd-config --libs`, LIBS) + AC_CHECK_FUNC(esd_play_stream, + have_esd_sound=yes, + c_switch_site="$save_c_switch_site" LIBS="$save_LIBS") + fi + + if test "$have_esd_sound" = "yes"; then + with_esd_sound=yes + need_miscplay=yes + XE_ADD_OBJS(esd.o) + AC_DEFINE(HAVE_ESD_SOUND) + else + test "$with_esd_sound" = "yes" && \ + XE_DIE("Required ESD sound support cannot be provided.") + with_esd_sound=no + fi +fi + +test "$need_miscplay" = "yes" && XE_ADD_OBJS(miscplay.o) dnl --------------------- dnl TTY-dependent options @@ -3508,26 +3774,26 @@ dnl On FreeBSD, both DB and DBM are part of libc. dnl By default, we check for DBM support in libgdbm, then libc, then libdbm. -test "$with_database_gnudbm $with_database_dbm $with_database_berkdb" \ +test "$with_database_gdbm $with_database_dbm $with_database_berkdb" \ != "no no no" && AC_CHECKING(for database support) dnl Check for ndbm.h, required for either kind of DBM support. -if test "$with_database_gnudbm $with_database_dbm" != "no no"; then +if test "$with_database_gdbm $with_database_dbm" != "no no"; then AC_CHECK_HEADER(ndbm.h, [:], [ - test "$with_database_gnudbm" = "yes" -o \ - "$with_database_dbm" = "yes" && \ + test "$with_database_gdbm" = "yes" -o \ + "$with_database_dbm" = "yes" && \ XE_DIE("Required DBM support cannot be provided.") - with_database_gnudbm=no with_database_dbm=no]) + with_database_gdbm=no with_database_dbm=no]) fi dnl Check for DBM support in libgdbm. -if test "$with_database_gnudbm" != "no"; then +if test "$with_database_gdbm" != "no"; then AC_CHECK_LIB(gdbm, dbm_open, [ - with_database_gnudbm=yes with_database_dbm=no libdbm=-lgdbm], [ - if test "$with_database_gnudbm" = "yes"; then + with_database_gdbm=yes with_database_dbm=no libdbm=-lgdbm], [ + if test "$with_database_gdbm" = "yes"; then XE_DIE("Required GNU DBM support cannot be provided.") fi - with_database_gnudbm=no]) + with_database_gdbm=no]) fi dnl Check for DBM support in libc and libdbm. @@ -3541,15 +3807,18 @@ dnl Tell make about the DBM support we detected. test -n "$libdbm" && XE_PREPEND("$libdbm", LIBS) -test "$with_database_gnudbm" = "yes" -o \ - "$with_database_dbm" = "yes" && \ +test "$with_database_gdbm" = "yes" -o \ + "$with_database_dbm" = "yes" && \ AC_DEFINE(HAVE_DBM) dnl Check for Berkeley DB. if test "$with_database_berkdb" != "no"; then AC_MSG_CHECKING(for Berkeley db.h) for path in "db/db.h" "db.h"; do - AC_TRY_COMPILE([#ifdef HAVE_INTTYPES_H + AC_TRY_COMPILE([ +#include +#if !(defined __GLIBC__ && __GLIBC_MINOR__ >= 1) +#ifdef HAVE_INTTYPES_H #define __BIT_TYPES_DEFINED__ #include typedef uint8_t u_int8_t; @@ -3559,6 +3828,7 @@ typedef uint64_t u_int64_t; #endif #endif +#endif #include <$path> ],[], db_h_path="$path"; break) done @@ -3587,7 +3857,7 @@ fi fi -if test "$with_database_gnudbm $with_database_dbm $with_database_berkdb" \ +if test "$with_database_gdbm $with_database_dbm $with_database_berkdb" \ != "no no no"; then AC_DEFINE(HAVE_DATABASE) XE_ADD_OBJS(database.o) @@ -3606,25 +3876,43 @@ fi dnl autodetect dll support -AC_CHECK_HEADERS(dlfcn.h, [have_dlfcn=yes - AC_DEFINE(HAVE_DLFCN_H)]) -test -z "$with_shlib" && test ! -z "$have_dlfcn" && { AC_CHECK_LIB(dl, dlopen, [ AC_DEFINE(HAVE_DLOPEN) DLL_LIB=dl; with_shlib=yes]) } -test -z "$with_shlib" && test ! -z "$have_dlfcn" && { AC_CHECK_LIB(c, _dlopen, [ AC_DEFINE(HAVE_DLOPEN) DLL_LIB=; with_shlib=yes]) } -test -z "$with_shlib" && test ! -z "$have_dlfcn" && { AC_CHECK_LIB(c, dlopen, [ AC_DEFINE(HAVE_DLOPEN) DLL_LIB=; with_shlib=yes]) } -test -z "$with_shlib" && { AC_CHECK_LIB(dld, shl_load, [ AC_DEFINE(HAVE_SHL_LOAD) DLL_LIB=dld; with_shlib=yes]) } -test -z "$with_shlib" && { AC_CHECK_LIB(dld, dld_init, [ AC_DEFINE(HAVE_DLD_INIT) DLL_LIB=dld; with_shlib=yes]) } -if test "$with_shlib" = "yes"; then - XE_SHLIB_STUFF +if test "$with_modules" != "no"; then + AC_CHECKING(for module support) + + dnl Find headers and libraries + AC_CHECK_HEADER(dlfcn.h, [ + AC_CHECK_LIB(dl, dlopen, [ have_dl=yes libdl=dl], [ + AC_CHECK_LIB(c, dlopen, [ have_dl=yes ])])]) + if test -n "$have_dl"; then + AC_DEFINE(HAVE_DLOPEN) + else + AC_CHECK_LIB(dld, shl_load, [ + libdl=dld have_dl=yes; + AC_DEFINE(HAVE_SHL_LOAD)], [ + AC_CHECK_LIB(dld, dld_init, [ + libdl=dld have_dl=yes; + AC_DEFINE(HAVE_DLD_INIT)])]) + fi + + if test -n "$have_dl"; then + dnl XE_SHLIB_STUFF (in aclocal.m4) defines $can_build_shared + XE_SHLIB_STUFF + fi + if test "$can_build_shared" = "yes"; then AC_DEFINE(HAVE_SHLIB) - XE_ADD_OBJS(sysdll.o) - XE_ADD_OBJS(emodules.o) + XE_ADD_OBJS(sysdll.o emodules.o) XE_APPEND(src, INSTALL_ARCH_DEP_SUBDIR) - test ! -z "$DLL_LIB" && XE_PREPEND(-l${DLL_LIB}, LIBS) + test -n "$libdl" && XE_PREPEND(-l${libdl}, LIBS) AC_CHECK_FUNCS(dlerror _dlerror) + with_modules=yes else - AC_MSG_WARN(disabling shared library support) - with_shlib=no + if test "$with_modules" = "yes"; then + XE_DIE("Required module support cannot be provided.") + else + AC_MSG_WARN("Module support cannot be provided.") + fi + with_modules=no fi fi @@ -3649,12 +3937,13 @@ echo "*** PANIC *** on your system. Don't do that." exit 1]) -dnl Process support (hardcoded) -dnl every system that supports this runs configure, the others don't - -dnl We're not ready for this yet. -AC_DEFINE(HAVE_UNIX_PROCESSES) -XE_ADD_OBJS(process-unix.o) +dnl Process support +if test "$win32_processes" = "yes"; then + XE_ADD_OBJS(process-nt.o) +else + AC_DEFINE(HAVE_UNIX_PROCESSES) + XE_ADD_OBJS(process-unix.o) +fi dnl -------------------------------- dnl Compute SUBST-itutable variables @@ -3711,15 +4000,32 @@ echo "" fi -dnl Create some auxiliary files -if test -f $srcdir/src/gdbinit -a ! -f src/gdbinit ; then - echo "creating src/gdbinit"; echo "" - echo "source $srcdir/src/gdbinit" > src/gdbinit +dnl ---------------------------------------------- +dnl Create some auxiliary files for developers. +dnl ---------------------------------------------- + +dnl Create a .gdbinit useful for debugging XEmacs +if test -f "$srcdir/src/.gdbinit" -a ! -f "src/.gdbinit"; then + test "$extra_verbose" = "yes" && echo "creating src/.gdbinit" + echo "source $srcdir/src/.gdbinit" > "src/.gdbinit" +fi + +dnl Create a .dbxrc useful for debugging XEmacs +if test -f "$srcdir/src/.dbxrc" -a ! -f "src/.dbxrc"; then + test "$extra_verbose" = "yes" && echo "creating src/.dbxrc" + echo ". $srcdir/src/.dbxrc" > "src/.dbxrc" +fi + +dnl Create a useful TAGS file +if test -f "$srcdir/TAGS" -a ! -f "TAGS"; then + test "$extra_verbose" = "yes" && echo "creating TAGS" + echo " +$srcdir/TAGS,include" > "TAGS" fi dnl Create top level .sbinit for Sun compilers if test "$__SUNPRO_C" = "yes"; then - echo "creating .sbinit"; echo "" + test "$extra_verbose" = "yes" && echo "creating .sbinit" ( echo "# For use with Sun WorkShop's Source browser." echo "# See sbquery(1) and sbinit(4) for more information" for dir in $MAKE_SUBDIR; do echo "import $dir"; done @@ -3740,6 +4046,8 @@ AC_SUBST(version) AC_SUBST(configuration) AC_SUBST(canonical) +AC_SUBST(inststaticdir) +AC_SUBST(instvardir) AC_SUBST(srcdir) AC_SUBST(bindir) AC_SUBST(datadir) @@ -3749,6 +4057,7 @@ AC_SUBST(mandir) AC_SUBST(prefix) +AC_SUBST(PREFIX_USER_DEFINED) dnl Yo, Stephen Bourne! I want to marry you! PREFIX=$prefix while true; do @@ -3760,6 +4069,7 @@ AC_SUBST(PREFIX) AC_SUBST(exec_prefix) +AC_SUBST(EXEC_PREFIX_USER_DEFINED) EXEC_PREFIX=$exec_prefix while true; do case "$EXEC_PREFIX" in @@ -3868,6 +4178,17 @@ done AC_SUBST(LOCKDIR) +AC_SUBST(docdir) +AC_SUBST(DOCDIR_USER_DEFINED) +DOCDIR=$docdir +while true; do + case "$DOCDIR" in + *\$* ) eval "DOCDIR=$DOCDIR" ;; + *) break ;; + esac +done +AC_SUBST(DOCDIR) + AC_SUBST(archlibdir) AC_SUBST(ARCHLIBDIR_USER_DEFINED) ARCHLIBDIR=$archlibdir @@ -3915,6 +4236,10 @@ : ${XEMACS_CC:=$CC} AC_SUBST(XEMACS_CC) +dnl The default is yes +if test "$with_prefix" = "yes"; then + AC_DEFINE(PREFIX_USER_DEFINED) +fi dnl The default is no if test "$with_site_lisp" = "no"; then @@ -3926,7 +4251,7 @@ fi XE_SPACE(ac_configure_args, $ac_configure_args) -AC_DEFINE_UNQUOTED(EMACS_CONFIGURATION, "$canonical") +AC_DEFINE_UNQUOTED(EMACS_CONFIGURATION, "$configuration") AC_DEFINE_UNQUOTED(EMACS_CONFIG_OPTIONS, "$ac_configure_args") AC_DEFINE_UNQUOTED(config_machfile, "$machfile") AC_DEFINE_UNQUOTED(config_opsysfile, "$opsysfile") @@ -3946,8 +4271,6 @@ dnl so that the user gets immediate feedback on the results of the dnl autodetection. -test -n "$puresize" && AC_DEFINE_UNQUOTED(RAW_PURESIZE, $puresize) - if test "$GNU_MALLOC" = "yes"; then AC_DEFINE(GNU_MALLOC) elif test "$with_system_malloc" = "yes"; then AC_DEFINE(USE_SYSTEM_MALLOC) elif test "$with_debug_malloc" = "yes"; then AC_DEFINE(USE_DEBUG_MALLOC) @@ -3957,13 +4280,13 @@ test "$GCC" = "yes" && AC_DEFINE(USE_GCC) test "$external_widget" = "yes" && AC_DEFINE(EXTERNAL_WIDGET) test "$no_doc_file" = "yes" && AC_DEFINE(NO_DOC_FILE) -dnl test "$const_is_losing" = "yes" && AC_DEFINE(CONST_IS_LOSING) test "$with_purify" = "yes" && AC_DEFINE(PURIFY) test "$with_quantify" = "yes" && AC_DEFINE(QUANTIFY) test "$with_pop" = "yes" && AC_DEFINE(MAIL_USE_POP) test "$with_kerberos" = "yes" && AC_DEFINE(KERBEROS) test "$with_hesiod" = "yes" && AC_DEFINE(HESIOD) test "$use_union_type" = "yes" && AC_DEFINE(USE_UNION_TYPE) +test "$pdump" = "yes" && AC_DEFINE(PDUMP) dnl ------------------------------- dnl Report on what we decided to do @@ -3980,8 +4303,15 @@ echo "$0 $quoted_arguments" ) > Installation -xemacs_betaname="" -test ! -z "${emacs_beta_version}" && xemacs_betaname="-b${emacs_beta_version}" +if test ! -z ${emacs_beta_version} ; then + if test -z "${emacs_is_beta}" ; then + xemacs_betaname=".${emacs_beta_version}" + else + xemacs_betaname="-b${emacs_beta_version}" + fi +else + xemacs_betaname="" +fi dnl Start stdout redirection to '| tee -a Installation' ( @@ -4013,6 +4343,10 @@ if test -n "$runpath"; then echo " Runtime library search path: $runpath" fi +if test "$have_xaw" = "yes"; then + echo " Athena library to link: $athena_lib" + echo " Athena header include path: $athena_h_path" +fi test "$with_dnet" = yes && echo " Compiling in support for DNET." test "$with_socks" = yes && echo " Compiling in support for SOCKS." test "$with_xauth" = yes && echo " Compiling in support for XAUTH." @@ -4050,20 +4384,17 @@ test "$with_jpeg" = yes && echo " Compiling in support for JPEG image handling." test "$with_tiff" = yes && echo " Compiling in support for TIFF image handling." test "$with_xface" = yes && echo " Compiling in support for X-Face message headers." -case "$with_sound" in - nas ) echo " Compiling in network sound (NAS) support." ;; - native ) echo " Compiling in native sound support." ;; - both ) echo " Compiling in both network and native sound support." ;; -esac -test "$old_nas" = yes && echo " nas library lacks error trapping, will play synchronously." + +test "$with_native_sound" = yes && echo " Compiling in native sound support." +test "$with_nas_sound" = yes && echo " Compiling in network sound (NAS) support." +test "$old_nas" = yes && echo " nas library lacks error trapping, will play synchronously." +test "$with_esd_sound" = yes && echo " Compiling in support for Enlightened Sound Daemon (ESD)." test "$with_database_berkdb" = yes && echo " Compiling in support for Berkeley DB." test "$with_database_dbm" = yes && echo " Compiling in support for DBM." -test "$with_database_gnudbm" = yes && echo " Compiling in support for GNU DBM." - -test "$with_umich_ldap" = yes && echo " Compiling in support for LDAP (UMich libs)." -test "$with_ns_ldap" = yes && echo " Compiling in support for LDAP (Netscape SDK)." -test "$with_ldap" = yes -a "$with_umich_ldap" = no -a "$with_ns_ldap" = no && echo " Compiling in support for LDAP (Generic)." +test "$with_database_gdbm" = yes && echo " Compiling in support for GNU DBM." + +test "$with_ldap" = yes && echo " Compiling in support for LDAP." test "$with_ncurses" = yes && echo " Compiling in support for ncurses." test "$with_gpm" = yes && echo " Compiling in support for GPM (General Purpose Mouse)." @@ -4086,19 +4417,25 @@ test "$with_offix" = yes && echo " Compiling in support for OffiX." test "$with_dragndrop" = yes && echo " Compiling in EXPERIMENTAL support for Drag'n'Drop ($dragndrop_proto )." test "$with_workshop" = yes && echo " Compiling in support for Sun WorkShop." -test "$with_session" != no && echo " Compiling in support for proper session-management." +test "$with_wmcommand" != no && echo " Compiling in support for proper WM_COMMAND handling." case "$with_menubars" in lucid ) echo " Using Lucid menubars." ;; motif ) echo " Using Motif menubars." echo " *WARNING* The Motif menubar implementation is currently buggy." echo " We recommend using the Lucid menubar instead." echo " Re-run configure with --with-menubars='lucid'." ;; + msw ) echo " Using MS-Windows menubars." ;; esac case "$with_scrollbars" in lucid ) echo " Using Lucid scrollbars." ;; motif ) echo " Using Motif scrollbars." ;; athena ) echo " Using Athena scrollbars." ;; - athena3d ) echo " Using Athena-3d scrollbars." ;; + msw ) echo " Using MS-Windows scrollbars." ;; +esac +case "$with_widgets" in + motif ) echo " Using Motif native widgets." ;; + athena ) echo " Using Athena native widgets." ;; + msw ) echo " Using MS-Windows native widgets." ;; esac case "$with_dialogs" in motif ) @@ -4111,9 +4448,9 @@ fi; fi ;; athena ) echo " Using Athena dialog boxes." ;; - athena3d ) echo " Using Athena-3d dialog boxes." ;; + msw ) echo " Using MS-Windows dialog boxes." ;; esac -test "$with_shlib" = "yes" && echo " Compiling in DLL support." +test "$with_modules" = "yes" && echo " Compiling in dynamic shared object module support." test "$with_clash_detection" = yes && \ echo " Clash detection will use \"$lockdir\" for locking files." echo " movemail will use \"$mail_locking\" for locking mail spool files." @@ -4121,11 +4458,9 @@ test "$with_kerberos" = yes && echo " Using Kerberos for POP authentication." test "$with_hesiod" = yes && echo " Using Hesiod to get POP server host." test "$use_union_type" = yes && echo " Using the union type for Lisp_Objects." -test "$use_minimal_tagbits" = yes && echo " Using Lisp_Objects with minimal tagbits." -test "$use_indexed_lrecord_implementation" = yes && echo " Using indexed lrecord implementation." -test "$debug" = yes && echo " Compiling in extra code for debugging." -test "$memory_usage_stats" = yes && echo " Compiling in code for checking XEmacs memory usage." -test "$usage_tracking" = yes && echo " Compiling with usage tracking active (Sun internal)." +test "$pdump" = yes && echo " Using the new portable dumper (wishful thinking)." +test "$debug" = yes && echo " Compiling in extra code for debugging." +test "$usage_tracking" = yes && echo " Compiling with usage tracking active (Sun internal)." if test "$error_check_extents $error_check_typecheck $error_check_bufpos $error_check_gc $error_check_malloc" \ != "no no no no no"; then echo " WARNING: ---------------------------------------------------------" @@ -4139,11 +4474,6 @@ dnl echo "The above configure report is appended to \"Installation\" file." echo "" -dnl Generate Installation.el -echo '(setq Installation-string "' > Installation.el -sed 's/"/\\"/g' Installation >> Installation.el -echo '")' >> Installation.el - dnl ----------------------------------- dnl Now generate config.h and Makefiles dnl ----------------------------------- @@ -4161,12 +4491,10 @@ for file in $internal_makefile_list; do test "$file" = src/Makefile.in && \ file="src/Makefile.in:src/Makefile.in.in:src/depend" - ac_output_files="${ac_output_files+$ac_output_files }$file" + XE_APPEND($file, ac_output_files) done ac_output_files="$ac_output_files src/paths.h lib-src/config.values" -if test "$with_shlib" = "yes"; then - ac_output_files="$ac_output_files lib-src/ellcc.h" -fi +test "$with_modules" = "yes" && XE_APPEND(lib-src/ellcc.h, ac_output_files) AC_OUTPUT($ac_output_files, [for dir in . $MAKE_SUBDIR; do diff -r f4aeb21a5bad -r 74fd4e045ea6 configure.usage --- a/configure.usage Mon Aug 13 11:12:06 2007 +0200 +++ b/configure.usage Mon Aug 13 11:13:30 2007 +0200 @@ -42,15 +42,14 @@ linking is the default. --srcdir=DIR Look for the XEmacs source files in DIR. Works best when using GNU Make. ---use-indexed-lrecord-implementation ---use-minimal-tagbits ---gung-ho Build with new-style Lisp_Objects. - Equivalent to both of the 2 previous options combined. Installation options: --prefix=DIR Install files below DIR. Defaults to `/usr/local'. +--with-prefix Compile the value of --prefix into the executable. + Defaults to `yes'. +--without-prefix Don't compile the value of --prefix into the executable. Window-system options: @@ -60,17 +59,21 @@ --x-includes=DIR Search for X header files in DIR. --x-libraries=DIR Search for X libraries in DIR. --without-toolbars Don't compile with any toolbar support. ---without-session Compile without realized leader window which will - keep the WM_COMMAND property. Required for proper - session-management. +--without-wmcommand Compile without realized leader window which will + keep the WM_COMMAND property. +--with-athena=TYPE Use TYPE Athena widgets + (xaw, 3d, next, 95, or xpm) --with-menubars=TYPE Use TYPE menubars (lucid, motif, or no). The Lucid widgets emulate Motif (mostly) but are faster. *WARNING* The Motif menubar is currently broken. --with-scrollbars=TYPE Use TYPE scrollbars - (lucid, motif, athena, athena3d, or no). ---with-dialogs=TYPE Use TYPE dialog boxes (motif, athena, athena3d, or no). + (lucid, motif, athena, or no). +--with-dialogs=TYPE Use TYPE dialog boxes (motif, athena, or no). Lucid menubars and scrollbars are the default. Motif dialog boxes will be used if Motif can be found. +--with-widgets=TYPE Use TYPE widgets (motif, athena, or no). + Motif widgets will be used if Motif can be found. + Other widget types are currently unsupported. --with-dragndrop (*) Compile in the generic drag and drop API. This is automatically added if one of the drag and drop protocols is found (currently CDE, OffiX, MSWindows). @@ -120,9 +123,13 @@ --with-database=TYPE (*) Compile with database support. Valid types are `no' or a comma-separated list of one or more of `berkdb' and either `dbm' or `gnudbm'. ---with-sound=native (*) Compile with native sound support. ---with-sound=nas Compile with network sound support. ---with-sound=both Compile with native and network sound support. +--with-sound=TYPE,[TYPE],... Compile with native sound support. + Valid types are `native', `nas' and `esd'. + Prefix a type with 'no' to disable. + The first option can be `none' or `all'. + `none' is a synonym for `nonative,nonas,noesd'. + `all' is a synonym for native,nas,esd or `all'. + The default is to autodetect all sound support. --native-sound-lib=LIB Native sound support library. Needed on Suns with --with-sound=both because both sound libraries are called libaudio. @@ -134,7 +141,9 @@ installed LDAP libraries on the system). --mail-locking=TYPE (*) Specify the locking to be used by movemail to prevent concurrent updates of mail spool files. Valid types - are `lockf', `flock', and `file'. + are `lockf', `flock', and `dot'. +--with-modules Compile in experimental support for dynamically + loaded libraries (Dynamic Shared Objects). --with-site-lisp=yes Allow for a site-lisp directory in the XEmacs hierarchy searched before the installation packages. --with-site-modules=no Disable site-modules directory in the XEmacs hierarchy, @@ -156,6 +165,9 @@ and localdir files in case run-time searching for them fails. --moduledir=DIR Directory to install dynamic modules in. +--pdump New, experimental, non-working, don't-sue-me-if- + your-house-collapses-and-your-wife-goes-away, + portable dumper. Internationalization options: @@ -210,7 +222,6 @@ Other options: ---puresize=VALUE Override default amount of space for pure Lisp code. --rel-alloc Use the relocating allocator (default for this option is system-dependent). --with-dlmalloc Control usage of Doug Lea malloc on systems that have @@ -225,10 +236,10 @@ Defaults to `${statedir}/xemacs/lock'. You may also specify any of the `path' variables found in Makefile.in, -including --bindir, --libdir, --lispdir, --sitelispdir, --datadir, ---infodir, --mandir and so on. Note that we recommend against -explicitly setting any of these variables. See the INSTALL file for a -complete list plus the reasons we advise not changing them. +including --bindir, --libdir, --docdir, --lispdir, --sitelispdir, +--datadir, --infodir, --mandir and so on. Note that we recommend +against explicitly setting any of these variables. See the INSTALL +file for a complete list plus the reasons we advise not changing them. If successful, configure leaves its status in config.status. If unsuccessful after disturbing the status quo, it removes config.status. diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/BETA --- a/etc/BETA Mon Aug 13 11:12:06 2007 +0200 +++ b/etc/BETA Mon Aug 13 11:13:30 2007 +0200 @@ -325,7 +325,7 @@ To bytecompile both of these files the command is: xemacs-21.0 -vanilla -batch -f batch-byte-compile \ - lisp-utils/auto-autoloads.el lisp-utils/custom-laod.el + lisp-utils/auto-autoloads.el lisp-utils/custom-load.el ** Building XEmacs and XEmacs packages from scratch =================================================== diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/DISTRIB --- a/etc/DISTRIB Mon Aug 13 11:12:06 2007 +0200 +++ b/etc/DISTRIB Mon Aug 13 11:13:30 2007 +0200 @@ -1,8 +1,8 @@ -*- text -*- - XEmacs availability information. Last Modified: 17-Apr-97. + XEmacs availability information. Last Modified: 18-Jul-99. -XEmacs is available via anonymous FTP from ftp.xemacs.org (128.174.252.16) +XEmacs is available via anonymous FTP from ftp.xemacs.org (207.96.122.8) in the directory /pub/xemacs/. ftp.xemacs.org is the primary distribution point, but you may find diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/FTP --- a/etc/FTP Mon Aug 13 11:12:06 2007 +0200 +++ b/etc/FTP Mon Aug 13 11:13:30 2007 +0200 @@ -1,282 +1,103 @@ - -*- text -*- - XEmacs availability information. Last Modified: 9-Jul-1998. + XEmacs availability information. Last Modified: 1999-11-08 XEmacs is available via anonymous FTP from ftp.xemacs.org (207.96.122.8) in the directory /pub/xemacs/. ftp.xemacs.org is the primary distribution point, but you may find copies of it at other sites as well. Some sites to try include: + +* North America - ftp://ftp.jaist.ac.jp/pub/GNU/xemacs/ - ftp://ring.aist.go.jp/pub/text/xemacs/ - ftp://ring.asahi-net.or.jp/pub/text/xemacs/ - ftp://ftp.uu.net/systems/gnu/xemacs/ - ftp://ftp.sunet.se/pub/gnu/xemacs/ - ftp://ftp.cenatls.cena.dgac.fr/pub/Emacs/xemacs/ - ftp://ftp.th-darmstadt.de/pub/editors/xemacs/ - ftp://sunsite.doc.ic.ac.uk/gnu/xemacs/ - ftp://ftp.lip6.fr/pub/emacs/xemacs/ - ftp://uiarchive.cso.uiuc.edu/pub/packages/xemacs/ - ftp://ftp.technion.ac.il/pub/unsupported/gnu/xemacs/ - ftp://ftp.linux.hr/pub/xemacs/ - ftp://sunsite.cnlab-switch.ch/mirror/xemacs/ - ftp://ftp.unicamp.br/pub/xemacs/ - ftp://ftp.usyd.edu.au/pub/Xemacs/ - ftp://ftp.lab.kdd.co.jp/xemacs/ - ftp://SunSITE.sut.ac.jp/pub/archives/xemacs/ - ftp://sunsite.icm.edu.pl/pub/unix/xemacs + o Canada + + ftp://ftp.crc.ca/pub/packages/editors/xemacs/ + + ftp://sunsite.ualberta.ca/pub/Mirror/xemacs/ + o United States + + ftp://uiarchive.uiuc.edu/pub/packages/xemacs/ + + ftp://metalab.unc.edu/pub/packages/editors/xemacs/ + + ftp://ftp.sunsite.utk.edu/pub/xemacs/ + +* South America + + o Brazil + + ftp://ftp.unicamp.br/pub/xemacs/ + +* Europe + + o Austria + + ftp://gd.tuwien.ac.at/editors/xemacs/ + o Denmark + + ftp://sunsite.auc.dk/pub/emacs/xemacs/ + o England + + ftp://sunsite.doc.ic.ac.uk/packages/xemacs/ + o Finland + + ftp://ftp.funet.fi/pub/mirrors/ftp.xemacs.org/pub/tux/xemacs/ + o France + + ftp://ftp.pasteur.fr/pub/computing/xemacs/ + + ftp://ftp.cenatls.cena.dgac.fr/Emacs/xemacs/ + o Germany + + ftp://ftp.tu-darmstadt.de/pub/editors/xemacs/ + o Hungary + + ftp://ftp.kfki.hu/pub/packages/xemacs/ + o Ireland + + ftp://ftp.eunet.ie/mirrors/ftp.xemacs.org/pub/xemacs/ + o Italy + + ftp://ftp.uniroma2.it/unix/misc/dist/XEMACS/ + o Norway + + ftp://sunsite.uio.no/pub/xemacs + o Poland + + ftp://ftp.icm.edu.pl/pub/unix/editors/xemacs/ + o Russia + + ftp://ftp.srcc.msu.su/mirror/ftp.xemacs.org/ + o Sweden + + ftp://ftp.sunet.se/pub/gnu/xemacs/ + o Switzerland + + ftp://sunsite.cnlab-switch.ch/mirror/xemacs/ + +* Asia + + o Japan + + ftp://ftp.netlab.is.tsukuba.ac.jp/pub/GNU/xemacs/ + + ftp://ftp.jaist.ac.jp/pub/GNU/xemacs/ + + ftp://ring.aist.go.jp/pub/text/xemacs/ + + ftp://ring.asahi-net.or.jp/pub/text/xemacs/ + + ftp://sunsite.sut.ac.jp/pub/archives/packages/xemacs/ + + ftp://ftp.dti.ad.jp/pub/unix/editor/xemacs/ + + ftp://mirror.nucba.ac.jp/mirror/xemacs/ + o Korea + + ftp://ftp.kreonet.re.kr/pub/tools/emacs/xemacs/ + o Taiwan + + ftp://coda.nctu.edu.tw/Editors/xemacs/ + +* Africa + + o South Africa + + ftp://ftp.sun.ac.za/xemacs/ + +* Middle East + + o Saudi Arabia + + ftp://ftp.isu.net.sa/pub/mirrors/ftp.xemacs.org/ + +* Australia + + o ftp://mirror.aarnet.edu.au/pub/xemacs The most up-to-date list of distribution sites can always be found on -the XEmacs WWW page, http://www.xemacs.org/. Try to pick a site -that is networkologically close to you. If you know of other mirrors -of the XEmacs archives, please send us mail and we will list them here -as well. +the XEmacs WWW page, http://www.xemacs.org/. Try to pick a site that +is networkologically close to you. If you know of other mirrors of +the XEmacs archives, please send us mail and we will list them here as +well. There are mailing lists and newsgroups specifically for discussing and reporting bugs in XEmacs; see the file MAILINGLISTS in this directory. -The FTP and ordering information in the remainder of this file applies -to the versions of GNU Emacs distributed by the Free Software Foundation, -not to XEmacs. - ----------------------------------------------------------------------- -How to get GNU Software by Internet FTP or by UUCP. Last updated 11 June 95. - -* Please send improvements to this file to gnu@prep.ai.mit.edu. - -* No Warranties - -We distribute software in the hope that it will be useful, but without -any warranty. No author or distributor of this software accepts -responsibility to anyone for the consequences of using it or for -whether it serves any particular purpose or works at all, unless he -says so in writing. - -* Updates - -If you find this file in the Emacs distribution, there is a chance it -is out of date. If you plan to FTP files from a GNU FTP host, you -might as well start by FTPing the current version of this file, which -is `/pub/gnu/GNUinfo/FTP'. - -* How to FTP - -Use the ftp program on your system (ask locally if you can't find it) -to connect to the host you are ftping from. Unless indicated -otherwise, login in as user "anonymous", with password: "your e-mail -address" and set "binary" mode (to transfer all eight bits in each -byte). - -* FTPing GNU Software - -** How to FTP GNU Emacs - -If you are on the Internet (see also "** Alternative Internet FTP -Sources" below), you can at present copy the latest distribution -version of GNU Emacs from the file /pub/gnu/emacs-M.N.tar on host -prep.ai.mit.edu (or the file /pub/gnu/emacs-M.N.tar.gz which has been -run through gzip after tar). M and N stand for version numbers; look -at a listing of the directory through ftp to see what version is -available. These files are about 11 and 4 megabytes long, -respectively. After you unpack the distribution, be sure to look at -the files README and INSTALL. - -Because of difficulties in transferring large files, sometimes a split -version of the tar file is created. This would be in a directory -named /pub/gnu/emacs-M.N.tar-split or perhaps -/pub/gnu/emacs-M.N.tar.gz-split, containing files of 100000 characters -each. There is generally no trouble in ftping files of this size. -They can be combined with cat to make a tar file or compressed tar -file. If you can't find such files on prep.ai.mit.edu, have a look at -archive.cis.ohio-state.edu. - -ALWAYS USE BINARY/IMAGE MODE TO TRANSFER THESE FILES! -Text mode does not work for tar files or compressed files. -Some ftp'ers have found it necessary for successful file transfer: - - to explicitly use prep.ai.mit.edu internet address: -18.159.0.42 (as of 18 June 95) - -Files of differences from previous widely distributed GNU Emacs -versions to the present version are also available on prep.ai.mit.edu -under names of the form emacs.diff-OO.OO-NN.NN in directory /pub/gnu. -These are made with diff -rc2. Sometimes there are versions -compressed with gzip of these difference files as well; their names -have .gz appended. - -The Emacs manual in source form is included in the distribution. The -dvi file produced by TeX is not included, but a copy may be available -for ftp under the name /pub/gnu/emacs.dvi. - -The Emacs Lisp Reference Manual is in a separate file: - /pub/gnu/elisp-manual-NN.tar.gz - -** VMS FTP sites with GNU Software -You can anonymously ftp a VMS version of GNU emacs from: - - ftp.stacken.kth.se:[.GNU-VMS] - GNU Emacs and some other VMS -ports (and some VMS binaries) of GNU software - - mango.rsmas.miami.edu has a VMS version of the GCC/G++ compiler. -Contact angel@flipper.miami.edu (angel li) for details. - - addvax.llnl.gov - GNU Emacs - - VMSD.OAC.UCI.EDU - GNU Emacs - - RIGEL.EFD.LTH.SE [130.235.48.3] - GNU Emacs - - ctrsci.cc.utah.edu - GNU Emacs - The 00readme.txt file gives details - - cc.utah.edu [128.110.8.24] - misc. GNU software - user -anonymous, pass guest. The 00README.txt file gives details. - -** Other GNU Software and How To FTP It - -Other GNU software is available on prep.ai.mit.edu under directory -/pub/gnu. diff files to convert between versions (like those used for -GNU Emacs), exist for some of these programs. Some programs have misc -support files as well. Have a look on prep to see which ones. -Compressed versions of the tar or diff files are often available -(indicated by a .gz suffix and made with the `gzip' program). Some of -this software is in beta test (probably still buggy), and is being -made available for use by hackers who like to test software. - -The file /pub/gnu/DESCRIPTIONS has a list of the packages distributed -on prep.ai.mit.edu with a brief description explaining what -each one can be used for. - -More information about these programs can typically be found in the -GNU Bulletin. To receive a copy, write to gnu@prep.ai.mit.edu. - -** Scheme and How to FTP It - -The latest distribution version of C Scheme is available via anonymous FTP -from altdorf.ai.mit.edu in /archive/scheme-X.XX/ (where X.XX is some version -number). - -Read the files INSTALL and README in the top level C Scheme directory. - -** TeX and How to Obtain It - -We don't distribute TeX now, but it is free software. + How to get GNU Software by Internet FTP or by UUCP: -TeX is a document formatter that is used, among other things, by the FSF -for all its documentation. You will need it if you want to make printed -manuals. - -TeX is freely redistributable. You can get it by ftp, tape, or CD/ROM. - -*** For FTP instructions, retrieve the file -ftp.cs.umb.edu:pub/tex/unixtex.ftp. (We don't include it here because it -changes relatively frequently. Sorry.) - -*** For TeX on a single tape (4mm DAT or QIC-24), ordering information is -available from unixtex@u.washington.edu. A distribution fee in the area -of US$210.00 covers administrative costs. Tapes will be available at -least through summer of 1994. - -*** The FSF hopes soon to distribute tapes of TeX itself, after the -University of Washington distribution service goes away. - -*** A minimal TeX collection (enough to process Texinfo files, anyway) -is included on the GNU source CD/ROM. See the file ORDERS in this -directory for more information. - -** Alternative Internet FTP Sources - -Please do NOT use a site outside your country, until you have checked -all sites inside your country, and then your continent. Trans-ocean -TCP/IP links are very expensive and usually very low speed. - -The administrators of louie.udel.edu maintains copies of GNU Emacs. -The files are available via anonymous ftp under directory ~ftp/gnu. - -Emacs and other GNU programs may be available via anonymous ftp from -these US sites: ftp.kpc.com:/pub/mirror/gnu (Silicon Valley, CA) -ftp.hawaii.edu:/mirrors/gnu, f.ms.uky.edu:/pub3/gnu, -ftp.digex.net:/pub/gnu (Internet address 164.109.10.23, nightly full -mirror, ran by mcguire@digex.net), wuarchive.wustl.edu:/systems/gnu, -col.hp.com:/mirrors/gnu, ftp.cs.columbia.edu:/archives/gnu/prep, -uiarchive.cso.uiuc.edu:/pub/gnu (Internet address 128.174.5.14, -nightly full mirror, ran by ftpadmin@uiuc.edu), -jaguar.utah.edu:/gnustuff, gatekeeper.dec.com:/pub/GNU, -labrea.stanford.edu, archive.cis.ohio-state.edu, and -ftp.uu.net:/archive/systems/gnu. +The XEmacs project is separate from and not managed by the GNU +project. The latest GNU project FTP and UUCP availability information +can be found at ftp://ftp.gnu.org/gnu/GNUinfo/FTP -And these foreign sites: ftp.cs.ubc.ca:/mirror2/gnu (Western Canada, -daily full mirror, ran by ftp-admin@cs.ubc.ca), -ftp.inf.utfsm.cl:/pub/gnu (Chile 146.83.198.3 nightly full mirror, ran -by ftp@inf.utfsm.cl), ftp.unicamp.br:/pub/gnu (Brazil manual mirror, -ran by oliva@dcc.unicamp.br), archie.au:/gnu (Australia (archie.oz or -archie.oz.au for ACSnet)), ftp.technion.ac.il:/pub/unsupported/gnu -(Israel, daily full mirror, ran by ftp-admin), ftp.sun.ac.za:/pub/gnu -(South Africa), ftp.etsimo.uniovi.es:/pub/gnu (Spain), -ftp.mcc.ac.uk:/pub/gnu (130.88.203.12 daily full mirror, ran by -root@ftp.mcc.ac.uk), unix.hensa.ac.uk:/mirrors/uunet/systems/gnu, -ftp.warwick.ac.uk (137.205.192.14 daily full mirror, ran by -unixhelp@warwick.ac.uk), ftp.informatik.tu-muenchen.de, -ftp.informatik.rwth-aachen.de, or germany.eu.net (mirror ran by -archive-admin@germany.eu.net) (Germany), isy.liu.se (Sweden), -ftp.stacken.kth.se or ftp.luth.se:/pub/unix/gnu (Sweden), -ftp.sunet.se:/pub/gnu (Sweden 130.238.127.3 daily mirror, ran by -archive@ftp.sunet.se (also mirrors the Mailing List Archives) -ftp.nl.net (Netherlands), ftp.win.tue.nl:/pub/gnu (Netherlands -131.155.70.100 daily mirror, ran by ftp@win.tue.nl), -ftp.funet.fi:/pub/gnu (Finland 128.214.6.100, ran by gnu-adm), -ftp.denet.dk (Denmark), ugle.unit.no (Norway 129.241.1.97), -ftp.eunet.ch or nic.switch.ch:/mirror/gnu (Switzerland), -irisa.irisa.fr:/pub/gnu or ftp.univ-lyon1.fr:pub/gnu (ran by -ftpmaint@ftp.univ-lyon1.fr) (France), ftp.ieunet.ie:pub/gnu (Ireland -192.111.39.1 weekly mirror, ran by archive@ieunet.ie), archive.eu.net -(Europe 192.16.202.1), cair-archive.kaist.ac.kr:/pub/gnu (Korea -143.248.11.171, ran by ftpkeeper@cair-archive.kaist.ac.kr), -ftp.nectec.or.th:/pub/mirrors/gnu (Thailand 192.150.251.32 daily -mirror, ran by ftp@nwg.nectec.or.th), -utsun.s.u-tokyo.ac.jp:/ftpsync/prep or ftp.cs.titech.ac.jp (Japan, -nemacs, the japanese port of GNU Emacs, is under ~ftp/JAPAN). - -* Getting GNU software in Great Britain - -jpo@cs.nott.ac.uk is willing to distribute those GNU sources he has -available. The smaller items are available from the info-server (send -to info-server@cs.nott.ac.uk) the larger items by negotiation. Due to -communication costs this service is only available within the UK. - -BattenIG@computer-science.birmingham.ac.uk (aka -I.G.Batten@fulcrum.bt.co.uk) is also willing to distribute those GNU -sources he has. He can also write tapes in qic-21 and qic-24 formats. - -lmjm@doc.ic.ac.uk is willing to distribute those GNU sources he has -along with comp.sources.unix, comp.sources.x, X windows et al. The -archive, on src.doc.ic.ac.uk in directory /gnu, is available via ftp -over the Internet (on 146.169.3.7), ftam over IXI, HTTP, FSP, Gopher, -ftpmail, NFS, Lanmanger over IP, telnet, and uucp. Due to -communication costs this service is only available within the UK. -Mail to info-server@doc.ic.ac.uk for details. He can also write sun -cartridge or exabyte tapes. - -UK sites with just anonymous FTP access are in the above list. - -* Getting GNU software via UUCP - -OSU is distributing via UUCP: most GNU software, MIT C Scheme, -Compress, News, RN, NNTP, Patch, some Appletalk stuff, some of the -Internet Requests For Comment (RFC) et al.. See their periodic -postings on the Usenet newsgroup comp.sources.d for informational -updates. Current details from or -<...!osu-cis!staff>. - -Information on how to uucp some GNU programs is available via -electronic mail from: uunet!hutch!barber, hqda-ai!merlin, acornrc!bob, -hao!scicom!qetzal!upba!ugn!nepa!denny, ncar!noao!asuvax!hrc!dan, -bigtex!james (aka james@bigtex.cactus.org), oli-stl!root, -src@contrib.de (Germany), toku@dit.co.jp (Japan) and info@ftp.uu.net. - -* If You Like The Software - -If you like the software developed and distributed by the Free -Software Foundation, please express your satisfaction with a donation. -Your donations will help to support the Foundation and make our future -efforts successful, including a complete development and operating -system, called GNU (Gnu's Not Un*x), which will run Un*x user -programs. For more information on GNU and the Foundation, contact us -at the above address. - -Ordering a distribution tape from the Foundation is often a good -way to bring your company or university to make a donation. diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/HELLO --- a/etc/HELLO Mon Aug 13 11:12:06 2007 +0200 +++ b/etc/HELLO Mon Aug 13 11:13:30 2007 +0200 @@ -2,31 +2,37 @@ Please correct this incomplete list and add more! --------------------------------------------------------- +Amharic ($(3"c!(B Arabic [2](38R(47d(3T!JSa(4W(3W[0](B Croatian (Hrvatski) Bog (Bok), Dobar dan -Czech (,Bh(Besky) Dobr,B}(B den +Czech (.BNhesky) DobrN} den Danish (Dansk) Hej, Goddag English Hello Esperanto Saluton Estonian Tere, Tervist FORTRAN PROGRAM Finnish (Suomi) Hei -French (Fran,Ag(Bais) Bonjour, Salut +French (Fran.ANgais) Bonjour, Salut German (Deutsch Nord) Guten Tag -German (Deutsch S,A|(Bd) Gr,A|_(B Gott -Greek (,FGkk]mija(B) ,FCei\(B ,Fsar(B -Hebrew [2],Hylem[0](B +German (Deutsch S.AN|d) GrN|N_ Gott +Greek (.FNENkNkNgNmNiNjN\) NCNeNiN\ NsNaNr +Hebrew [2].HNyNlNeNm[0] Italiano Ciao, Buon giorno Maltese Ciao Nederlands, Vlaams Hallo, Hoi, Goedendag Norwegian (Norsk) Hei, God dag -Polish Cze,B6f(B! -Russian (,L@caaZXY(B) ,L7T`PRabRcYbU(B! -Spanish (Espa,Aq(Bol) ,A!(BHola! +Polish Cze.BN6Nf! +Russian (.LN@NcNaNaNZNXNY) N7NTN`NPNRNaNbNRNcNYNbNU! +Slovak Dobr.BN} deNr +Spanish (Espa.ANqol) N!Hola! Swedish (Svenska) Hej, Goddag -Vietnamese (Ti,1*(Bng Vi,1.(Bt) Ch,1`(Bo b,1U(Bn +Thai ($(?@0R0I0R0d070B0(B) $(?J0G8J04H$0C8:0(B, $(?J0G8J04H$2P0(B -Japanese ($BF|K\8l(B) $B$3$s$K$A$O(B, (I:]FAJ(B, $BqV$(DiQ(B +Tigrigna ($(3"8#r!N"^(B) $(3!Q!,!<"8(B +Turkish (T.AN|rkNge) Merhaba +Vietnamese (Ti.1N*ng ViN.t) ChN`o bNUn + +Japanese ($BF|K\8l(B) $B$3$s$K$A$O(B, *IN:N]NFNANJ, $BqV$(DiQ(B Chinese ($AVPND(B,$AFUM(;0(B,$A::So(B) $ADc:C(B Cantonese ($(0GnM$(B,$(0N]0*Hd(B) $(0*/=((B, $(0+$)p(B Hangul ($(CGQ1[(B) $(C>H3gGO<H3gGO=J4O1n(B diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/MAILINGLISTS --- a/etc/MAILINGLISTS Mon Aug 13 11:12:06 2007 +0200 +++ b/etc/MAILINGLISTS Mon Aug 13 11:13:30 2007 +0200 @@ -1,1206 +1,112 @@ - XEmacs Electronic Mailing Lists. Last Modified: 1997-01-13 + XEmacs Electronic Mailing Lists. Last Modified: 1999-11-08 + +XEmacs has its own mailing lists and newsgroup which are distinct from +the FSF GNU Emacs mailing lists and newsgroups. The mailing lists are: -XEmacs has its own mailing list and newsgroup which are distinct from -the FSF GNU Emacs mailing lists and newsgroups. The mailing list is: +xemacs@xemacs.org comp.emacs.xemacs bi-directional gateway. + + xemacs is an open list for discussion and bug reporting for + XEmacs. This mailing list is bi-directionally gatewayed with the + USENET newsgroup comp.emacs.xemacs. + +xemacs-announce@xemacs.org XEmacs Announcements. + + xemacs-announce is a read-only, low volume list for announcements + concerning the XEmacs project and new releases of the XEmacs + software. + +xemacs-beta@xemacs.org XEmacs Beta Testers. + + xemacs-beta is an open list for bug reports and general + communication about beta versions of XEmacs. - xemacs@xemacs.org For reporting all bugs in XEmacs, including bugs - in the compilation and installation procedures. - Also for all random questions and conversation - about XEmacs. +xemacs-build-reports@xemacs.org XEmacs Build Report Submissions. + + xemacs-build-reports is an open list for submission of build-reports + on beta versions of XEmacs. For information on what the + build-reports should contain, please see the `etc/BETA' file which + is included in each beta distribution. + +xemacs-cvs@xemacs.org XEmacs CVS Commit Notices. -This mailing list is bidirectionally gatewayed into the USENET newsgroup -comp.emacs.xemacs. + xemacs-cvs is a read-only list for notices and information on what + has been committed to the XEmacs CVS trees, by whom, and for + what. (For more information on the XEmacs CVS Archive: + http://cvs.xemacs.org/.) + +xemacs-mule@xemacs.org XEmacs International Extensions. + + xemacs-mule is an open mailing list for discussion of International + extensions to XEmacs including Mule, XIM, I18n issues, etc, and is + not confined to developmental issues. This list is not restricted + to English, postings in all languages are welcome. + +xemacs-nt@xemacs.org XEmacs on Windows NT/98/95. -To be added or removed from this mailing list, send mail to -xemacs-request@xemacs.org (If it is possible for you to read the -messages via the newsgroup, we would prefer that; the fewer people there -are on the mailing list, the less trouble it is to maintain.) + xemacs-nt is a developer's only mailing list and is intended for + people who wish to work actively on the porting of XEmacs to + Microsoft Windows NT and Microsoft Windows 98/95. + +xemacs-patches@xemacs.org XEmacs Patch Submissions. -Please do NOT send messages about problems with XEmacs to the FSF GNU -Emacs newsgroups and mailing lists (listed below) unless you are sure -that the problem you are reporting is a problem with both versions of -GNU Emacs. People who aren't subscribed to the XEmacs mailing list most -likely are not interested in hearing about problems with it. + xemacs-patches is an open, moderated list for submission of patches + to the XEmacs distribution and its packages. Anyone may subscribe or + submit to xemacs-patches, but all submissions are reviewed by the + list moderator before they are distributed to the list. Discussion + is not appropriate on xemacs-patches. + +xemacs-users-ja@xemacs.org XEmacs (Japanese). + + xemacs-users-ja is an open list for discussion and bug reporting for + XEmacs. Japanese is the preferred language of discussion. It is not + gated to comp.emacs.xemacs or the xemacs list. For fastest + response, bugs not specifically related to Japanese or Mule features + should be reported on xemacs (in English). + +xemacs-beta-ja@xemacs.org XEmacs Beta (Japanese). -The XEmacs mailing list is archived at ftp://ftp.xemacs.org/pub/xemacs/mlists/. + xemacs-beta-ja is an open list for bug reports and general + communication about beta versions of XEmacs, especially features + related to Mule and Japanese-handling. Japanese is the preferred + language of discussion. Bugs not specifically related to Japanese or + Mule features should be reported on xemacs-beta (in English). Please + consider sending bug reports on Mule to xemacs-mule, in English. -See the file etc/BETA for more information about mailing lists for use -by beta testers and XEmacs developers. +The most up to date information on the mailing lists can always be +found at http://www.xemacs.org/. + +Subscriptions: -IMPORTANT IMPORTANT IMPORTANT: +Subscription to all the lists is accomplished by sending an e-mail +message to LISTNAME-request@xemacs.org with `subscribe' (without the +quotes) as the BODY of the message. + +To unsubscribe, send an e-mail to LISTNAME-request@xemacs.org with +`unsubscribe' (without the quotes) as the BODY of the message. + +List Archives: -Aside from the names of the mailing lists and newsgroups corresponding -to this version of Emacs, the guidelines enumerated below still apply. -Please read them before sending a message. +A browsable and searchable archive of these lists is available at +http://www.xemacs.org/list-archives/. + +Problems: + +Any comments, questions, or complaints about the lists should be +brought to the attention of the XEmacs Mailing List Manager +. ----------------------------------------------------------------------- - GNU Project Electronic Mailing Lists and gnUSENET Newsgroups - Last Updated 1 July 97 - Please report improvements to: gnu@prep.ai.mit.edu - -* GNU mailing lists are also distributed as USENET news groups - -The mailing lists are gated both ways with the gnu.all newsgroups at -ohio-state.edu. The one-to-one correspondence is indicated below. If -you don't know if your site is on USENET, ask your system administrator. -If you are a USENET site and don't get the gnu.all newsgroups, please -ask your USENET administrator to get them. If he has your feeds ask -their feeds, you should win. And everyone else wins: newsgroups make -better use of the limited bandwidth of the computer networks and your -home machine than mailing list traffic; and staying off the mailing -lists make better use of the people who maintain the lists and the -machines that the GNU people working with rms use (i.e. we have more -time to produce code!!). Thanx. - -* Getting the mailing lists directly - -If several users at your site or local network want to read a list and -you aren't a USENET site, Project GNU would prefer that you would set up -one address that redistributes locally. This reduces overhead on our -people and machines, your gateway machine, and the network(s) used to -transport the mail from us to you. - -* How to subscribe to and report bugs in mailing lists - -Send messages ABOUT these lists, such as reports of mail problems, or -requests to be added or removed, to help-gnu-emacs-request (or -info-gnu-request, bug-gdb-request, etc.), NOT to info-gnu-emacs (or -info-gnu, etc.). These -request addresses go only to the -people who can do something about your requests or problems, and thus -avoids disturbing everyone else. - -Note that all GNU mailing lists are maintained by volunteers. They get -behind occasionally. Wait at least 3 or 4 days before asking again. -Thanks! - -Many of the GNU mailing lists are very large and are received by many -people. Please don't send them anything that is not seriously important -to all their readers. All GNU mailing lists are unmoderated, mail -reflectors, except info-gnu, info-gnu-emacs, info-gcc, info-g++, -info-gnu-fortran. - -All addresses below are in internet format. Consult the mail guru for -your computer to figure out address syntaxes from other networks. From -UUCP machines: - ..!ucbvax!prep.ai.mit.edu!ADDRESS - ..!uunet!prep.ai.mit.edu!ADDRESS - -If a message you mail to a list is returned from a MAILER-DAEMON (often -with the line: - ----- Transcript of session follows ----- - don't resend the message to the list. All this return means is that -your original message failed to reach a few addresses on the list. Such -messages are NEVER a reason to resend a piece of mail a 2nd time. This -just bothers all (less the few delivery failures (which will probably -just fail again!)) of the readers of the list with a message they have -already seen. It also wastes computer and network resources. - -It is appropriate to send these to the -request address for a list, and -ask them to check the problem out. - -* Send Specific Requests for Information to: gnu@prep.ai.mit.edu - -Specific requests for information about obtaining GNU software, or GNU -activities in Cambridge and elsewhere can be directed to: - gnu@prep.ai.mit.edu - -* General Information about all lists - -Please keep each message under 25,000 characters. Some mailers bounce -messages that are longer than this. If your message is long, it is -generally better to send a message offering to make the large file -available to only those people who want it (e.g. mailing it to people -who ask, or putting it up for FTP). In the case of gnu.emacs.sources, -somewhat larger postings (up to 10 parts of no more than 25,000 -characters each) are acceptable (assuming they are likely to be of -interest to a reasonable number of people); if it is larger than that -have it added to archive.cis.ohio-state.edu (the GNU Emacs Lisp ftp and -uucp archive on and announce) its location there. Good bug reports are -short. See section '* General Information about bug-* lists and ...' -for further details. - -Most of the time, when you reply to a message sent to a list, the reply -should not go to the list. But most mail reading programs supply, by -default, all the recipients of the original as recipients of the reply. -Make a point of deleting the list address from the header when it does -not belong. This prevents bothering all readers of a list, and reduces -network congestion. - -The GNU mailing lists and newsgroups, like the GNU project itself, exist -to promote the freedom to share software. So don't use these lists to -promote or recommend non-free software. (Using them to post ordering -information is the ultimate faux pas.) If there is no free program to -do a certain task, then somebody should write one! - -* General Information about info-* lists - -These lists and their newsgroups are meant for important announcements. -Since the GNU project uses software development as a means for social -change, the announcements may be technical or political. - -Most GNU projects info-* lists (and their corresponding gnu.*.announce -newsgroups) are moderated to keep their content significant and -relevant. If you have a bug to report, send it to the bug-* list. If -you need help on something else and the help-* list exists, ask it. - -See section '* General Information about all lists'. - -* General Information about help-* lists - -These lists (and their newsgroups) exist for anyone to ask questions -about the GNU software that the list deals with. The lists are read by -people who are willing to take the time to help other users. - -When you answer the questions that people ask on the help-* lists, keep -in mind that you shouldn't answer by promoting a proprietary program as -a solution. The only real solutions are the ones all the readers can -share. - -If a program crashes, or if you build it following the standard -procedure on a system on which it is supposed to work and it does not -work at all, or if an command does not behave as it is documented to -behave, this is a bug. Don't send bug reports to a help-* list; mail -them to the bug-* list instead. - -See section '* General Information about all lists'. - -* General Information about bug-* lists and reporting program bugs - -If you think something is a bug in a program, it might be one; or, it -might be a misunderstanding or even a feature. Before beginning to -report bugs, please read the section ``Reporting Emacs Bugs'' toward the -end of the GNU Emacs reference manual (or node Emacs/Bugs in Emacs's -built-in Info system) for a discussion of how and when to send in bug -reports. For GNU programs other than GNU Emacs, also consult their -documentation for their bug reporting procedures. Always include the -version number of the GNU program, as well as the operating system and -machine the program was ran on (if the program doesn't have a version -number, send the date of the latest entry in the file ChangeLog). For -GNU Emacs bugs, type "M-x emacs-version". A debugger backtrace of any -core dump, can also be useful. Be careful to separate out hypothesis -from fact! For bugs in GNU Emacs lisp, set variable debug-on-error to -t, and re-enter the command(s) that cause the error message; Emacs will -pop up a debug buffer if something is wrong; please include a copy of -the buffer in your bug report. Please also try to make your bug report -as short as possible; distill the problem to as few lines of code and/or -input as possible. GNU maintainers give priority to the shortest, high -quality bug reports. - -Please don't send in a patch without a test case to illustrate the -problem the patch is supposed to fix. Sometimes the patches aren't -correct or aren't the best way to do the job, and without a test case -there is no way to debug an alternate fix. - -The purpose of reporting a bug is to enable the bug to be fixed for the -sake of the whole community of users. You may or may not receive a -response; the maintainers will send one if that helps them find or -verify a fix. Most GNU maintainers are volunteers and all are -overworked; they don't have time to help individuals and still fix the -bugs and make the improvements that everyone wants. If you want help -for yourself in particular, you may have to hire someone. The GNU -project maintains a list of people providing such services. It is -distributed with GNU Emacs in file etc/SERVICE, and can be requested -from gnu@prep.ai.mit.edu. - -Anything addressed to the implementors and maintainers of a GNU program -via a bug-* list, should NOT be sent to the corresponding info-* or -help-* list. - -Please DON'T post your bug reports on the gnu.*.bug newsgroups! Mail -them to bug-*@prep instead! At first sight, it seems to make no -difference: anything sent to one will be propagated to the other; but: - - if you post on the newsgroup, the information about how to -reach you is lost in the message that goes on the mailing list. It -can be very important to know how to reach you, if there is anything -in the bug report that we don't understand; - - bug reports reach the GNU maintainers quickest when they are -sent to the bug-* mailing list submittal address; - - mail is much more reliable then netnews; and - - if the internet mailers can't get your bug report delivered, -they almost always send you an error message, so you can find another -way to get the bug report in. When netnews fails to get your message -delivered to the maintainers, you'll never know about it and the -maintainers will never see the bug report. - -And please DON'T post your GNU bug reports to comp.* or other gnu.* -newsgroups, they never make it to the GNU maintainers at all. Please -mail them to bug-*@prep instead! - -See section '* General Information about all lists'. - -* info-gnu-request@prep.ai.mit.edu to subscribe to info-gnu -** gnUSENET newsgroup: gnu.announce -** Send announcements to: info-gnu@prep.ai.mit.edu - -This list distributes progress reports on the GNU Project. It is also -used by the GNU Project to ask people for various kinds of help. It is -NOT for general discussion. - -The list is filtered to remove items meant for info-gnu-request, that -can be answered by the moderator without bothering the list, or should -have been sent to another list. - -See section '* General Information about info-* lists'. - -* gnu-misc-discuss-request@prep.ai.mit.edu to subscribe to gnu-misc-discuss -** gnUSENET newsgroup: gnu.misc.discuss -** Send contributions to: gnu-misc-discuss@prep.ai.mit.edu - -This list is for serious discussion of freed software, the GNU Project, -the GNU Manifesto, and their implications. It's THE place for -discussion that is not appropriate in the other GNU mailing lists and -gnUSENET newsgroups. - -Flaming is out of place. Tit-for-tat is not welcome. Repetition -should not occur. - -Good READING and writing are expected. Before posting, wait a while, -cool off, and think. - -Don't use this group for complaints and bug reports about GNU software! -The maintainers don't read this group; they won't see your complaint. -Use the appropriate bug-reporting mailing list instead, so that people -who can do something about the problem will see it. - -Don't trust pronouncements made on gnu-misc-discuss about what GNU is, -what FSF position is, what the GNU General Public License is, etc., -unless they are made by someone you know is well connected with GNU and -are sure the message is not forged. - -USENET and gnUSENET readers are expected to have read ALL the articles -in news.announce.newusers before posting. If news.announce.newusers is -empty at your site, wait (the articles are posted monthly), your posting -isn't that urgent! Readers on the Internet can anonymous FTP these -articles from host ftp.uu.net under directory ?? - -Someone from the Free Software Foundation will attempt to follow this -group as time and volume permits. - -Remember, "GNUs Not Unix" and "gnUSENET is Not USENET". We have -higher standards! - -Note that sending technical questions about specific GNU software to -gnu-misc-discuss is likely to be less useful than sending them to the -appropriate mailing list or gnUSENET newsgroup, since more technical -people read those. - -* bug-gnu-sql-request@prep.ai.mit.edu to subscribe to bug-gnu-sql -** gnUSENET newsgroup: NONE PLANNED -** GNU-SQL BUG reports to: bug-gnu-sql@prep.ai.mit.edu - -This list distributes, to the active maintainers of GNU's SQL (GNU's SQL -full scale database server), bug reports and fixes for, and suggestions -for improvements to GNU's SQL. User discussion of GNU's SQL also occurs -here. - -There are no other GNU mailing lists or gnUSENET newsgroups for GNU's SQL. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-guile-request@prep.ai.mit.edu to subscribe to bug-guile -** gnUSENET newsgroup: NONE PLANNED -** GUILE BUG reports to: bug-guile@prep.ai.mit.edu - -This list distributes, to the active maintainers of GUILE (GNU's -Ubiquitous Extension Language), bug reports and fixes for, and suggestions for -improvements to GUILE. User discussion of GUILE also occurs here. - -There are no other GNU mailing lists or gnUSENET newsgroups for GUILE . - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* guile-sources-request@prep.ai.mit.edu to subscribe to guile-sources -** gnUSENET newsgroup: NONE PLANNED -** Guile source code to: guile-sources@prep.ai.mit.edu - -This list will be for the posting, by their authors, of GUILE, Scheme, -and C sources and patches that improve Guile. Its contents will be -reviewed by the FSF for inclusion in future releases of GUILE. - -Please do NOT discuss or request source code here. Use bug-guile for -those purposes. This allows the automatic archiving of sources posted -to this list. + GNU Project Electronic Mailing Lists and gnUSENET Newsgroups: -Please do NOT post such sources to any other GNU mailing list (e.g -bug-guile) or gnUSENET newsgroups. It's up to each poster to decide -whether to cross-post to any non-gnUSENET newsgroup. - -Please do NOT announce that you have posted source code to guile.sources -to any other GNU mailing list (e.g. bug-guile) or gnUSENET newsgroups. -People who want to keep up with sources will read this list. It's up to -each poster to decide whether to announce a guile.sources article in any -non-gnUSENET newsgroup (e.g. comp.emacs or comp.sources.d). - -If source or patches that were previously posted or a simple fix is -requested in bug-guile, please mail it to the requester. Do NOT -repost it. If you also want something that is requested, send mail to -the requester asking him to forward it to you. This kind of traffic is -best handled by e-mail, not by a broadcast medium that reaches millions -of sites. - -If the requested source is very long (>10k bytes) send mail offering to -send it. This prevents the requester from getting many redundant copies -and saves network bandwidth. - -* bug-gnustep-request@prep.ai.mit.edu to subscribe to bug-gnustep -** gnUSENET newsgroup: gnu.gnustep.bug -** Gnustep bug reports to: bug-gnustep@prep.ai.mit.edu -** FAQ-URL: none known -** FAQ-Archive-name: none known -** FAQ-Posting-frequency: none known - -This list distributes bug reports for, fixes for bugs in, and -suggestions for improvements in GNUstep to its active developers. - -Subscribers to bug-gnustep get all info-gnustep messages. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-gnustep-request@prep.ai.mit.edu to subscribe to help-gnustep -** gnUSENET newsgroup: gnu.gnustep.help -** Send contributions to: help-gnustep@prep.ai.mit.edu -** FAQ-URL: none known -** FAQ-Archive-name: none known -** FAQ-Posting-frequency: none known - -This list is the place for users and installers of the GNUstep to ask -for help. Please send bug reports to bug-gnustep@prep.ai.mit.edu -instead of posting them here. - -See section '* General Information about help-* lists'. - -* discuss-gnustep-request@prep.ai.mit.edu to subscribe to discuss-gnustep -** gnUSENET newsgroup: gnu.gnustep.discuss -** Send contributions to: discuss-gnustep@prep.ai.mit.edu -** FAQ-URL: none known -** FAQ-Archive-name: none known -** FAQ-Posting-frequency: none known - -This list is the place for GNUstep users and developers to discuss -GNUstep. Please send bug reports to bug-gnustep@prep.ai.mit.edu -instead of posting them here. - -See section '* General Information about discuss-* lists'. - -* info-gnustep-request@prep.ai.mit.edu to subscribe to info-gnustep -** gnUSENET newsgroup: gnu.gnustep.announce -** Send announcements to: info-gnustep@prep.ai.mit.edu -** FAQ-URL: none known -** FAQ-Archive-name: none known -** FAQ-Posting-frequency: none known - -This list distributes announcements and progress reports on GNUstep. -It is NOT for general discussion; please use discuss-gnustep for that. - -The list is filtered to remove items meant for info-gnustep-request, that -can be answered by the moderator without bothering the list, or should -have been sent to another list. - -Do not report GNUstep bugs to info-gnustep, help-gnustep, or -discuss-gnustep, mail them to bug-gnustep@prep.ai.mit.edu instead. - -See section '* General Information about info-* lists'. - -* bug-hurd-request@prep.ai.mit.edu to subscribe to bug-hurd -** gnUSENET newsgroup: gnu.hurd.bug -** Hurd bug reports to: bug-hurd@prep.ai.mit.edu - -This list distributes bug reports for, fixes for bugs in, and -suggestions for improvements in the GNU Hurd to its active developers. - -No info-gnu-hurd list is planned. Announcements about the GNU Hurd will -be made to the list info-gnu@prep.ai.mit.edu (see above). - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-hurd-request@prep.ai.mit.edu to subscribe to help-hurd -** gnUSENET newsgroup: gnu.hurd.help -** Send contributions to: help-hurd@prep.ai.mit.edu - -This list is the place for users and installers of the GNU Hurd to ask -for help. - -No info-gnu-hurd list is planned. Announcements about the GNU Hurd will -be made to the list info-gnu@prep.ai.mit.edu (see above). - -See section '* General Information about help-* lists'. - -* hurd-ann-request@prep.ai.mit.edu IS NOW DEFUNCT -** gnUSENET newsgroup: NEVER EXISTED -** DEAD address: hurd-ann@prep.ai.mit.edu - -This list is dead. Announcements about the GNU Hurd will be made to the -list info-gnu@prep.ai.mit.edu (see above). - -* bug-gnu-emacs-request@prep.ai.mit.edu to subscribe to bug-gnu-emacs -** gnUSENET newsgroup: gnu.emacs.bug -** Gnu Emacs bug reports to: bug-gnu-emacs@prep.ai.mit.edu - -This list distributes, to the active maintainers of GNU Emacs, bug -reports and fixes for, and suggestions for improvements in GNU Emacs. - -Send bugs in the GNU Emacs Lisp reference manual to: - lisp-manual-bugs@prep.ai.mit.edu - -lisp-manual-bugs is neither a mailing list nor a gnUSENET newsgroup. -It's just a bug-reporting address. - -Subscribers to bug-gnu-emacs get all info-gnu-emacs messages. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* gnu-emacs-sources-request@prep.ai.mit.edu to subscribe to gnu-emacs-sources -** gnUSENET newsgroup: gnu.emacs.sources -** Gnu Emacs source code to: gnu-emacs-sources@prep.ai.mit.edu - -This list/newsgroup will be for the posting, by their authors, of Emacs -Lisp and C sources and patches that improve GNU Emacs. Its contents -will be reviewed by the FSF for inclusion in future releases of GNU -Emacs. - -Please do NOT discuss or request source code here. Use -help-gnu-emacs/gnu.emacs.help for those purposes. This allows the -automatic archiving of sources posted to this list/newsgroup. - -Please do NOT post such sources to any other GNU mailing list (e.g -help-gnu-emacs) or gnUSENET newsgroups (e.g. gnu.emacs.help). It's up -to each poster to decide whether to cross-post to any non-gnUSENET -newsgroup (e.g. comp.emacs or vmsnet.sources). - -Please do NOT announce that you have posted source code to -gnu.emacs.sources to any other GNU mailing list (e.g. help-gnu-emacs) or -gnUSENET newsgroups (e.g. gnu.emacs.help). People who want to keep up -with sources will read this list/newsgroup. It's up to each poster to -decide whether to announce a gnu.emacs.sources article in any -non-gnUSENET newsgroup (e.g. comp.emacs or comp.sources.d). - -If source or patches that were previously posted or a simple fix is -requested in help-gnu-emacs, please mail it to the requester. Do NOT -repost it. If you also want something that is requested, send mail to -the requester asking him to forward it to you. This kind of traffic is -best handled by e-mail, not by a broadcast medium that reaches millions -of sites. - -If the requested source is very long (>10k bytes) send mail offering to -send it. This prevents the requester from getting many redundant copies -and saves network bandwidth. - -* help-gnu-emacs-request@prep.ai.mit.edu to subscribe to help-gnu-emacs -** gnUSENET newsgroup: gnu.emacs.help (and one-way into comp.emacs) -** Send contributions to: help-gnu-emacs@prep.ai.mit.edu - -This list is the place for users and installers of GNU Emacs to ask for -help. Please send bug reports to bug-gnu-emacs instead of posting them -here. - -Since help-gnu-emacs is a very large list, send it only those items that -are seriously important to many people. - -If source or patches that were previously posted or a simple fix is -requested in help-gnu-emacs, please mail it to the requester. Do NOT -repost it. If you also want something that is requested, send mail to -the requester asking him to forward it to you. This kind of traffic is -best handled by e-mail, not a broadcast medium that reaches millions of -sites. - -This list is also gated one way to USENET's newsgroup comp.emacs (once -known as net.emacs). This one-way gating is done for users whose sites -get comp.emacs, but not gnu.emacs.help. Users at non-USENET sites may -receive all articles from comp.emacs by making their request to: -unix-emacs-request@bbn.com - -If Emacs crashes, or if you build Emacs following the standard procedure -on a system which Emacs is supposed to work on (see etc/MACHINES) and it -does not work at all, or if an editing command does not behave as it is -documented to behave, this is a bug. Don't send bug reports to -help-gnu-emacs (gnu.emacs.help) or post them to comp.emacs; mail them to -bug-gnu-emacs@prep.ai.mit.edu instead. - -See section '* General Information about help-* lists'. - -* info-gnu-emacs-request@prep.ai.mit.edu to subscribe to info-gnu-emacs -** gnUSENET newsgroup: gnu.emacs.announce (and one-way into comp.emacs) -** Send announcements to: info-gnu-emacs@prep.ai.mit.edu - -This list distributes announcements and progress reports on GNU Emacs. -It is NOT for general discussion; please use help-gnu-emacs for that. - -The list is filtered to remove items meant for info-gnu-emacs-request, -that can be answered by the moderator without bothering the list, or -should have been sent to another list. - -info-gnu-emacs is also gated one way to USENET's newsgroup comp.emacs -(once known as net.emacs). This one-way gating is done for users whose -sites get comp.emacs, but not gnu.emacs.announce. Users at non-USENET -sites may receive all articles from comp.emacs by making their request -to: unix-emacs-request@bbn.com - -Do not report GNU Emacs bugs to info-gnu-emacs or comp.emacs, instead -mail them to bug-gnu-emacs@prep.ai.mit.edu. - -See section '* General Information about info-* lists'. - -* vms-gnu-emacs-request@prep.ai.mit.edu to subscribe -** gnUSENET newsgroup: gnu.emacs.vms -** Send contributions to: vms-gnu-emacs@prep.ai.mit.edu - -This list was a working group who did the initial port of GNU Emacs to -the VMS operating system. It still discusses problems and solutions to -the VMS port and the distribution of it. - -* bug-bash-request@prep.ai.mit.edu to subscribe to bug-bash -** gnUSENET newsgroup: gnu.bash.bug -** BASH bug reports to: bug-bash@prep.ai.mit.edu - -This list distributes, to the active maintainers of BASH (the Bourne -Again SHell), bug reports and fixes for, and suggestions for -improvements in BASH. User discussion of BASH also occurs here. - -Always report the version number of the operating system, hardware, and -bash (flag -version on startup or check the variable $BASH_VERSION in a -running bash). - -There are no other GNU mailing lists or gnUSENET newsgroups for BASH. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-gdb-request@prep.ai.mit.edu to subscribe to bug-gdb -** gnUSENET newsgroup: gnu.gdb.bug -** GDB bug reports to: bug-gdb@prep.ai.mit.edu - -This list distributes, to the active maintainers of GDB (Gnu's -DeBugger), bug reports and fixes for, and suggestions for improvements -in GDB. - -There are no other GNU mailing lists or gnUSENET newsgroups for GDB. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-octave-request@che.utexas.edu to subscribe to bug-octave -** gnUSENET newsgroup: NONE PLANNED -** Octave bug reports to: bug-octave@che.utexas.edu - -This list distributes, to the active maintainers of Octave (a system -for numerical computations), bug reports and fixes for, and -suggestions for improvements to Octave. - -The help-octave mailing list is for user discussion of Octave. - -See section '* General Information about bug-* lists and reporting -program bugs'. - - -* help-octave-request@che.utexas.edu to subscribe to help-octave -** gnUSENET newsgroup: NONE PLANNED -** Send contributions to: help-octave@che.utexas.edu - -This list is the place for users and installers of Octave to ask for -help. Please send bug reports to bug-octave instead of posting them -here. - -If Octave crashes, or if you build Octave following the standard -procedure on a system on which Octave is supposed to work on and it -does not work at all, or if a command does not behave as it is -documented to behave, this is a bug. Don't send bug reports to -help-octave; mail them to bug-octave@che.utexas.edu instead. - -See section '* General Information about help-* lists'. - -* bug-gcc-request@prep.ai.mit.edu to subscribe to bug-gcc -** gnUSENET newsgroup: gnu.gcc.bug -** GCC bug reports to: bug-gcc@prep.ai.mit.edu +The XEmacs project is separate from and not managed by the GNU +project. The latest information about the GNU project mailing lists +can be found at ftp://ftp.gnu.org/gnu/GNUinfo/MAILINGLISTS -This list distributes bug reports for, fixes for bugs in, and -suggestions for improvements in the GNU C Compiler to its active -developers. - -Please don't send in a patch without a test case to illustrate the -problem the patch is supposed to fix. Sometimes the patches aren't -correct or aren't the best way to do the job, and without a test case -there is no way to debug an alternate fix. - -The most convenient form of test case is a piece of cpp output that can -be passed directly to cc1. Preferably written in C, not C++ or -Objective C. - -Subscribers to bug-gcc get all info-gcc messages. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-gcc-request@prep.ai.mit.edu to subscribe to help-gcc -** gnUSENET newsgroup: gnu.gcc.help -** Send contributions to: help-gcc@prep.ai.mit.edu - -This list is the place for users and installers of the GNU C Compiler to -ask for help. - -If gcc crashes, or if you build gcc following the standard procedure on -a system which gcc is supposed to work on (see config.sub) and it does -not work at all, or if an command line option does not behave as it is -documented to behave, this is a bug. Don't send bug reports to help-gcc -(gnu.gcc.help); mail them to bug-gcc@prep.ai.mit.edu instead. - -See section '* General Information about help-* lists'. - -* info-gcc-request@prep.ai.mit.edu to subscribe to info-gcc -** gnUSENET newsgroup: gnu.gcc.announce -** Send announcements to: info-gcc@prep.ai.mit.edu - -This list distributes announcements and progress reports on the GNU C -Compiler. It is NOT for general discussion; please use help-gcc for -that. - -The list is filtered to remove items meant for info-gcc-request, that -can be answered by the moderator without bothering the list, or should -have been sent to another list. - -See section '* General Information about info-* lists'. - -* bug-gnu960-request@ichips.intel.com to subscribe to bug-gnu960 -** gnUSENET newsgroup: NONE PLANNED -** Intel 960 Port bug reports to: bug-gnu960@ichips.intel.com - -This list distributes bug reports for, fixes for bugs in, and -suggestions for improvements in Intel's port of GNU software to the -Intel 960 microprocessor. - -You can also fax to: GNU/960 - 1-503-696-4930. - -There are no other GNU mailing lists or gnUSENET newsgroups for Intel's -port of GNU software to the Intel 960 microprocessor. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-glibc-request@prep.ai.mit.edu to subscribe to bug-glibc -** gnUSENET newsgroup: gnu.glibc.bug -** GNU C Library bug reports to: bug-glibc@prep.ai.mit.edu - -This list distributes, to the active maintainers of glibc (GNU's C -library), bug reports and fixes for, and suggestions for improvements in -glibc. User discussion of glibc also occurs here. - -Announcements of new releases of glibc are made on both info-gcc and -bug-glibc. - -There are no other GNU mailing lists or gnUSENET newsgroups for the GNU -C Library. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-g++-request@prep.ai.mit.edu to subscribe to bug-g++ -** gnUSENET newsgroup: gnu.g++.bug -** G++ bug reports to: bug-g++@prep.ai.mit.edu - -This list distributes bug reports for, fixes for bugs in, and -suggestions for improvements in the GNU C++ Compiler to its active -developers. - -G++ uses the GNU C-Compiler back end. Active developers may wish to -subscribe to bug-gcc@prep.ai.mit.edu as well. - -Subscribers to bug-g++ get all info-g++ messages. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-g++-request@prep.ai.mit.edu to subscribe to help-g++ -** gnUSENET newsgroup: gnu.g++.help (and one-way into comp.lang.c++) -** Send contributions to: help-g++@prep.ai.mit.edu - -This list is the place for users and installers of the GNU C++ Compiler -to ask for help. Please send bug reports to bug-g++@prep.ai.mit.edu -instead of posting them here. - -help-g++ is also gated one way to USENET's newsgroup comp.lang.c++. -This one-way gating is done for users whose sites get comp.lang.c++, but -not gnu.g++.help. - -See section '* General Information about help-* lists'. - -* info-g++-request@prep.ai.mit.edu to subscribe to info-g++ -** gnUSENET newsgroup: gnu.g++.announce (and one-way into comp.lang.c++) -** Send announcements to: info-g++@prep.ai.mit.edu - -This list distributes announcements and progress reports on the GNU C++ -Compiler. It is NOT for general discussion; please use help-g++ for -that. - -The list is filtered to remove items meant for info-g++-request, that -can be answered by the moderator without bothering the list, or should -have been sent to another list. - -It is also gated one way to USENET's newsgroup comp.lang.c++. This -one-way gating is done for users whose sites get comp.lang.c++, but not -gnu.g++.announce. - -Do not report g++ bugs to info-g++ or comp.lang.c++, mail them to -bug-g++@prep.ai.mit.edu instead. - -See section '* General Information about info-* lists'. - -* bug-lib-g++-request@prep.ai.mit.edu to subscribe to bug-lib-g++ -** gnUSENET newsgroup: gnu.g++.lib.bug -** lib-g++ bug reports to: bug-lib-g++@prep.ai.mit.edu - -This list distributes, to the active maintainers of libg++ (GNU's -library for C++), bug reports and fixes for, and suggestions for -improvements in lib-g++. User discussion of libg++ also occurs here. - -Announcements of new releases of libg++ are made on both info-g++ and -bug-lib-g++. - -There are no other GNU mailing lists or gnUSENET newsgroups for GNU's -G++ Library. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* info-gnu-fortran-request@prep.ai.mit.edu to subscribe to info-gnu-fortran -** gnUSENET newsgroup: NONE YET -** Send announcements to: info-gnu-fortran@prep.ai.mit.edu - -This list is for progress reports about the GNU Fortran compiler. In -the future it will also be used for release notices. - -The list is filtered to remove items meant for info-gnu-fortran-request, -that can be answered by the moderator without bothering the list, or -should have been sent to another list. - -People on the Internet can get a current status report by fingering the -address fortran@gnu.ai.mit.edu. - -See section '* General Information about info-* lists'. - -There are no other GNU mailing lists or gnUSENET newsgroups for GNU -Fortran (yet). - -* bug-oleo-request@prep.ai.mit.edu to subscribe to bug-oleo -** gnUSENET newsgroup: NONE PLANNED -** Oleo bug reports to: bug-oleo@prep.ai.mit.edu - -This list distributes, to the active maintainers of Oleo (the GNU -spreadsheet), bug reports and fixes for, and suggestions for -improvements to Oleo. User discussion of Oleo also occurs here. - -There are no other GNU mailing lists or gnUSENET newsgroups for Oleo . - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-gmp-request@prep.ai.mit.edu to subscribe to bug-gmp -** gnUSENET newsgroup: NONE PLANNED -** gmp bug reports to: bug-gmp@prep.ai.mit.edu - -This list distributes, to the active maintainers of gmp (the GNU -Multiple Precision Library), bug reports and fixes for, and suggestions -for improvements to gmp. User discussion of gmp also occurs here. - -There are no other GNU mailing lists or gnUSENET newsgroups for gmp . - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-pine-request@prep.ai.mit.edu to subscribe to bug-pine -** gnUSENET newsgroup: NONE PLANNED -** pine bug reports to: bug-pine@prep.ai.mit.edu - -This list distributes, to the active maintainers of pine (the GNU -version of the pine mail reader), bug reports and fixes for, and suggestions -for improvements to pine. User discussion of pine also occurs here. - -There are no other GNU mailing lists or gnUSENET newsgroups for pine . - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-cfengine-request@prep.ai.mit.edu to subscribe to bug-cfengine -** gnUSENET newsgroup: gnu.cfengine.bug -** cfengine bug reports to: bug-cfengine@prep.ai.mit.edu - -This list distributes, to the active maintainers of cfengine (configure -BSD and System-5-like operating systems attached to a TCP/IP network), -bug reports and fixes for, and suggestions for improvements to cfengine. -User discussion of cfengine also occurs here. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-cfengine-request@prep.ai.mit.edu to subscribe to help-cfengine -** gnUSENET newsgroup: gnu.cfengine.help -** Send contributions to: help-cfengine@prep.ai.mit.edu - -This list is the place for users and installers of cfengine to ask for -help. Please send bug reports to bug-cfengine instead of posting them -here. - -This list is also used for announcements about cfengine and related -programs, and small but important patches. Announcements of cfengine -releases are also made to info-gnu@prep.ai.mit.edu (see above) - -Since help-cfengine is a large list, send it only those items that -are seriously important to many people. - -If source or patches that were previously posted or a simple fix is -requested in help-cfengine, please mail it to the requester. Do NOT -repost it. If you also want something that is requested, send mail to -the requester asking him to forward it to you. This kind of traffic is -best handled by e-mail, not a broadcast medium that reaches millions of -sites. - -See section '* General Information about help-* lists'. -Also see section '* General Information about info-* lists'. - -* bug-gnu-smalltalk-request@prep.ai.mit.edu to subscribe to bug-gnu-smalltalk -** gnUSENET newsgroup: gnu.smalltalk.bug -** GNU Smalltalk bug reports to: bug-gnu-smalltalk@prep.ai.mit.edu - -GNU Smalltalk is the GNU project implementation of the Smalltalk language. - -This list distributes, to the active maintainers of GNU Smalltalk, bug -reports and fixes for, and suggestions for improvements to GNU -Smalltalk. User discussion of GNU Smalltalk also occurs here. - -For now, new releases of GNU Smalltalk will also be announced on this list. - -There are no other GNU mailing lists or gnUSENET newsgroups for GNU -Smalltalk. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* st-next-request@laplace.eng.sun.com to subscribe to st-next -** gnUSENET newsgroup: NONE PLANNED -** Send contributions to: st-next@laplace.eng.sun.com - -For people interested in working on GNU Smalltalk on the NeXT. - -* bug-groff-request@prep.ai.mit.edu to subscribe to bug-groff -** gnUSENET newsgroup: gnu.groff.bug -** GNU groff bug reports to: bug-groff@prep.ai.mit.edu - -groff is the GNU project implementation, in C++, of the traditional Unix -document formatting tools. - -This list distributes, to the active maintainers of groff, bug reports -and fixes for, and suggestions for improvements to groff (and it -component programs). User discussion of groff also occurs here. - -For now, new releases of groff will also be announced on this list. - -There are no other GNU mailing lists or gnUSENET newsgroups for groff. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-ghostscript-request@prep.ai.mit.edu to subscribe to bug-ghostscript -** gnUSENET newsgroup: gnu.ghostscript.bug -** Ghostscript bug reports to: bug-ghostscript@prep.ai.mit.edu - -Ghostscript is the GNU project implementation of a language and graphics -library with a remarkable similarity to PostScript. +Please do NOT send messages about problems with XEmacs to the FSF GNU +Emacs newsgroups and mailing lists unless you are sure that the +problem you are reporting is a problem with both versions of GNU +Emacs. People who aren't subscribed to the XEmacs mailing list most +likely are not interested in hearing about problems with it. -This list distributes, to the active maintainers of Ghostscript, bug -reports and fixes for, and suggestions for improvements in Ghostscript. - -For now, new releases of Ghostscript will also be announced on this list. - -There are no other GNU mailing lists or gnUSENET newsgroups for -Ghostscript. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-gnu-utils-request@prep.ai.mit.edu to subscribe to bug-gnu-utils -** gnUSENET newsgroup: gnu.utils.bug -** GNU Utilities bug reports to: bug-gnu-utils@prep.ai.mit.edu - -This list distributes, to the active maintainers of these programs, bug -reports and fixes for, and suggestions for improvements in GNU programs -not covered by other bug-* mailing lists/gnu.*.bug newsgroups. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-gnu-utils-request@prep.ai.mit.edu to subscribe to help-gnu-utils -** gnUSENET newsgroup: gnu.utils.help -** Send contributions to: help-gnu-utils@prep.ai.mit.edu - -This list is the place for users and installers of GNU programs not -covered by other GNU mailing lists/gnu.* newsgroups to ask for help. - -Don't send bug reports to help-gnu-utils (gnu.utils.help); mail them to -bug-gnu-utils@prep.ai.mit.edu instead. - -See section '* General Information about help-* lists'. - -* info-gnu-utils-request@prep.ai.mit.edu IS NOW DEFUNCT -** a gnUSENET newsgroup bever existed -** DEAD address: info-gnu-utils@prep.ai.mit.edu - -This list is dead. Announcements about GNU Utilities will be made to the -list info-gnu@prep.ai.mit.edu (see above). - -* info-cvs-request@prep.ai.mit.edu to subscribe to info-cvs. -** USENET newsgroup: (none) -** CVS discussions/questions to: info-cvs@prep.ai.mit.edu - -This list is for discussion and dissemination of information about -CVS. Please check the FAQ before posting questions, however. - -* bug-cvs-request@prep.ai.mit.edu to subscribe to bug-cvs. -** USENET newsgroup: (none) -** CVS bug reports to: bug-cvs@prep.ai.mit.edu - -This list distributes bug reports, fixes, and suggestions for -improvements to the maintainers of CVS. - -* bug-fortran-mode-request@erl.mit.edu to subscribe to bug-fortran-mode -** USENET newsgroup: (none) -** Fortran mode bug reports to: bug-fortran-mode@erl.mit.edu - -This list collects bug reports, fixes for bugs, and suggestions for -improvements in GNU Emacs's Fortran mode (a major mode to support -editing Fortran source code). - -It is the place to report Fortran mode bugs by all users of Fortran -mode. - -Always report the version number Fortran mode reports on startup as well -as the version of Emacs. - -There is no info-fortran-mode list. There are no USENET gateways to -bug-fortran-mode at this time. - -* info-gnus-request@flab.fujitsu.co.jp to subscribe -** gnUSENET newsgroup: NONE YET -** Send contributions to: info-gnus@flab.fujitsu.co.jp - -The list is intended to exchange useful information about GNUS, such as -bug reports, useful hooks, and extensions of GNUS. GNUS is an NNTP-base -network news reader for GNU Emacs (which also works with a news spool). -English and Japanese are the official languages of the list. GNUS is -quite different than gnews. - -* info-gnus-english-request@prep.ai.mit.edu to subscribe -** gnUSENET newsgroup: gnu.emacs.gnus -** Send contributions to: info-gnus-english@prep.ai.mit.edu - -The list has the same charter as info-gnus. The difference is that -English is the only official language of the list. - -info-gnus-english/gnu.emacs.gnus is forward to info-gnus, but NOT -vice-versa. - -* info-gnews-request@ics.uci.edu to subscribe to info-gnews -** gnUSENET newsgroup: gnu.emacs.gnews -** Send contributions to: info-gnews@ics.uci.edu - -This newsgroup is intended to exchange useful information about gnews, -such as bug reports, useful hooks, and extensions of gnews. gnews is an -NNTP-base network news reader for GNU Emacs (which also works a news -spool). It is quite different than GNUS. - -* gnu-emacs-ada-request@grebyn.com to subscribe to gnu-emacs-ada -** gnUSENET newsgroup: NONE PLANNED -** Gnu Emacs Ada support bug reports to: gnu-emacs-ada@grebyn.com - -This list distributes bug reports for, fixes for bugs in, and -suggestions for improvements in GNU Emacs' editing support of the Ada -programming language. - -There are no other GNU mailing lists or gnUSENET newsgroups for GNU -Emacs' editing support of Ada. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-vm-request@uunet.uu.net to subscribe to bug-vm -** gnUSENET newsgroup: gnu.emacs.vm.bug -** VM mail reader bug reports to: bug-vm@uunet.uu.net - -This list discusses bugs in View Mail mode for GNU Emacs, with an -emphasis on beta and prerelease versions. - -Always report the version number of VM you are using, as well as the -version of Emacs you're running. If you believe it is significant, -report the operating system used and the hardware. - -Subscribers to bug-vm get all info-vm messages. - -* info-vm-request@uunet.uu.net to subscribe to info-vm -** gnUSENET newsgroup: gnu.emacs.vm.info -** Send contributions to: info-vm@uunet.uu.net - -This list discusses the View Mail mode for GNU Emacs, an alternative to -rmail mode. - -* supercite-request@warsaw.nlm.nih.gov to subscribe to supercite -** gnUSENET newsgroup: NONE PLANNED -** Send articles to: supercite@warsaw.nlm.nih.gov -*** UUCP: ..!uunet!warsaw.nlm.nih.gov!supercite-request - -The supercite mailing list covers issues related to the advanced -mail/news citation package called Supercite for GNU Emacs. - -* auc-tex-request@iesd.auc.dk to subscribe -** USENET newsgroup: NONE YET -** Send contributions to: auc-tex@iesd.auc.dk - -The list is intended to exchange information about AUC TeX, such as -bug reports, request for help, and information on current -developments. AUC TeX is a much enhanced LaTeX mode for GNU Emacs. - -The list is unmoderated. - -* bug-gnu-chess-request@prep.ai.mit.edu to subscribe to bug-gnu-chess -** gnUSENET newsgroup: gnu.chess.bug -** GNU Chess bug reports to: bug-gnu-chess@prep.ai.mit.edu - -This list directly accesses the GNU Chess developer's group. If you -have a *BUG* to report about the program, which can also include a -feature enhancement request, please send it to this list. - -Subscribers to bug-gnu-chess get all info-gnu-chess messages. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-gnu-chess-request@prep.ai.mit.edu IS NOW DEFUNCT -** gnUSENET newsgroup: NONE PLANNED -** DEAD address: help-gnu-chess@prep.ai.mit.edu - -This list is dead. Use info-gnu-chess@prep.ai.mit.edu/gnu.chess instead. - -* info-gnu-chess-request@prep.ai.mit.edu to subscribe to info-gnu-chess -** gnUSENET newsgroup: gnu.chess -** Send contributions to: info-gnu-chess@prep.ai.mit.edu -** FAQ-URL: http://www.research.digital.com/SRC/personal/Tim_Mann/chess.html -** FAQ-Archive-name: games/chess/gnu-faq -** FAQ-Posting-frequency: monthly - -This list is the place for users and installers of GNU Chess to ask for -help. This list is also used for games played by people or other -entities against the program, and other generalized non-bug, -non-enhancement data. Please send bug reports to bug-gnu-chess instead -of posting them here. - -This list is also used for announcements about GNU Chess and related -programs, and small but important patches. Announcements of GNU Chess -releases are also made to info-gnu@prep.ai.mit.edu (see above) - -Since info-gnu-chess is a large list, send it only those items that -are seriously important to many people. - -If source or patches that were previously posted or a simple fix is -requested in info-gnu-chess, please mail it to the requester. Do NOT -repost it. If you also want something that is requested, send mail to -the requester asking him to forward it to you. This kind of traffic is -best handled by e-mail, not a broadcast medium that reaches millions of -sites. - -See section '* General Information about help-* lists'. -Also see section '* General Information about info-* lists'. - -* bug-gnu-shogi-request@prep.ai.mit.edu to subscribe to bug-gnu-shogi -** gnUSENET newsgroup: NONE PLANNED -** GNU Shogi bug reports to: bug-gnu-shogi@prep.ai.mit.edu - -This list directly accesses the GNU Shogi developer's group. If you -have a *BUG* to report about the program, which can also include a -feature enhancement request, please send it to this list. - -Subscribers to bug-gnu-shogi get all info-gnu-shogi messages. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -Shogi is a game something like chess. There are several different types -of pieces, a board that is 9 by 9 squares, and the modification that a -captured piece can be reintroduced on the board by the capturing player -(and used). Due to this last difference from Western chess, a Shogi -game never simplifies. - -* help-gnu-shogi-request@prep.ai.mit.edu IS NOW DEFUNCT -** gnUSENET newsgroup: NONE PLANNED -** DEAD address: help-gnu-shogi@prep.ai.mit.edu - -This list is dead. - -* info-gnu-shogi-request@prep.ai.mit.edu to subscribe to info-gnu-shogi -** gnUSENET newsgroup: NONE PLANNED -** Send contributions to: info-gnu-shogi@prep.ai.mit.edu - -This list is the place for users and installers of GNU Shogi to ask for -help. This list is also used for games played by people or other -entities against the program, and other generalized non-bug, -non-enhancement data. Please send bug reports to bug-gnu-shogi instead -of posting them here. - -This list is also used for announcements about GNU Shogi and related -programs, and small but important patches. Announcements of GNU Shogi -releases are also made to info-gnu@prep.ai.mit.edu (see above) - -Since info-gnu-shogi is a large list, send it only those items that -are seriously important to many people. - -If source or patches that were previously posted or a simple fix is -requested in info-gnu-shogi, please mail it to the requester. Do NOT -repost it. If you also want something that is requested, send mail to -the requester asking him to forward it to you. This kind of traffic is -best handled by e-mail, not a broadcast medium that reaches millions of -sites. - -See section '* General Information about help-* lists'. -Also see section '* General Information about info-* lists'. - -* gnu-manual-request@a.cs.uiuc.edu IS NOW DEFUNCT -** DEAD: Gnusenet newsgroup: gnu.emacs.lisp.manual -** DEAD address: gnu-manual@a.cs.uiuc.edu -*** DEAD UUCP address: ..!uunet!uiucdcs!gnu-manual-request - -This list and newsgroup is dead. It was a working group whose -volunteers wrote, proofread and commented on the developing GNU Emacs -Lisp programmers manual. - -Send bugs in the GNU Emacs Lisp reference manual to: - lisp-manual-bugs@prep.ai.mit.edu - -lisp-manual-bugs is neither a mailing list nor a gnUSENET newsgroup. -It's just a bug-reporting address. - -* no mailing list request -** gnUSENET newsgroup: gnu.gnusenet.config -** no mailing list - -This newsgroup has nothing to do with GNU software, especially its -configuration. It exists to distribute information about the -administration and configuration of gnUSENET: the gnu.all alternative -USENET hierarchy that carry the GNU mailing lists. - -Administrators of gnUSENET hosts receiving the gnu.all newsgroups are -welcome to ask questions here or via e-mail of gnu@prep.ai.mit.edu. - -* no mailing list request -** gnUSENET newsgroup: gnu.gnusenet.test -** no mailing list - -This newsgroup has nothing to do with GNU software, especially its -testing. It exists to allow test messages to be made in gnUSENET: the -gnu.all alternative USENET hierarchy that carry the GNU mailing lists. - -Local variables: -mode: outline -fill-column: 72 -End: diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/NEWS --- a/etc/NEWS Mon Aug 13 11:12:06 2007 +0200 +++ b/etc/NEWS Mon Aug 13 11:13:30 2007 +0200 @@ -33,15 +33,76 @@ * Changes in XEmacs 21.2 ======================== -** Interactive searching and matching case improvements: -Case sensitiveness in searching operations is controled by the variable -`case-fold-search' (if non-nil, case is ignored while searching). This -mechanism has now been slightly improved in the case of an interactive -search: if the search string (or regexp) happens to contain uppercase -characters, the searching is forced to be case-sensitive, regardless of -the value of `case-fold-search'. This behavior affects all functions -performing interactive searches, like `zap-to-char', `tags-search', -`occur' etc. +** The delete key now deletes forward by default. + +This is regulated by the variable `delete-key-deletes-forward', which +now defaults to t. `delete-key-deletes-forward' takes effect only on +the systems that offer both a backspace and a delete key. If set to +nil, the key labeled "Delete" will always delete backward. If set to +non-nil, the "Delete" key will delete forward, except on keyboards +where a "Backspace" key is not provided (e.g. old DEC keyboards.) + +Unless our implementation has bugs, the only reason why you would want +to set `delete-key-deletes-forward' to nil is if you want to use the +Delete key to delete backwards, despite the presence (according to +Xlib) of a BackSpace key on the keyboard. + +** Interactive searching and matching case improvements. + +Case sensitiveness in searching operations is normally controlled by +the variable `case-fold-search' (if non-nil, case is ignored while +searching). This mechanism has now been slightly improved for +interactive searches: if the search string (or regexp) contains +uppercase characters, the searching is forced to be case-sensitive, +`case-fold-search'. + +The new behavior affects all functions performing interactive +searches, like `zap-to-char', `list-matching-lines', `tags-search' +etc. The incremental search facility has always behaved that way. + +** Incremental search will now highlight all visible matches, making +it easier to anticipate where consecutive C-s or C-r will place the +point. If you want to disable the feature, set +`isearch-highlight-all-matches' to nil. + +** You can now use the buffer tabs to switch between buffers. The +tabs are located between the toolbar and the uppermost window, in a +location called "gutter". If you dislike the buffer tabs, you can +disable them by specifying: + + (set-specifier default-gutter-visible-p nil) + +in your `.emacs'. You can change the location of the gutter with +`set-default-gutter-position', however currently only MS-Windows +supports tab widgets with orientations other than vertical.. + +** When you press RET at a minibuffer prompt that provides a default +value, the value is stored in history instead of an empty line. Also, +you can now edit the default value by pressing the down arrow, +accessing the logical "future" value. Not all minibuffer prompts have +yet been converted to support this feature. + +** The rectangle functions have been almost completely rewritten in +order to avoid inserting undesirable spaces, notably at the end of +lines. Two typical examples of the old behavior were +`string-rectangle', which filled all lines up to the right side of the +rectangle, and `clear-rectangle', which filled even empty lines up to +the left side. All functions have been rewritten to avoid inserting +unwanted spaces, and an optional prefix now allows them to behave the +old way. + +As a side effect, the FORCE argument to `move-to-column' now +understands the special value `coerce', which means that the line +should not be filled if it is too short to reach the desired column. + +** Customize now supports adding comments about your face and variable +settings using a new menu entry. Comments for variables can also be +assigned by calling `customize-set-(value|variable)' with a prefix +argument. + +** XEmacs now locates the early package hierarchies at +~/.xemacs/mule-packages/ and ~/.xemacs/xemacs-packages/. Previously, +the early packages were located in ~/.xemacs/. ** You can now create "indirect buffers", like in GNU Emacs. An indirect buffer shares its text with another buffer ("base buffer"), @@ -52,63 +113,210 @@ cannot itself be indirect. Use (make-indirect-buffer BASE-BUFFER NAME) to make an indirect buffer -named NAME whose base is BASE-BUFFER. If BASE-BUFFER is an indirect -buffer, its base buffer is used as the base for the new buffer. +named NAME whose base is BASE-BUFFER. If BASE-BUFFER is itself an +indirect buffer, its base buffer is used as the base for the new +buffer. You can make an indirect buffer current, or switch to it in a window, just as you would a non-indirect buffer. -The function `buffer-base-buffer', given an indirect buffer, returns -its base buffer. It returns nil when given an ordinary buffer (not -indirect). `buffer-indirect-children' returns a list of the indirect -children of a base buffer. +The function `buffer-base-buffer' returns a buffer's base buffer or +nil, if given an ordinary (non-indirect) buffer. The function +`buffer-indirect-children' returns a list of the indirect children of +a base buffer. + +** User names following the tilde character can now be completed at +file name prompts; e.g. `C-x C-f ~hni' will complete to +`~hniksic/'. To make this operation faster, a cache of user names is +maintained internally. + +The new primitives available for this purpose are functions named +`user-name-completion' and `user-name-all-completions'. + +** XEmacs can now play sound using Enlightenment Sound Daemon (ESD). +It will try NAS first, then ESD, then playing native sound directly. + +** X-Face support is now available under MS-Windows. +If an X-Face libary built under MS-Windows is available then XEmacs +will use this at build time. + +** The font-menu is now available under MS-Windows. + +** MS-Windows support for selection is now much more robust. + +Generally selection should now do what you would expect under +MS-Windows: the middle mouse button will paste your current selection +or the clipboard; conversions from different types of selection to the +clipboard can be made; the kill-ring and friends will be updated as +per X. + +The only thing selection doesn't do is set the clipboard automatically +as this would break the MS-Windows model. If you want this behaviour +then set `selection-sets-clipboard' to t + +** Mail spool locking now works correctly. +XEmacs has always come with a little auxiliary program, movemail, +which moves mail out of the system's spool area into user storage. To +coordinate between XEmacs, the mail delivery agent, and other mail +user agents, movemail needs to properly lock the spool file before +moving it. Movemail now correctly respects the --mail-locking option +to configure. Moreover, movemail's locking behavior can be specified +at run-time, via a new command-line option -m to movemail, or through +the environment variable EMACSLOCKMETHOD. + +When installing XEmacs, make sure you configure it according to your +environment's mail spool locking conventions. When you're using a +binary kit, set the `mail-lock-method' variable at startup, or the +EMACSLOCKMETHOD environment variable. + +** New command-line switches -user-init-file and -user-init-directory. +These can be used to specify alternate locations for what is normally +~/.emacs and ~/.xemacs. + +Moreover, -user (which used to only work in unpredictable ways) +is now equivalent to +-user-init-file ~/.emacs -user-init-directory ~/.xemacs. + +** New variable `mswindows-meta-activates-menu'. +If you set this variable to nil then pressing the Alt key under +MS-Windows will no longer activate the menubar. The default is t. + +** Pixel-based scrolling has been implemented. +By default this will attempt to scroll in increments equal to the +height of the default face. Set `window-pixel-scroll-increment' to +modify this behaviour. + +** Etags changes. + +*** In DOS, etags looks for file.cgz if it cannot find file.c. + +*** New option --ignore-case-regex is an alternative to --regex. It is now +possible to bind a regexp to a language, by prepending the regexp with +{lang}, where lang is one of the languages that `etags --help' prints +out. This feature is useful especially for regex files, where each +line contains a regular expression. The manual contains details. + +*** In C and derived languages, etags creates tags for function +declarations when given the --declarations option. + +*** In C++, tags are created for "operator". The tags have the form +"operator+", without spaces between the keyword and the operator. + +*** New language Ada: tags are functions, procedures, packages, tasks, and +types. + +*** In Fortran, procedure is no more tagged. + +*** In Java, tags are created for "interface". + +*** In Lisp, "(defstruct (foo", "(defun (operator" and similar constructs +are now tagged. + +*** In Perl, the --globals option tags global variables. my and local +variables are tagged. + +*** New language Python: def and class at the beginning of a line are tags. + +*** .ss files are Scheme files, .pdb is Postscript with C syntax, .psw is +for PSWrap. * Lisp and internal changes in XEmacs 21.2 ========================================== -** Functions for decoding base64 encoding are now available; see -`base64-encode-region', `base64-encode-string', `base64-decode-region' -and `base64-decode-string'. +** A new portable dumper is available for beta testing. + +Olivier Galibert has written a portable dumper for XEmacs, based on +initial work by Kyle Jones. Normally, XEmacs C sources link into an +executable called `temacs', which loads the Lisp code and "unexecs" +into a proper `xemacs' executable. The unexec() process is hard to +implement correctly and makes XEmacs very hard to port to new +operating systems, or even to new releases of old systems. -** Many basic lisp operations are now faster. +A portable dumper is a different approach to dumping: instead of +dumping full-fledged executable, it only dumps out the initialized +data structures (both Lisp and C) into an external file. A normally +running XEmacs only needs to mmap() that file and relocate a bit to +get to the initialized data. In that scheme, there is no difference +between `temacs' and `xemacs'. + +This is all very experimental, though. Configure with `--pdump' to +try testing it. NOTE: it is expected that `make' will fail after +dumping `xemacs.dmp'. This is because Makefiles have not yet been +modified to not expect `temacs' producing an `xemacs' executable. You +can try it out by simply running `src/temacs'. If it starts without +failure, the portable dumping worked. + +#### NOTE: the portable dumper is not really usable yet, because the +state of built-in variables is not yet saved. Olivier promised to fix +it. Nag, nag. + +** Much effort has been invested to make XEmacs Lisp faster: + +*** Many basic lisp operations are now faster. This is especially the case when running a Mule-enabled XEmacs. A general overhaul of the lisp engine should produce a speedup of 1.4 in a Latin-1 XEmacs, and 2.1 in a Mule XEmacs. These numbers were -obtained running (byte-compile "simple.el"), which should be a pretty -typical test of `pure' lisp. +obtained running `(byte-compile "simple.el")', which should be a +pretty typical test of "pure" Lisp. -Lisp hash tables have been re-implemented. The Common Lisp style hash -table interface has been made standard, and moved from cl.el into fast -C code (See the section on hash tables in the XEmacs Lisp Reference). -A speedup factor of 3 can be expected with code that makes intensive -use of hash tables. +*** Lisp hash tables have been re-implemented. The Common Lisp style +hash table interface has been made standard, and moved from cl.el into +fast C code (See the section on hash tables in the XEmacs Lisp +Reference). A speedup factor of 3 can be expected with code that +makes intensive use of hash tables. -The garbage collector has been tuned, leading to a speedup of 1.16. +*** The garbage collector has been tuned, leading to a speedup of +1.16. -The family of functions that iterate over lists, like `memq', and +*** The family of functions that iterate over lists, like `memq', and `rassq', have been made a little faster (typically 1.3). -Lisp function calls are faster, by approximately a factor of two. -However, defining inline functions (via defsubst) still make sense. +*** Lisp function calls are faster, by approximately a factor of two. +However, defining inline functions (via defsubst) still makes sense +for tight loops. -And finally, a few functions have had dramatic performance -improvements. For example, (last long-list) is now 30 times faster. +*** Finally, a few functions have had dramatic performance +improvements. For example, `(last long-list)' is now 30 times faster. Of course, your mileage will vary. Many operations do not see any improvement. Surprisingly, running -(font-lock-refontify-buffer) does not use the Lisp engine much at all. +(font-lock-fontify-buffer) does not use the Lisp engine much at all. Speeding up your favorite slow operation is an excellent project to improve XEmacs. Don't forget to profile! +** Native widgets can be displayed in buffers. + +The glyph system has been extended to allow the display of glyphs that +are implemented as native window-system widgets. Thus you can embed +buttons, scrollbars, combo boxes, edit fields and progress gauges in a +buffer. As a side effect subwindow support now works once again. + +All of this is still fairly experimental and there is no +documentation. The current APIs might change in a future version of +XEmacs. Some widgets are only available under MS-Windows. See the +file glyphs-test.el in the XEmacs src distribution for examples of +usage. + +The buffers-tab functionality and progress gauge have been implemented +using this feature. + +** `user-init-file' and `user-init-directory' are now absolute +file/directory names. Previously, both variables used to be relative +to (concat "~" init-file-user). This turned out to be too complicated +for most packages (and some core Lisp files) to use correctly. Also, +the `init-file-user' variable has been obsoleted in the process. + +The user-visible options like `-u' have not changed their behaviour. + ** XEmacs finally has an automated test suite! Although this is not yet very sophisticated, it is already responsible for several important bug fixes in XEmacs. To try it out, simply use the makefile target `make check' after building XEmacs. -** New hash table implementation +** Hash tables have been reimplemented. As was pointed out above, the standard interface to hash tables is now the Common Lisp interface, as described in Common Lisp, the Language (CLtL2, by Steele). The older interface (functions with names @@ -122,14 +330,118 @@ ** Lisp code handles circular lists much more robustly. Many basic lisp functions used to loop forever when given a circular -list. Now this is more likely to trigger a `circular-list' error. -Printing a circular list now results in something like this: +list, expecting you to C-g (quit) out of the loop. Now this is more +likely to trigger a `circular-list' error. Printing a circular list +now results in something like this: - (progn (setq x (cons 'foo 'foo)) (setcdr x x) x) -==> (foo ... ) + (let ((x (cons 'foo 'foo))) + (setcdr x x) + x) + => (foo ... ) An extra bonus is that checking for circularities is not just -friendlier, but actually faster than checking for quit. +friendlier, but actually faster than checking for C-g. + +** Functions for decoding base64 encoding are now available; see +`base64-encode-region', `base64-encode-string', `base64-decode-region' +and `base64-decode-string'. + +** The functions `read-string', `read-expression', `eval-minibuffer', +`read-variable', `read-command', `read-function', `read-number', +`read-shell-command', `read-from-minibuffer', and `completing-read' +now take an additional argument which specifies the default value. If +this argument is non-nil, it should be a string; that string is used +in two ways: + + It is returned if the user enters empty input. + It is available through the history command M-n. + +** LDAP changes. + +*** The LDAP interface now consists of two layers, a low-level layer +that closely matches the LDAP C API, and a more convenient +higher-level set of functions. + +*** The low-level functions that used to be named *-internal are now +named more simply: `ldap-open', `ldap-close', `ldap-search-basic', +`ldap-add', and `ldap-modify'. They should be used directly for very +specific purposes (such as multiple operations on a connection) only. + +*** The higher-level functions provide a more convenient way to access +LDAP directories hiding the subtleties of handling the connection, +translating arguments and ensuring compliance with LDAP +internationalization rules and formats (currently partly implemented +only.) This layer provides atomic operations for searches, +modification, addition and deletion of multiple entries at once: +`ldap-search-entries', `ldap-add-entries', `ldap-delete-entries', and +`ldap-modify-entries'. + +*** To maintain compatibility with previous code, the now obsolete +function `ldap-search' is now merely a wrapper that calls either +`ldap-search-basic' or `ldap-search-entries'. Please don't use the +`ldap-search' function in your new programs -- a direct call to one of +the two replacements is more efficient and unambiguous. + +** The arguments to `locate-file' are now more Lisp-like. As before, +the usage is: + + (locate-file FILENAME PATH-LIST &optional SUFFIXES MODE) + +Except that SUFFIXES are now a list of strings instead of a single, +colon-separated string. MODE is now a symbol or a list of symbols +(symbols `exists', `executable', `writable', and `readable' are +supported) instead of an integer code. See the documentation for +details. Of course, the old form is still accepted for backward +compatibility. + +Several bugs in locate-file have been fixed, most notably its failure +to call expand-file-name on elements of PATH-LIST. Because of that +elements of load-path of the form "~/..." used to not work. +locate-file is now guaranteed to expand files during its course of +operation. + +** `translate-region' has been improved in several ways. Its TABLE +argument used to be a 256-character string. In addition to this, it +can now also be a vector or a char-table, which makes the function +useful for Mule, which it wasn't. If TABLE a vector or a generic +char-table, you can map characters to strings instead of to other +characters. For instance: + + (let ((table (make-char-table 'generic))) + (put-char-table ?a "the letter a" table) + (put-char-table ?b "" table) + (put-char-table ?c ?\n table) + (translate-region (point-min) (point-max) table)) + +** The new form `ignore-file-errors', similar to `ignore-errors' may +be used as a short-hand for condition-case when you wish to ignore +file-related error. For example: + + (ignore-file-errors (delete-file "foo")) + +** The first argument to `intern-soft' may now also be a symbol, like +with `unintern'. If given a symbol, `intern-soft' will look for that +exact symbol rather than for any string. This is useful when you want +to check whether a specific symbol is interned in an obarray, e.g.: + + (intern "foo") + (intern-soft "foo") + => foo + (intern-soft (make-symbol "foo")) + => nil + +** The `keywordp' function now returns non-nil only on symbols +interned in the global obarray. For example: + + (keywordp (intern ":foo" [0])) + => nil + (keywordp (intern ":foo")) ; The same as (keywordp :foo) + => t + +This behaviour is compatible with other code which treats symbols +beginning with colon as keywords only if they are interned in the +global obarray. `keywordp' used to wrongly return t in both cases +above. * Changes in XEmacs 21.0 @@ -161,8 +473,18 @@ ** When the Zmacs region is active, `M-x query-replace' and the other replace commands now operate on the region contents only. -** Using the new `-private' option, you can make XEmacs use a private -colormap. +** XEmacs now is able to choose X visuals and use private colormaps. +The '-visual ' command line option or the '.EmacsVisual' +Xresource controls which visual XEmacs will use, and +'-privateColormap' or '.privateColormap' will force XEmacs to create a +private colormap for use. The syntax for the visual string is +"" where is one of 'StaticColor', +'TrueColor', 'GrayScale', 'PseudoColor' or 'DirectColor' and + is the appropriate number of bits per pixel. If an invalid +or non-supported combination is entered, XEmacs attempts to find a happy +medium. The X creation mechanism will then determine if it needs to +create a colormap for use, or the presence of the private flags will +force it to create it. ** The `imenu' package has been ported to XEmacs and is available as a package. @@ -259,8 +581,7 @@ *** Like the old 'gnudoit' program. Gnuclient -batch now can read from stdin. -*** Again like the old 'gnudoit' program, gnuclient now can return multiple -lines. +*** Gnuclient -batch no longer breaks off the output at the first LF. ** C mode changes @@ -604,7 +925,7 @@ Look under "Startup Paths" in the Info documentation for more information. -*** site-lisp is now longer part of the load-path by default. +*** site-lisp is no longer part of the load-path by default. Its use is deprecated, but you can specify --with-site-lisp=yes at the configure command line to get it back. diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/OONEWS --- a/etc/OONEWS Mon Aug 13 11:12:06 2007 +0200 +++ b/etc/OONEWS Mon Aug 13 11:13:30 2007 +0200 @@ -2403,7 +2403,7 @@ *** utils/bench.el Commentary: -Adapted from Shane Holder's bench.el by steve@altair.xemacs.org. +Adapted from Shane Holder's bench.el by steve@xemacs.org. To run Extract the shar file in /tmp, or modify bench-lisp-file to @@ -4568,7 +4568,7 @@ `get', `put', and `remprop' have been generalized to allow you to set and retrieve properties on many different kinds of objects: symbols, strings, faces, glyphs, and extents (for extents, however, this is not -yet implemented). They are joined by a new function `object-props' +yet implemented). They are joined by a new function `object-plist' that returns all of the properties that have been set on an object. New functions `plists-eq' and `plists-equal' are provided for diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/README.HYPERBOLE --- a/etc/README.HYPERBOLE Mon Aug 13 11:12:06 2007 +0200 +++ b/etc/README.HYPERBOLE Mon Aug 13 11:13:30 2007 +0200 @@ -2,5 +2,5 @@ The latest working version of this package with major enhancements is available together with professional support exclusively from their -developer, Altrasoft Inc. See http://www.altrasoft.com for product +developer, BeOpen Inc. See http://www.beopen.com for product and service details. diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/README.OO-BROWSER --- a/etc/README.OO-BROWSER Mon Aug 13 11:12:06 2007 +0200 +++ b/etc/README.OO-BROWSER Mon Aug 13 11:13:30 2007 +0200 @@ -2,5 +2,5 @@ The latest working version of this package with major enhancements is available together with professional support exclusively from their -developer, Altrasoft Inc. See http://www.altrasoft.com for product +developer, BeOpen Inc. See http://www.beopen.com for product and service details. diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/SERVICE --- a/etc/SERVICE Mon Aug 13 11:12:06 2007 +0200 +++ b/etc/SERVICE Mon Aug 13 11:13:30 2007 +0200 @@ -40,13 +40,13 @@ ** Please keep the entries in this file alphabetical **  -Altrasoft +BeOpen 4880 Stevens Creek Blvd., Suite 205 San Jose, CA 95129-1034 +1 408 243 3300 -http://www.altrasoft.com +http://www.beopen.com -Altrasoft provides corporate-quality support, development and user +BeOpen provides corporate-quality support, development and user documentation for GNU Emacs, XEmacs and InfoDock. (InfoDock is a turnkey information management and software development toolset built atop emacs, written by one of our associates.) Emacs distributions for a variety of diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/TUTORIAL.de --- a/etc/TUTORIAL.de Mon Aug 13 11:12:06 2007 +0200 +++ b/etc/TUTORIAL.de Mon Aug 13 11:13:30 2007 +0200 @@ -1,4 +1,4 @@ -Copyright (c) 1997, Adrian Aichner . +Copyright (c) 1997-2000, Adrian Aichner . Copyright (c) 1985, 1996 Free Software Foundation, Inc. See end for conditions. @@ -39,7 +39,7 @@ META-Taste gedrückt und tippe v oder tippe v wenn Deine Tastatur keine META-, EDIT- oder ALT-Taste besitzt). ->> Versuche ein paar Mal M-v und C-v zu tippen. +>> Versuche ein paarmal M-v und C-v zu tippen. * ZUSAMMENFASSUNG @@ -1131,13 +1131,13 @@ Ben Wing hat das Tutorial für X Windows erweitert. Martin Buchholz und Hrvoje Niksic haben weitere Korrekturen für XEmacs beigetragen. Ins Deutsche übertragen wurde es von Adrian Aichner -. +. Diese Version des Tutorials ist, wie GNU Emacs selbst, urheberrechtlich geschützt und erlaubt die Verteilung von Kopien unter bestimmten Voraussetzungen: -Copyright (c) 1997, Adrian Aichner . +Copyright (c) 1997-2000, Adrian Aichner . Copyright (c) 1985, 1996 Free Software Foundation diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/TUTORIAL.ru --- a/etc/TUTORIAL.ru Mon Aug 13 11:12:06 2007 +0200 +++ b/etc/TUTORIAL.ru Mon Aug 13 11:13:30 2007 +0200 @@ -1079,4 +1079,4 @@ writing, and sharing free software! // ÚÁÍÅÞÁÎÉÑ, ÉÓÐÒÁ×ÌÅÎÉÑ ÏÛÉÂÏË Ó ÎÅÔÅÒÐÅÎÉÅÍ ÖÄÕ ÐÏ ÁÄÒÅÓÕ bor@vb.dn.ua -// Vladimir Bormotov. \ No newline at end of file +// Vladimir Bormotov. diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/TUTORIAL.th --- a/etc/TUTORIAL.th Mon Aug 13 11:12:06 2007 +0200 +++ b/etc/TUTORIAL.th Mon Aug 13 11:13:30 2007 +0200 @@ -1,669 +1,669 @@ ============================== - GNUEMACS ,T@RIR0-Uh10;Xh19(B (Mule) ,T`0:Wi1M'05i19(B + GNUEMACS ÀÒÉÒ­Õè»Øè¹ (Mule) àº×éͧµé¹ ============================== -,TKARB`K05X1(B: ,T`M!JRC)0:Q1:`0:Wi1M'05i1909Ui1(B 0,T6Y1!`0"U1B90"Vi19b4B0BV14K0EQ1!07Uh10Gh1R(B ",TEM'`0Eh19`EB04U1!0Gh1R`0CU1B90CYi1(B" - ,T:CC07Q1407Uh1`0CTh1A05i1904i1GB(B ">>" ,T(P0AU1$S0JQh1'0Gh1R(B 0,T5h1Md;(Pc0Ki17SMPdC(B +ËÁÒÂà˵Ø: àÍ¡ÊÒéºÑºàº×éͧµé¹¹Õé ¶Ù¡à¢Õ¹¢Öé¹â´ÂÂÖ´ËÅÑ¡·ÕèÇèÒ "ÅͧàÅè¹àÅ´աÇèÒàÃÕ¹ÃÙé" + ºÃ÷Ѵ·ÕèàÃÔèÁµé¹´éÇ ">>" ¨ÐÁÕ¤ÓÊÑè§ÇèÒ µèÍ仨ÐãËé·ÓÍÐäà - ,Tb4B07Qh1Gd;(B ,T!RC0;i1M9$S0JQh1'c0Ki10!Q1:(B Mule ,T7Sd04i1b4Bc0*i1(B 0,T;Xh1A$M9b7CE(B (0,T;Xh1A07Uh1:9K09i1R0JQ1A0 ,TKARB06V1'(B ,Tc0Ki1!40;Xh1A$M9b7CE0$i1R'd0Gi1(B ,Ta0Ei1G!40;Xh1A(B <0,T5Q1G0MQ1!IC(B> 0,T5Q1GM0Bh1R'`0*h19(B C-f - ,TKARB06V1'(B ,Tc0Ki1!40;Xh1A$M9b7CE0$i1R'd0Gi1(B ,Ta0Ei1G!40;Xh1A(B f +C-<µÑÇÍÑ¡ÉÃ> ËÁÒ¶֧ ãËé¡´»ØèÁ¤Í¹â·ÃŤéÒ§äÇé áÅéÇ¡´»ØèÁ <µÑÇÍÑ¡ÉÃ> µÑÇÍÂèÒ§àªè¹ C-f + ËÁÒ¶֧ ãËé¡´»ØèÁ¤Í¹â·ÃŤéÒ§äÇé áÅéÇ¡´»ØèÁ f <> - >> ,T5M909Ui1"Mc0Ki1EM'!4(B C-v (View Next Screen 0,T4Y1K09i1R05h1Md;(B) 0,T4Y1(B ,T`0>Wh1M`0EWh1M9d;0Mh1R9K09i1R(B - 0,T5h1Md;(B - 0,T5h1M(R!09Ui1`0;g1905i19d;(B 0,T7X1!$0CQi1'07Uh10Mh1R9K09i1RK09Vh1'(B ,Tf(B ,T(:"Mc0Ki17Sc97S9M'`04U1BG0!Q19(B ,T`0>Wh1M`0EWh1M9d;(B - 0,T4Y1K09i1R05h1Md;(B + >> µÍ¹¹Õé¢ÍãËéÅͧ¡´ C-v (View Next Screen ´Ù˹éÒµèÍä») ´Ù à¾×èÍàÅ×è͹ä»Íèҹ˹éÒ + µèÍä» + µèͨҡ¹Õéà»ç¹µé¹ä» ·Ø¡¤ÃÑ駷ÕèÍèҹ˹éÒ˹Öè§ æ ¨º¢ÍãËé·Ó㹷ӹͧà´ÕÂǡѹ à¾×èÍàÅ×èÍ¹ä» + ´Ù˹éÒµèÍä» -ESC <0,T5Q1G0MQ1!IC(B> ,TKARB06V1'(B ,Tc0Ki1!40;Xh1A(B ESC ,Ta0Ei1G;0Eh1MB(B ,TK0EQ1'(R!09Qi190(V1'!40;Xh1A(B <0,T5Q1G0MQ1!IC(B> ,T5RA(B +ESC <µÑÇÍÑ¡ÉÃ> ËÁÒ¶֧ ãËé¡´»ØèÁ ESC áÅéÇ»ÅèÍ ËÅѧ¨Ò¡¹Ñ鹨֧¡´»ØèÁ <µÑÇÍÑ¡ÉÃ> µÒÁ -,TKARB`K05X1(B: <0,T5Q1G0MQ1!IC(B> ,Td0Ah10Gh1R`0;g1905Q1GcK0-h1K0CW1M05Q1G`0Eg1!(B ,T(Pc0Ki1$GRAKARB`K0AW1M90!Q19`0AWh1M06Y1!c0*i1c9(B - ,T$S0JQh1'(B 0,T6i1RKR!0AU10;Xh1A(B META ,Tc0Ki1!4(B 0,T!g1(PJRARC6c0*i1!RC!4(B M-<0,T5Q1G0MQ1!IC(B> ,Ta79(B - ,T!RC(B ESC <0,T5Q1G0MQ1!IC(B> ,Td04i1(B (0,T$W1Mc0Ki1!40;Xh1A(B META 0,T$i1R'd0Gi1(B ,Ta0Ei1G0(V1'!4(B <0,T5Q1G0MQ1!IC(B>) +ËÁÒÂà˵Ø: <µÑÇÍÑ¡ÉÃ> äÁèÇèÒà»ç¹µÑÇãË­èËÃ×͵ÑÇàÅç¡ ¨ÐãËé¤ÇÒÁËÁÒÂàËÁ×͹¡Ñ¹àÁ×èͶ١ãªéã¹ + ¤ÓÊÑè§ ¶éÒËÒ¡ÁÕ»ØèÁ META ãËé¡´ ¡ç¨ÐÊÒÁÒöãªé¡Òá´ M-<µÑÇÍÑ¡ÉÃ> á·¹ + ¡Òà ESC <µÑÇÍÑ¡ÉÃ> ä´é (¤×ÍãËé¡´»ØèÁ META ¤éÒ§äÇé áÅéǨ֧¡´ <µÑÇÍÑ¡ÉÃ>) -0,T"i1MJS0$Q1-(B: ,T`GER(P`0ET1!c0*i1(B Emacs ,Tc0Ki1!4(B C-x C-c ,TK0CW1Mc9!C03U107Uh10JQh1'(B Emacs ,T(R!(B csh - 0,T!g1JRARC6c0*i1(B suspend (,TK0BX140*Qh1G$CRG(B) ,Td04i1(B ,T!RC(B suspend Emacs ,T7Sd04i1b4B(B - ,T!4(B C-z +¢éÍÊӤѭ: àÇÅÒ¨ÐàÅÔ¡ãªé Emacs ãËé¡´ C-x C-c ËÃ×Í㹡óշÕèÊÑè§ Emacs ¨Ò¡ csh + ¡çÊÒÁÒöãªé suspend (ËÂØ´ªÑèǤÃÒÇ) ä´é ¡Òà suspend Emacs ·Óä´éâ´Â + ¡´ C-z - 0,T5h1M(R!09Ui1(B ,T"Mc0Ki10;i1M9$S0JQh1'(B C-v 0,T7X1!(B ,Tf(B ,T$0CQi1'07Uh10Mh1R9(:K09Vh1'K09i1R(B + µèͨҡ¹Õé ¢ÍãËé»é͹¤ÓÊÑè§ C-v ·Ø¡ æ ¤ÃÑ駷ÕèÍèÒ¹¨ºË¹Öè§Ë¹éÒ - ,T@RBc9K09i1R07Uh1a0Ei1G0!Q1:K09i1R06Q14d;(B ,T(P0AU1`09Wi1MKR0+i1S0!Q19M0BYh1:R':CC07Q14(B 0,T7Uh1`0;g19`0*h1909Ui1(B 0,T!g1`0>Wh1Mc0Ki1JRARC60CYi1(B -,Td04i10Gh1R(B ,T`09Wi1MKR07Uh1aJ4'M0BYh109Qi19(B 0,T5h1M`09Wh1M'0!Q19M0BYh1(B + ÀÒÂã¹Ë¹éÒ·ÕèáÅéǡѺ˹éÒ¶Ñ´ä» ¨ÐÁÕà¹×éÍËÒ«éӡѹÍÂÙèºÒ§ºÃ÷Ѵ ·Õèà»ç¹àªè¹¹Õé ¡çà¾×èÍãËéÊÒÁÒöÃÙé +ä´éÇèÒ à¹×éÍËÒ·ÕèáÊ´§ÍÂÙè¹Ñé¹ µèÍà¹×èͧ¡Ñ¹ÍÂÙè - 0,T!h1M90MWh19(B ,T(S`0;g19(P05i1M'0CYi10GT108U1!RCbB!0Bi1RB5SaK09h1'd;AR(B ,T@RBc9a0?i1A0"i1M0AY1E`0JU1B0!h1M9(B ,T5RA07Uh1:M!d;(B -,Ta0Ei1G(B 0,T!g10$W1M(B C-v ,Tc0*i1JSK0CQ1:`0EWh1M9d;0"i1R'K09i1R(B 0,T6i1R(P`0EWh1M9!0EQ1:07Uh1`0!h1R(B 0,T!g1c0Ki1!4(B ESC v + ¡è͹Í×è¹ ¨Óà»ç¹¨ÐµéͧÃÙéÇÔ¸Õ¡ÒÃâ¡ÂéÒµÓá˹è§ä»ÁÒ ÀÒÂã¹á¿éÁ¢éÍÁÙÅàÊÕ¡è͹ µÒÁ·ÕèºÍ¡ä» +áÅéÇ ¡ç¤×Í C-v ãªéÊÓËÃѺàÅ×è͹仢éҧ˹éÒ ¶éÒ¨ÐàÅ×è͹¡ÅѺ·Õèà¡èÒ ¡çãËé¡´ ESC v - >> ,TEM'c0*i1(B ESC v ,TaEP(B C-v ,T`0>Wh1M`0EWh1M9d;AR04Y1(B 0,TJQ1!JM'JRA$0CQi1'(B + >> Åͧãªé ESC v áÅÐ C-v à¾×èÍàÅ×è͹ä»ÁÒ´Ù ÊÑ¡ÊͧÊÒÁ¤ÃÑé§ -,TJ0CX1;(B +ÊÃØ» === - ,T$S0JQh1'(B ,TJSK0CQ1:`0EWh1M9d;AR07U1EPK09i1R@RBc9a0?i1A0"i1M0AY1E(B 0,T$W1M(B + ¤ÓÊÑè§ ÊÓËÃѺàÅ×è͹ä»ÁÒ·ÕÅÐ˹éÒÀÒÂã¹á¿éÁ¢éÍÁÙÅ ¤×Í - C-v ,T`0EWh1M9d;0"i1R'K09i1R(B ,TK09Vh1'K09i1R(M(B - ESC v ,T`0EWh1M9d;0"i1R'K0EQ1'(B ,TK09Vh1'K09i1R(M(B - C-l ,T`0"U1B9K09i1R(McK0Ah1(B ,TaEPc9"3P`04U1BG0!Q19(B 0,T!g1c0Ki1`0EWh1M95SaK09h1'"M'`$M0Cl1`+M0Cl1(B (cursor) - ,Td;M0BYh15C'!ER'(M(B + C-v àÅ×è͹仢éҧ˹éÒ Ë¹Öè§Ë¹éÒ¨Í + ESC v àÅ×è͹仢éÒ§ËÅѧ ˹Öè§Ë¹éÒ¨Í + C-l à¢Õ¹˹éÒ¨ÍãËÁè áÅÐã¹¢³Ðà´ÕÂǡѹ ¡çãËéàÅ×è͹µÓá˹觢ͧà¤ÍÃìà«ÍÃì (cursor) + ä»ÍÂÙèµÃ§¡ÅÒ§¨Í - >> ,T"Mc0Ki10JQ1'`!504Y10Gh1R(B ,Tc9"3P09Ui1`$M0Cl1`+M0Cl1M0BYh107Uh1dK9(B ,T>0Ci1MA07Qi1'(S0"i1M$GRA07Uh1M0BYh1CM:0"i1R'"M'(B - ,T`$M0Cl1`+M0Cl104i1GB(B ,Ta0Ei1GEM'!4(B C-l 0,T4Y1(B ,T5CG(JM:04Y10Gh1R(B ,T`$M0Cl1`+M0Cl1`0EWh1M9d;M0BYh107Uh1dK9(B - 0,T"i1M$GRA07Uh1M0BYh1CM:0"i1R'`;0EUh1B9d;M0Bh1R'dC(B + >> ¢ÍãËéÊѧࡵ´ÙÇèÒ ã¹¢³Ð¹Õéà¤ÍÃìà«ÍÃìÍÂÙè·Õèä˹ ¾ÃéÍÁ·Ñ駨ӢéͤÇÒÁ·ÕèÍÂÙèÃͺ¢éÒ§¢Í§ + à¤ÍÃìà«ÍÃì´éÇ áÅéÇÅͧ¡´ C-l ´Ù µÃǨÊͺ´ÙÇèÒ à¤ÍÃìà«ÍÃìàÅ×è͹ä»ÍÂÙè·Õèä˹ + ¢éͤÇÒÁ·ÕèÍÂÙèÃͺ¢éÒ§à»ÅÕè¹ä»ÍÂèÒ§äà -0,TGT108U1bB!0Bi1RB`$M0Cl1`+M0Cl10"Qi190>Wi190R9(B +ÇÔ¸Õâ¡ÂéÒÂà¤ÍÃìà«ÍÃì¢Ñé¹¾×é¹°Ò¹ ======================= - ,T5M909Ui1(B ,T`CR0!g10CYi10GT108U1bB!0Bi1RBd;ARa::07U1EPK09i1Ra0Ei1G(B 0,T5h1Md;(B 0,T!g1AR`0CU1B90CYi10GT108U1bB!0Bi1RBd;07Uh15SaK09h1'c4(B -,T5SaK09h1'K09Vh1'@RBc9K09i1R`04U1BG0!Q19(B 0,T+Vh1'JRARC67Sd04i1KERB0GT108U1(B 0,TGT108U1K09Vh1'0!g10$W1Mc0Ki1c0*i1$S0JQh1'(B ,Td;:CC07Q140!h1M9K09i1R(B -(previous) ,Td;:CC07Q1405h1Md;(B (next) ,Td;04i1R9K09i1R(B (forward) ,Td;04i1R9K0EQ1'(B (backward) ,T$S0JQh1'(B -,T`K0Eh1R09Ui1(B 0,T6Y1!05Qi1'd0Gi107Uh1(B C-p C-n C-f ,TaEP(B C-b ,T5RAES04Q1:(B 0,T+Vh1'(P7Sc0Ki1bB!0Bi1RBd;ARd04i1(B ,Tb4B`07U1B:0!Q1:(B -,T5SaK09h1'0;Q1(0(X10:Q19(B ,TJ0CX1;`0"U1B9`0;g19a<9@R>d04i104Q1'09Ui1(B + µÍ¹¹Õé àÃÒ¡çÃÙéÇÔ¸Õâ¡ÂéÒÂä»ÁÒẺ·ÕÅÐ˹éÒáÅéÇ µèÍä» ¡çÁÒàÃÕ¹ÃÙéÇÔ¸Õâ¡ÂéÒÂä»·ÕèµÓá˹è§ã´ +µÓá˹è§Ë¹Öè§ÀÒÂã¹Ë¹éÒà´ÕÂǡѹ «Öè§ÊÒÁÒö·Óä´éËÅÒÂÇÔ¸Õ ÇÔ¸Õ˹Ö觡ç¤×ÍãËéãªé¤ÓÊÑè§ ä»ºÃ÷Ѵ¡è͹˹éÒ +(previous) 仺Ã÷ѴµèÍä» (next) ä»´éҹ˹éÒ (forward) ä»´éÒ¹ËÅѧ (backward) ¤ÓÊÑè§ +àËÅèÒ¹Õé ¶Ù¡µÑé§äÇé·Õè C-p C-n C-f áÅÐ C-b µÒÁÅӴѺ «Ö觨зÓãËéâ¡ÂéÒÂä»ÁÒä´é â´Âà·Õº¡Ñº +µÓá˹觻Ѩ¨ØºÑ¹ ÊÃØ»à¢Õ¹à»ç¹á¼¹ÀÒ¾ä´é´Ñ§¹Õé - ,T:CC07Q1407Uh1a0Ei1G(B C-p + ºÃ÷Ѵ·ÕèáÅéÇ C-p : : - 0,T5Q1G0MQ1!IC04i1R9K0EQ1'(B C-b .... ,T5SaK09h1'`$M0Cl1`+M0Cl10;Q1(0(X10:Q19(B .... 0,T5Q1G0MQ1!IC04i1R9K09i1R(B C-f + µÑÇÍÑ¡ÉôéÒ¹ËÅѧ C-b .... µÓá˹è§à¤ÍÃìà«ÍÃì»Ñ¨¨ØºÑ¹ .... µÑÇÍÑ¡Éôéҹ˹éÒ C-f : : - ,T:CC07Q1405h1Md;(B C-n + ºÃ÷ѴµèÍä» C-n - ,T$S0JQh1'`K0Eh1R09Ui1(B ,T`MRAR(R!05Q1G0MQ1!IC05Q1GaC!"M'(B ,T$S0Gh1R(B Previous Next Backward Forward -0,T+Vh1'(P0*h1GBc0Ki1(Sd04i1d0Ah1BR!(B ,T$S0JQh1'`K0Eh1R09Ui1`0;g19$S0JQh1'JSK0CQ1:!RCbB!0Bi1RB0"Qi190>Wi190R9(B 0,T+Vh1'05i1M'c0*i1M0BYh1`JAM(B + ¤ÓÊÑè§àËÅèÒ¹Õé àÍÒÁÒ¨Ò¡µÑÇÍÑ¡ÉõÑÇáá¢Í§ ¤ÓÇèÒ Previous Next Backward Forward +«Ö觨ЪèÇÂãËé¨Óä´éäÁèÂÒ¡ ¤ÓÊÑè§àËÅèÒ¹Õéà»ç¹¤ÓÊÑè§ÊÓËÃѺ¡ÒÃâ¡ÂéÒ¢Ñé¹¾×é¹°Ò¹ «Ö觵éͧãªéÍÂÙèàÊÁÍ - >> ,TEM'!4(B C-n 0,T4Y1KERB(B ,Tf(B ,T$0CQi1'(B ,T`0>Wh1M`0EWh1M9`$M0Cl1`+M0Cl1AR0BQ1':CC07Q1409Ui1(B (,T:CC07Q1407Uh1!S0EQ1'0Mh1R9(B - ,TM0BYh109Ui1(B) + >> Åͧ¡´ C-n ´ÙËÅÒÂ æ ¤ÃÑé§ à¾×èÍàÅ×è͹à¤ÍÃìà«ÍÃìÁÒÂѧºÃ÷Ѵ¹Õé (ºÃ÷Ѵ·Õè¡ÓÅѧÍèÒ¹ + ÍÂÙè¹Õé) - >> ,TEM'!4(B C-f 0,T4Y1KERB(B ,Tf(B ,T$0CQi1'(B ,T`0>Wh1M`0EWh1M9`$M0Cl1`+M0Cl1d;0BQ1'5C'!ER'"M':CC07Q14(B ,Ta0Ei1GEM'(B - ,T!4(B C-p ,T`0EWh1M90"Vi190"i1R':904Y1(B 0,TJQ1'`!504Y104i1GB0Gh1R(B ,T5SaK09h1'"M'`$M0Cl1`+M0Cl1`;0EUh1B9d;M0Bh1R'dC(B + >> Åͧ¡´ C-f ´ÙËÅÒÂ æ ¤ÃÑé§ à¾×èÍàÅ×è͹à¤ÍÃìà«ÍÃìä»ÂѧµÃ§¡ÅÒ§¢Í§ºÃ÷Ѵ áÅéÇÅͧ + ¡´ C-p àÅ×è͹¢Öé¹¢éÒ§º¹´Ù Êѧࡵ´Ù´éÇÂÇèÒ µÓá˹觢ͧà¤ÍÃìà«ÍÃìà»ÅÕè¹ä»ÍÂèÒ§äà - >> ,TEM'!4(B C-b ,T"3P07Uh1M0BYh107Uh15SaK09h1'K09i1R0JX14"M':CC07Q1404Y1(B 0,TJQ1'`!504Y104i1GB0Gh1R(B ,T`$M0Cl1`+M0Cl1`$0EWh1M9(B - ,Td;M0Bh1R'dC(B ,T(R!09Qi19c0Ki1!4(B C-b 0,TMU1!JM'JRA$0CQi1'(B ,Ta0Ei1G!4(B C-f ,T`0>Wh1M`0EWh1M9d;0BQ1'07i1RB0JX14(B - ,T"M':CC07Q1404Y1(B ,T`$M0Cl1`+M0Cl1(P`0;g19M0Bh1R'dC(B 0,T6i1R!4(9`EB07i1RB:CC07Q14d;(B + >> Åͧ¡´ C-b ¢³Ð·ÕèÍÂÙè·ÕèµÓá˹è§Ë¹éÒÊØ´¢Í§ºÃ÷Ѵ´Ù Êѧࡵ´Ù´éÇÂÇèÒ à¤ÍÃìà«ÍÃìà¤Å×è͹ + ä»ÍÂèÒ§äà ¨Ò¡¹Ñé¹ãËé¡´ C-b ÍÕ¡ÊͧÊÒÁ¤ÃÑé§ áÅéÇ¡´ C-f à¾×èÍàÅ×è͹ä»Âѧ·éÒÂÊØ´ + ¢Í§ºÃ÷Ѵ´Ù à¤ÍÃìà«ÍÃì¨Ðà»ç¹ÍÂèÒ§äà ¶éÒ¡´¨¹àÅ·éÒºÃÃ·Ñ´ä» - ,T`GER07Uh1`0EWh1M9`$M0Cl1`+M0Cl1(B ,T(9`EB:CC07Q14aC!0JX14K0CW1M:CC07Q1407i1RB0JX14"M'K09i1Rd;(B ,T`$M0Cl1`+M0Cl1(P(B -,T`0EWh1M9d;0BQ1':CC07Q1405h1Md;c907T1H7R'09Qi19(B ,Tf(B ,TaEP;0CQ1:c0Ki1`$M0Cl1`+M0Cl1!0EQ1:ARM0BYh1:9K09i1R(M`JAM(B + àÇÅÒ·ÕèàÅ×è͹à¤ÍÃìà«ÍÃì ¨¹àźÃ÷ѴááÊØ´ËÃ×ͺÃ÷Ѵ·éÒÂÊØ´¢Í§Ë¹éÒä» à¤ÍÃìà«ÍÃì¨Ð +àÅ×è͹ä»ÂѧºÃ÷ѴµèÍä»ã¹·ÔÈ·Ò§¹Ñé¹ æ áÅлÃѺãËéà¤ÍÃìà«ÍÃì¡ÅѺÁÒÍÂÙ躹˹éÒ¨ÍàÊÁÍ - >> ,TEM'!4(B C-n ,T`0>Wh1M`0EWh1M9`$M0Cl1`+M0Cl1c0Ki1`EB:CC07Q140Eh1R'0JX14"M'K09i1R(M04Y1(B ,Ta0Ei1G0JQ1'`!504Y10Gh1R(B - ,T`0!T14MPdC0"Vi19(B ,TaEP5SaK09h1'"M'`$M0Cl1`+M0Cl1`;0EUh1B9d;M0Bh1R'dC(B + >> Åͧ¡´ C-n à¾×èÍàÅ×è͹à¤ÍÃìà«ÍÃìãËéàźÃ÷ѴÅèÒ§ÊØ´¢Í§Ë¹éҨʹ٠áÅéÇÊѧࡵ´ÙÇèÒ + à¡Ô´ÍÐäâÖé¹ áÅеÓá˹觢ͧà¤ÍÃìà«ÍÃìà»ÅÕè¹ä»ÍÂèÒ§äà - 0,T6i1R0CYi10JV1!0Gh1R!RC"0BQ1:d;07U1EP05Q1G0MQ1!IC09Qi190MW14MR40BW14BR4(B 0,T!g1JRARC6c0*i1!RC`0EWh1M9`$M0Cl1`+M0Cl1d;07U1EP$S(B -,Td04i1(B ,T!4(B ESC f ,T`0>Wh1Mc0Ki1`0EWh1M9d;0"i1R'K09i1RK09Vh1'$S(B ,TaEP(B ESC b ,T`0>Wh1Mc0Ki1`0EWh1M9d;0"i1R'K0EQ1'K09Vh1'$S(B + ¶éÒÃÙéÊÖ¡ÇèÒ¡ÒâÂѺ价ÕÅеÑÇÍÑ¡ÉùÑé¹Í×´ÍÒ´Â×´ÂÒ´ ¡çÊÒÁÒöãªé¡ÒÃàÅ×è͹à¤ÍÃìà«ÍÃìä»·ÕÅÐ¤Ó +ä´é ¡´ ESC f à¾×èÍãËéàÅ×è͹仢éҧ˹éÒ˹Öè§¤Ó áÅÐ ESC b à¾×èÍãËéàÅ×è͹仢éÒ§ËÅѧ˹Öè§¤Ó -,TKARB`K05X1(B: ,TJSK0CQ1:@RIRd7B(B 0,TBQ1'd0Ah1JRARC6a0:h1'aB!5SaK09h1'"M'$Sd04i106Y1!05i1M'(B 0,T(V1'd0Ah1(B - ,TJRARC6c0*i1JM'$S0JQh1'09Ui1d04i1(B +ËÁÒÂà˵Ø: ÊÓËÃѺÀÒÉÒä·Â ÂѧäÁèÊÒÁÒöáºè§á¡µÓá˹觢ͧ¤Óä´é¶Ù¡µéͧ ¨Ö§äÁè + ÊÒÁÒöãªéÊͧ¤ÓÊÑ觹Õéä´é - >> ,TEM'!4(B ESC f ,TaEP(B ESC b ,TEM'04Y1KERB(B ,Tf(B ,T$0CQi1'(B ,TaEPEM'c0*i10Ch1GA0!Q1:(B C-f 0,T!Q1:(B C-b 0,T4Y1(B - 0,T4i1GB(B + >> Åͧ¡´ ESC f áÅÐ ESC b Åͧ´ÙËÅÒÂ æ ¤ÃÑé§ áÅÐÅͧãªéÃèÇÁ¡Ñº C-f ¡Ñº C-b ´Ù + ´éÇ - ,T(P0JQ1'`!5`0Kg19d04i10Gh1R(B ESC f ,TaEP(B ESC b 0,TAU10CY1;a::$0Ei1RB$0EV1'0!Q1:(B C-f ,TaEP(B C-b ,Tb4B0Jh1G9cK0-h1(B -ESC <0,T5Q1G0MQ1!IC(B> ,T(Pc0*i1`0!Uh1BG0!Q1:!RC0(Q14!RC0"i1M$GRA(B 0,TJh1G9(B C-<0,T5Q1G0MQ1!IC(B> ,T(Pc0*i10!Q1:0JTh1'07Uh1`0;g190>Wi190R9AR!(B -,T!0Gh1R(B (,T`0*h19(B 0,T5Q1G0MQ1!IC(B ,TK0CW1M(B ,T:CC07Q14(B) + ¨ÐÊѧࡵàËç¹ä´éÇèÒ ESC f áÅÐ ESC b ÁÕÃٻẺ¤ÅéÒ¤ÅÖ§¡Ñº C-f áÅÐ C-b â´ÂÊèǹãË­è +ESC <µÑÇÍÑ¡ÉÃ> ¨Ðãªéà¡ÕèÂǡѺ¡ÒèѴ¡ÒâéͤÇÒÁ Êèǹ C-<µÑÇÍÑ¡ÉÃ> ¨Ðãªé¡ÑºÊÔ觷Õèà»ç¹¾×é¹°Ò¹ÁÒ¡ +¡ÇèÒ (àªè¹ µÑÇÍÑ¡Éà ËÃ×Í ºÃ÷Ѵ) - C-a 0,T!Q1:(B C-e ,T`0;g19$S0JQh1'09h1R(P0CYi1d0Gi1(B ,T`>CRP0$h1M90"i1R'JP4G!04U107U1`04U1BG(B C-a ,Tc0*i1JSK0CQ1:`0EWh1M9(B -,T`$M0Cl1`+M0Cl1d;07Uh15SaK09h1'K09i1R0JX14"M':CC07Q14(B C-e ,TJSK0CQ1:`0EWh1M9d;07Uh15SaK09h1'07i1RB0JX14"M':CC07Q14(B + C-a ¡Ñº C-e à»ç¹¤ÓÊÑ觹èÒ¨ÐÃÙéäÇé à¾ÃÒФè͹¢éÒ§Êдǡ´Õ·Õà´ÕÂÇ C-a ãªéÊÓËÃѺàÅ×è͹ +à¤ÍÃìà«ÍÃìä»·ÕèµÓá˹è§Ë¹éÒÊØ´¢Í§ºÃ÷Ѵ C-e ÊÓËÃѺàÅ×è͹价ÕèµÓá˹觷éÒÂÊØ´¢Í§ºÃ÷Ѵ - >> ,TEM'!4(B C-a 0,T4Y1JM'$0CQi1'(B ,TK0EQ1'(R!09Qi19c0Ki1!4(B C-e 0,T4Y1JM'$0CQi1'(B ,Ta0Ei1GEM'0JQ1'`!504Y10Gh1R(B ,T!RC(B - ,T!4$S0JQh1'09Ui1AR!!0Gh1RJM'$0CQi1'(B ,T(Pd0Ah10*h1GBc0Ki1`0EWh1M9`$M0Cl1`+M0Cl1d;dK9d04i1AR!!0Gh1R09Qi190MU1!(B + >> Åͧ¡´ C-a ´ÙÊͧ¤ÃÑé§ ËÅѧ¨Ò¡¹Ñé¹ãËé¡´ C-e ´ÙÊͧ¤ÃÑé§ áÅéÇÅͧÊѧࡵ´ÙÇèÒ ¡Òà + ¡´¤ÓÊÑ觹ÕéÁÒ¡¡ÇèÒÊͧ¤ÃÑé§ ¨ÐäÁèªèÇÂãËéàÅ×è͹à¤ÍÃìà«ÍÃìä»ä˹ä´éÁÒ¡¡ÇèÒ¹Ñé¹ÍÕ¡ - 0,TBQ1'0AU10MU1!JM'$S0JQh1'(B ,TJSK0CQ1:!RC`0EWh1M9`$M0Cl1`+M0Cl1a::0'h1RB(B ,Tf(B 0,T$W1M(B ,T$S0JQh1'(B ESC < ,TJSK0CQ1:!RC`0EWh1M9(B -,T`$M0Cl1`+M0Cl1d;07Uh15SaK09h1'aC!0JX14"M'a0?i1A0"i1M0AY1E(B ,TaEP$S0JQh1'(B ESC > ,TJSK0CQ1:!RC`0EWh1M9d;5SaK09h1'07i1RB0JX14(B + ÂѧÁÕÍÕ¡Êͧ¤ÓÊÑè§ ÊÓËÃѺ¡ÒÃàÅ×è͹à¤ÍÃìà«ÍÃìẺ§èÒÂ æ ¤×Í ¤ÓÊÑè§ ESC < ÊÓËÃѺ¡ÒÃàÅ×è͹ +à¤ÍÃìà«ÍÃìä»·ÕèµÓá˹è§ááÊØ´¢Í§á¿éÁ¢éÍÁÙÅ áÅФÓÊÑè§ ESC > ÊÓËÃѺ¡ÒÃàÅ×è͹仵Óá˹觷éÒÂÊØ´ - ,T`CR`0CU1B!5SaK09h1'"M'0"i1M$GRA(B 0,T7Uh10AU1`$M0Cl1`+M0Cl1M0BYh10Gh1R(B "0,T(X14(B (point)" ,TK0CW1M0>Y140MU1!M0Bh1R'K09Vh1'd04i1(B -0,TGh1R(B ,T`$M0Cl1`+M0Cl1(B ,T`0;g190JTh1'07Uh1:M!c0Ki1`CR0CYi10Gh1R(B 0,T(X14(B ,TM0BYh15C'dK9"M'K09i1R(M(B + àÃÒàÃÕ¡µÓá˹觢ͧ¢éͤÇÒÁ ·ÕèÁÕà¤ÍÃìà«ÍÃìÍÂÙèÇèÒ "¨Ø´ (point)" ËÃ×;ٴÍÕ¡ÍÂèҧ˹Öè§ä´é +ÇèÒ à¤ÍÃìà«ÍÃì à»ç¹ÊÔ觷ÕèºÍ¡ãËéàÃÒÃÙéÇèÒ ¨Ø´ ÍÂÙèµÃ§ä˹¢Í§Ë¹éÒ¨Í - ,TJ0CX1;$S0JQh1'JSK0CQ1:!RC`$0EWh1M9d;AR(B 0,T+Vh1'CGA!RC`$0EWh1M907Uh1c9K09h1GB"M'$S(B ,TK09h1GB"M':CC07Q14d0Gi104i1GB(B -,Td04i104Q1'09Ui1(B + ÊÃØ»¤ÓÊÑè§ÊÓËÃѺ¡ÒÃà¤Å×è͹ä»ÁÒ «Öè§ÃÇÁ¡ÒÃà¤Å×è͹·Õèã¹Ë¹èÇ¢ͧ¤Ó ˹èÇ¢ͧºÃ÷ѴäÇé´éÇ +ä´é´Ñ§¹Õé - C-f ,Td;0"i1R'K09i1RK09Vh1'05Q1G0MQ1!IC(B - C-b ,T!0EQ1:0"i1R'K0EQ1'K09Vh1'05Q1G0MQ1!IC(B + C-f 仢éҧ˹éÒ˹Ö觵ÑÇÍÑ¡Éà + C-b ¡ÅѺ¢éÒ§ËÅѧ˹Ö觵ÑÇÍÑ¡Éà - ESC f ,Td;0"i1R'K09i1RK09Vh1'$S(B - ESC b ,T!0EQ1:0"i1R'K0EQ1'K09Vh1'$S(B + ESC f 仢éҧ˹éÒ˹Öè§¤Ó + ESC b ¡ÅѺ¢éÒ§ËÅѧ˹Öè§¤Ó - C-n ,T`0EWh1M9d;:CC07Q1405h1Md;(B - C-p ,T`0EWh1M9d;:CC07Q1407Uh1a0Ei1G(B + C-n àÅ×è͹仺Ã÷ѴµèÍä» + C-p àÅ×è͹仺Ã÷Ѵ·ÕèáÅéÇ - ESC ] ,T`0EWh1M9d;5SaK09h1'07i1RB0JX14"M'0Bh1MK09i1R(B (paragraph) - ESC [ ,T`0EWh1M9d;5SaK09h1'aC!0JX14"M'0Bh1MK09i1R(B + ESC ] àÅ×è͹仵Óá˹觷éÒÂÊØ´¢Í§ÂèÍ˹éÒ (paragraph) + ESC [ àÅ×è͹仵Óá˹è§ááÊØ´¢Í§ÂèÍ˹éÒ - C-a ,T`0EWh1M9d;5SaK09h1'aC!0JX14"M':CC07Q14(B - C-e ,T`0EWh1M9d;5SaK09h1'07i1RB0JX14"M':CC07Q14(B + C-a àÅ×è͹仵Óá˹è§ááÊØ´¢Í§ºÃ÷Ѵ + C-e àÅ×è͹仵Óá˹觷éÒÂÊØ´¢Í§ºÃ÷Ѵ - ESC < ,T`0EWh1M9d;5SaK09h1'aC!0JX14"M'a0?i1A0"i1M0AY1E(B - ESC > ,T`0EWh1M9d;5SaK09h1'07i1RB0JX14"M'a0?i1A0"i1M0AY1E(B + ESC < àÅ×è͹仵Óá˹è§ááÊØ´¢Í§á¿éÁ¢éÍÁÙÅ + ESC > àÅ×è͹仵Óá˹觷éÒÂÊØ´¢Í§á¿éÁ¢éÍÁÙÅ - >> ,TEM'c0*i1$S0JQh1'a05h1EP$S0JQh1'04Y1(B ,T$S0JQh1'`K0Eh1R09Ui1`0;g19$S0JQh1'07Uh1c0*i10!Q190:h1MB0JX14(B ,T$S0JQh1'JM'$S0JQh1'K0EQ1'(B - ,T(P`0EWh1M9`$M0Cl1`+M0Cl1(B ,Td;0BQ1'07Uh107Uh10$h1M90"i1R'd!E(B ,Tc0Ki1EM'c0*i1$S0JQh1'(B C-v ,TaEP(B ESC v ,T`0>Wh1M(B - ,T`0EWh1M9`$M0Cl1`+M0Cl1!0EQ1:AR07Uh15C'09Ui1(B + >> Åͧãªé¤ÓÊÑè§áµèÅФÓÊÑ觴٠¤ÓÊÑè§àËÅèÒ¹Õéà»ç¹¤ÓÊÑ觷Õèãªé¡Ñ¹ºèÍÂÊØ´ ¤ÓÊÑè§Êͧ¤ÓÊÑè§ËÅѧ + ¨ÐàÅ×è͹à¤ÍÃìà«ÍÃì ä»Âѧ·Õè·Õè¤è͹¢éÒ§ä¡Å ãËéÅͧãªé¤ÓÊÑè§ C-v áÅÐ ESC v à¾×èÍ + àÅ×è͹à¤ÍÃìà«ÍÃì¡ÅѺÁÒ·ÕèµÃ§¹Õé - ,TJSK0CQ1:$S0JQh1'0MWh19(B ,Tf(B ,T"M'(B Emacs 0,T!g1`0*h190!Q19(B ,T$S0JQh1'`K0Eh1R09Ui1(PJRARC6`0>Th1A05Q1G`0EW1M!(B (argument) -,T`0>Wh1M!SK94(B ,T(S9G9$0CQi1'(B ,Tc9!RC;0/T10:Q105T1'R9d04i1(B ,T!RC!SK94(S9G9$0CQi1'(B ,T7Sd04i1b4B!4(B C-u ,Ta0Ei1G5RA(B -0,T4i1GB(S9G9$0CQi1'07Uh105i1M'!RC0!h1M9(B ,Ta0Ei1G0(V1'0$h1MB!4$S0JQh1'5RA(B + ÊÓËÃѺ¤ÓÊÑè§Í×è¹ æ ¢Í§ Emacs ¡çàªè¹¡Ñ¹ ¤ÓÊÑè§àËÅèÒ¹Õé¨ÐÊÒÁÒöà¾ÔèÁµÑÇàÅ×Í¡ (argument) +à¾×èÍ¡Ó˹´ ¨Ó¹Ç¹¤ÃÑé§ ã¹¡Òû¯ÔºÑµÔ§Ò¹ä´é ¡ÒáÓ˹´¨Ó¹Ç¹¤ÃÑé§ ·Óä´éâ´Â¡´ C-u áÅéǵÒÁ +´éǨӹǹ¤ÃÑ駷Õèµéͧ¡Òáè͹ áÅéǨ֧¤èÍ¡´¤ÓÊÑ觵ÒÁ - 0,T5Q1GM0Bh1R'`0*h19(B ,T$S0JQh1'(B C-u 8 C-f ,TKARB06V1'(B ,Tc0Ki1`0EWh1M9d;0"i1R'K09i1R(B 8 0,T5Q1G0MQ1!IC(B + µÑÇÍÂèÒ§àªè¹ ¤ÓÊÑè§ C-u 8 C-f ËÁÒ¶֧ ãËéàÅ×è͹仢éҧ˹éÒ 8 µÑÇÍÑ¡Éà - >> ,Tc0Ki1EM'!SK94(S9G9$0CQi1'07Uh1`KARPJAJSK0CQ1:$S0JQh1'(B C-n ,TK0CW1M(B C-p ,T`0>Wh1M`0EWh1M9`$M0Cl1`+M0Cl1(B - ,Tc0Ki1ARM0BYh1c!0Ei1:CC07Q1409Ui1c0Ki1AR!07Uh10JX14`07h1R07Uh1(P7Sd04i1(B ,Tc9!RC`0EWh1M9`$M0Cl1`+M0Cl1$0CQi1'`04U1BG(B + >> ãËéÅͧ¡Ó˹´¨Ó¹Ç¹¤ÃÑ駷ÕèàËÁÒÐÊÁÊÓËÃѺ¤ÓÊÑè§ C-n ËÃ×Í C-p à¾×èÍàÅ×è͹à¤ÍÃìà«ÍÃì + ãËéÁÒÍÂÙèã¡ÅéºÃ÷Ѵ¹ÕéãËéÁÒ¡·ÕèÊØ´à·èÒ·Õè¨Ð·Óä´é 㹡ÒÃàÅ×è͹à¤ÍÃìà«ÍÃì¤ÃÑé§à´ÕÂÇ - ,TJSK0CQ1:(B C-v ,TaEP(B ESC v ,T(Pd04i1> ,TEM'!4(B C-u 3 C-v 0,T4Y1(B + >> Åͧ¡´ C-u 3 C-v ´Ù - ,T`0EWh1M9!0EQ1:07Uh1`0!h1Rd04i1b4B(B C-u 3 ESC v + àÅ×è͹¡ÅѺ·Õèà¡èÒä´éâ´Â C-u 3 ESC v -,T$S0JQh1'B!`0ET1!(B +¤ÓÊÑè§Â¡àÅÔ¡ ========= - ,T$S0JQh1'(B C-g ,Tc0*i1JSK0CQ1:0JQh1'B!`0ET1!$S0JQh1'05h1R'(B ,Tf(B 0,T7Uh105i1M'!RC!RC0;i1M90"i1M0AY1E`0>Th1A`05T1A(B 0,T5Q1GM0Bh1R'`0*h19(B -,TCPK0Gh1R'07Uh1c0Jh105Q1G`0EW1M!(B (argument) ,TM0BYh1(B ,TK0CW1MCPK0Gh1R'$S0JQh1'07Uh105i1M'!RC!40;Xh1AAR!!0Gh1R(B 2 0,T;Xh1A0"Vi19d;(B 0,T6i1R(B -,TKR!05i1M'!RCB!`0ET1!(B 0,T!g1c0Ki1!4(B C-g + ¤ÓÊÑè§ C-g ãªéÊÓËÃѺÊÑè§Â¡àÅÔ¡¤ÓÊÑ觵èÒ§ æ ·Õèµéͧ¡ÒáÒûé͹¢éÍÁÙÅà¾ÔèÁàµÔÁ µÑÇÍÂèÒ§àªè¹ +ÃÐËÇèÒ§·ÕèãÊèµÑÇàÅ×Í¡ (argument) ÍÂÙè ËÃ×ÍÃÐËÇèÒ§¤ÓÊÑ觷Õèµéͧ¡Òá´»ØèÁÁÒ¡¡ÇèÒ 2 »ØèÁ¢Öé¹ä» ¶éÒ +ËÒ¡µéͧ¡ÒáàÅÔ¡ ¡çãËé¡´ C-g - >> ,TEM'!SK94(S9G9$0CQi1'c0Ki1`0;g19(B 100 ,Tb4B!RC!4(B C-u 100 ,Ta0Ei1G!4(B C-g 0,T4Y1(B ,TK0EQ1'(R!09Qi19(B - ,Tc0Ki1EM'!4(B C-f 0,T4Y1(B ,Ta0Ei1G0JQ1'`!504Y10Gh1R`$M0Cl1`+M0Cl1`0EWh1M9d;0!Uh105Q1G0MQ1!IC(B ,TK0CW1M5M907Uh1>ER4d;!4(B - ESC ,Tb4Bd0Ah105Qi1'c((B 0,T!g1JRARC6!4(B C-g ,TB!`0ET1!d04i1(B + >> Åͧ¡Ó˹´¨Ó¹Ç¹¤ÃÑé§ãËéà»ç¹ 100 â´Â¡Òá´ C-u 100 áÅéÇ¡´ C-g ´Ù ËÅѧ¨Ò¡¹Ñé¹ + ãËéÅͧ¡´ C-f ´Ù áÅéÇÊѧࡵ´ÙÇèÒà¤ÍÃìà«ÍÃìàÅ×è͹仡ÕèµÑÇÍÑ¡Éà ËÃ×͵͹·Õè¾ÅҴ仡´ + ESC â´ÂäÁèµÑé§ã¨ ¡çÊÒÁÒö¡´ C-g ¡àÅÔ¡ä´é -0,T"i1M0ER4(B (Error) +¢éͼԴ¾ÅÒ´ (Error) ================ - ,Tc9:R'$0CQi1'(B ,TMR((P0AU1!RC0JQh1';0/T10:Q105T1'R9:R'M0Bh1R'(B 0,T7Uh1(B Emacs ,TBMA0CQ1:d0Ah1d04i1`0!T140"Vi19(B 0,T5Q1GM0Bh1R'`0*h19(B -,T!RC!4$S0JQh1'$M9b7CE:R'$S0JQh1'(B 0,T7Uh1d0Ah1d04i1!SK94d0Gi1c9(B Emacs 0,T!g1(P7Sc0Ki1(B Emacs 0,TJh1'`0JU1B'`05W1M9(B -,TaEPaJ4'ER4M0Bh1R'dC(B + 㹺ҧ¤ÃÑé§ ÍÒ¨¨ÐÁÕ¡ÒÃÊÑ觻¯ÔºÑµÔ§Ò¹ºÒ§ÍÂèÒ§ ·Õè Emacs ÂÍÁÃѺäÁèä´éà¡Ô´¢Öé¹ µÑÇÍÂèÒ§àªè¹ +¡Òá´¤ÓÊÑ觤͹â·Ãźҧ¤ÓÊÑè§ ·ÕèäÁèä´é¡Ó˹´äÇéã¹ Emacs ¡ç¨Ð·ÓãËé Emacs Êè§àÊÕ§àµ×͹ +áÅÐáÊ´§¼Å·ÕèºÃ÷ѴÅèÒ§ÊØ´¢Í§¨Í ºÍ¡ÇèÒ¼Ô´¾ÅÒ´ÍÂèÒ§äà - ,T$S0JQh1':R'$S0JQh1'07Uh1`0"U1B9d0Gi1c9`M!JRC)0:Q1:09Ui1(B ,TMR(c0*i1d0Ah1d04i10!Q1:(B Emacs ,T:R'0CXh19(B (version) 0,T+Vh1'(P(B -,T7Sc0Ki10AU1!RCaJ4'ER4(B (error) 0,T"Vi19(B ,Tc9!C03U109Ui1(B ,T"Mc0Ki1!40;Xh1AMPdC0!g1d04i1(B ,T`0>Wh1M`0EWh1M9d;0BQ1'0Jh1G9(B -0,T5h1Md;(B + ¤ÓÊÑ觺ҧ¤ÓÊÑ觷Õèà¢Õ¹äÇéã¹àÍ¡ÊÒéºÑº¹Õé ÍÒ¨ãªéäÁèä´é¡Ñº Emacs ºÒ§ÃØè¹ (version) «Ö觨Р+·ÓãËéÁÕ¡ÒÃáÊ´§¼Å¢éͼԴ¾ÅÒ´ (error) ¢Öé¹ ã¹¡Ã³Õ¹Õé ¢ÍãËé¡´»ØèÁÍÐäáçä´é à¾×èÍàÅ×è͹ä»ÂѧÊèǹ +µèÍä» -0,TGT19b40Gl1(B (Window) +ÇÔ¹â´Çì (Window) ============== - Emacs ,TJRARC6`0;T140GT19b40Gl1d04i1>0Ci1MA0!Q19KERB0GT19b40Gl1(B ,TaEPc0*i10GT19b40Gl1`K0Eh1R09Qi19aJ4'08l1"M'$S0JQh1':R'$S0JQh1'(B ,TK0CW1M(B Help ,TMM!`0JU1B0!h1M9(B + Emacs ÊÒÁÒöà»Ô´ÇÔ¹â´Çìä´é¾ÃéÍÁ¡Ñ¹ËÅÒÂÇÔ¹â´Çì áÅÐãªéÇÔ¹â´ÇìàËÅèÒ¹Ñé¹áÊ´§¼Å¢éͤÇÒÁ +µèÒ§ æ µÒÁµéͧ¡ÒÃä´é ¡è͹Í×è¹ ¡ç¤ÇèзӤÇÒÁÃÙé¨Ñ¡¡Ñº¤ÓÊÑè§ ·ÕèãªéÊÓËÃѺ¡ÒÃźÇÔ¹â´ÇìÊèǹà¡Ô¹ +ã¹àÇÅÒ·ÕèáÊ´§¼ÅÅѾ¸ì¢Í§¤ÓÊÑ觺ҧ¤ÓÊÑè§ ËÃ×Í Help ÍÍ¡àÊÕ¡è͹ - C-x 1 ,T7Sc0Ki1`0;g190GT19b40Gl1`04U1BG(B + C-x 1 ·ÓãËéà»ç¹ÇÔ¹â´Çìà´ÕÂÇ - ,T$S0JQh1'(B C-x 1 ,Tc0*i1JSK0CQ1:E:0GT19b40Gl10MWh19(B ,Ta0Ei1G"BRB0GT19b40Gl107Uh10AU1`$M0Cl1`+M0Cl1M0BYh1(B ,Tc0Ki1`05g1A(M`0;g19(B -0,TGT19b40Gl1`04U1BG(B + ¤ÓÊÑè§ C-x 1 ãªéÊÓËÃѺźÇÔ¹â´ÇìÍ×è¹ áÅéÇ¢ÂÒÂÇÔ¹â´Çì·ÕèÁÕà¤ÍÃìà«ÍÃìÍÂÙè ãËéàµçÁ¨Íà»ç¹ +ÇÔ¹â´Çìà´ÕÂÇ - >> ,Tc0Ki1`0EWh1M9`$M0Cl1`+M0Cl1AR07Uh1:CC07Q1409Ui1(B ,Ta0Ei1G!4(B C-u 0 C-l + >> ãËéàÅ×è͹à¤ÍÃìà«ÍÃìÁÒ·ÕèºÃ÷Ѵ¹Õé áÅéÇ¡´ C-u 0 C-l - >> ,TEM'!4(B C-h k C-f 0,T4Y1(B ,Ta0Ei1G0JQ1'`!504Y10Gh1R0GT19b40Gl109Ui1`;0EUh1B9d;M0Bh1R'dC(B ,T`0AWh1M0AU10GT19b40Gl1cK0Ah10+Vh1'(B - ,TM08T1:RB0GT108U1c0*i1$S0JQh1'(B C-f ,T;CR!/0"Vi19(B + >> Åͧ¡´ C-h k C-f ´Ù áÅéÇÊѧࡵ´ÙÇèÒÇÔ¹â´Çì¹Õéà»ÅÕè¹ä»ÍÂèÒ§äà àÁ×èÍÁÕÇÔ¹â´ÇìãËÁè«Öè§ + ͸ԺÒÂÇÔ¸Õãªé¤ÓÊÑè§ C-f »ÃÒ¡¯¢Öé¹ - >> ,TEM'!4(B C-x 1 ,T`0>Wh1ME:0GT19b40Gl107Uh1b<0Eh10"Vi19ARcK0Ah1(B ,TMM!(B + >> Åͧ¡´ C-x 1 à¾×èÍźÇÔ¹â´Çì·Õèâ¼Åè¢Öé¹ÁÒãËÁè ÍÍ¡ -,T!RCa7C!(B (insert) ,TaEP(B ,T!RCE:(B (delete) +¡ÒÃá·Ã¡ (insert) áÅÐ ¡ÒÃź (delete) =================================== - ,T:9(B Emacs ,T`CR(PJRARC60>T1A0>l105Q1G0MQ1!IC`0"i1Rd;d04i1`EB(B ,T`0AWh1M05i1M'!RC0>T1A0>l10"i1M$GRA(B Emacs ,T(P(B -0,T6W1M0Gh1R05Q1GK09Q1'0JW1M07Uh1AM'`0Kg19d04i107X1!05Q1G(B (,T`0*h19(B 'A' '7' '*' ',T!(B' ,TaEP0MWh19(B ,Tf(B) ,T`0;g190"i1M$GRA07Uh105i1M'!RC(P(B -,Ta7C!(B (insert) ,T`0"i1Rd;5C'(B ,Tf(B ,T`0AWh1M(P(::CC07Q14(B ,Tc0Ki1!4(B ,T`0>Wh1M`05T1A0MQ1!IC0"Vi19:CC07Q14cK0Ah1(B -(linefeed character) ,Ta7C!`0"i1Rd;(B + º¹ Emacs àÃÒ¨ÐÊÒÁÒö¾ÔÁ¾ìµÑÇÍÑ¡ÉÃà¢éÒä»ä´éàÅ àÁ×è͵éͧ¡ÒþÔÁ¾ì¢éͤÇÒÁ Emacs ¨Ð +¶×ÍÇèÒµÑÇ˹ѧÊ×Í·ÕèÁͧàËç¹ä´é·Ø¡µÑÇ (àªè¹ 'A' '7' '*' '¡' áÅÐÍ×è¹ æ) à»ç¹¢éͤÇÒÁ·Õèµéͧ¡ÒèР+á·Ã¡ (insert) à¢éÒ仵ç æ àÁ×èͨШººÃ÷Ѵ ãËé¡´ à¾×èÍàµÔÁÍÑ¡ÉâÖ鹺Ã÷ѴãËÁè +(linefeed character) á·Ã¡à¢éÒä» - ,Tc0Ki1!4(B ,T`0AWh1M05i1M'!RC(PE:05Q1G0MQ1!IC07Uh1`0>Th1'0>T1A0>l1`0"i1Rd;(B ,TKARB06V1'0;Xh1A`0"U1B9(B -,T:90 -,Tc0*i1JSK0CQ1:E:05Q1G0MQ1!IC07Uh1M0BYh10!h1M9K09i1R5SaK09h1'`$M0Cl1`+M0Cl10;Q1(0(X10:Q19(B + ãËé¡´ àÁ×è͵éͧ¡ÒèÐźµÑÇÍÑ¡É÷Õèà¾Ô觾ÔÁ¾ìà¢éÒä» ËÁÒ¶֧»ØèÁà¢Õ¹ +º¹¼ÔÇ˹éÒäÇéÇèÒ "Delete" ËÃ×ͺҧ·ÕÍÒ¨¨Ðà¢Õ¹äÇé "Rubout" ¡çä´é â´Â·ÑèÇä» +ãªéÊÓËÃѺźµÑÇÍÑ¡É÷ÕèÍÂÙè¡è͹˹éÒµÓá˹è§à¤ÍÃìà«ÍÃì»Ñ¨¨ØºÑ¹ - >> ,TEM'0>T1A0>l105Q1G0MQ1!IC`0"i1Rd;KERB(B ,Tf(B 0,T5Q1G(B ,Ta0Ei1Gc0*i1(B ,TE:05Q1G0MQ1!IC`K0Eh1R09Qi1907Ti1'(B + >> Åͧ¾ÔÁ¾ìµÑÇÍÑ¡ÉÃà¢éÒä»ËÅÒÂ æ µÑÇ áÅéÇãªé źµÑÇÍÑ¡ÉÃàËÅèÒ¹Ñé¹·Ôé§ - >> ,TEM'0>T1A0>l10"i1M$GRAE'd;c0Ki1`0!T19"M:"GR(B (right margin) ,T`GER07Uh10>T1A0>l10"i1M$GRA`0"i1Rd;(B - ,TBRG`0!T19$GRA!0Gi1R'"M'K09Vh1':CC07Q14(B ,T:CC07Q1409Qi190!g1(P(B "0,T6Y1!05h1M(B" ,Tc0Ki1BRG`0!T19K09Vh1'K09i1R(M(B - ,Tb4Bc0Jh1`$0CWh1M'KARB(B '\' ,Td0Gi107Uh1"M:"GR0JX14(B ,T`0>Wh1M:M!c0Ki10CYi10Gh1R:CC07Q1409Ui10BQ1'0AU105h1M(B Emacs ,T(P(B - ,T`0EWh1M9(B (scroll) ,TK09i1R(M`0>Wh1Mc0Ki1`0Kg195SaK09h1'07Uh1!S0EQ1'a0!i1d"M0BYh1d04i1M0Bh1R'0*Q14`(9(B 0,T6i1RKR!(B - ,T"M:"GRK0CW1M"M:0+i1RB"M'0AU1`$0CWh1M'KARB(B '\' ,TM0BYh1(B 0,T!g1`0;g19!RC:M!c0Ki10CYi10Gh1R(B ,T:CC07Q1409Qi190BQ1'0AU105h1M(B - ,Td;c907T1H7R'09Qi19(B ,Tf(B + >> Åͧ¾ÔÁ¾ì¢éͤÇÒÁŧä»ãËéà¡Ô¹¢Íº¢ÇÒ (right margin) àÇÅÒ·Õè¾ÔÁ¾ì¢éͤÇÒÁà¢éÒä» + ÂÒÇà¡Ô¹¤ÇÒÁ¡ÇéÒ§¢Í§Ë¹Ö觺Ã÷Ѵ ºÃ÷Ѵ¹Ñ鹡ç¨Ð "¶Ù¡µèÍ" ãËéÂÒÇà¡Ô¹Ë¹Öè§Ë¹éÒ¨Í + â´ÂãÊèà¤Ã×èͧËÁÒ '\' äÇé·Õè¢Íº¢ÇÒÊØ´ à¾×èͺ͡ãËéÃÙéÇèÒºÃ÷Ѵ¹ÕéÂѧÁÕµèÍ Emacs ¨Ð + àÅ×è͹ (scroll) ˹éÒ¨Íà¾×èÍãËéàËç¹µÓá˹觷Õè¡ÓÅѧá¡éä¢ÍÂÙèä´éÍÂèÒ§ªÑ´à¨¹ ¶éÒËÒ¡ + ¢Íº¢ÇÒËÃ×͢ͺ«éÒ¢ͧÁÕà¤Ã×èͧËÁÒ '\' ÍÂÙè ¡çà»ç¹¡Òú͡ãËéÃÙéÇèÒ ºÃ÷Ѵ¹Ñé¹ÂѧÁÕµèÍ + ä»ã¹·ÔÈ·Ò§¹Ñé¹ æ - ,TEM';0/T10:Q105T104Y1`EB(B ,T$'(P0*h1GBc0Ki1`0"i1Rc(0'h1RB!0Gh1R!RCM08T1:RB04i1GB05Q1GK09Q1'0JW1M(B + Åͧ»¯ÔºÑµÔ´ÙàÅ ¤§¨ÐªèÇÂãËéà¢éÒ㨧èÒ¡ÇèÒ¡ÒÃ͸ԺÒ´éǵÑÇ˹ѧÊ×Í - >> ,Tc0Ki1"0BQ1:`$M0Cl1`+M0Cl1d;d0Gi1:9:CC07Q140+Vh1'06Y1!05h1Mc0Ki1BRG`0!T19K09Vh1'K09i1R(M(B 0,T7Uh1`0>Th1'0;i1M9`0"i1Rd;`0AWh1M(B - 0,TJQ1!$0CYh109Ui1(B ,Ta0Ei1Gc0*i1(B C-d ,TE:0"i1M$GRAMM!:R'0Jh1G9(B ,T(9$GRABRG"M'0"i1M$GRAM0BYh1@RBc9K09Vh1'(B - ,T:CC07Q14(B 0,TJQ1'`!504Y10Gh1R`$0CWh1M'KARB(B '\' ,T(PKRBd;(B + >> ãËé¢ÂѺà¤ÍÃìà«ÍÃìä»äÇ麹ºÃ÷Ѵ«Ö觶١µèÍãËéÂÒÇà¡Ô¹Ë¹Öè§Ë¹éÒ¨Í ·Õèà¾Ô觻é͹à¢éÒä»àÁ×èÍ + ÊÑ¡¤ÃÙè¹Õé áÅéÇãªé C-d ź¢éͤÇÒÁÍÍ¡ºÒ§Êèǹ ¨¹¤ÇÒÁÂÒǢͧ¢éͤÇÒÁÍÂÙèÀÒÂã¹Ë¹Öè§ + ºÃ÷Ѵ Êѧࡵ´ÙÇèÒà¤Ã×èͧËÁÒ '\' ¨ÐËÒÂä» - >> ,Tc0Ki1`0EWh1M9`$M0Cl1`+M0Cl1d;d0Gi107Uh15SaK09h1'aC!0JX14"M':CC07Q14(B ,Ta0Ei1G!4(B 0,T4Y1(B ,T!RC7S(B - ,Ta::09Ui1(B ,T(P7Sc0Ki10JQ1-0EQ1!I03l10$Qh19CPK0Gh1R':CC07Q1406Y1!E:MM!d;(B ,T:CC07Q1409Qi190!g1(P06Y1!`MRd;05h1M0!Q1:(B - ,T:CC07Q140!h1M9K09i1R09Qi19(B ,TCGA0!Q19`0;g19:CC07Q14BRG:CC07Q14`04U1BG(B ,TaEPMR((P0AU10JQ1-0EQ1!I03l105h1M:CC07Q14(B - ,T;CR!/0"Vi19(B + >> ãËéàÅ×è͹à¤ÍÃìà«ÍÃìä»äÇé·ÕèµÓá˹è§ááÊØ´¢Í§ºÃ÷Ѵ áÅéÇ¡´ ´Ù ¡ÒÃ·Ó + Ẻ¹Õé ¨Ð·ÓãËéÊÑ­Åѡɳì¤Ñè¹ÃÐËÇèÒ§ºÃ÷Ѵ¶Ù¡ÅºÍÍ¡ä» ºÃ÷Ѵ¹Ñ鹡ç¨Ð¶Ù¡àÍÒ仵è͡Ѻ + ºÃ÷Ѵ¡è͹˹éÒ¹Ñé¹ ÃÇÁ¡Ñ¹à»ç¹ºÃ÷ѴÂÒǺÃ÷Ѵà´ÕÂÇ áÅÐÍÒ¨¨ÐÁÕÊÑ­ÅѡɳìµèͺÃ÷Ѵ + »ÃÒ¡¯¢Öé¹ - >> ,Tc0Ki1!4(B ,T`0>Wh1M`0>Th1A(B 0,T5Q1G0MQ1!IC0"Vi19:CC07Q14cK0Ah1(B ,T!0EQ1:d;M0Bh1R'`04T1A(B + >> ãËé¡´ à¾×èÍà¾ÔèÁ µÑÇÍÑ¡ÉâÖ鹺Ã÷ѴãËÁè ¡ÅѺä»ÍÂèÒ§à´ÔÁ - ,T$S0JQh1'0Jh1G9cK0-h1"M'(B Emacs ,T(PJRARC6!SK94(S9G9$0CQi1'07Uh105i1M'!RCc0Ki1;0/T10:Q105T1d04i1(B ,TCGA07Qi1'!RC(B -,Ta7C!(B (insert) 0,T5Q1G0MQ1!IC04i1GB(B + ¤ÓÊÑè§ÊèǹãË­è¢Í§ Emacs ¨ÐÊÒÁÒö¡Ó˹´¨Ó¹Ç¹¤ÃÑ駷Õèµéͧ¡ÒÃãË黯ԺѵÔä´é ÃÇÁ·Ñ駡Òà +á·Ã¡ (insert) µÑÇÍÑ¡ÉôéÇ - >> ,TEM'0;i1M9$S0JQh1'(B C-u 8 * 0,T4Y1(B 0,TJQ1'`!504Y10Gh1R`0!T14MPdC0"Vi19(B + >> Åͧ»é͹¤ÓÊÑè§ C-u 8 * ´Ù Êѧࡵ´ÙÇèÒà¡Ô´ÍÐäâÖé¹ - 0,T6i1R05i1M'!RC(P`0>Th1A:CC07Q140Gh1R'(B ,Tf(B (blank line) ,TCPK0Gh1R'JM':CC07Q14(B ,Tc0Ki1`0EWh1M9d;07Uh15SaK09h1'(B -,TaC!0JX14"M':CC07Q1407Uh1JM'(B ,Ta0Ei1G!4(B C-o + ¶éÒµéͧ¡ÒèÐà¾ÔèÁºÃ÷ѴÇèÒ§ æ (blank line) ÃÐËÇèÒ§ÊͧºÃ÷Ѵ ãËéàÅ×è͹价ÕèµÓáË¹è§ +ááÊØ´¢Í§ºÃ÷Ѵ·ÕèÊͧ áÅéÇ¡´ C-o - >> ,Tc0Ki1`0EWh1M9d;07Uh15SaK09h1'aC!0JX14"M':CC07Q14c40!g1d04i1(B ,Ta0Ei1GEM'!4(B C-o 0,T4Y1(B + >> ãËéàÅ×è͹价ÕèµÓá˹è§ááÊØ´¢Í§ºÃ÷Ѵ㴡çä´é áÅéÇÅͧ¡´ C-o ´Ù - 0,T6V1'5C'09Ui1(B ,T`CR0!g1d04i1`0CU1B90GT108U10>Wi190R9JSK0CQ1:!RC0;i1M90"i1M$GRA(B ,TaEP!RCa0!i107Uh10 ,TE:05Q1G0MQ1!IC07Uh1M0BYh1K09i1R`$M0Cl1`+M0Cl1(B - C-d ,TE:05Q1G0MQ1!IC07Uh1M0BYh107Uh1`$M0Cl1`+M0Cl1(B + źµÑÇÍÑ¡É÷ÕèÍÂÙè˹éÒà¤ÍÃìà«ÍÃì + C-d źµÑÇÍÑ¡É÷ÕèÍÂÙè·Õèà¤ÍÃìà«ÍÃì - ESC ,TE:$S07Uh1M0BYh1K09i1R`$M0Cl1`+M0Cl1(B - ESC d ,TE:$S05Qi1'a05h15SaK09h1'07Uh1`$M0Cl1`+M0Cl1M0BYh1(B + ESC ź¤Ó·ÕèÍÂÙè˹éÒà¤ÍÃìà«ÍÃì + ESC d ź¤ÓµÑé§áµèµÓá˹觷Õèà¤ÍÃìà«ÍÃìÍÂÙè - C-k ,TE::CC07Q1405Qi1'a05h15SaK09h1'07Uh1`$M0Cl1`+M0Cl1M0BYh1(B + C-k źºÃ÷ѴµÑé§áµèµÓá˹觷Õèà¤ÍÃìà«ÍÃìÍÂÙè - ,Tc9:R'$0CQi1'(B ,T`CRMR(05i1M'!RC(P`MR0Jh1G907Uh1E:d;!0EQ1:0$W19AR(B ,Tb;Ca!CA(B Emacs ,T(P(S0Jh1G907Uh1E:(B -,TMM!d0Gi1(B ,T`GER07Uh1E:0"i1M$GRAc9K09h1GB07Uh1AR!!0Gh1RK09Vh1'05Q1G0MQ1!IC(B ,Tc0Ki1c0*i1$S0JQh1'(B C-y ,T`GER07Uh105i1M'!RC(P`MR(B -0,T"i1M$GRA!0EQ1:0$W19(B 0,TJTh1'07Uh1$GCCP0GQ1'0!g10$W1M(B C-y ,Td0Ah1c0*h1c0*i1d04i1`0>U1B'a0$h15SaK09h1'07Uh1E:0"i1M$GRAMM!`07h1R09Qi19(B ,Ta05h1(P(B -,Tc0*i10!Q1:5SaK09h1'c40!g1d04i1(B C-y ,T`0;g19$S0JQh1'JSK0CQ1:a7C!0"i1M$GRA07Uh1`0!g1:d0Gi1(B ,TE'c95SaK09h1'07Uh10AU1`$M0Cl1`+M0Cl1M0BYh1(B -,T`CRJRARC6c0*i1$GRAJRARC609Ui1c9!RC`$0EWh1M90Bi1RB0"i1M$GRAd04i1(B + 㹺ҧ¤ÃÑé§ àÃÒÍÒ¨µéͧ¡ÒèÐàÍÒÊèǹ·Õèź仡ÅѺ¤×¹ÁÒ â»Ãá¡ÃÁ Emacs ¨Ð¨ÓÊèǹ·Õèź +ÍÍ¡äÇé àÇÅÒ·Õèź¢éͤÇÒÁã¹Ë¹èÇ·ÕèÁÒ¡¡ÇèÒ˹Ö觵ÑÇÍÑ¡Éà ãËéãªé¤ÓÊÑè§ C-y àÇÅÒ·Õèµéͧ¡ÒèÐàÍÒ +¢éͤÇÒÁ¡ÅѺ¤×¹ ÊÔ觷Õè¤ÇÃÃÐÇѧ¡ç¤×Í C-y äÁèãªèãªéä´éà¾Õ§á¤èµÓá˹觷Õèź¢éͤÇÒÁÍÍ¡à·èÒ¹Ñé¹ áµè¨Ð +ãªé¡ÑºµÓá˹è§ã´¡çä´é C-y à»ç¹¤ÓÊÑè§ÊÓËÃѺá·Ã¡¢éͤÇÒÁ·Õèà¡çºäÇé ŧ㹵Óá˹觷ÕèÁÕà¤ÍÃìà«ÍÃìÍÂÙè +àÃÒÊÒÁÒöãªé¤ÇÒÁÊÒÁÒö¹Õé㹡ÒÃà¤Å×è͹ÂéÒ¢éͤÇÒÁä´é - ,T$S0JQh1'JSK0CQ1:!RCE:0AU1M0BYh1JM'a::0$W1M(B ,T$S0JQh1'(B "Delete" 0,T!Q1:(B ,T$S0JQh1'(B "Kill" ,T$S0JQh1'(B "Kill" -,T(P`0!g1:0Jh1G9E:MM!d0Gi1(B ,Ta05h1$S0JQh1'(B "Delete" ,T(Pd0Ah1`0!g1:(B ,Ta05h106i1RKR!c0*i1$S0JQh1'09Ui1KERB(B ,Tf(B ,T$0CQi1'(B 0,T!g1(P`0!g1:(B -0,TJh1G907Uh1E:MM!d0Gi1c0Ki1(B + ¤ÓÊÑè§ÊÓËÃѺ¡ÒÃźÁÕÍÂÙèÊͧẺ¤×Í ¤ÓÊÑè§ "Delete" ¡Ñº ¤ÓÊÑè§ "Kill" ¤ÓÊÑè§ "Kill" +¨Ðà¡çºÊèǹźÍÍ¡äÇé áµè¤ÓÊÑè§ "Delete" ¨ÐäÁèà¡çº áµè¶éÒËÒ¡ãªé¤ÓÊÑ觹ÕéËÅÒÂ æ ¤ÃÑé§ ¡ç¨Ðà¡çº +Êèǹ·ÕèźÍÍ¡äÇéãËé - >> ,Tc0Ki1!4(B C-n 0,TJQ1!JM'JRA$0CQi1'(B ,T`0>Wh1M`0EWh1M9d;0BQ1'07Uh107Uh1`KARPJA:9K09i1R(M(B ,Ta0Ei1GEM'!4(B C-k ,T`0>Wh1M(B - ,TE::CC07Q1409Qi19MM!04Y1(B + >> ãËé¡´ C-n ÊÑ¡ÊͧÊÒÁ¤ÃÑé§ à¾×èÍàÅ×è͹ä»Âѧ·Õè·ÕèàËÁÒÐÊÁº¹Ë¹éÒ¨Í áÅéÇÅͧ¡´ C-k à¾×èÍ + źºÃ÷Ѵ¹Ñé¹ÍÍ¡´Ù - ,T`0AWh1M!4(B C-k ,T$0CQi1'aC!(B 0,T"i1M$GRAc9:CC07Q1409Qi19(P06Y1!E:MM!(B ,TaEP`0AWh1M!40MU1!(B C-k 0,TMU1!$0CQi1'(B ,T:CC07Q14(B -0,T9Qi19`M'07Qi1':CC07Q140!g1(P06Y1!E:MM!d;04i1GB(B ,Ta05h106i1R!SK94(S9G9$0CQi1'c0Ki10!Q1:$S0JQh1'(B C-k 0,T!g1(PKARB06V1'(B ,Tc0Ki1E:(B -,T:CC07Q14MM!(B (0,T7Qi1'`09Wi1MKRaEP05Q1G:CC07Q14(B) ,T`0;g19(S9G9:CC07Q14(B ,T`07h1R0!Q1:(S9G9$0CQi1'07Uh1!SK94(B + àÁ×èÍ¡´ C-k ¤ÃÑé§áá ¢éͤÇÒÁ㹺Ã÷Ѵ¹Ñ鹨ж١źÍÍ¡ áÅÐàÁ×èÍ¡´ÍÕ¡ C-k ÍÕ¡¤ÃÑé§ ºÃ÷Ѵ +¹Ñé¹àͧ·Ñ駺Ã÷Ѵ¡ç¨Ð¶Ù¡ÅºÍÍ¡ä»´éÇ áµè¶éÒ¡Ó˹´¨Ó¹Ç¹¤ÃÑé§ãËé¡Ñº¤ÓÊÑè§ C-k ¡ç¨ÐËÁÒ¶֧ ãËéź +ºÃ÷ѴÍÍ¡ (·Ñé§à¹×éÍËÒáÅеÑǺÃ÷Ѵ) à»ç¹¨Ó¹Ç¹ºÃ÷Ѵ à·èҡѺ¨Ó¹Ç¹¤ÃÑ駷Õè¡Ó˹´ - ,T:CC07Q1407Uh1`0>Th1'E:MM!d;(B ,T(P06Y1!`0!g1:d0Gi1(B ,TaEPJRARC69S!0EQ1:0$W19ARd04i1(B ,Tb4Bc0*i1$S0JQh1'(B C-y + ºÃ÷Ѵ·Õèà¾Ôè§ÅºÍÍ¡ä» ¨Ð¶Ù¡à¡çºäÇé áÅÐÊÒÁÒö¹Ó¡ÅѺ¤×¹ÁÒä´é â´Âãªé¤ÓÊÑè§ C-y - >> ,TEM'!4(B C-y 0,T4Y1(B + >> Åͧ¡´ C-y ´Ù - 0,T"i1M$GRA07Uh106Y1!E:MM!(B ,Tb4B!RC!4(B C-k ,TKERB(B ,Tf(B ,T$0CQi1'(B ,T(P06Y1!`0!g1:CG:CGAd0Gi1(B ,TaEPJRARC69S(B -,T!0EQ1:AR07Qi1'KA4d04i1c9$0CQi1'`04U1BG(B ,Tb4B!RC!4(B C-y + ¢éͤÇÒÁ·Õè¶Ù¡ÅºÍÍ¡ â´Â¡Òá´ C-k ËÅÒÂ æ ¤ÃÑé§ ¨Ð¶Ù¡à¡çºÃǺÃÇÁäÇé áÅÐÊÒÁÒö¹Ó +¡ÅѺÁÒ·Ñé§ËÁ´ä´é㹤ÃÑé§à´ÕÂÇ â´Â¡Òá´ C-y - >> ,TEM'!4(B C-k 0,T4Y1KERB(B ,Tf(B ,T$0CQi1'(B + >> Åͧ¡´ C-k ´ÙËÅÒÂ æ ¤ÃÑé§ - >> ,T$S0JQh1'JSK0CQ1:`0CU1B!0"i1M$GRA!0EQ1:AR(B 0,T$W1M(B C-y 0,T!h1M90MWh19c0Ki1`0EWh1M9`$M0Cl1`+M0Cl1E'd;0"i1R'0Eh1R'(B - 0,TJQ1!JM'JRA:CC07Q14(B ,Ta0Ei1GEM'!4(B C-y 0,T4Y1(B 0,T!g1(PJRARC60$Q14EM!(B (copy) 0,T"i1M$GRAd04i1(B + >> ¤ÓÊÑè§ÊÓËÃѺàÃÕ¡¢éͤÇÒÁ¡ÅѺÁÒ ¤×Í C-y ¡è͹Í×è¹ãËéàÅ×è͹à¤ÍÃìà«ÍÃìŧ仢éÒ§ÅèÒ§ + ÊÑ¡ÊͧÊÒÁºÃ÷Ѵ áÅéÇÅͧ¡´ C-y ´Ù ¡ç¨ÐÊÒÁÒö¤Ñ´ÅÍ¡ (copy) ¢éͤÇÒÁä´é - 0,T6i1R5M909Ui1`0!g1:0"i1M$GRAMPdC:R'M0Bh1R'd0Gi1(B ,Ta0Ei1GE:0"i1M$GRA0MWh19`0>Th1A`0"i1Rd;0MU1!(B ,T(P`0!T14MPdC0"Vi19(B -,T08l10$W1M(B C-y ,T(P`0CU1B!0$W19d04i1a0$h1`0>U1B'0"i1M$GRA07Uh1E:MM!$0CQi1'0Eh1R0JX14`07h1R09Qi19(B + ¶éҵ͹¹Õéà¡çº¢éͤÇÒÁÍÐäúҧÍÂèÒ§äÇé áÅéÇź¢éͤÇÒÁÍ×è¹à¾ÔèÁà¢éÒä»ÍÕ¡ ¨Ðà¡Ô´ÍÐäâÖé¹ +¼ÅÅѾ¸ì¤×Í C-y ¨ÐàÃÕ¡¤×¹ä´éá¤èà¾Õ§¢éͤÇÒÁ·ÕèźÍÍ¡¤ÃÑé§ÅèÒÊØ´à·èÒ¹Ñé¹ - >> ,TEM'E::CC07Q1404Y1K09Vh1':CC07Q14(B ,Ta0Ei1G`0EWh1M9`$M0Cl1`+M0Cl1d;07Uh10MWh19(B ,Ta0Ei1GE::CC07Q14MM!04Y10MU1!K09Vh1'(B - ,T:CC07Q14(B ,TEM'!4(B C-y 0,T4Y1(B ,Ta0Ei1G0JQ1'`!504Y10Gh1R(Pd04i1a0$h1`0>U1B':CC07Q1407Uh1JM'0$W19`07h1R09Qi19(B + >> ÅͧźºÃ÷Ѵ´Ù˹Ö觺Ã÷Ѵ áÅéÇàÅ×è͹à¤ÍÃìà«ÍÃìä»·ÕèÍ×è¹ áÅéÇźºÃ÷ѴÍÍ¡´ÙÍա˹Öè§ + ºÃ÷Ѵ Åͧ¡´ C-y ´Ù áÅéÇÊѧࡵ´ÙÇèÒ¨Ðä´éá¤èà¾Õ§ºÃ÷Ѵ·ÕèÊͧ¤×¹à·èÒ¹Ñé¹ -,T!RC0MQ1904Y1(B (UNDO) +¡ÒÃÍѹ´Ù (UNDO) ============= - ,T`GER07Uh1a0!i1d"0"i1M$GRA:R'M0Bh1R'(B ,Ta0Ei1G05i1M'!RC(P`;0EUh1B9!0EQ1:c0Ki1`0;g19M0Bh1R'`04T1A(B 0,T!g1JRARC67Sd04i107X1!(B -,T`0AWh1M04i1GB$S0JQh1'(B C-x u ,Tb4B;!05T1(B ,T(Pc0*i1JSK0CQ1:B!`0ET1!$S0JQh1'(B 0,T7Uh10;i1M9`0"i1Rd;b4Bd0Ah105Qi1'c((B ,TJRARC6c0*i1(B -,T$S0JQh1'09Ui10!Uh1$0CQi1'0!g1d04i15RA05i1M'!RC(B + àÇÅÒ·Õèá¡é䢢éͤÇÒÁºÒ§ÍÂèÒ§ áÅéǵéͧ¡ÒèÐà»ÅÕ蹡ÅѺãËéà»ç¹ÍÂèÒ§à´ÔÁ ¡çÊÒÁÒö·Óä´é·Ø¡ +àÁ×èÍ´éǤÓÊÑè§ C-x u â´Â»¡µÔ ¨ÐãªéÊÓËÃѺ¡àÅÔ¡¤ÓÊÑè§ ·Õè»é͹à¢éÒä»â´ÂäÁèµÑé§ã¨ ÊÒÁÒöãªé +¤ÓÊÑ觹Õé¡Õè¤ÃÑ駡çä´éµÒÁµéͧ¡Òà - >> ,TEM'E::CC07Q1409Ui1MM!04Y1(B 0,T4i1GB$S0JQh1'(B C-k ,Ta0Ei1G`0CU1B!!0EQ1:0$W19AR04i1GB(B C-x u + >> ÅͧźºÃ÷Ѵ¹ÕéÍÍ¡´Ù ´éǤÓÊÑè§ C-k áÅéÇàÃÕ¡¡ÅѺ¤×¹ÁÒ´éÇ C-x u - ,T$S0JQh1'(B C-_ 0,T!g1`0;g19$S0JQh1'0MQ1904Y10MU1!0MQ19K09Vh1'(B ,T$GRAJRARC6`K0AW1M90!Q1:$S0JQh1'(B C-x u + ¤ÓÊÑè§ C-_ ¡çà»ç¹¤ÓÊÑè§Íѹ´ÙÍÕ¡Íѹ˹Öè§ ¤ÇÒÁÊÒÁÒöàËÁ×͹¡Ñº¤ÓÊÑè§ C-x u - ,TJRARC6!SK94(S9G9$0CQi1'c0Ki1$S0JQh1'(B C-_ ,TaEP(B C-x u ,Td04i1(B + ÊÒÁÒö¡Ó˹´¨Ó¹Ç¹¤ÃÑé§ãËé¤ÓÊÑè§ C-_ áÅÐ C-x u ä´é -,Ta0?i1A0"i1M0AY1E(B (File) +á¿éÁ¢éÍÁÙÅ (File) ============== - ,T`CR(S`0;g1905i1M'`0!g1:0CQ1!IR(B (save) 0,T"i1M$GRA07Uh1a0!i1d"d0Gi1c9a0?i1A0"i1M0AY1E(B 0,T6i1R05i1M'!RC(Pc0Ki10JTh1'07Uh1(B -,Ta0!i1d"`;0EUh1B9d;M0Bh1R'6RGC(B ,Td0Ah1`0*h1909Qi19(B 0,TJTh1'07Uh1a0!i1d"d;0!g1(PKRBd;(B 0,T7Q1907U107Uh1`0ET1!!RCc0*i1(B Emacs + àÃÒ¨Óà»ç¹µéͧà¡çºÃÑ¡ÉÒ (save) ¢éͤÇÒÁ·Õèá¡éä¢äÇéã¹á¿éÁ¢éÍÁÙÅ ¶éÒµéͧ¡ÒèÐãËéÊÔ觷Õè +á¡éä¢à»ÅÕè¹ä»ÍÂèÒ§¶ÒÇà äÁèàªè¹¹Ñé¹ ÊÔ觷Õèá¡éä¢ä»¡ç¨ÐËÒÂä» ·Ñ¹·Õ·ÕèàÅÔ¡¡ÒÃãªé Emacs - ,Ta0?i1A0"i1M0AY1E07Uh1AM'`0Kg19M0BYh1(B 0,T$W1M0JTh1'07Uh10:Q1907V1!0JTh1'07Uh1!S0EQ1'a0!i1d"M0BYh1(B ,TK0CW1M0>Y140'h1RB(B ,Tf(B 0,T!g10$W1Ma0?i1A0"i1M0AY1E07Uh1AM'`0Kg19(B -,TM0BYh10$W1M05Q1Ga0?i1A0"i1M0AY1E07Uh1!S0EQ1'a0!i1d"M0BYh1(B + á¿éÁ¢éÍÁÙÅ·ÕèÁͧàËç¹ÍÂÙè ¤×ÍÊÔ觷ÕèºÑ¹·Ö¡ÊÔ觷Õè¡ÓÅѧá¡éä¢ÍÂÙè ËÃ×;ٴ§èÒÂ æ ¡ç¤×Íá¿éÁ¢éÍÁÙÅ·ÕèÁͧàËç¹ +ÍÂÙè¤×͵ÑÇá¿éÁ¢éÍÁÙÅ·Õè¡ÓÅѧá¡éä¢ÍÂÙè - ,Ta05h1(9!0Gh1Ra0?i1A0"i1M0AY1E(P06Y1!`0!g1:0CQ1!IR(B (save) ,TE'd;(B ,Ta0?i1A0"i1M0AY1E07Uh106Y1!a0!i1d"M0BYh1(B ,T(Pd0Ah106Y1!`0"U1B907Q1:(B -,TE'd;M0Bh1R'`04g14"R4(B 0,TMQ1909Ui1`0>Wh1M`0;g19!RC0;i1M'0!Q19!RC`0"U1B907Q1:a0?i1A0"i1M0AY1E07Uh1a0!i1d"d;a::$0CVh1'(B ,Tf(B ,T!ER'(B ,Tf(B -,Tb4Bd0Ah1d04i105Qi1'c((B + áµè¨¹¡ÇèÒá¿éÁ¢éÍÁÙŨж١à¡çºÃÑ¡ÉÒ (save) Å§ä» á¿éÁ¢éÍÁÙÅ·Õè¶Ù¡á¡éä¢ÍÂÙè ¨ÐäÁè¶Ù¡à¢Õ¹·Ñº +ŧä»ÍÂèÒ§à´ç´¢Ò´ Íѹ¹Õéà¾×èÍà»ç¹¡Òûéͧ¡Ñ¹¡ÒÃà¢Õ¹·Ñºá¿éÁ¢éÍÁÙÅ·Õèá¡éä¢ä»áºº¤ÃÖè§ æ ¡ÅÒ§ æ +â´ÂäÁèä´éµÑé§ã¨ - ,T9M!(R!09Ui1(B ,T`0>Wh1M`0;g19!RC0;i1M'0!Q19!RC`0!g1:0CQ1!IR(B (save) 0,TJTh1'07Uh1a0!i1d"0Th1A`05T1A`0!Uh1BG0!Q1::CC07Q14bKA4(B (mode line) ,Tc95M9K0EQ1'(B +ËÁÒÂà˵Ø: ¨ÐÁÕ¤Ó͸ԺÒÂà¾ÔèÁàµÔÁà¡ÕèÂǡѺºÃ÷ѴâËÁ´ (mode line) 㹵͹ËÅѧ - ,T$S0JQh1'c0Ki1KRa0?i1A0"i1M0AY1E(B ,TaEP$S0JQh1'c0Ki1`0!g1:0CQ1!IRa0?i1A0"i1M0AY1E(B 0,TAU10EQ1!I3Pa5!05h1R'(R!$S0JQh1'07Uh10 + áÅéÇ Emacs ¨Ð¶ÒÁª×èͧ͢á¿éÁ¢éÍÁÙÅ â´Â»ÃÒ¡¯¢Öé¹·ÕèÊèǹÅèÒ§¢Í§¨Í àÃÒàÃÕ¡Êèǹ·ÕèãËé»é͹ +ª×èÍá¿éÁ¢éÍÁÙŹÑé¹ÇèÒ ÁԹԺѿà¿ÍÃì (mini buffer) ÁԹԺѿà¿ÍÃì¨Ð¶Ù¡ãªé§Ò¹ã¹ÅѡɳйÕé ÁԹԺѿà¿ÍÃì +¨ÐËÁ´Ë¹éÒ·ÕèáÅÐËÒÂä» ËÅѧ¨Ò¡·Õè»é͹ª×èÍá¿éÁ¢éÍÁÙÅ áÅéÇ¡´»ØèÁ - >> ,TEM'!4(B C-x C-f ,Ta0Ei1G5RA04i1GB(B C-g 0,T4Y1(B ,T`0;g19!RC0JQh1'B!`0ET1!`09Wi1MKRc90AT109T10:Q1?`?M0Cl1(B ,TK0CW1M(B - ,TB!`0ET1!$S0JQh1'(B C-x C-f 0,T4Q1'09Qi19(B Emacs ,T(Pd0Ah10$i19KRa0?i1A0"i1M0AY1Ec4(B ,Tf(B + >> Åͧ¡´ C-x C-f áÅéǵÒÁ´éÇ C-g ´Ù à»ç¹¡ÒÃÊÑè§Â¡àÅÔ¡à¹×éÍËÒã¹ÁԹԺѿà¿ÍÃì ËÃ×Í + ¡àÅÔ¡¤ÓÊÑè§ C-x C-f ´Ñ§¹Ñé¹ Emacs ¨ÐäÁè¤é¹ËÒá¿éÁ¢éÍÁÙÅã´ æ - ,T$CRG09Ui1(B ,TAREM'`0!g1:0CQ1!IRa0?i1A0"i1M0AY1E04Y1(B ,T`GER07Uh105i1M'!RC`0!g1:0CQ1!IR0JTh1'07Uh1a0!i1d"AR(906V1'5M909Ui1(B 0,T!g1c0Ki1c0*i1(B -,T$S0JQh1'04Q1'09Ui1(B + ¤ÃÒǹÕé ÁÒÅͧà¡çºÃÑ¡ÉÒá¿éÁ¢éÍÁÙÅ´Ù àÇÅÒ·Õèµéͧ¡ÒÃà¡çºÃÑ¡ÉÒÊÔ觷Õèá¡éä¢ÁÒ¨¹¶Ö§µÍ¹¹Õé ¡çãËéãªé +¤ÓÊÑ觴ѧ¹Õé - C-x C-s ,T`0!g1:0CQ1!IR(B (save) ,Ta0?i1A0"i1M0AY1E(B + C-x C-s à¡çºÃÑ¡ÉÒ (save) á¿éÁ¢éÍÁÙÅ - ,Ta0Ei1G`09Wi1MKR07Uh1M0BYh1c9(B Emacs 0,T!g1(P06Y1!`0"U1B9E'd;07Uh1a0?i1A0"i1M0AY1E(B ,T`GER`0!g1:0CQ1!IRa0?i1A0"i1M0AY1E(B ,Ta0?i1A0"i1M0AY1E(B -0,T5i19)0:Q1:(Pd0Ah10JY1-KRBd;(B ,Ta05h1(P06Y1!`0!g1:d0Gi1c90*Wh1McK0Ah1(B 0,T+Vh1'd04i1AR(R!0*Wh1M`0!h1R07Uh105h1M07i1RB04i1GB(B '~' + áÅéÇà¹×éÍËÒ·ÕèÍÂÙèã¹ Emacs ¡ç¨Ð¶Ù¡à¢Õ¹ŧ价Õèá¿éÁ¢éÍÁÙÅ àÇÅÒà¡çºÃÑ¡ÉÒá¿éÁ¢éÍÁÙÅ á¿éÁ¢éÍÁÙÅ +µé¹©ºÑº¨ÐäÁèÊÙ­ËÒÂä» áµè¨Ð¶Ù¡à¡çºäÇé㹪×èÍãËÁè «Öè§ä´éÁÒ¨Ò¡ª×èÍà¡èÒ·ÕèµèÍ·éÒ´éÇ '~' - ,TK0EQ1'(R!07Uh1`0!g1:0CQ1!IRa0?i1A0"i1M0AY1E`J0Cg1(a0Ei1G(B Emacs 0,T!g1(PaJ4'0*Wh1Ma0?i1A0"i1M0AY1E07Uh1`0!g1:c0Ki104Y1(B + ËÅѧ¨Ò¡·Õèà¡çºÃÑ¡ÉÒá¿éÁ¢éÍÁÙÅàÊÃç¨áÅéÇ Emacs ¡ç¨ÐáÊ´§ª×èÍá¿éÁ¢éÍÁÙÅ·Õèà¡çºãËé´Ù - >> ,TEM'!4(B C-x C-x ,T`0>Wh1M`0!g1:0CQ1!IRJS`9R"M'(B Tutorial 0,T9Ui104Y1(B 0,T!g1(P`0Kg190Gh1R(B 0,T7Uh10Jh1G90Eh1R'(B - ,T"M'(M(B 0,TAU10"i1M$GRA0Gh1R(B "Wrote ...../TUTORIAL.th" ,T;CR!/0"Vi19(B + >> Åͧ¡´ C-x C-x à¾×èÍà¡çºÃÑ¡ÉÒÊÓà¹Ò¢Í§ Tutorial ¹Õé´Ù ¡ç¨ÐàËç¹ÇèÒ ·ÕèÊèǹÅèÒ§ + ¢Í§¨Í ÁÕ¢éͤÇÒÁÇèÒ "Wrote ...../TUTORIAL.th" »ÃÒ¡¯¢Öé¹ - ,T`GER07Uh1(PJ0Ci1R'a0?i1A0"i1M0AY1EcK0Ah1(B 0,T!g1c0Ki17SCRG0!Q1:0Gh1R(P0$i19KR(B (find-file) ,Ta0?i1A0"i1M0AY1E`0!h1R0+Vh1'0AU1(B -,TM0BYh10!h1M9K09i1R09Ui1a0Ei1G(B ,Ta0Ei1G0>T1A0>l10"i1M$GRAE'd;c9a0?i1A0"i1M0AY1E07Uh1KR`(M(B + àÇÅÒ·Õè¨ÐÊÃéÒ§á¿éÁ¢éÍÁÙÅãËÁè ¡çãËé·ÓÃÒǡѺÇèҨФé¹ËÒ (find-file) á¿éÁ¢éÍÁÙÅà¡èÒ«Öè§ÁÕ +ÍÂÙè¡è͹˹éÒ¹ÕéáÅéÇ áÅéǾÔÁ¾ì¢éͤÇÒÁŧä»ã¹á¿éÁ¢éÍÁÙÅ·ÕèËÒà¨Í - ,TaEP`GER07Uh10JQh1'`0!g1:0CQ1!IRa0?i1A0"i1M0AY1E`07h1R09Qi19(B 0,T$W1M5M907Uh1(B Emacs ,T(P`0!g1:`09Wi1MKR07Uh1a0!i1d"AR07Qi1'KA4(B ,TE'(B -,Tc9a0?i1A0"i1M0AY1E`0;g19$0CQi1'aC!(B + áÅÐàÇÅÒ·ÕèÊÑè§à¡çºÃÑ¡ÉÒá¿éÁ¢éÍÁÙÅà·èÒ¹Ñé¹ ¤×͵͹·Õè Emacs ¨Ðà¡çºà¹×éÍËÒ·Õèá¡éä¢ÁÒ·Ñé§ËÁ´ ŧ +ã¹á¿éÁ¢éÍÁÙÅà»ç¹¤ÃÑé§áá -0,T:Q1?`?M0Cl1(B (Buffer) +ºÑ¿à¿ÍÃì (Buffer) =============== - 0,T6i1RKR!0JQh1'c0Ki1KRa0?i1A0"i1M0AY1E0MQ1907Uh1JM'(B 0,T4i1GB$S0JQh1'(B C-x C-f ,T`09Wi1MKR"M'a0?i1A0"i1M0AY1EaC!(B 0,T!g1(P0BQ1'$'(B -0,T6Y1!`0!g1:0CQ1!IRM0BYh1c9(B Emacs 0,TJTh1'07Uh1`0!g1:0CQ1!IRa0?i1A0"i1M0AY1E07Uh10Mh1R9`0"i1RAR(B 0,T+Vh1'M0BYh1@RBc9(B Emacs ,T`0CU1B!0Gh1R(B -0,T:Q1?`?M0Cl1(B (Buffer) ,T`GER07Uh10Mh1R9a0?i1A0"i1M0AY1EcK0Ah1`0"i1RAR(B Emacs 0,T!g1(PJ0Ci1R'0:Q1?`?M0Cl1cK0Ah1(B 0,T"Vi19AR@RBc9(B + ¶éÒËÒ¡ÊÑè§ãËéËÒá¿éÁ¢éÍÁÙÅÍѹ·ÕèÊͧ ´éǤÓÊÑè§ C-x C-f à¹×éÍËҢͧá¿éÁ¢éÍÁÙÅáá ¡ç¨ÐÂѧ¤§ +¶Ù¡à¡çºÃÑ¡ÉÒÍÂÙèã¹ Emacs ÊÔ觷Õèà¡çºÃÑ¡ÉÒá¿éÁ¢éÍÁÙÅ·ÕèÍèÒ¹à¢éÒÁÒ «Öè§ÍÂÙèÀÒÂã¹ Emacs àÃÕ¡ÇèÒ +ºÑ¿à¿ÍÃì (Buffer) àÇÅÒ·ÕèÍèÒ¹á¿éÁ¢éÍÁÙÅãËÁèà¢éÒÁÒ Emacs ¡ç¨ÐÊÃéÒ§ºÑ¿à¿ÍÃìãËÁè ¢Öé¹ÁÒÀÒÂã¹ - 0,T6i1R05i1M'!RC(P04Y1CRB!RC"M'0:Q1?`?M0Cl1(B 0,T7Uh106Y1!`0!g1:0CQ1!IRM0BYh1@RBc9(B Emacs 0,T!g1c0Ki1!4$S0JQh1'(B + ¶éÒµéͧ¡ÒèдÙÃÒ¡ÒâͧºÑ¿à¿ÍÃì ·Õè¶Ù¡à¡çºÃÑ¡ÉÒÍÂÙèÀÒÂã¹ Emacs ¡çãËé¡´¤ÓÊÑè§ C-x C-b - >> ,TEM'!4(B C-x C-b 0,T4Y1(B 0,TJQ1'`!504Y10Gh1Ra05h1EP0:Q1?`?M0Cl10AU10*Wh1M0Gh1RMPdC(B ,TaEP06Y1!05Qi1'0*Wh1Md0Gi10Gh1R(B - ,TM0Bh1R'dC(B ,Tc9(B Emacs + >> Åͧ¡´ C-x C-b ´Ù Êѧࡵ´ÙÇèÒáµèÅкѿà¿ÍÃìÁÕª×èÍÇèÒÍÐäà áÅж١µÑ駪×èÍäÇéÇèÒ + ÍÂèÒ§äà 㹠Emacs - 0,TAU1:R'0:Q1?`?M0Cl1(B 0,T7Uh1d0Ah10AU10$Yh10!Q1:a0?i1A0"i1M0AY1E(0CT1'(B ,Tf(B 0,T5Q1GM0Bh1R'`0*h19(B ,Td0Ah10AU1a0?i1A0"i1M0AY1E07Uh10AU10*Wh1M0Gh1R(B "*Buffer -List*" ,TM0BYh1(0CT1'(B ,Tf(B ,Ta05h1`0;g190:Q1?`?M0Cl107Uh1J0Ci1R'0"Vi19AR`0>Wh1MaJ4'CRB!RC0:Q1?`?M0Cl1(B ,Tb4B$S0JQh1'(B C-x C-b + ÁÕºÒ§ºÑ¿à¿ÍÃì ·ÕèäÁèÁÕ¤Ùè¡Ñºá¿éÁ¢éÍÁÙŨÃÔ§ æ µÑÇÍÂèÒ§àªè¹ äÁèÁÕá¿éÁ¢éÍÁÙÅ·ÕèÁÕª×èÍÇèÒ "*Buffer +List*" ÍÂÙè¨ÃÔ§ æ áµèà»ç¹ºÑ¿à¿ÍÃì·ÕèÊÃéÒ§¢Öé¹ÁÒà¾×èÍáÊ´§ÃÒ¡Òúѿà¿ÍÃì â´Â¤ÓÊÑè§ C-x C-b - 0,T"i1M$GRA07X1!0"i1M$GRA07Uh1;CR!/M0BYh1c90GT19b40Gl1"M'(B Emacs 0,T9Qi19(B ,T(PM0BYh1c90:Q1?`?M0Cl1c40:Q1?`?M0Cl1K09Vh1'`JAM(B + ¢éͤÇÒÁ·Ø¡¢éͤÇÒÁ·Õè»ÃÒ¡¯ÍÂÙèã¹ÇÔ¹â´Çì¢Í§ Emacs ¹Ñé¹ ¨ÐÍÂÙè㹺ѿà¿ÍÃì㴺ѿà¿ÍÃì˹Öè§àÊÁÍ - >> ,TEM'!4(B C-x 1 ,T`0>Wh1ME:CRB!RC0:Q1?`?M0Cl1MM!04Y1(B + >> Åͧ¡´ C-x 1 à¾×èÍźÃÒ¡Òúѿà¿ÍÃìÍÍ¡´Ù - ,T!RC`0CU1B!a0?i1A0"i1M0AY1E0MWh190"Vi19ARa0!i1d"(B ,T5M907Uh1!S0EQ1'a0!i1d"a0?i1A0"i1M0AY1EK09Vh1'M0BYh109Qi19(B ,T(Pd0Ah17Sc0Ki1a0?i1A0"i1M0AY1E(B -,TaC!06Y1!`0!g1:0CQ1!IR(B 0,TJTh1'07Uh1a0!i1d"d;c9a0?i1A0"i1M0AY1EaC!(P06Y1!0:Q1907V1!d0Gi1c90:Q1?`?M0Cl1"M'a0?i1A0"i1M0AY1E09Qi19(B ,T`07h1R09Qi19(B + ¡ÒÃàÃÕ¡á¿éÁ¢éÍÁÙÅÍ×è¹¢Öé¹ÁÒá¡éä¢ µÍ¹·Õè¡ÓÅѧá¡éä¢á¿éÁ¢éÍÁÙÅ˹Öè§ÍÂÙè¹Ñé¹ ¨ÐäÁè·ÓãËéá¿éÁ¢éÍÁÙÅ +áá¶Ù¡à¡çºÃÑ¡ÉÒ ÊÔ觷Õèá¡éä¢ä»ã¹á¿éÁ¢éÍÁÙÅáá¨Ð¶Ù¡ºÑ¹·Ö¡äÇé㹺ѿà¿ÍÃì¢Í§á¿éÁ¢éÍÁÙŹÑé¹ à·èÒ¹Ñé¹ - ,T!RCJ0Ci1R'0:Q1?`?M0Cl1cK0Ah10"Vi19(B ,TJSK0CQ1:a0!i1d"a0?i1A0"i1M0AY1E0MQ1907Uh1JM'(B ,Ta0Ei1Ga0!i1MPdC:R'M0Bh1R'c90:Q1?`?M0Cl109Qi19(B -,T(Pd0Ah10AU1Wh1M(B -,Ta0!i1d"c95M9K0EQ1'(B + ¡ÒÃÊÃéÒ§ºÑ¿à¿ÍÃìãËÁè¢Öé¹ ÊÓËÃѺá¡éä¢á¿éÁ¢éÍÁÙÅÍѹ·ÕèÊͧ áÅéÇá¡éÍÐäúҧÍÂèҧ㹺ѿà¿ÍÃì¹Ñé¹ +¨ÐäÁèÁÕ¼Åã´ æ µèͺѿà¿ÍÃì¢Í§á¿éÁ¢éÍÁÙÅÍѹ·Õè˹Ö觷Ñé§ÊÔé¹ ¨Ø´¹Õé·ÓãËéÊÒÁÒöà¡çºá¿éÁ¢éÍÁÙÅááäÇéà¾×èÍ +á¡éä¢ã¹µÍ¹ËÅѧ - ,Ta05h1`GER07Uh105i1M'!RC(P`0!g1:0CQ1!IR(B (save) 0,T:Q1?`?M0Cl1E'd;c9a0?i1A0"i1M0AY1E(B 0,T4i1GB$S0JQh1'(B C-x C-s 0,T9Qi19(B -,T(P05i1M'J0GT170+l1d;0BQ1'0:Q1?`?M0Cl107Uh105i1M'!RC(P`0!g1:(B 0,T4i1GB$S0JQh1'(B C-x C-f 0,T+Vh1'0$h1M90"i1R'0BXh1'BR!(B ,T`CR0AU1$S0JQh1'0+Vh1'(B -,Tc0*i1JSK0CQ1:!RC09Ui1b4B`)>RP(B 0,T$W1M(B + áµèàÇÅÒ·Õèµéͧ¡ÒèÐà¡çºÃÑ¡ÉÒ (save) ºÑ¿à¿ÍÃìŧä»ã¹á¿éÁ¢éÍÁÙÅ ´éǤÓÊÑè§ C-x C-s ¹Ñé¹ +¨ÐµéͧÊÇÔ·«ìä»ÂѧºÑ¿à¿ÍÃì·Õèµéͧ¡ÒèÐà¡çº ´éǤÓÊÑè§ C-x C-f «Ö觤è͹¢éÒ§ÂØè§ÂÒ¡ àÃÒÁÕ¤ÓÊÑ觫Öè§ +ãªéÊÓËÃѺ¡ÒùÕéâ´Â੾ÒÐ ¤×Í - C-x s ,T`0!g1:0CQ1!IR(B (save) 0,T7X1!0:Q1?`?M0Cl107Uh10AU1M0BYh1(B + C-x s à¡çºÃÑ¡ÉÒ (save) ·Ø¡ºÑ¿à¿ÍÃì·ÕèÁÕÍÂÙè - C-x s ,T(P`0!g1:0CQ1!IR07X1!0:Q1?`?M0Cl107Uh106Y1!a0!i1d"`09Wi1MKRd;(B ,TE'c9a0?i1A0"i1M0AY1E(B ,Tb4B(P6RA0!h1M90Gh1R(Pc0Ki1(B -,T`0!g1:0:Q1?`?M0Cl109Ui1dKA(B y ,TK0CW1M(B n 0,T!Q1:0:Q1?`?M0Cl1a05h1EP0:Q1?`?M0Cl1(B ,T$S6RA(P;CR!/c90Jh1G90Eh1R'"M'K09i1R(M(B 0,T4Q1'(B -0,T5Q1GM0Bh1R'09Ui1(B + C-x s ¨Ðà¡çºÃÑ¡ÉÒ·Ø¡ºÑ¿à¿ÍÃì·Õè¶Ù¡á¡éä¢à¹×éÍËÒä» Å§ã¹á¿éÁ¢éÍÁÙÅ â´Â¨Ð¶ÒÁ¡è͹ÇèÒ¨ÐãËé +à¡çººÑ¿à¿ÍÃì¹ÕéäËÁ y ËÃ×Í n ¡ÑººÑ¿à¿ÍÃìáµèÅкѿà¿ÍÃì ¤Ó¶ÒÁ¨Ð»ÃÒ¡¯ã¹ÊèǹÅèÒ§¢Í§Ë¹éÒ¨Í ´Ñ§ +µÑÇÍÂèÒ§¹Õé Save file /usr/private/yours/TUTORIAL.th? (y or n) -,T!RC"BRB$S0JQh1'(B (extension) +¡ÒâÂÒ¤ÓÊÑè§ (extension) ======================= - ,Tc9b;Ca!CA(B Editor 0,T9Ui1(B 0,TAU1(S9G9$S0JQh1'AR!!0Gh1R(B ,T(S9G9$S0JQh1'0+Vh1'JRARC6!4d04i1b4B0;Xh1A$M9b7CE(B -,TK0CW1M0;Xh1A(B META ,Td04i1KA4(B ,T$S0JQh1'"BRB(B (eXtend) 0,TAU1d0Gi1`0>Wh1Mc0Ki1JRARC6c0*i1$S0JQh1'`K0Eh1R09Ui1d04i1KA4(B 0,TAU1M0BYh1(B 2 -,Ta::(B 0,T4Q1'09Ui1(B + ã¹â»Ãá¡ÃÁ Editor ¹Õé Áըӹǹ¤ÓÊÑè§ÁÒ¡¡ÇèÒ ¨Ó¹Ç¹¤ÓÊÑ觫Öè§ÊÒÁÒö¡´ä´éâ´Â»ØèÁ¤Í¹â·ÃÅ +ËÃ×Í»ØèÁ META ä´éËÁ´ ¤ÓÊÑ觢ÂÒ (eXtend) ÁÕäÇéà¾×èÍãËéÊÒÁÒöãªé¤ÓÊÑè§àËÅèÒ¹Õéä´éËÁ´ ÁÕÍÂÙè 2 +Ẻ ´Ñ§¹Õé - C-x ,T"BRB`0>Th1A04i1GB05Q1G0MQ1!IC(B ,TJSK0CQ1:!405Q1G0MQ1!IC5RA`0"i1Rd;(B 1 0,T5Q1G(B - ESC x ,T"BRB`0>Th1A04i1GB0*Wh1M$S0JQh1'(B ,TJSK0CQ1:!40*Wh1M$S0JQh1'5RA`0"i1Rd;07Qi1'KA4(B + C-x ¢ÂÒÂà¾ÔèÁ´éǵÑÇÍÑ¡Éà ÊÓËÃѺ¡´µÑÇÍÑ¡ÉõÒÁà¢éÒä» 1 µÑÇ + ESC x ¢ÂÒÂà¾ÔèÁ´éǪ×èͤÓÊÑè§ ÊÓËÃѺ¡´ª×èͤÓÊÑ觵ÒÁà¢éÒä»·Ñé§ËÁ´ - ,T$S0JQh1';CP`@709Ui1(B 0,T!g1`0;g19$S0JQh1'07Uh10AU1;CPbB*09l1(B ,Ta05h10Jh1G9cK0-h1(P06Y1!`0CU1B!c0*i1(B 0,T9i1MB$0CQi1'!0Gh1R$S0JQh1'07Qh1Gd;(B -0,T5Q1GM0Bh1R'`0*h19(B ,T$S0JQh1'KRa0?i1A0"i1M0AY1E(B (find) C-x C-f ,T$S0JQh1'`0!g1:0CQ1!IRa0?i1A0"i1M0AY1E(B (save) C-x C-s -,T$S0JQh1'(B C-x C-c (,T`0ET1!(B Editor) 0,T5h1R'0!g1`0;g19K09Vh1'c9$S0JQh1'`K0Eh1R09Ui1(B + ¤ÓÊÑ觻ÃÐàÀ·¹Õé ¡çà»ç¹¤ÓÊÑ觷ÕèÁÕ»ÃÐ⪹ì áµèÊèǹãË­è¨Ð¶Ù¡àÃÕ¡ãªé ¹éͤÃÑ駡ÇèÒ¤ÓÊÑ觷ÑèÇä» +µÑÇÍÂèÒ§àªè¹ ¤ÓÊÑè§ËÒá¿éÁ¢éÍÁÙÅ (find) C-x C-f ¤ÓÊÑè§à¡çºÃÑ¡ÉÒá¿éÁ¢éÍÁÙÅ (save) C-x C-s +¤ÓÊÑè§ C-x C-c (àÅÔ¡ Editor) µèÒ§¡çà»ç¹Ë¹Öè§ã¹¤ÓÊÑè§àËÅèÒ¹Õé - ,T$S0JQh1'(B C-z ,T`0;g19$S0JQh1'07Uh1c0*i1c9c9!RCMM!(R!(B Emacs 0,T$h1M90"i1R'0:h1MB(B ,T$S0JQh1'09Ui1(Pd0Ah1B!`0ET1!(B -Emacs ,T`EB07U1`04U1BG(B ,Ta05h1(PK0BX14(B Emacs ,Td0Gi10*Qh1G$CRG(B ,T`0>Wh1Mc0Ki1JRARC6!0EQ1:d;c0*i1(B csh ,Td04i10MU1!(B ,T!RC!4(B -C-z 0,T(V1'`0;g19!RCK0BX14(B Emacs ,Td0Gi10*Qh1G$CRG`07h1R09Qi19(B ,T(Pd0Ah17S$GRA`0JU1BKRBc0Ki10!Q1:`09Wi1MKR07Uh1a0!i1d"d;(B + ¤ÓÊÑè§ C-z à»ç¹¤ÓÊÑ觷Õèãªéã¹ã¹¡ÒÃÍÍ¡¨Ò¡ Emacs ¤è͹¢éÒ§ºèÍ ¤ÓÊÑ觹Õé¨ÐäÁè¡àÅÔ¡ +Emacs àÅ·Õà´ÕÂÇ áµè¨ÐËÂØ´ Emacs äÇéªÑèǤÃÒÇ à¾×èÍãËéÊÒÁÒö¡ÅѺä»ãªé csh ä´éÍÕ¡ ¡Òá´ +C-z ¨Ö§à»ç¹¡ÒÃËÂØ´ Emacs äÇéªÑèǤÃÒÇà·èÒ¹Ñé¹ ¨ÐäÁè·Ó¤ÇÒÁàÊÕÂËÒÂãËé¡Ñºà¹×éÍËÒ·Õèá¡éä¢ä» -,TKARB`K05X1(B: ,Ta05h170Gh1R(B ,Tc9!C03U107Uh1c0*i1:9(B X-window ,TK0CW1Mc0*i1(B sh ,TM0BYh1(B 0,T!g1(Pd0Ah10AU1$GRAJRARC609Ui1(B +ËÁÒÂà˵Ø: áµè·ÇèÒ ã¹¡Ã³Õ·Õèãªéº¹ X-window ËÃ×Íãªé sh ÍÂÙè ¡ç¨ÐäÁèÁÕ¤ÇÒÁÊÒÁÒö¹Õé - ,T$S0JQh1';CP`@7(B C-x 0,TAU1AR!ARBKERB$S0JQh1'(B ,T$S0JQh1'07Uh1M08T1:RBd;a0Ei1G0AU104Q1'09Ui1(B + ¤ÓÊÑ觻ÃÐàÀ· C-x ÁÕÁÒ¡ÁÒÂËÅÒ¤ÓÊÑè§ ¤ÓÊÑ觷Õè͸ԺÒÂä»áÅéÇÁմѧ¹Õé - C-x C-f ,TKRa0?i1A0"i1M0AY1E(B (find) ,TJSK0CQ1:a0!i1d"(B - C-x C-s ,T`0!g1:0CQ1!IRa0?i1A0"i1M0AY1E(B (save) - C-x C-b ,TaJ4'CRB!RC0:Q1?`?M0Cl1(B (buffer list) - C-x C-c ,T`0ET1!!RCc0*i1(B Editor ,TaEP`0!g1:0CQ1!IRa0?i1A0"i1M0AY1Eb4B0MQ15b90AQ105T1(B ,Ta05h106i1RKR!0AU1a0?i1A(B - 0,T"i1M0AY1E:R'0MQ1906Y1!a0!i1d"(B 0,T!g1c0Ki16RA0Gh1R(P`0!g1:0CQ1!IRa0?i1A0"i1M0AY1E09Qi19dKA(B ,Tb4B07Qh1Gd;(B - ,T!RCMM!(R!(B Emacs ,T7Sd04i1b4B$S0JQh1'(B C-x C-s C-x C-c 0,T$W1Mc0Ki1`0!g1:0CQ1!IR(B - 0,T!h1M9a0Ei1G0(V1'`0ET1!(B + C-x C-f ËÒá¿éÁ¢éÍÁÙÅ (find) ÊÓËÃѺá¡éä¢ + C-x C-s à¡çºÃÑ¡ÉÒá¿éÁ¢éÍÁÙÅ (save) + C-x C-b áÊ´§ÃÒ¡Òúѿà¿ÍÃì (buffer list) + C-x C-c àÅÔ¡¡ÒÃãªé Editor áÅÐà¡çºÃÑ¡ÉÒá¿éÁ¢éÍÁÙÅâ´ÂÍѵâ¹ÁÑµÔ áµè¶éÒËÒ¡ÁÕá¿éÁ + ¢éÍÁÙźҧÍѹ¶Ù¡á¡éä¢ ¡çãËé¶ÒÁÇèÒ¨Ðà¡çºÃÑ¡ÉÒá¿éÁ¢éÍÁÙŹÑé¹äËÁ â´Â·ÑèÇä» + ¡ÒÃÍÍ¡¨Ò¡ Emacs ·Óä´éâ´Â¤ÓÊÑè§ C-x C-s C-x C-c ¤×ÍãËéà¡çºÃÑ¡ÉÒ + ¡è͹áÅéǨ֧àÅÔ¡ - ,T$S0JQh1'"BRB`0>Th1Aa::0*Wh1M09Qi19(B ,Tc0*i1JSK0CQ1:$S0JQh1'07Uh1d0Ah10$h1MBd04i1c0*i1(B ,TK0CW1M$S0JQh1'07Uh1c0*i1`)>RP0!Q1:bKA40>T1`HI:R'(B -,TbKA4(B 0,T5Q1GM0Bh1R'`0*h19(B ,T$S0JQh1'(B "command-apropos" 0,T+Vh1'(P6RA(B 0,T$U10Bl1`0GT10Cl14(B (keyword) ,Ta0Ei1GaJ4'> ,TEM'!4(B ESC x ,T5RA04i1GB(B "command-apropos" ,TK0CW1M(B - "command-a" ,TK0EQ1'(R!09Qi190!g1!4(B "kanji" 0,T4Y1(B + >> Åͧ¡´ ESC x µÒÁ´éÇ "command-apropos" ËÃ×Í + "command-a" ËÅѧ¨Ò¡¹Ñ鹡硴 "kanji" ´Ù - ,Tc0Ki1!4(B C-x 1 ,T`GER05i1M'!RC(PE:(B "0,TGT19b40Gl1(B" 0,T7Uh1b<0Eh10"Vi19ARcK0Ah1(B + ãËé¡´ C-x 1 àÇÅÒµéͧ¡ÒèÐź "ÇÔ¹â´Çì" ·Õèâ¼Åè¢Öé¹ÁÒãËÁè -,T:CC07Q14bKA4(B (Mode Line) +ºÃ÷ѴâËÁ´ (Mode Line) ===================== - ,T`GER07Uh10>T1A0>l1$S0JQh1'`0"i1Rd;0*i1R(B ,Tf(B Emacs ,T(PaJ4'0JTh1'07Uh10>T1A0>l1E'd;5C':CC07Q140Eh1R'0JX14"M'(M0+Vh1'`0CU1B!(B -0,TGh1R(B echo area ,T:CC07Q140+Vh1'M0BYh106Q140"Vi19ARK09Vh1':CC07Q14(B ,T`0CU1B!0Gh1R:CC07Q14bKA4(B (mode line) ,T:CC07Q14(B -,TbKA40AU10EQ1!I3P04Q1'09Ui1(B + àÇÅÒ·Õè¾ÔÁ¾ì¤ÓÊÑè§à¢éÒ仪éÒ æ Emacs ¨ÐáÊ´§ÊÔ觷Õè¾ÔÁ¾ìŧ仵çºÃ÷ѴÅèÒ§ÊØ´¢Í§¨Í«Öè§àÃÕ¡ +ÇèÒ echo area ºÃ÷Ѵ«Öè§ÍÂÙè¶Ñ´¢Öé¹ÁÒ˹Ö觺Ã÷Ѵ àÃÕ¡ÇèÒºÃ÷ѴâËÁ´ (mode line) ºÃ÷Ѵ +âËÁ´ÁÕÅѡɳдѧ¹Õé [--]J:--**-Mule: TUTORIAL.th (Fundamental) ---NN%-------------- -,TKARB`K05X1(B: ,T5C'0Jh1G9(B NN ,T"M'(B NN% ,T(P0AU105Q1G`E"c0Jh1M0BYh1(B ,T:CC07Q14bKA407Uh1aJ4'M0BYh1MR((Pa5!05h1R'(B - ,Td;(R!05Q1GM0Bh1R'0:i1R'(B ,Ta05h10!g1d0Ah1`0;g19dC(B 0,T5Q1GM0Bh1R'`0*h19(B ,TMR((P0AU1`GERK0CW1M(B uptime - ,TaJ4'D05T1!CCA07Uh1a5!05h1R'0!Q19b4B0JTi19`0*T1'(B ,T`0AWh1MM0BYh1c9bKA4K0EQ1!07Uh105h1R'0!Q19(B 0,T5Q1GM0Bh1R'(B -,T`0*h19(B ,T`GERb;Ca!CA@RIR(B ,T(P0AU1$S0JQh1'JSK0CQ1:J0Ci1R'(B ,TKARB`K05X1(B (comment) ,TM0BYh1(B ,T`09Wh1M'(R!0GT108U1c0Jh1(B -,TKARB`K05X1"M'@RIRa05h1EP@RIRa5!05h1R'0!Q19(B ,T$S0JQh1'09Ui10!g1(Pa5!05h1R'0!Q19d;c9a05h1EPbKA4K0EQ1!(B ,T`0>Wh1Mc0Ki1(B -,TJRARC6c0Jh1KARB`K05X1c9a05h1EP@RIRd04i1M0Bh1R'06Y1!05i1M'(B + ¤ÓÊÑ觺ҧ¤ÓÊÑ觨ÐÁվĵԡÃÃÁ·ÕèᵡµèÒ§¡Ñ¹â´ÂÊÔé¹àªÔ§ àÁ×èÍÍÂÙèã¹âËÁ´ËÅÑ¡·ÕèµèÒ§¡Ñ¹ µÑÇÍÂèÒ§ +àªè¹ àÇÅÒâ»Ãá¡ÃÁÀÒÉÒ ¨ÐÁÕ¤ÓÊÑè§ÊÓËÃѺÊÃéÒ§ ËÁÒÂà赯 (comment) ÍÂÙè à¹×èͧ¨Ò¡ÇÔ¸ÕãÊè +ËÁÒÂà˵آͧÀÒÉÒáµèÅÐÀÒÉÒᵡµèÒ§¡Ñ¹ ¤ÓÊÑ觹Õé¡ç¨ÐᵡµèÒ§¡Ñ¹ä»ã¹áµèÅÐâËÁ´ËÅÑ¡ à¾×èÍãËé +ÊÒÁÒöãÊèËÁÒÂà˵Øã¹áµèÅÐÀÒÉÒä´éÍÂèÒ§¶Ù¡µéͧ - ,T$S0JQh1'JSK0CQ1:!RC`;0EUh1B9bKA4c0Ki1`0;g19bKA4K0EQ1!0MWh19(B 0,T$W1M$S0JQh1'"BRB(B (extend) 0,T+Vh1'0*Wh1M$S0JQh1'`0;g190*Wh1M(B -,TbKA4(B 0,T5Q1GM0Bh1R'`0*h19(B ,T$S0JQh1'(B M-x fundamental-mode 0,T$W1M$S0JQh1'JSK0CQ1:`;0EUh1B9bKA4`0;g19bKA4(B + ¤ÓÊÑè§ÊÓËÃѺ¡ÒÃà»ÅÕè¹âËÁ´ãËéà»ç¹âËÁ´ËÅÑ¡Í×è¹ ¤×ͤÓÊÑ觢ÂÒ (extend) «Ö觪×èͤÓÊÑè§à»ç¹ª×èÍ +âËÁ´ µÑÇÍÂèÒ§àªè¹ ¤ÓÊÑè§ M-x fundamental-mode ¤×ͤÓÊÑè§ÊÓËÃѺà»ÅÕè¹âËÁ´à»ç¹âËÁ´ Fundamental - ,T`GER07Uh1(Pa0!i1d"a0?i1A0"i1M0AY1E@RIR0MQ1'!DI(B 0,T!g1c0Ki1c0*i1(B Text mode + àÇÅÒ·Õè¨Ðá¡éä¢á¿éÁ¢éÍÁÙÅÀÒÉÒÍѧ¡ÄÉ ¡çãËéãªé Text mode - >> ,TEM'0;i1M9$S0JQh1'(B M-x text-mode + >> Åͧ»é͹¤ÓÊÑè§ M-x text-mode - 0,T6i1R05i1M'!RCKR0"i1M0AY1E`0>Th1A`0!Uh1BG0!Q1:bKA4K0EQ1!07Uh1c0*i1M0BYh1c90;Q1(0(X10:Q19(B 0,T!g1c0Ki10;i1M9$S0JQh1'(B C-h m + ¶éÒµéͧ¡ÒÃËÒ¢éÍÁÙÅà¾ÔèÁà¡ÕèÂǡѺâËÁ´ËÅÑ¡·ÕèãªéÍÂÙè㹻Ѩ¨ØºÑ¹ ¡çãËé»é͹¤ÓÊÑè§ C-h m - >> ,Tc0Ki1!4(B C-h m ,T`0>Wh1M0HV1!IR0"i1Ma5!05h1R'CPK0Gh1R'(B Text mode 0,T!Q1:(B Fundamental mode + >> ãËé¡´ C-h m à¾×èÍÈÖ¡ÉÒ¢éÍᵡµèÒ§ÃÐËÇèÒ§ Text mode ¡Ñº Fundamental mode - >> ,Tc0Ki1!4(B C-x 1 ,T`0>Wh1ME:`M!JRCMM!(R!(M(B + >> ãËé¡´ C-x 1 à¾×èÍźàÍ¡ÊÒÃÍÍ¡¨Ò¡¨Í - ,T5C'0Jh1G90+i1RB"M':CC07Q14bKA4(B ,T(P0AU10JQ1-0EQ1!I03l1(B '[--]' ,T`0>Wh1MaJ4'bKA4JSK0CQ1:!RC0;i1M90"i1M0AY1E(B -(input mode) ,TM0BYh1(B 0,TJQ1-0EQ1!I03l1(B [--] ,TKARB06V1'JRARC60;i1M90"i1M0AY1Ed04i104i1GB05Q1G0MQ1!IC@RIR0MQ1'!DI(B -(English alphabets) ,T!0CX13R0Mh1R90$Yh10AW1M"M'(B "Tamago" ,TJSK0CQ1:CRBEP`0MU1B4"M'0GT108U1c0*i1(B + µÃ§Êèǹ«éÒ¢ͧºÃ÷ѴâËÁ´ ¨ÐÁÕÊÑ­Åѡɳì '[--]' à¾×èÍáÊ´§âËÁ´ÊÓËÃѺ¡Òûé͹¢éÍÁÙÅ +(input mode) ÍÂÙè ÊÑ­Åѡɳì [--] ËÁÒ¶֧ÊÒÁÒö»é͹¢éÍÁÙÅä´é´éǵÑÇÍÑ¡ÉÃÀÒÉÒÍѧ¡ÄÉ +(English alphabets) ¡ÃسÒÍèÒ¹¤ÙèÁ×ͧ͢ "Tamago" ÊÓËÃѺÃÒÂÅÐàÍÕ´¢Í§ÇÔ¸Õãªé - ,TaEP5C'04i1R9"GR"M'0JQ1-0EQ1!I03l109Qi19(B ,T(P0AU1`$0CWh1M'KARBaJ4'J6R9P"M'(B flag ,T"M'CP::C0KQ1J(B -(coding-system) ,TM0BYh1(B Mule ,TJRARC6!SK94CP::C0KQ1JaB!`)>RPJSK0CQ1:(B ,T!RC`0!g1:0Mh1R9a0?i1A0"i1M0AY1E(B -,T!RC0;i1M90"i1M0AY1E(R!0$U10Bl1:M0Cl14(B ,T!RCaJ4'RP(B -0,TJQ1-0EQ1!I03l10*h1GB(S(B (mnemonic) ,T"M'CP::C0KQ1JJSK0CQ1:!RC`0!g1:0Mh1R9a0?i1A0"i1M0AY1E(B ,T`07h1R09Qi19(B + áÅеç´éÒ¹¢ÇҢͧÊÑ­Åѡɳì¹Ñé¹ ¨ÐÁÕà¤Ã×èͧËÁÒÂáÊ´§Ê¶Ò¹Ð¢Í§ flag ¢Í§ÃкºÃËÑÊ +(coding-system) ÍÂÙè Mule ÊÒÁÒö¡Ó˹´ÃкºÃËÑÊá¡੾ÒÐÊÓËÃѺ ¡ÒÃà¡çºÍèÒ¹á¿éÁ¢éÍÁÙÅ +¡Òûé͹¢éÍÁÙŨҡ¤ÕÂìºÍÃì´ ¡ÒÃáÊ´§¼ÅÍÍ¡·Ò§¨Í ä´éÍÔÊÃШҡ¡Ñ¹ áµèâ´Â»¡µÔ¨ÐáÊ´§à©¾ÒÐ +ÊÑ­ÅѡɳìªèÇÂ¨Ó (mnemonic) ¢Í§ÃкºÃËÑÊÊÓËÃѺ¡ÒÃà¡çºÍèÒ¹á¿éÁ¢éÍÁÙÅ à·èÒ¹Ñé¹ - >> ,T5CG(04Y10Gh1R0AU10JQ1-0EQ1!I03l1(B ,T$0Ei1RB$0EV1'0!Q1:(B "J:" "S:" "E:" ,TaJ4'M0BYh107Uh1:CC07Q14bKA4K0CW1Md0Ah1(B + >> µÃǨ´ÙÇèÒÁÕÊÑ­ÅÑ¡É³ì ¤ÅéÒ¤ÅÖ§¡Ñº "J:" "S:" "E:" áÊ´§ÍÂÙè·ÕèºÃ÷ѴâËÁ´ËÃ×ÍäÁè - 0,T5Q1G0MQ1!IC05Q1GaC!0$W1M(B 0,TJQ1-0EQ1!I03l10*h1GB(S(B (mnemonic) ,T"M'CP::C0KQ1J07Uh1c0*i1M0BYh1(B 0,T5Q1G(B ':' ,TaJ4'c0Ki10CYi1(B -0,TGh1R0AU105Q1G0MQ1!IC"M'@RIR0MWh19(B ,T9M!(R!@RIR0MQ1'!DIaJ4'M0BYh1(B (,T`0*h19(B ,T@RIR0(U19(B ,T@RIR0-Uh10;Xh19(B ,T`0;g1905i19(B) 0,T5Q1G(B J -,TKARB06V1'(B ,TC0KQ1J07Uh1c0*i10!Q1:(B JUNET 0,T$W1M(B ,TC0KQ1J(B JIS 0,T5Q1G(B S ,TKARB06V1'(B Shift-JIS ,TaEP(B 0,T5Q1G(B E ,TKARB06V1'(B -,TC0KQ1J(B EUC ,T@RIR0-Uh10;Xh19(B ,T(PJ0EQ1:`;0EUh1B9(B (toggle) ,T!RCaJ4'> ,TEM'0;i1M9$S0JQh1'(B C-x C-k t 0,T4Y1JM'$0CQi1'(B + >> Åͧ»é͹¤ÓÊÑè§ C-x C-k t ´ÙÊͧ¤ÃÑé§ - 0,T6i1R`7M0Cl10AT109Q1E07Uh1c0*i1M0BYh10AU10;Xh1A(B META ,TaEPbKA407Uh1c0*i1M0BYh1`0;g19C0KQ1J(B JIS ,T`CR0!g1(PJRARC6c0*i10;Xh1A(B META -,Ta79!RC!40;Xh1A(B ESCAPE ,Td04i1(B 0,TGT108U1c0*i1(P`K0AW1M90!Q1:!RCc0*i10;Xh1A$M9b7CE(B 0,T$W1Mc0Ki1!40;Xh1A(B META 0,T$i1R'd0Gi1a0Ei1G0(V1'(B -,T!405Q1G0MQ1!IC5RA(B M-<0,T5Q1G0MQ1!IC(B> ,T(P7SK09i1R07Uh1`K0AW1M90!Q1:(B ESC <0,T5Q1G0MQ1!IC(B> 0,T9Qh190$W1M(B 0,T7X1!M0Bh1R'07Uh1M08T1:RBAR(B -,T(906V1'0(X1409Ui1(B ,T(P0BQ1'$'0AU1 ,Tc0Ki1`0;g19(B M-<0,T5Q1G0MQ1!IC(B> ,Ta05h10"i1M(B -,T$GCCP0GQ1'0!g10$W1M(B 0,T;Xh1A(B META ,T(Pd0Ah1JRARC6c0*i1d04i10!Q1:C0KQ1J(B Shift-JIS ,TaEP(B EUC + ¶éÒà·ÍÃìÁÔ¹ÑÅ·ÕèãªéÍÂÙèÁÕ»ØèÁ META áÅÐâËÁ´·ÕèãªéÍÂÙèà»ç¹ÃËÑÊ JIS àÃÒ¡ç¨ÐÊÒÁÒöãªé»ØèÁ META +á·¹¡Òá´»ØèÁ ESCAPE ä´é ÇÔ¸Õãªé¨ÐàËÁ×͹¡Ñº¡ÒÃãªé»ØèÁ¤Í¹â·ÃÅ ¤×ÍãËé¡´»ØèÁ META ¤éÒ§äÇéáÅéǨ֧ +¡´µÑÇÍÑ¡ÉõÒÁ M-<µÑÇÍÑ¡ÉÃ> ¨Ð·Ó˹éÒ·ÕèàËÁ×͹¡Ñº ESC <µÑÇÍÑ¡ÉÃ> ¹Ñ蹤×Í ·Ø¡ÍÂèÒ§·Õè͸ԺÒÂÁÒ +¨¹¶Ö§¨Ø´¹Õé ¨ÐÂѧ¤§ÁÕ¼ÅàËÁ×͹à´ÔÁ ËÅѧ¨Ò¡à»ÅÕè¹ ESC <µÑÇÍÑ¡ÉÃ> ãËéà»ç¹ M-<µÑÇÍÑ¡ÉÃ> áµè¢éÍ +¤ÇÃÃÐÇѧ¡ç¤×Í »ØèÁ META ¨ÐäÁèÊÒÁÒöãªéä´é¡ÑºÃËÑÊ Shift-JIS áÅÐ EUC - ,T!RC`;0EUh1B9CP::C0KQ1J(P0AU1U1B'0!Q1:a05h1EP0:Q1?`?M0Cl1`07h1R09Qi19(B ,TJRARC604Y1$S0JQh1'`0!Uh1BG0!Q1:CP::C0KQ1J(B -,Td04i1b4B$S0JQh1'(B C-h a coding-system + ¡ÒÃà»ÅÕè¹ÃкºÃËÑʨÐÁÕ¼Åá¤èà¾Õ§¡ÑºáµèÅкѿà¿ÍÃìà·èÒ¹Ñé¹ ÊÒÁÒö´Ù¤ÓÊÑè§à¡ÕèÂǡѺÃкºÃËÑÊ +ä´éâ´Â¤ÓÊÑè§ C-h a coding-system - >> ,Tc0Ki10;i1M9$S0JQh1'(B C-h a coding-system ,Ta0Ei1G0Mh1R9CRBEP`0MU1B4"M'$S0JQh1'(B - set-display-coding-system set-file-coding-system ,TaEP(B - set-process-coding-system ,T(R!`M!JRC07Uh1;CR!/0"Vi19(B + >> ãËé»é͹¤ÓÊÑè§ C-h a coding-system áÅéÇÍèÒ¹ÃÒÂÅÐàÍÕ´¢Í§¤ÓÊÑè§ + set-display-coding-system set-file-coding-system áÅÐ + set-process-coding-system ¨Ò¡àÍ¡ÊÒ÷Õè»ÃÒ¡¯¢Öé¹ -,T!RC0$i19KR(B (search) +¡Òäé¹ËÒ (search) ================ - Emacs ,TJRARC60$i19KRJRB0MQ1!"CP(B (string) ,T@RBc9a0?i1A0"i1M0AY1Ed;7R'0"i1R'K09i1RK0CW1M0"i1R'K0EQ1'd04i1(B -0,T6i1R05i1M'!RC0$i19KRd;7R'0"i1R'K09i1R"M'5SaK09h1'`$M0Cl1`+M0Cl1(B (cursor) 0,T!g1c0Ki1!4(B C-s 0,T6i1R05i1M'!RC0$i19KR(B -,Td;7R'0"i1R'K0EQ1'"M'5SaK09h1'`$M0Cl1`+M0Cl1(B 0,T!g1c0Ki1!4(B C-r ,TK0EQ1'(R!09Qi19(P0AU10"i1M$GRA0Gh1R(B "I-search:" -,T;CR!/0"Vi195C'(B echo area ,TB!`0ET1!!RC0$i19KRd04i104i1GB!RC!4(B ESC + Emacs ÊÒÁÒö¤é¹ËÒÊÒÂÍÑ¡¢ÃÐ (string) ÀÒÂã¹á¿éÁ¢éÍÁÙÅä»·Ò§¢éҧ˹éÒËÃ×Í¢éÒ§ËÅѧä´é +¶éÒµéͧ¡Òäé¹ËÒä»·Ò§¢éҧ˹éҢͧµÓá˹è§à¤ÍÃìà«ÍÃì (cursor) ¡çãËé¡´ C-s ¶éÒµéͧ¡Òäé¹ËÒ +ä»·Ò§¢éÒ§ËÅѧ¢Í§µÓá˹è§à¤ÍÃìà«ÍÃì ¡çãËé¡´ C-r ËÅѧ¨Ò¡¹Ñ鹨ÐÁÕ¢éͤÇÒÁÇèÒ "I-search:" +»ÃÒ¡¯¢Ö鹵ç echo area ¡àÅÔ¡¡Òäé¹ËÒä´é´éÇ¡Òá´ ESC - >> ,T!4(B C-s ,T`0>Wh1M`0CTh1A!RC0$i19KR(B ,Ta0Ei1G!405Q1G0MQ1!IC"M'$S0Gh1R(B "cursor" ,TE'd;07U1EP05Q1GM0Bh1R'(B - 0,T*i1R(B ,Ta0Ei1G0JQ1'`!504Y10Gh1R`$M0Cl1`+M0Cl1"0BQ1:d;M0Bh1R'dC(B + >> ¡´ C-s à¾×èÍàÃÔèÁ¡Òäé¹ËÒ áÅéÇ¡´µÑÇÍÑ¡Éâͧ¤ÓÇèÒ "cursor" ŧ价ÕÅеÑÇÍÂèÒ§ + ªéÒ áÅéÇÊѧࡵ´ÙÇèÒà¤ÍÃìà«ÍÃì¢ÂѺä»ÍÂèÒ§äà - >> ,TEM'!4(B C-s 0,T4Y10MU1!K09Vh1'$0CQi1'`0>Wh1M0$i19KR$S0Gh1R(B "cursor" 0,T5Q1G05h1Md;(B + >> Åͧ¡´ C-s ´ÙÍա˹Ö觤ÃÑé§à¾×èͤé¹ËÒ¤ÓÇèÒ "cursor" µÑǵèÍä» - >> ,T!4(B 0,T4Y1(B 4 ,T$0CQi1'(B ,Ta0Ei1G0JQ1'`!504Y10Gh1R!RC`$0EWh1M907Uh1"M'`$M0Cl1`+M0Cl1(B + >> ¡´ ´Ù 4 ¤ÃÑé§ áÅéÇÊѧࡵ´ÙÇèÒ¡ÒÃà¤Å×è͹·Õè¢Í§à¤ÍÃìà«ÍÃì - >> ,T!4(B ESC ,T`0>Wh1MB!`0ET1!!RC0$i19KR(B + >> ¡´ ESC à¾×èÍ¡àÅÔ¡¡Òäé¹ËÒ - ,T!RC0$i19KR(P`0CTh1A0"Vi1907Q1907U1(B ,Tc9CPK0Gh1R'07Uh10>T1A0>l1JRB0MQ1!"CP07Uh105i1M'!RC(P0$i19KR(B ,T`0"i1Rd;`0>U1B':R'0Jh1G9(B -0,T6i1R05i1M'!RC(P0$i19KR05Q1G05h1Md;(B 0,T!g1c0Ki1!4(B C-s 0,TMU1!K09Vh1'$0CQi1'(B 0,T6i1RKR!0$i19KRJRB0MQ1!"CP07Uh10;i1M9`0"i1Rd;d0Ah1>:(B 0,T!g1(B -,T(P0AU10"i1M$GRA;CR!/0"Vi19(B ,Tc0Ki1!4(B C-g ,T`0>Wh1MB!`0ET1!(B + ¡Òäé¹ËÒ¨ÐàÃÔèÁ¢Ö鹷ѹ·Õ ã¹ÃÐËÇèÒ§·Õè¾ÔÁ¾ìÊÒÂÍÑ¡¢ÃзÕèµéͧ¡ÒèФé¹ËÒ à¢éÒä»à¾Õ§ºÒ§Êèǹ +¶éÒµéͧ¡ÒèФé¹ËÒµÑǵèÍä» ¡çãËé¡´ C-s Íա˹Ö觤ÃÑé§ ¶éÒËÒ¡¤é¹ËÒÊÒÂÍÑ¡¢ÃзÕè»é͹à¢éÒä»äÁ辺 ¡ç +¨ÐÁÕ¢éͤÇÒÁ»ÃÒ¡¯¢Öé¹ ãËé¡´ C-g à¾×èÍ¡àÅÔ¡ - ,TCPK0Gh1R'07Uh10$i19KRM0BYh1(B 0,T6i1R!4(B 0,T5Q1G0MQ1!IC05Q1G0JX1407i1RBc9JRB0MQ1!"CP0!g1(P06Y1!E:d;(B ,Ta0Ei1G(B -,T`$M0Cl1`+M0Cl10!g1(P!0EQ1:d;5SaK09h1'0!h1M9K09i1R(B 0,T5Q1GM0Bh1R'`0*h19(B 0,T6i1R!4(B "cu" 0,T!g1(P0$i19KRd;06V1'5SaK09h1'07Uh10AU1$S0Gh1R(B -"cu" ,Ta05h106i1R!4(B ,Tc90(Q1'KGP09Ui1(B 0,T5Q1G(B 'u' ,Tc9(B search line 0,T!g1(PKRBd;(B ,Ta0Ei1G`$M0Cl1`+M0Cl1(B -,T(P"0BQ1:!0EQ1:d;07Uh15SaK09h1'07Uh10AU105Q1G(B 'c' ,TM0BYh1(B + ÃÐËÇèÒ§·Õè¤é¹ËÒÍÂÙè ¶éÒ¡´ µÑÇÍÑ¡ÉõÑÇÊØ´·éÒÂã¹ÊÒÂÍÑ¡¢ÃСç¨Ð¶Ù¡Åºä» áÅéÇ +à¤ÍÃìà«ÍÃì¡ç¨Ð¡ÅѺ仵Óá˹觡è͹˹éÒ µÑÇÍÂèÒ§àªè¹ ¶éÒ¡´ "cu" ¡ç¨Ð¤é¹ËÒ件֧µÓá˹觷ÕèÁÕ¤ÓÇèÒ +"cu" áµè¶éÒ¡´ 㹨ѧËÇйÕé µÑÇ 'u' ã¹ search line ¡ç¨ÐËÒÂä» áÅéÇà¤ÍÃìà«ÍÃì +¨Ð¢ÂѺ¡ÅѺ价ÕèµÓá˹觷ÕèÁÕµÑÇ 'c' ÍÂÙè - 0,T6i1R!405Q1G0MQ1!IC$M9b7CE(B (control character) 0,T5Q1G0MWh19(B ,T9M!`K09W1M(R!(B C-s ,TK0CW1M(B C-r -,T!RC0$i19KR0!g1(P0JTi190JX14E'(B + ¶éÒ¡´µÑÇÍÑ¡Éä͹â·ÃÅ (control character) µÑÇÍ×è¹ ¹Í¡à˹×ͨҡ C-s ËÃ×Í C-r +¡Òäé¹ËÒ¡ç¨ÐÊÔé¹Êشŧ - ,T$S0JQh1'(B C-s ,T(P0$i19KRJRB0MQ1!"CP07Uh105i1M'!RC(B ,Td;7R'0"i1R'K09i1R"M'5SaK09h1'`$M0Cl1`+M0Cl1(B 0,T6i1R05i1M'!RC(B -0,T$i19KRd;7R'07T1HK0EQ1'(B 0,T!g1c0Ki1!4(B C-r 0,T9Qh190$W1M(B ,TJRARC6c0*i1(B C-s ,TaEP(B C-r ,TJ0EQ1:0!Q19`0>Wh1M0$i19KRd;d04i1c907Qi1'(B -,TJM'07T1H7R'(B C-s ,TaEP(B C-r ,T7SK09i1R07Uh1`K0AW1M90!Q1907X1!;CP!RC(B ,T(P05h1R'0!Q190!g15C'07T1H7R'!RC0$i19KR`07h1R09Qi19(B + ¤ÓÊÑè§ C-s ¨Ð¤é¹ËÒÊÒÂÍÑ¡¢ÃзÕèµéͧ¡Òà 价ҧ¢éҧ˹éҢͧµÓá˹è§à¤ÍÃìà«ÍÃì ¶éÒµéͧ¡Òà +¤é¹ËÒä»·Ò§·ÔÈËÅѧ ¡çãËé¡´ C-r ¹Ñ蹤×Í ÊÒÁÒöãªé C-s áÅÐ C-r ÊÅѺ¡Ñ¹à¾×èͤé¹ËÒä»ä´éã¹·Ñé§ +Êͧ·ÔÈ·Ò§ C-s áÅÐ C-r ·Ó˹éÒ·ÕèàËÁ×͹¡Ñ¹·Ø¡»ÃСÒà ¨ÐµèÒ§¡Ñ¹¡çµÃ§·ÔÈ·Ò§¡Òäé¹ËÒà·èÒ¹Ñé¹ Recursive Editing Level - ,T:R'07U1(B ,T`CRMR((PK0EX14`0"i1Rd;M0BYh1c9J6R9P07Uh1`0CU1B!0Gh1R(B Recursive Editing Level ,Td04i1b4B(B -,Td0Ah105Qi1'c((B ,Tc9bKA409Ui1(B ,T`$0CWh1M'KARBG'`0Eg1:(B '()' 0,T7Uh1aJ4'0*Wh1MbKA4K0EQ1!(B (major mode) ,TM0BYh1(P0AU1G'`0Eg1:(B -'[]' 0,TEi1MA(B ,T`0>Th1A0"Vi190MU1!K09Vh1'0*Qi19(B 0,T5Q1GM0Bh1R'`0*h19(B 0,T6i1R`04T1A`0;g19(B (Fundamental) ,TM0BYh1(B 0,T!g1(P`;0EUh1B9`0;g19(B -[(Fundamental)] ,Ta79(B + ºÒ§·Õ àÃÒÍÒ¨¨ÐËÅØ´à¢éÒä»ÍÂÙèã¹Ê¶Ò¹Ð·ÕèàÃÕ¡ÇèÒ Recursive Editing Level ä´éâ´Â +äÁèµÑé§ã¨ ã¹âËÁ´¹Õé à¤Ã×èͧËÁÒÂǧàÅçº '()' ·ÕèáÊ´§ª×èÍâËÁ´ËÅÑ¡ (major mode) ÍÂÙè¨ÐÁÕǧàÅçº +'[]' ÅéÍÁ à¾ÔèÁ¢Öé¹Íա˹Ö觪Ñé¹ µÑÇÍÂèÒ§àªè¹ ¶éÒà´ÔÁà»ç¹ (Fundamental) ÍÂÙè ¡ç¨Ðà»ÅÕè¹à»ç¹ +[(Fundamental)] á·¹ -,TKARB`K05X1(B: ,T`CR(Pd0Ah1M08T1:RB`0!Uh1BG0!Q1:(B Recursive Editing Level ,Tc907Uh109Ui1(B +ËÁÒÂà˵Ø: àÃÒ¨ÐäÁè͸ԺÒÂà¡ÕèÂǡѺ Recursive Editing Level ã¹·Õè¹Õé - ,Tc0Ki1!4(B M-x top-level ,T`0>Wh1M07Uh1(PMM!(R!(B Recursive Editing Level + ãËé¡´ M-x top-level à¾×èÍ·Õè¨ÐÍÍ¡¨Ò¡ Recursive Editing Level - >> ,TEM'!404Y1(B ,T5C'0Jh1G90Eh1R'"M'(M(P0AU10"i1M$GRA0Gh1R(B "Back to top level" ,T;CR!/0"Vi19(B + >> Åͧ¡´´Ù µÃ§ÊèǹÅèÒ§¢Í§¨Í¨ÐÁÕ¢éͤÇÒÁÇèÒ "Back to top level" »ÃÒ¡¯¢Öé¹ - ,T`09Wh1M'(R!(B ,T`CRM0BYh1c9CP04Q1::90JX14(B (top level) ,TM0BYh1a0Ei1G(B ,T$S0JQh1'09Ui10(V1'd0Ah10AU1Wh1M07Uh1(PMM!(R!(B Recursive Editing Level ,Td04i1(B + äÁèÊÒÁÒöãªé ¤ÓÊÑè§ C-g à¾×èÍ·Õè¨ÐÍÍ¡¨Ò¡ Recursive Editing Level ä´é Help ==== - Emacs 0,TAU1$GRAJRARC607Uh10AU1;CPbB*09l1(B ,TAR!ARBKERBM0Bh1R'(B 0,T+Vh1'd0Ah1JRARC6M08T1:RBd04i1KA4c907Uh109Ui1(B -,Ta05h1`CR(PJRARC6`0CU1B!c0*i1(B ,T`0>Wh1M07Uh1(P`0CU1B90CYi1$GRAJRARC6`K0Eh1R09Ui1(B ,Td04i1b4B!RC!4(B C-h 0,T+Vh1'(P(B -0,T*h1GBc0Ki1`CRd04i10CQ1:0CYi10"i1M0AY1E`0>Th1A`05T1AKERBM0Bh1R'(B + Emacs ÁÕ¤ÇÒÁÊÒÁÒö·ÕèÁÕ»ÃÐ⪹ì ÁÒ¡ÁÒÂËÅÒÂÍÂèÒ§ «Öè§äÁèÊÒÁÒö͸ԺÒÂä´éËÁ´ã¹·Õè¹Õé +áµèàÃÒ¨ÐÊÒÁÒöàÃÕ¡ãªé à¾×èÍ·Õè¨ÐàÃÕ¹ÃÙé¤ÇÒÁÊÒÁÒöàËÅèÒ¹Õé ä´éâ´Â¡Òá´ C-h «Ö觨Р+ªèÇÂãËéàÃÒä´éÃѺÃÙé¢éÍÁÙÅà¾ÔèÁàµÔÁËÅÒÂÍÂèÒ§ - 0,TGT108U1c0*i10$W1Mc0Ki1!4(B C-h ,Ta0Ei1G5RA04i1GB05Q1G`0EW1M!(B (option) 0,TMU1!K09Vh1'05Q1G0MQ1!IC(B 0,T6i1Rd0Ah10CYi10Gh1R(P05i1M'c0*i1(B -0,T5Q1G`0EW1M!MPdC(B 0,T!g1c0Ki1!4(B C-h ? ,Ta0Ei1G(P0AU1$SM08T1:RB`0!Uh1BG0!Q1:05Q1G`0EW1M!;CR!/0"Vi19(B ,Td04i1KR!`;0EUh1B9c((P(B -,Td0Ah1`0CU1B!(B HELP ,TK0EQ1'(R!!4(B C-h 0,T!g1c0Ki1!4(B C-g ,T`0>Wh1MB!`0ET1!d04i1(B + ÇÔ¸Õãªé¤×ÍãËé¡´ C-h áÅéǵÒÁ´éǵÑÇàÅ×Í¡ (option) Íա˹Ö觵ÑÇÍÑ¡Éà ¶éÒäÁèÃÙéÇèҨеéͧãªé +µÑÇàÅ×Í¡ÍÐäà ¡çãËé¡´ C-h ? áÅéǨÐÁÕ¤Ó͸ԺÒÂà¡ÕèÂǡѺµÑÇàÅ×Í¡»ÃÒ¡¯¢Öé¹ ä´éËÒ¡à»ÅÕè¹㨨Р+äÁèàÃÕ¡ HELP ËÅѧ¨Ò¡¡´ C-h ¡çãËé¡´ C-g à¾×èÍ¡àÅÔ¡ä´é - ,T$S0JQh1'(B HELP 0,T>Wi190R907Uh10JX140MQ19K09Vh1'0!g10$W1M(B C-h c ,Ta0Ei1G5RA04i1GB!RC!4$S0JQh1':R'$S0JQh1'(B 0,T+Vh1'(Pc0Ki1$S(B -,TM08T1:RB0JQi19(B ,Tf(B ,T`0!Uh1BG0!Q1:$S0JQh1'09Qi19(B + ¤ÓÊÑè§ HELP ¾×é¹°Ò¹·ÕèÊØ´Íѹ˹Ö觡ç¤×Í C-h c áÅéǵÒÁ´éÇ¡Òá´¤ÓÊÑ觺ҧ¤ÓÊÑè§ «Ö觨ÐãËé¤Ó +͸ԺÒÂÊÑé¹ æ à¡ÕèÂǡѺ¤ÓÊÑ觹Ñé¹ - >> ,TEM'!4(B C-h c C-p 0,T4Y1(B 0,T+Vh1'(Pc0Ki10"i1M$GRA0Gh1R(B + >> Åͧ¡´ C-h c C-p ´Ù «Ö觨ÐãËé¢éͤÇÒÁÇèÒ "C-p runs the command previous-line" - ,T$S0JQh1'09Ui1(P0*h1GB0CWi1M0?Wi19$GRA(S(B ,T`0!Uh1BG0!Q1:$S0JQh1'07Uh1`$B0> ,TEM'!4(B C-h k C-p 0,T4Y1(B + >> Åͧ¡´ C-h k C-p ´Ù - 0,T!g1(P0AU10GT19b40Gl1`0>Th1Ac9(B Emacs 0,TMU1!K09Vh1'0MQ19(B ,T`0>Wh1MaJ4'CRBEP`0MU1B4"M'$S0JQh1'09Qi19(B ,T`0AWh1M0Mh1R9(:a0Ei1G(B -0,T!g1c0Ki1!4(B C-x 1 ,T`0>Th1AE:0GT19b40Gl1MM!(B + ¡ç¨ÐÁÕÇÔ¹â´Çìà¾ÔèÁã¹ Emacs Íա˹Öè§Íѹ à¾×èÍáÊ´§ÃÒÂÅÐàÍÕ´¢Í§¤ÓÊÑ觹Ñé¹ àÁ×èÍÍèÒ¹¨ºáÅéÇ +¡çãËé¡´ C-x 1 à¾ÔèÁźÇÔ¹â´ÇìÍÍ¡ - 0,T5Q1G`0EW1M!0MWh1907Uh10AU1;CPbB*09l1(B 0,TAU104Q1'09Ui1(B + µÑÇàÅ×Í¡Í×è¹·ÕèÁÕ»ÃÐ⪹ì Áմѧ¹Õé - C-h f ,Tc0Ki1c0Jh10*Wh1M"M'$S0JQh1'(B ,T`0>Wh1MaJ4'CRBEP`0MU1B4`0!Uh1BG0!Q1:$S0JQh1'09Qi19(B + C-h f ãËéãÊèª×èͧ͢¤ÓÊÑè§ à¾×èÍáÊ´§ÃÒÂÅÐàÍÕ´à¡ÕèÂǡѺ¤ÓÊÑ觹Ñé¹ - >> ,Tc0Ki1!4(B C-h f previous-line ,Ta0Ei1G5RA04i1GB(B ,T`0>Wh1MaJ4'CRBEP`0MU1B4`0!Uh1BG(B - 0,T!Q1:$S0JQh1'0+Vh1'`0CU1B!c0*i1d04i1(R!!RC!4(B C-p + >> ãËé¡´ C-h f previous-line áÅéǵÒÁ´éÇ à¾×èÍáÊ´§ÃÒÂÅÐàÍÕ´à¡ÕèÂÇ + ¡Ñº¤ÓÊÑ觫Öè§àÃÕ¡ãªéä´é¨Ò¡¡Òá´ C-p - C-h a ,Ta0Ei1G5RA04i1GB0$U10Bl1`0GT10Cl14(B (keyword) ,T`0>Wh1MaJ4'$S0JQh1'07X1!$S0JQh1'(B 0,T7Uh10AU10$U10Bl1`0GT10Cl14(B ,TCGAM0BYh1(B - ,T$S0JQh1'`K0Eh1R09Ui1JRARC6`0CU1B!c0*i1d04i1b4B!RC!4(B ESC x + C-h a áÅéǵÒÁ´éǤÕÂìàÇÔÃì´ (keyword) à¾×èÍáÊ´§¤ÓÊÑ觷ء¤ÓÊÑè§ ·ÕèÁÕ¤ÕÂìàÇÔÃì´ ÃÇÁÍÂÙè + ¤ÓÊÑè§àËÅèÒ¹ÕéÊÒÁÒöàÃÕ¡ãªéä´éâ´Â¡Òá´ ESC x - >> ,TEM'!4(B C-h a file ,Ta0Ei1G5RA04i1GB(B ,T`0>Wh1MaJ4'0*Wh1M$S0JQh1'07X1!$S0JQh1'07Uh10AU1$S0Gh1R(B - "file" ,TCGAM0BYh1(B 0,T+Vh1'(P0AU1(B find-file ,TaEP(B write-file 0,T7Uh1`0CU1B!c0*i1d04i1b4B!RC!4(B - C-x C-f ,TaEP(B C-x C-w ,TCGAM0BYh104i1GB(B + >> Åͧ¡´ C-h a file áÅéǵÒÁ´éÇ à¾×èÍáÊ´§ª×èͤÓÊÑ觷ء¤ÓÊÑ觷ÕèÁÕ¤ÓÇèÒ + "file" ÃÇÁÍÂÙè «Ö觨ÐÁÕ find-file áÅÐ write-file ·ÕèàÃÕ¡ãªéä´éâ´Â¡Òá´ + C-x C-f áÅÐ C-x C-w ÃÇÁÍÂÙè´éÇ -0,T7i1RB0JX1409Ui1(B +·éÒÂÊØ´¹Õé ====== -,TM0Bh1R0EW1A(B: ,T$S0JQh1'JSK0CQ1:!RC`0ET1!(B Emacs 0,T$W1M(B C-x C-c +ÍÂèÒÅ×Á: ¤ÓÊÑè§ÊÓËÃѺ¡ÒÃàÅÔ¡ Emacs ¤×Í C-x C-c - ,T`M!JRC)0:Q1:`0:Wi1M'05i1909Ui1(B 0,T5Qi1'c(`0"U1B90"Vi19JSK0CQ1:0RP(B 0,T6i1RKR!0AU10(X14dK907Uh1d0Ah1(B -,T`0"i1Rc((B 0,T!g1M0Bh1R0AQ1Ga05h1b7I05Q1G`M'(B ,Ta05h1"Mc0Ki1bB9$GRA0RP(B -,TM0Bh1R'0BTh1'0!Q1:(B EMACS ,T`09Wh1M'(R!`0;g19b;Ca!CA07Uh10AU1$GRAJRARC6KER!KERBAR!(B 0,TMQ1907Uh1(0CT1'a0Ei1G(B EMACS -,T7Sd04i107X1!0JTh1'07X1!M0Bh1R'(B + ËÅѧ¨Ò¡ãªé EMACS ´ÙÊÑ¡ÊͧÊÒÁÇѹ ¡ç¤§¨ÐªÔ¹ä»àͧ 㹵͹áá ÍÒ¨¨ÐÁըش·ÕèÃÙéÊÖ¡ÊѺʹáÅÐ +äÁèà¢éÒã¨ÍÂÙèºéÒ§ áµèÊÔ觹ÕéÂèÍÁà¡Ô´¢Öé¹àÊÁÍ àÇÅÒáµèàÃÔèÁãªé Editor ãËÁèã´ æ ¡çµÒÁ â´Â੾ÒÐ +ÍÂèÒ§ÂÔ觡Ѻ EMACS à¹×èͧ¨Ò¡à»ç¹â»Ãá¡ÃÁ·ÕèÁÕ¤ÇÒÁÊÒÁÒöËÅÒ¡ËÅÒÂÁÒ¡ Íѹ·Õè¨ÃÔ§áÅéÇ EMACS +·Óä´é·Ø¡ÊÔ觷ءÍÂèÒ§ -,T"M"M:0$X13(B +¢Í¢Íº¤Ø³ ======= - ,T`M!JRC)0:Q1:09Ui1(B 0,T4Q14a;E'AR(R!(B "MicroEMACS (kemacs) ,T@RIR0-Uh10;Xh19(B ,T`0:Wi1M'05i19(B" 0,T+Vh1'd04i1AR(R!(B -JUNET ,T`0>Wh1Mc0Ki1c0*i1`0;g19(B Tutorial ,TJSK0CQ1:(B GNUEmacs (Nemacs) + àÍ¡ÊÒéºÑº¹Õé ´Ñ´á»Å§ÁÒ¨Ò¡ "MicroEMACS (kemacs) ÀÒÉÒ­Õè»Øè¹ àº×éͧµé¹" «Öè§ä´éÁÒ¨Ò¡ +JUNET à¾×èÍãËéãªéà»ç¹ Tutorial ÊÓËÃѺ GNUEmacs (Nemacs) - ,T`M!JRC09Ui1(B 0,T4Q14a;E'AR(R!(B "JOVE Tutorial" (19 ,TA!CR$A(B 86) ,T"M'(B Jonathan Payne - 0,T+Vh1'04Q14a;E'AR(R!`M!JRC"M'(B Steve Zimmerman ,Ta0Kh1'(B CCA-UNIX 0,T+Vh1'04Q14a;E'(B (0,TMU1!07U1(B) ,TAR(B - ,T(R!`M!JRC(B "Teach-Emacs" ,T)0:Q1:`0:Wi1M'05i19(B (31 0,T5X1ER$A(B 85) ,T"M'(B MIT + àÍ¡ÊÒùÕé ´Ñ´á»Å§ÁÒ¨Ò¡ "JOVE Tutorial" (19 Á¡ÃÒ¤Á 86) ¢Í§ Jonathan Payne + «Ö觴Ѵá»Å§ÁÒ¨Ò¡àÍ¡ÊÒâͧ Steve Zimmerman áËè§ CCA-UNIX «Ö觴Ѵá»Å§ (ÍÕ¡·Õ) ÁÒ + ¨Ò¡àÍ¡ÊÒà "Teach-Emacs" ©ºÑºàº×éͧµé¹ (31 µØÅÒ¤Á 85) ¢Í§ MIT Update - February 1986 by Dana Hoggatt. @@ -671,20 +671,20 @@ Update/Translate - July 1987 by SANETO Takanori -,T"M"M:0$X13`0;g190>T1`HI(B +¢Í¢Íº¤Ø³à»ç¹¾ÔàÈÉ ============== - 0,T$X13(B SANETO Takanori (,T+R`9b5P(B ,T7R!Rb90CT1(B) 0,TER4(B 0,T"i1M0AY1E`07g1((B ,TaEP0MWh19(B ,Tf(B ,Td0Gi1a05h1`0>U1B'0 +# From Steve Baur # Run temacs as XEmacs function runtemacs { diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/custom/example-themes/europe-theme.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/custom/example-themes/europe-theme.el Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,13 @@ +;;;autoload +(deftheme europe + "Settings for European users." + :set-variable-settings + "This variable has a value appropriate for European users." + :set-variable-settings + "This has been forceed to the value appropriate for European users.") + +(custom-theme-set-variables 'europe + '(sentence-end-double-space nil) + '(ps-paper-type (quote a4))) + +(provide-theme 'europe) diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/custom/example-themes/ex-custom-file --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/custom/example-themes/ex-custom-file Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,21 @@ +;; Sample User custom-file. All forms below are autogenerated. + + + + + + + + + +(custom-load-themes + 'example ) +(custom-reset-variables + '(sentence-end-double-space standard)) +(custom-set-variables + '(package-get-remove-copy t) + '(package-get-dir "/scratch/incoming") + '(sgml-public-map (quote ("%S" "/scratch/xemacs/xemacs-20/xemacs-packages/etc/psgml/%o/%c/%d" "/usr/lib/sgml/%o/%c/%d"))) + '(paren-mode (quote paren) nil (paren))) +(custom-set-faces + '(default ((t (:background "oldlace"))) t)) diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/custom/example-themes/example-theme.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/custom/example-themes/example-theme.el Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,15 @@ +;;;autoload +(deftheme example + "A sample theme for customize theme support." + :variable-set-string "This variable has been made an example.") + +(custom-theme-load-themes 'example + 'europe) + +(custom-theme-set-variables 'example + '(iswitchb-prompt-newbuffer nil)) + +(provide-theme 'example) + + + \ No newline at end of file diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/editclient.sh --- a/etc/editclient.sh Mon Aug 13 11:12:06 2007 +0200 +++ b/etc/editclient.sh Mon Aug 13 11:13:30 2007 +0200 @@ -1,6 +1,5 @@ #!/bin/sh -if gnuclient -batch -eval t >/dev/null 2>&1 -then +if gnuclient -batch -eval t >/dev/null 2>&1; then exec gnuclient ${1+"$@"} else xemacs -unmapped -f gnuserv-start & diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/etags.1 --- a/etc/etags.1 Mon Aug 13 11:12:06 2007 +0200 +++ b/etc/etags.1 Mon Aug 13 11:13:30 2007 +0200 @@ -1,6 +1,6 @@ .\" Copyright (c) 1992 Free Software Foundation .\" See section COPYING for conditions for redistribution -.TH etags 1 "19apr1994" "GNU Tools" "GNU Tools" +.TH etags 1 "02nov1999" "GNU Tools" "GNU Tools" .de BP .sp .ti -.2i @@ -12,24 +12,33 @@ .SH SYNOPSIS .hy 0 .na -.B etags [\|\-aCDRSVh\|] [\|\-i \fIfile\fP\|] [\|\-l \fIlanguage\fP\|] [\|\-i \fIregexp\fP\|] [\|\-o \fItagfile\fP\|] +.B etags [\|\-aCDGImRVh\|] [\|\-i \fIfile\fP\|] [\|\-l \fIlanguage\fP\|] +.if n .br +.B [\|\-o \fItagfile\fP\|] [\|\-r \fIregexp\fP\|] .br -[\|\-\-c++\|] [\|\-\-no\-defines\|] [\|\-\-ignore\-indentation\|] -[\|\-\-language=\fIlanguage\fP\|] [\|\-\-regex=\fIregexp\fP\|] -[\|\-\-no\-regexp\|] [\|\-\-help\|] [\|\-\-version\|] -[\|\-\-include=\fIfile\fP\|] [\|\-\-output=\fItagfile\fP\|] -[\|\-\-append\|] \fIfile\fP .\|.\|. +[\|\-\-append\|] [\|\-\-c++\|] [\|\-\-no\-defines\|] +[\|\-\-no\-globals\|] [\|\-\-include=\fIfile\fP\|] +[\|\-\-ignore\-indentation\|] [\|\-\-language=\fIlanguage\fP\|] +[\|\-\-members\|] [\|\-\-output=\fItagfile\fP\|] +[\|\-\-regex=\fIregexp\fP\|] [\|\-\-no\-regex\|] +[\|\-\-ignore\-case\-regex=\fIregexp\fP\|] +[\|\-\-help\|] [\|\-\-version\|] +\fIfile\fP .\|.\|. -.B ctags [\|\-aCdRSVh\|] [\|\-BtTuvwx\|] [\|\-l \fIlanguage\fP\|] +.B ctags [\|\-aCdgImRVh\|] [\|\-BtTuvwx\|] [\|\-l \fIlanguage\fP\|] +.if n .br +.B [\|\-o \fItagfile\fP\|] [\|\-r \fIregexp\fP\|] .br -[\|\-i \fIregexp\fP\|] [\|\-o \fItagfile\fP\|] -[\|\-\-c++\|] [\|\-\-defines\|] [\|\-\-ignore\-indentation\|] -[\|\-\-no\-warn\|] [\|\-\-cxref\|] [\|\-\-backward\-search\|] -[\|\-\-forward\-search\|] [\|\-\-typedefs\|] [\|\-\-typedefs\-and\-c++\|] -[\|\-\-language=\fIlanguage\fP\|] [\|\-\-regex=\fIregexp\fP\|] +[\|\-\-append\|] [\|\-\-backward\-search\|] [\|\-\-c++\|] +[\|\-\-cxref\|] [\|\-\-defines\|] [\|\-\-forward\-search\|] +[\|\-\-globals\|] [\|\-\-ignore\-indentation\|] +[\|\-\-language=\fIlanguage\fP\|] [\|\-\-members\|] +[\|\-\-output=\fItagfile\fP\|] [\|\-\-regex=\fIregexp\fP\|] +[\|\-\-ignore\-case\-regex=\fIregexp\fP\|] +[\|\-\-typedefs\|] [\|\-\-typedefs\-and\-c++\|] +[\|\-\-update\|] [\|\-\-no\-warn\|] [\|\-\-help\|] [\|\-\-version\|] -.br -[\|\-\-output=\fItagfile\fP\|] [\|\-\-append\|] [\|\-\-update\|] \fIfile\fP .\|.\|. +\fIfile\fP .\|.\|. .ad b .hy 1 .SH DESCRIPTION @@ -40,8 +49,8 @@ format understood by .BR vi ( 1 )\c \&. Both forms of the program understand -the syntax of C, Objective C, C++, Java, Fortran, Pascal, Cobol, -LaTeX, Scheme, Emacs Lisp/Common Lisp, Postscript, Erlang, Prolog and +the syntax of C, Objective C, C++, Java, Fortran, Pascal, Cobol, Ada, Perl, +LaTeX, Scheme, Emacs Lisp/Common Lisp, Postscript, Erlang, Python, Prolog and most assembler\-like syntaxes. Both forms read the files specified on the command line, and write a tag table (defaults: `\|TAGS\|' for \fBetags\fP, `\|tags\|' for @@ -77,18 +86,39 @@ code. Files with `\|.C\|', `\|.H\|', `\|.cxx\|', `\|.hxx\|', or `\|.cc\|' extensions are always assumed to be C++ code. .TP +.B \-\-declarations +In C and derived languages, create tags for function declarations, +and create tags for extern variables unless \-\-no\-globals is used. +.TP .B \-d, \-\-defines -Create tag entries for C preprocessor constant definitions +Create tag entries for C preprocessor constant definitions and enum constants, too. This is the -default behavior for \fBetags\fP, so this option is only accepted -by \fBctags\fP. +default behavior for \fBetags\fP. .TP .B \-D, \-\-no\-defines Do not create tag entries for C preprocessor constant definitions and enum constants. This may make the tags file much smaller if many header files are tagged. -This is the default behavior for \fBctags\fP, so this option is only -accepted by \fBetags\fP. +This is the default behavior for \fBctags\fP. +.TP +.B \-g, \-\-globals +Create tag entries for global variables in C, C++, Objective C, Java, +and Perl. +This is the default behavior for \fBetags\fP. +.TP +.B \-G, \-\-no\-globals +Do not tag global variables. Typically this reduces the file size by +one fourth. This is the default behavior for \fBctags\fP. +.TP +\fB\-i\fP \fIfile\fP, \fB\-\-include=\fIfile\fP +Include a note in the tag file indicating that, when searching for a +tag, one should also consult the tags file \fIfile\fP after checking the +current file. This options is only accepted by \fBetags\fP. +.TP +.B \-I, \-\-ignore\-indentation +Don't rely on indentation as much as we normally do. Currently, this +means not to assume that a closing brace in the first column is the +final brace of a function or structure definition in C and C++. .TP \fB\-l\fP \fIlanguage\fP, \fB\-\-language=\fIlanguage\fP Parse the following files according to the given language. More than @@ -99,27 +129,30 @@ language may be used to disable language parsing altogether; only regexp matching is done in this case (see the \fB\-\-regex\fP option). .TP -\fB\-\-no_globals\fP -Do not tag global variables in C, C++, Objective C, Java. Typically -this reduces the file size by one fourth. +.B \-m, \-\-members +Create tag entries for variables that are members of structure-like +constructs in C++, Objective C, Java. .TP -\fB\-\-members\fP -Tag variables that are members of strucure-like constructs in C++, -Objective C, Java. +.B \-M, \-\-no\-members +Do not tag member variables. This is the default behavior. +.TP +.B \-\-packages\-only +Only tag packages in Ada files. .TP \fB\-o\fP \fItagfile\fP, \fB\-\-output=\fItagfile\fP Explicit name of file for tag table; overrides default `\|TAGS\|' or `\|tags\|'. (But ignored with \fB\-v\fP or \fB\-x\fP.) .TP \fB\-r\fP \fIregexp\fP, \fB\-\-regex=\fIregexp\fP -Make tags based on regexp matching for each line of the files -following this option, in addition to the tags made with the standard -parsing based on language. May be freely intermixed with filenames -and the \fB\-R\fP option. The regexps are cumulative, i.e. each -option will add to the previous ones. The regexps are of the form: +\fB\-\-ignore\-case\-regex=\fIregexp\fP\ +Make tags based on regexp matching for each line of the files following +this option, in addition to the tags made with the standard parsing based +on language. When using \-\-regex, case is significant, while it is not +with \-\-ignore\-case\-regex. May be freely intermixed with filenames and +the \fB\-R\fP option. The regexps are cumulative, i.e. each option will +add to the previous ones. The regexps are of the form: .br - - \fB/\fP\fItagregexp\fP[\fB/\fP\fInameregexp\fP]\fB/\fP + \fB/\fP\fItagregexp\fP[\fB/\fP\fInameregexp\fP]\fB/\fP .br where \fItagregexp\fP is used to match the lines that must be tagged. @@ -127,8 +160,8 @@ such that more characters than needed are unavoidably matched by \fItagregexp\fP, it may be useful to add a \fInameregexp\fP, to narrow down the tag scope. \fBctags\fP ignores regexps without a -\fInameregexp\fP. The syntax of regexps is the same as in emacs, -augmented with intervals of the form \\{m,n\\}, as id ed or grep. +\fInameregexp\fP. The syntax of regexps is the same as in emacs, +augmented with intervals of the form \\{m,n\\}, as in ed or grep. .br Here are some examples. All the regexps are quoted to protect them from shell interpretation. @@ -152,16 +185,25 @@ .br \fI\-\-lang\=none \-\-regex\='/proc[\ \\t]+\\([^\ \\t]+\\)/\\1/'\fP +.br +A regexp can be preceded by {lang}, thus restriciting it to match lines of +files of the specified language. Use \fBetags --help\bP to obtain a list +of the recognised languages. This feature is particularly useful inside +\fBregex files\fB. A regex file contains one regex per line. Empty lines, +and those lines beginning with space or tab are ignored. Lines beginning +with @ are references to regex files whose name follows the @ sign. Other +lines are considered regular expressions like those following \-\-regex. +.br +For example, the command +.br +etags \-\-regex=@regex.file *.c +.br +reads the regexes contained in the file regex.file. .TP .B \-R, \-\-no\-regex Don't do any more regexp matching on the following files. May be freely intermixed with filenames and the \fB\-\-regex\fP option. .TP -.B \-S, \-\-ignore\-indentation -Don't rely on indentation as much as we normally do. Currently, this -means not to assume that a closing brace in the first column is the -final brace of a function or structure definition in C and C++. -.TP .B \-t, \-\-typedefs Record typedefs in C code as tags. Since this is the default behaviour of \fBetags\fP, only \fBctags\fP accepts this option. @@ -192,7 +234,7 @@ Instead of generating a tag file, write a cross reference (in \fBcxref\fP format) to standard output. Only \fBctags\fP accepts this option. .TP -.B \-H, \-\-help +.B \-h, \-H, \-\-help Print usage information. .TP .B \-V, \-\-version @@ -209,7 +251,7 @@ .BR vi ( 1 ). .SH COPYING -Copyright (c) 1992 Free Software Foundation, Inc. +Copyright (c) 1999 Free Software Foundation, Inc. .PP Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/gnuserv.1 --- a/etc/gnuserv.1 Mon Aug 13 11:12:06 2007 +0200 +++ b/etc/gnuserv.1 Mon Aug 13 11:13:30 2007 +0200 @@ -291,4 +291,4 @@ etc/emacsclient.c, etc/server.c and lisp/server.el from the GNU Emacs 18.52 distribution. Various modifications from Bob Weiner (weiner@mot.com), Darrell Kindred (dkindred@cmu.edu), Arup Mukherjee (arup@cmu.edu), Ben -Wing (ben@xemacs.org) and Hrvoje Niksic (hniksic@srce.hr). +Wing (ben@xemacs.org) and Hrvoje Niksic (hniksic@xemacs.org). diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/package-index.LATEST.pgp --- a/etc/package-index.LATEST.pgp Mon Aug 13 11:12:06 2007 +0200 +++ b/etc/package-index.LATEST.pgp Mon Aug 13 11:13:30 2007 +0200 @@ -1,21 +1,68 @@ +-----BEGIN PGP SIGNED MESSAGE----- +Hash: SHA1 + ;; Package Index file -- Do not edit manually. ;;;@@@ (package-get-update-base-entry (quote +(lookup + (standards-version 1.1 + version "1.03" + author-version "1.0" + date "1999-05-05" + build-date "1999-07-30" + maintainer "XEmacs Development Team " + distribution mule + priority high + category "mule" + dump nil + description "Dictionary support" + filename "lookup-1.03-pkg.tar.gz" + md5sum "d99759b042f8bf401d487e4ea140450d" + size 212861 + provides (lookup) + requires (cookie lookup) + type regular +)) +)) +;;;@@@ +(package-get-update-base-entry (quote +(os-utils + (standards-version 1.1 + version "1.18" + author-version "21.1" + date "1999-07-20" + build-date "1999-07-30" + maintainer "XEmacs Development Team " + distribution xemacs + priority medium + category "os" + dump nil + description "Miscellaneous O/S utilities." + filename "os-utils-1.18-pkg.tar.gz" + md5sum "bafbe5e2628fc678daad46b07ba7fef6" + size 179680 + provides (archive-mode background crypt crypt++ inf-lisp jka-compr lpr mchat tar-mode telnet terminal uncompress) + requires (xemacs-base) + type single +)) +)) +;;;@@@ +(package-get-update-base-entry (quote (ediff - (standards-version 1.0 - version "1.18" + (standards-version 1.1 + version "1.22" author-version "2.72" - date "1999-03-03" - build-date "1999-03-05" + date "1999-05-27" + build-date "1999-07-30" maintainer "Michael Kifer " - distribution stable + distribution xemacs priority medium category "prog" dump nil description "Interface over GNU patch." - filename "ediff-1.18-pkg.tar.gz" - md5sum "ece3aca382d80a7c03d71766987b9f2f" - size 281635 + filename "ediff-1.22-pkg.tar.gz" + md5sum "a9ece02fc03ac74ee4501845dec88710" + size 282084 provides (ediff) requires (pcl-cvs elib dired xemacs-base) type regular @@ -68,20 +115,20 @@ ;;;@@@ (package-get-update-base-entry (quote (skk - (standards-version 1.0 - version "1.12" + (standards-version 1.1 + version "1.14" author-version "10.38" - date "1998-10-01" - build-date "1999-02-02" - maintainer "SL Baur " + date "1999-05-18" + build-date "1999-07-30" + maintainer "SL Baur " distribution mule priority medium category "mule" - dump t + dump nil description "Japanese Language Input Method." - filename "skk-1.12-pkg.tar.gz" - md5sum "f690c518a0da65c4dc9fe2a867026c26" - size 1514106 + filename "skk-1.14-pkg.tar.gz" + md5sum "b8c89832f314570cb251147ced107c49" + size 1514095 provides (skk skk-tut) requires (viper mule-base elib xemacs-base) type regular @@ -90,20 +137,20 @@ ;;;@@@ (package-get-update-base-entry (quote (egg-its - (standards-version 1.0 - version "1.15" - author-version "21.0b62" - date "1999-01-04" - build-date "1999-02-02" + (standards-version 1.1 + version "1.19" + author-version "21.1" + date "1999-07-26" + build-date "1999-07-30" maintainer "XEmacs Development Team " distribution mule priority high category "mule" - dump t + dump nil description "Wnn (4.2 and 6) support. SJ3 support." - filename "egg-its-1.15-pkg.tar.gz" - md5sum "9c3f18c0c7eb0e77bc23af5aed0e3bcd" - size 257327 + filename "egg-its-1.19-pkg.tar.gz" + md5sum "121037363bae6925fd4933f861cbdabb" + size 261537 provides (egg-cnpinyin egg-cnzhuyin egg-cwnn-leim egg-jisx0201 egg-jsymbol egg-kwnn-leim egg-leim egg-sj3-client egg-sj3-leim egg-sj3 egg-wnn egg) requires (leim mule-base fsf-compat xemacs-base) type regular @@ -112,20 +159,20 @@ ;;;@@@ (package-get-update-base-entry (quote (edict - (standards-version 1.0 - version "1.07" + (standards-version 1.1 + version "1.08" author-version "0.9.8" date "1998-07-23" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "Stephen J. Turnbull " distribution mule priority high category "mule" dump nil description "Lisp Interface to EDICT, Kanji Dictionary" - filename "edict-1.07-pkg.tar.gz" - md5sum "493ef0ec6f2760e5c94423c23c9d124e" - size 71661 + filename "edict-1.08-pkg.tar.gz" + md5sum "f339e93a2cb02d9224e4bf9f313b0b62" + size 71621 provides (dui-registry dui edict-edit edict-english edict-japanese edict-morphology edict-test edict ts-mode) requires (mule-base xemacs-base) type regular @@ -134,20 +181,20 @@ ;;;@@@ (package-get-update-base-entry (quote (leim - (standards-version 1.0 - version "1.12" - author-version "21.0b62" - date "1998-07-23" - build-date "1999-02-02" + (standards-version 1.1 + version "1.13" + author-version "21.1" + date "1999-06-29" + build-date "1999-07-30" maintainer "XEmacs Development Team " distribution mule priority medium category "mule" dump nil description "Quail. All non-English and non-Japanese language support." - filename "leim-1.12-pkg.tar.gz" - md5sum "07cc5be34a0d9d312b883b430349a882" - size 1671757 + filename "leim-1.13-pkg.tar.gz" + md5sum "9cd059afefa3aff94fd1802c8db6c39a" + size 1702922 provides () requires (mule-base fsf-compat xemacs-base) type regular @@ -156,20 +203,20 @@ ;;;@@@ (package-get-update-base-entry (quote (locale - (standards-version 1.0 - version "1.12" - author-version "21.0b64" - date "1999-02-02" - build-date "1999-03-05" + (standards-version 1.1 + version "1.14" + author-version "21.1" + date "1999-05-11" + build-date "1999-07-30" maintainer "XEmacs Development Team " distribution mule priority high category "mule" dump nil description "Localized menubars and localized splash screens." - filename "locale-1.12-pkg.tar.gz" - md5sum "fbdb329b8e57e5eaf8c8fb9488357312" - size 33900 + filename "locale-1.14-pkg.tar.gz" + md5sum "5a5c7e878596a1009e97a8c4f491826c" + size 35744 provides () requires (mule-base) type regular @@ -178,42 +225,42 @@ ;;;@@@ (package-get-update-base-entry (quote (mule-base - (standards-version 1.0 - version "1.28" - author-version "21.0b63" - date "1999-02-17" - build-date "1999-03-01" - maintainer "SL Baur " + (standards-version 1.1 + version "1.32" + author-version "21.1" + date "1999-06-30" + build-date "1999-07-30" + maintainer "SL Baur " distribution mule priority high category "mule" - dump t + dump nil description "Basic Mule support, required for building with Mule." - filename "mule-base-1.28-pkg.tar.gz" - md5sum "498d725e923476af3df12b83fef6277d" - size 441953 + filename "mule-base-1.32-pkg.tar.gz" + md5sum "40950af24540e6cfc6875a9ddc7bab5d" + size 453902 provides (canna-leim canna char-table china-util cyril-util isearch-ext japan-util ccl can-n-egg mule-help) - requires (fsf-compat xemacs-base) + requires (fsf-compat xemacs-base apel) type regular )) )) ;;;@@@ (package-get-update-base-entry (quote (strokes - (standards-version 1.0 - version "1.04" - author-version "21.0b62" + (standards-version 1.1 + version "1.05" + author-version "21.1" date "1998-01-25" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority medium category "oa" dump nil description "Mouse enhancement utility." - filename "strokes-1.04-pkg.tar.gz" - md5sum "9a83020e888d140da2360dcac83c7c86" - size 43481 + filename "strokes-1.05-pkg.tar.gz" + md5sum "42b991c28dc393a78f9da792f15e53d3" + size 43480 provides (strokes) requires (text-modes edit-utils mail-lib xemacs-base) type regular @@ -222,20 +269,20 @@ ;;;@@@ (package-get-update-base-entry (quote (time - (standards-version 1.0 - version "1.07" + (standards-version 1.1 + version "1.08" author-version "1.17" date "1998-04-24" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority medium category "oa" dump nil description "Display time & date on the modeline." - filename "time-1.07-pkg.tar.gz" - md5sum "4cc97d84357412fb7d737a88b6f05cbe" - size 20006 + filename "time-1.08-pkg.tar.gz" + md5sum "c67d7143de5694ec4a7e17023ceab902" + size 19994 provides (time) requires (xemacs-base) type regular @@ -244,20 +291,20 @@ ;;;@@@ (package-get-update-base-entry (quote (text-modes - (standards-version 1.0 - version "1.18" - author-version "21.0b63" - date "1999-02-15" - build-date "1999-03-01" + (standards-version 1.1 + version "1.21" + author-version "21.1" + date "1999-07-06" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority high category "oa" dump nil description "Miscellaneous support for editing text files." - filename "text-modes-1.18-pkg.tar.gz" - md5sum "f9d30bd220d0806179397194603b0b0f" - size 207596 + filename "text-modes-1.21-pkg.tar.gz" + md5sum "d9d9505dfbe52854b3337eddfce093d1" + size 207873 provides (autoinsert crontab-edit filladapt fold-isearch folding image-mode iso-acc iso-ascii iso-cvt iso-insert iso-swed swedish tabify whitespace-mode winmgr-mode xpm-mode xrdb-mode) requires (ispell fsf-compat xemacs-base) type regular @@ -266,20 +313,20 @@ ;;;@@@ (package-get-update-base-entry (quote (slider - (standards-version 1.0 - version "1.09" + (standards-version 1.1 + version "1.10" author-version "0.3x1" date "1998-08-13" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution experimental + distribution xemacs priority low category "oa" dump nil description "User interface tool." - filename "slider-1.09-pkg.tar.gz" - md5sum "b211a950179fee88712fc5c38e395069" - size 12004 + filename "slider-1.10-pkg.tar.gz" + md5sum "a67e165592a2921ff0978a69befa0d6d" + size 12000 provides (slider color-selector) requires () type regular @@ -288,20 +335,20 @@ ;;;@@@ (package-get-update-base-entry (quote (sgml - (standards-version 1.0 - version "1.04" - author-version "21.0b62" + (standards-version 1.1 + version "1.05" + author-version "21.1" date "1998-01-25" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution contrib + distribution xemacs priority low category "oa" dump nil description "SGML/Linuxdoc-SGML editing." - filename "sgml-1.04-pkg.tar.gz" - md5sum "2b762a0fbdda616916624dc2fa53e647" - size 26938 + filename "sgml-1.05-pkg.tar.gz" + md5sum "ead5d1671dfebf394be76166c786b0c2" + size 26937 provides (sgml linuxdoc-sgml) requires (xemacs-base) type regular @@ -310,20 +357,20 @@ ;;;@@@ (package-get-update-base-entry (quote (psgml - (standards-version 1.0 - version "1.12" + (standards-version 1.1 + version "1.14" author-version "1.01" - date "1999-03-05" - build-date "1999-03-05" + date "1999-06-13" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority medium category "oa" dump nil description "Validated HTML/SGML editing." - filename "psgml-1.12-pkg.tar.gz" - md5sum "7303b3a604659b64f24b0847b3a686d5" - size 425458 + filename "psgml-1.14-pkg.tar.gz" + md5sum "44102484c3e5588bab21005cec1a46e1" + size 425227 provides (psgml sgml) requires (edit-utils) type regular @@ -332,20 +379,20 @@ ;;;@@@ (package-get-update-base-entry (quote (pc - (standards-version 1.0 - version "1.14" - author-version "21.0b62" - date "1998-07-25" - build-date "1999-02-02" + (standards-version 1.1 + version "1.16" + author-version "21.1" + date "1999-04-13" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "oa" dump nil description "PC style interface emulation." - filename "pc-1.14-pkg.tar.gz" - md5sum "e300f9e0ee56640e110bee972fca8333" - size 16243 + filename "pc-1.16-pkg.tar.gz" + md5sum "d721157770274b9fee0b16933764c636" + size 16324 provides (delbs fusion pc-select pending-del s-region) requires (xemacs-base) type regular @@ -354,20 +401,20 @@ ;;;@@@ (package-get-update-base-entry (quote (ispell - (standards-version 1.0 - version "1.14" - author-version "3.1" - date "1998-12-09" - build-date "1999-02-02" + (standards-version 1.1 + version "1.16" + author-version "3.2" + date "1999-07-22" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "oa" dump nil description "Spell-checking with GNU ispell." - filename "ispell-1.14-pkg.tar.gz" - md5sum "2b382122698c2c46aeaa4847e7ab3825" - size 67525 + filename "ispell-1.16-pkg.tar.gz" + md5sum "a3140984afc8a9d5aa0d0116625b2d07" + size 68157 provides (ispell) requires () type regular @@ -376,20 +423,20 @@ ;;;@@@ (package-get-update-base-entry (quote (frame-icon - (standards-version 1.0 - version "1.06" - author-version "21.0b62" + (standards-version 1.1 + version "1.07" + author-version "21.1" date "1998-07-14" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution contrib + distribution xemacs priority low category "oa" dump nil description "Set up mode-specific icons for each frame under XEmacs" - filename "frame-icon-1.06-pkg.tar.gz" - md5sum "bc4f6e838a4fa12d7f3b8b1996b3a9ac" - size 33483 + filename "frame-icon-1.07-pkg.tar.gz" + md5sum "320909b8d8caa9754c08963878acbb8b" + size 33434 provides (forms forms-mode) requires () type regular @@ -398,20 +445,20 @@ ;;;@@@ (package-get-update-base-entry (quote (forms - (standards-version 1.0 - version "1.09" - author-version "2.10" - date "1998-01-25" - build-date "1999-02-02" + (standards-version 1.1 + version "1.11" + author-version "2.37" + date "1999-05-11" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution contrib + distribution xemacs priority low category "oa" dump nil description "Forms editing support (obsolete, use Widget instead)." - filename "forms-1.09-pkg.tar.gz" - md5sum "7023bf24836c00572fc3b014d9c9b3c9" - size 47673 + filename "forms-1.11-pkg.tar.gz" + md5sum "36604485f4a1031d28968fe2c8534a6d" + size 48263 provides (forms forms-mode) requires () type regular @@ -420,20 +467,20 @@ ;;;@@@ (package-get-update-base-entry (quote (calendar - (standards-version 1.0 - version "1.10" - author-version "21.0b63" - date "1999-02-08" - build-date "1999-03-01" + (standards-version 1.1 + version "1.12" + author-version "21.1" + date "1999-06-24" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "oa" dump nil description "Calendar and diary support." - filename "calendar-1.10-pkg.tar.gz" - md5sum "09e93d157d2853a35e735a6a04f54055" - size 248580 + filename "calendar-1.12-pkg.tar.gz" + md5sum "d6ad2b3a3477d04ca3b669a67eecc8bc" + size 250669 provides (appt cal-dst cal-french cal-mayan cal-x cal-xemacs calendar diary-ins diary-lib holidays lunar solar) requires (xemacs-base) type regular @@ -442,20 +489,20 @@ ;;;@@@ (package-get-update-base-entry (quote (calc - (standards-version 1.0 - version "1.10" + (standards-version 1.1 + version "1.11" author-version "2.02fX3" date "1998-07-25" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "oa" dump nil description "Emacs calculator" - filename "calc-1.10-pkg.tar.gz" - md5sum "148c82bf6f213d6e2fb234e1f21e4699" - size 1616821 + filename "calc-1.11-pkg.tar.gz" + md5sum "7a0cce9d75b5c70f02db67f18eb6a97d" + size 1616700 provides (calc) requires () type regular @@ -464,20 +511,20 @@ ;;;@@@ (package-get-update-base-entry (quote (speedbar - (standards-version 1.0 - version "1.11" + (standards-version 1.1 + version "1.13" author-version "0.6.2x" - date "1998-10-02" - build-date "1999-02-02" + date "1999-07-15" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "oa" dump nil description "Provides a seperate frame with convenient references." - filename "speedbar-1.11-pkg.tar.gz" - md5sum "896acffc88848f175ada5ae637b67738" - size 64858 + filename "speedbar-1.13-pkg.tar.gz" + md5sum "0a2352aa6866888fc8ecdc7ec8d86516" + size 64955 provides (speedbar) requires (xemacs-base) type regular @@ -486,20 +533,20 @@ ;;;@@@ (package-get-update-base-entry (quote (edit-utils - (standards-version 1.0 - version "1.37" - author-version "21.0b63" - date "1999-02-18" - build-date "1999-03-01" + (standards-version 1.1 + version "1.41" + author-version "21.1" + date "1999-07-07" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority high category "oa" dump nil description "Miscellaneous editor extensions, you probably need this." - filename "edit-utils-1.37-pkg.tar.gz" - md5sum "fb7f38fd037c0fa045a199796c69e6d7" - size 577293 + filename "edit-utils-1.41-pkg.tar.gz" + md5sum "a3d5116811348bde6d56976ce94a991a" + size 579673 provides (abbrevlist atomic-extents avoid backup-dir balloon-help big-menubar blink-cursor blink-paren bookmark compare-w completion dabbrev desktop detached-minibuf edit-toolbar fast-lock file-part floating-toolbar flow-ctrl foldout func-menu hippie-exp icomplete id-select info-look iswitchb lazy-lock lazy-shot live-icon man mic-paren paren popper mode-motion+ outl-mouse page-ext blink-paren paren permanent-buffers recent-files redo reportmail rsz-minibuf saveconfsavehist saveplace scroll-in-place tempo toolbar-utils tree-menu uniquify where-was-i-db) requires (xemacs-base) type single @@ -508,20 +555,20 @@ ;;;@@@ (package-get-update-base-entry (quote (view-process - (standards-version 1.0 - version "1.06" + (standards-version 1.1 + version "1.07" author-version "2.4" date "1998-01-24" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "os" dump nil description "A Unix process browsing tool." - filename "view-process-1.06-pkg.tar.gz" - md5sum "61c4c7175f23cb4cfd314e10303b238c" - size 59958 + filename "view-process-1.07-pkg.tar.gz" + md5sum "47a82bb6569dd9d9bed03a57c9391538" + size 59953 provides (view-process-mode) requires (xemacs-base) type regular @@ -531,19 +578,19 @@ (package-get-update-base-entry (quote (os-utils (standards-version 1.0 - version "1.14" - author-version "21.0b62" - date "1998-12-30" - build-date "1999-02-02" + version "1.15" + author-version "21.0" + date "1999-03-19" + build-date "1999-05-13" maintainer "XEmacs Development Team " distribution stable priority medium category "os" dump nil description "Miscellaneous O/S utilities." - filename "os-utils-1.14-pkg.tar.gz" - md5sum "2ff61cea716a53af1846d1699b5194a7" - size 227298 + filename "os-utils-1.15-pkg.tar.gz" + md5sum "92a3d72b0df1fb79fef2aee88a4d4f50" + size 228261 provides (archive-mode background crypt crypt++ inf-lisp jka-compr lpr mchat ps-print tar-mode telnet terminal uncompress) requires (xemacs-base) type single @@ -552,20 +599,20 @@ ;;;@@@ (package-get-update-base-entry (quote (ilisp - (standards-version 1.0 - version "1.07" + (standards-version 1.1 + version "1.08" author-version "5.8" date "1998-01-24" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "os" dump nil description "Front-end for Inferior Lisp." - filename "ilisp-1.07-pkg.tar.gz" - md5sum "38cb2d94926e310a6e71ec1be854d636" - size 262173 + filename "ilisp-1.08-pkg.tar.gz" + md5sum "12041533cb292d9d58a55278c8882c70" + size 262171 provides (ilisp completer) requires (xemacs-base) type regular @@ -574,20 +621,20 @@ ;;;@@@ (package-get-update-base-entry (quote (igrep - (standards-version 1.0 - version "1.05" + (standards-version 1.1 + version "1.06" author-version "2.83" date "1998-08-11" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "os" dump nil description "Enhanced front-end for Grep." - filename "igrep-1.05-pkg.tar.gz" - md5sum "e70d4973a2af4dbd6222f5943bfa1a50" - size 14935 + filename "igrep-1.06-pkg.tar.gz" + md5sum "9a61dc2c81e909993e14254f30df3ee7" + size 14927 provides (igrep) requires (dired xemacs-base) type regular @@ -596,20 +643,20 @@ ;;;@@@ (package-get-update-base-entry (quote (eterm - (standards-version 1.0 - version "1.08" - author-version "21.0b62" - date "1998-06-28" - build-date "1999-02-02" + (standards-version 1.1 + version "1.09" + author-version "21.1" + date "1999-07-07" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority medium category "os" dump nil description "Terminal emulation." - filename "eterm-1.08-pkg.tar.gz" - md5sum "77e56529b5de6a0a0dd46c5d1634eebf" - size 108905 + filename "eterm-1.09-pkg.tar.gz" + md5sum "9cdab77e28dc87a79db4c503c961b37a" + size 109066 provides (eterm) requires (xemacs-base) type regular @@ -618,20 +665,20 @@ ;;;@@@ (package-get-update-base-entry (quote (viper - (standards-version 1.0 - version "1.14" + (standards-version 1.1 + version "1.17" author-version "3.061" - date "1999-03-03" - build-date "1999-03-05" + date "1999-05-27" + build-date "1999-07-30" maintainer "Michael Kifer " - distribution stable + distribution xemacs priority low category "wp" dump nil description "VI emulation support." - filename "viper-1.14-pkg.tar.gz" - md5sum "0e118822906e195dc352f28c8efc01e0" - size 317899 + filename "viper-1.17-pkg.tar.gz" + md5sum "89285f1297d73552d43602cf1288aefd" + size 317943 provides (viper) requires (xemacs-base) type regular @@ -640,20 +687,20 @@ ;;;@@@ (package-get-update-base-entry (quote (tpu - (standards-version 1.0 - version "1.08" + (standards-version 1.1 + version "1.09" author-version "4.2X" date "1998-07-23" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "Kevin Oberman " - distribution normal + distribution xemacs priority medium category "wp" dump nil description "DEC EDIT/TPU support." - filename "tpu-1.08-pkg.tar.gz" - md5sum "2306ac55a0a1ed23da02a85c91f881bb" - size 58804 + filename "tpu-1.09-pkg.tar.gz" + md5sum "9a467bd306599d97f0f5be0266850d79" + size 58814 provides (tpu) requires () type regular @@ -662,20 +709,20 @@ ;;;@@@ (package-get-update-base-entry (quote (textools - (standards-version 1.0 - version "1.08" - author-version "21.0b62" + (standards-version 1.1 + version "1.09" + author-version "21.1" date "1998-04-29" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stabl + distribution xemacs priority medium category "wp" dump nil description "Miscellaneous TeX support." - filename "textools-1.08-pkg.tar.gz" - md5sum "22dd0e16433a96547fde5757c6793388" - size 79176 + filename "textools-1.09-pkg.tar.gz" + md5sum "d0e16392dfdcd9ec8eab4ebc8da9948e" + size 79187 provides (bib-mode bibtex refer-to-bibtex) requires (xemacs-base) type single @@ -684,20 +731,20 @@ ;;;@@@ (package-get-update-base-entry (quote (texinfo - (standards-version 1.0 - version "1.14" - author-version "21.0b62" + (standards-version 1.1 + version "1.15" + author-version "21.1" date "1998-07-20" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority high category "wp" dump nil description "XEmacs TeXinfo support." - filename "texinfo-1.14-pkg.tar.gz" - md5sum "b1b6a7f4c1ff10be38d3e27d1213f1c8" - size 127830 + filename "texinfo-1.15-pkg.tar.gz" + md5sum "3c0ba97404953b4383d06f0a88a3a6cd" + size 127873 provides (makeinfo tex-mode texinfmt texinfo texnfo-tex texnfo-upd) requires (xemacs-base) type regular @@ -706,20 +753,20 @@ ;;;@@@ (package-get-update-base-entry (quote (reftex - (standards-version 1.0 - version "1.12" + (standards-version 1.1 + version "1.14" author-version "3.43" - date "1999-03-01" - build-date "1999-03-02" + date "1999-04-06" + build-date "1999-07-30" maintainer "Carsten Dominik " - distribution stable + distribution xemacs priority medium category "wp" dump nil description "Emacs support for LaTeX cross-references, citations.." - filename "reftex-1.12-pkg.tar.gz" - md5sum "73efb58d055143d9322024d97fcca479" - size 215874 + filename "reftex-1.14-pkg.tar.gz" + md5sum "e56e631f54e895ed95377be6e882bed5" + size 215968 provides (reftex) requires (fsf-compat xemacs-base) type regular @@ -728,20 +775,20 @@ ;;;@@@ (package-get-update-base-entry (quote (edt - (standards-version 1.0 - version "1.07" - author-version "21.0b62" + (standards-version 1.1 + version "1.08" + author-version "21.1" date "1998-04-07" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution contrib + distribution xemacs priority low category "wp" dump nil description "DEC EDIT/EDT emulation." - filename "edt-1.07-pkg.tar.gz" - md5sum "6c48ceb9686c50058be3938288940bc5" - size 46131 + filename "edt-1.08-pkg.tar.gz" + md5sum "bade43d3b5c90a4b9c969a1f85ef606e" + size 46128 provides (edt) requires (xemacs-base) type regular @@ -750,20 +797,20 @@ ;;;@@@ (package-get-update-base-entry (quote (crisp - (standards-version 1.0 - version "1.09" + (standards-version 1.1 + version "1.10" author-version "1.34" date "1998-08-18" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "wp" dump nil description "Crisp/Brief emulation." - filename "crisp-1.09-pkg.tar.gz" - md5sum "faa9b6f2868a7e5b212d1094039cf526" - size 10067 + filename "crisp-1.10-pkg.tar.gz" + md5sum "82fcef8e2a2c6e0d40c68f6142c6a780" + size 10065 provides (crisp scroll-lock) requires () type regular @@ -772,20 +819,20 @@ ;;;@@@ (package-get-update-base-entry (quote (auctex - (standards-version 1.0 - version "1.16" + (standards-version 1.1 + version "1.17" author-version "9.7p" date "1998-09-30" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority medium category "wp" dump nil description "Basic TeX/LaTeX support." - filename "auctex-1.16-pkg.tar.gz" - md5sum "56e3454a1162c25db93fc84bdab61d0f" - size 365136 + filename "auctex-1.17-pkg.tar.gz" + md5sum "be1dc85bba341dba02ec13ce06bf9609" + size 365053 provides (auc-old bib-cite font-latex latex multi-prompt tex-buf tex-info tex-jp tex-site tex) requires (xemacs-base) type regular @@ -794,20 +841,20 @@ ;;;@@@ (package-get-update-base-entry (quote (vhdl - (standards-version 1.0 - version "1.07" + (standards-version 1.1 + version "1.08" author-version "2.74" date "1998-01-24" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "prog" dump nil description "Support for VHDL." - filename "vhdl-1.07-pkg.tar.gz" - md5sum "0eae8d15cff7d7b6dd7e1d00029c0e3a" - size 65961 + filename "vhdl-1.08-pkg.tar.gz" + md5sum "8d3422f8b6ba5584dbf89d3ef6759594" + size 65948 provides (vhdl-mode) requires () type regular @@ -816,20 +863,20 @@ ;;;@@@ (package-get-update-base-entry (quote (vc - (standards-version 1.0 - version "1.17" - author-version "21.0b63" - date "1999-02-25" - build-date "1999-03-01" + (standards-version 1.1 + version "1.19" + author-version "21.1" + date "1999-06-07" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "prog" dump nil description "Version Control for Free systems." - filename "vc-1.17-pkg.tar.gz" - md5sum "4e80458c0e6d4cf2805ed6a46135e1c6" - size 84499 + filename "vc-1.19-pkg.tar.gz" + md5sum "2794428c1167de3f1db8e9928041b065" + size 84689 provides (vc) requires (dired xemacs-base) type regular @@ -838,20 +885,20 @@ ;;;@@@ (package-get-update-base-entry (quote (vc-cc - (standards-version 1.0 - version "1.11" - author-version "21.0b62" + (standards-version 1.1 + version "1.12" + author-version "21.1" date "1998-12-09" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution contrib + distribution xemacs priority low category "prog" dump nil description "Version Control for ClearCase (UnFree) systems." - filename "vc-cc-1.11-pkg.tar.gz" - md5sum "561ab60400e3fa6bfef8ad8567a3702d" - size 96544 + filename "vc-cc-1.12-pkg.tar.gz" + md5sum "db978159bf5d1d194782b79961d003d1" + size 96520 provides (vc) requires (dired xemacs-base) type regular @@ -860,20 +907,20 @@ ;;;@@@ (package-get-update-base-entry (quote (sh-script - (standards-version 1.0 - version "1.08" + (standards-version 1.1 + version "1.10" author-version "2.0e" - date "1998-05-12" - build-date "1999-02-02" + date "1999-05-31" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "prog" dump nil description "Support for editing shell scripts." - filename "sh-script-1.08-pkg.tar.gz" - md5sum "f2f584ab19761b1db14160d9d3cbc6f3" - size 33900 + filename "sh-script-1.10-pkg.tar.gz" + md5sum "003e39a5e97acce6f9b751a1fec5e398" + size 33987 provides (sh-script executable) requires (xemacs-base) type regular @@ -882,20 +929,20 @@ ;;;@@@ (package-get-update-base-entry (quote (scheme - (standards-version 1.0 - version "1.07" - author-version "21.0b62" - date "1998-09-08" - build-date "1999-02-02" + (standards-version 1.1 + version "1.09" + author-version "21.1" + date "1999-06-15" + build-date "1999-07-30" maintainer "Karl M. Hegbloom " - distribution contrib + distribution xemacs priority low category "prog" dump nil description "Front-end support for Inferior Scheme." - filename "scheme-1.07-pkg.tar.gz" - md5sum "998d46aee749b32493cae61cac3888d2" - size 36292 + filename "scheme-1.09-pkg.tar.gz" + md5sum "a4542795594e46af3b803d44ed3d7c8d" + size 36505 provides (scheme xscheme cmuscheme cmuscheme48) requires (xemacs-base) type regular @@ -904,20 +951,20 @@ ;;;@@@ (package-get-update-base-entry (quote (prog-modes - (standards-version 1.0 - version "1.18" - author-version "21.0b63" - date "1999-02-05" - build-date "1999-03-01" + (standards-version 1.1 + version "1.21" + author-version "21.1" + date "1999-07-15" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority medium category "prog" dump nil description "Support for various programming languages." - filename "prog-modes-1.18-pkg.tar.gz" - md5sum "b6b86a7a88544c54e5231e11e0a9af79" - size 595658 + filename "prog-modes-1.21-pkg.tar.gz" + md5sum "e83aff3ead4ab018d07b9b22e9ba301d" + size 601321 provides (autoconf-mode cperl-mode eiffel3 f90 fortran ksh-mode m4-mode makefile perl-mode postscript python-mode rexx-mode simula-mode tcl teco verilog-mod) requires (mail-lib xemacs-devel xemacs-base) type regular @@ -926,20 +973,20 @@ ;;;@@@ (package-get-update-base-entry (quote (emerge - (standards-version 1.0 - version "1.05" - author-version "21.0b62" + (standards-version 1.1 + version "1.06" + author-version "21.1" date "1998-04-07" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "prog" dump nil description "Another interface over GNU patch." - filename "emerge-1.05-pkg.tar.gz" - md5sum "1f4d70d7f4e73290837b2dbd2189be99" - size 61009 + filename "emerge-1.06-pkg.tar.gz" + md5sum "1f4c3003975e8c540742c37cd398dd4b" + size 61012 provides (emerge) requires () type regular @@ -948,20 +995,20 @@ ;;;@@@ (package-get-update-base-entry (quote (debug - (standards-version 1.0 - version "1.08" - author-version "21.0b62" - date "1998-11-18" - build-date "1999-02-02" + (standards-version 1.1 + version "1.10" + author-version "21.1" + date "1999-05-12" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution contrib + distribution xemacs priority low category "prog" dump nil description "GUD, gdb, dbx debugging support." - filename "debug-1.08-pkg.tar.gz" - md5sum "e2c9ff97146272670632311a9267765a" - size 89552 + filename "debug-1.10-pkg.tar.gz" + md5sum "81fab3bf4b08036d122f1e6abb7ffc74" + size 103093 provides (dbx gdb-highlight gdb gdbsrc gud history) requires (xemacs-base) type regular @@ -970,20 +1017,20 @@ ;;;@@@ (package-get-update-base-entry (quote (c-support - (standards-version 1.0 - version "1.12" - author-version "21.0b64" + (standards-version 1.1 + version "1.13" + author-version "21.1" date "1999-03-02" - build-date "1999-03-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution contrib + distribution xemacs priority low category "prog" dump nil description "Basic single-file add-ons for editing C code." - filename "c-support-1.12-pkg.tar.gz" - md5sum "a793cd83bb595d34771332a46d2abfd4" - size 69913 + filename "c-support-1.13-pkg.tar.gz" + md5sum "d4568a0fd8c0ea31917ad37e190e443b" + size 69931 provides (c-comment-edit cmacexp ctypes hideif hideshow) requires (cc-mode xemacs-base) type regular @@ -992,20 +1039,20 @@ ;;;@@@ (package-get-update-base-entry (quote (ada - (standards-version 1.0 - version "1.06" + (standards-version 1.1 + version "1.07" author-version "2.27" date "1998-01-24" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "prog" dump nil description "Ada language support." - filename "ada-1.06-pkg.tar.gz" - md5sum "0f3d2dc2ff33d40092b324a7a5a363d6" - size 54364 + filename "ada-1.07-pkg.tar.gz" + md5sum "f12fe7c6ac8ed3bcfeb761ffd9e60661" + size 54369 provides (ada-mode ada-stmt) requires () type regular @@ -1014,20 +1061,20 @@ ;;;@@@ (package-get-update-base-entry (quote (pcl-cvs - (standards-version 1.0 - version "1.38" + (standards-version 1.1 + version "1.40" author-version "R-2_0-Beta_2" - date "1998-11-17" - build-date "1999-02-02" + date "1999-06-16" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "prog" dump nil description "CVS frontend." - filename "pcl-cvs-1.38-pkg.tar.gz" - md5sum "a5ff4e61dffe3985c20385eb741d4783" - size 163524 + filename "pcl-cvs-1.40-pkg.tar.gz" + md5sum "2ad22b28bb14a7bade0b2fad0723d35f" + size 163639 provides (pcl-cvs generic-sc) requires (xemacs-base elib dired) type regular @@ -1036,20 +1083,20 @@ ;;;@@@ (package-get-update-base-entry (quote (cc-mode - (standards-version 1.0 - version "1.15" + (standards-version 1.1 + version "1.16" author-version "5.25" date "1998-12-30" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "Barry Warsaw " - distribution stable + distribution xemacs priority medium category "prog" dump nil description "C, C++ and Java language support." - filename "cc-mode-1.15-pkg.tar.gz" - md5sum "ca73b190e79f96ab928eecd12af94222" - size 212611 + filename "cc-mode-1.16-pkg.tar.gz" + md5sum "9f8c53d9abca09982e739344c733c7c3" + size 212664 provides (cc-mode) requires (xemacs-base) type regular @@ -1058,20 +1105,20 @@ ;;;@@@ (package-get-update-base-entry (quote (misc-games - (standards-version 1.0 - version "1.10" - author-version "21.0b64" - date "1999-03-04" - build-date "1999-03-05" + (standards-version 1.1 + version "1.12" + author-version "21.1" + date "1999-03-05" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "games" dump nil description "Other amusements and diversions." - filename "misc-games-1.10-pkg.tar.gz" - md5sum "d5d5c6c074fab908ba48a8a6ccdc4273" - size 165902 + filename "misc-games-1.12-pkg.tar.gz" + md5sum "74c3421bdfdfe77989741389f0e1330a" + size 166163 provides (decipher gomoku hanoi life morse rot13) requires (xemacs-base) type single @@ -1080,20 +1127,20 @@ ;;;@@@ (package-get-update-base-entry (quote (mine - (standards-version 1.0 - version "1.10" + (standards-version 1.1 + version "1.11" author-version "1.9" date "1998-05-09" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "games" dump nil description "Minehunt Game." - filename "mine-1.10-pkg.tar.gz" - md5sum "a2d4f93830fe86e4d4e2f081ec0517fb" - size 66679 + filename "mine-1.11-pkg.tar.gz" + md5sum "fad5f9d385ac22c2cf446db18e57300e" + size 66703 provides (xmine) requires (xemacs-base) type regular @@ -1102,20 +1149,20 @@ ;;;@@@ (package-get-update-base-entry (quote (games - (standards-version 1.0 - version "1.09" + (standards-version 1.1 + version "1.10" author-version "1.04" date "1998-06-04" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "Glynn Clements " - distribution stable + distribution xemacs priority low category "games" dump nil description "Tetris, Sokoban, and Snake." - filename "games-1.09-pkg.tar.gz" - md5sum "76a327a228745576538711180a9e444e" - size 32146 + filename "games-1.10-pkg.tar.gz" + md5sum "e43de212a7ceb56cbaad7e40eb775dd2" + size 32184 provides (gamegrid snake tetris sokoban) requires (xemacs-base) type regular @@ -1124,20 +1171,20 @@ ;;;@@@ (package-get-update-base-entry (quote (cookie - (standards-version 1.0 - version "1.10" - author-version "21.0b62" + (standards-version 1.1 + version "1.11" + author-version "21.1" date "1998-04-07" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "games" dump nil description "Spook and Yow (Zippy quotes)." - filename "cookie-1.10-pkg.tar.gz" - md5sum "1c5599fa30e346af452c126d872121be" - size 34198 + filename "cookie-1.11-pkg.tar.gz" + md5sum "291ea47a1e71de661de365aea0addb60" + size 34221 provides (cookie1 yow) requires (xemacs-base) type regular @@ -1146,20 +1193,20 @@ ;;;@@@ (package-get-update-base-entry (quote (bbdb - (standards-version 1.0 - version "1.07" - author-version "2.00.02" - date "1998-10-08" - build-date "1999-02-02" + (standards-version 1.1 + version "1.08" + author-version "2.00.06" + date "1999-01-24" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority medium category "comm" dump nil description "The Big Brother Data Base" - filename "bbdb-1.07-pkg.tar.gz" - md5sum "e28c4aed70df000812d34cb3795c2f72" - size 282200 + filename "bbdb-1.08-pkg.tar.gz" + md5sum "c95ed737fab5b59e88d9acc33703697b" + size 282061 provides (bbdb) requires (bbdb edit-utils gnus mh-e rmail supercite vm tm apel mail-lib xemacs-base) type regular @@ -1168,20 +1215,20 @@ ;;;@@@ (package-get-update-base-entry (quote (zenirc - (standards-version 1.0 - version "1.05" + (standards-version 1.1 + version "1.06" author-version "2.112" date "1998-08-15" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority medium category "comm" dump nil description "ZENIRC IRC Client." - filename "zenirc-1.05-pkg.tar.gz" - md5sum "df432e4987ddd0dd65e0124d7d910967" - size 276054 + filename "zenirc-1.06-pkg.tar.gz" + md5sum "7b701d195193ad6b0bf8e2067e17e372" + size 276012 provides (zenirc) requires (zenirc) type regular @@ -1190,20 +1237,20 @@ ;;;@@@ (package-get-update-base-entry (quote (mew - (standards-version 1.0 - version "1.07" + (standards-version 1.1 + version "1.08" author-version "1.93b38x1" date "1998-12-09" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution contrib + distribution xemacs priority low category "comm" dump nil description "Messaging in an Emacs World." - filename "mew-1.07-pkg.tar.gz" - md5sum "04ed302d5a3735169835e52dadc9e84d" - size 518432 + filename "mew-1.08-pkg.tar.gz" + md5sum "47ff3e8966c6a198cbae3a413139f4b7" + size 518502 provides (mew) requires (mew) type regular @@ -1212,20 +1259,20 @@ ;;;@@@ (package-get-update-base-entry (quote (tm - (standards-version 1.0 - version "1.17" - author-version "21.0b63" + (standards-version 1.1 + version "1.20" + author-version "21.1" date "1999-02-06" - build-date "1999-02-06" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "comm" dump nil description "Emacs MIME support." - filename "tm-1.17-pkg.tar.gz" - md5sum "ee33e9f5fb4cd461e19e5ff23b4a3ea2" - size 329581 + filename "tm-1.20-pkg.tar.gz" + md5sum "d602235f7efdcdd37e7758101e3c162d" + size 329547 provides (tm tm-edit tm-view mime-setup) requires (gnus mh-e rmail vm mailcrypt mail-lib apel xemacs-base) type regular @@ -1234,20 +1281,20 @@ ;;;@@@ (package-get-update-base-entry (quote (gnus - (standards-version 1.0 - version "1.39" + (standards-version 1.1 + version "1.42" author-version "5.6.45x1" - date "1999-02-17" - build-date "1999-03-05" + date "1999-03-12" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority medium category "comm" dump nil description "The Gnus Newsreader and Mailreader." - filename "gnus-1.39-pkg.tar.gz" - md5sum "5413e7508693bfcb16c5a4a0e0bce7c7" - size 1869261 + filename "gnus-1.42-pkg.tar.gz" + md5sum "f076c9ae4ca6ab468454d8036a178501" + size 1872714 provides (gnus message) requires (gnus tm apel w3 mh-e mailcrypt rmail mail-lib xemacs-base) type regular @@ -1256,20 +1303,20 @@ ;;;@@@ (package-get-update-base-entry (quote (rmail - (standards-version 1.0 - version "1.08" - author-version "21.0b62" + (standards-version 1.1 + version "1.10" + author-version "21.1" date "1998-06-28" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution contrib + distribution xemacs priority low category "comm" dump nil description "An obsolete Emacs mailer." - filename "rmail-1.08-pkg.tar.gz" - md5sum "90f98f9043e0c6f2180ffec9c6904eca" - size 96450 + filename "rmail-1.10-pkg.tar.gz" + md5sum "4a8b8e1d7b68957ab357d8f86f232fac" + size 96442 provides (rmail rmailsum) requires (tm apel mail-lib xemacs-base) type regular @@ -1278,42 +1325,42 @@ ;;;@@@ (package-get-update-base-entry (quote (mailcrypt - (standards-version 1.0 - version "1.07" - author-version "3.4" - date "1998-01-24" - build-date "1999-02-02" + (standards-version 1.1 + version "2.01" + author-version "3.5.3" + date "1999-03-12" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "comm" dump nil description "Support for messaging encryption with PGP." - filename "mailcrypt-1.07-pkg.tar.gz" - md5sum "350dccab50ef0800b95d44ef62cca359" - size 86362 + filename "mailcrypt-2.01-pkg.tar.gz" + md5sum "1225a54298f26e6a06749dfb0665b658" + size 134061 provides (mailcrypt) - requires (gnus vm mail-lib xemacs-base) + requires (mail-lib fsf-compat xemacs-base) type regular )) )) ;;;@@@ (package-get-update-base-entry (quote (supercite - (standards-version 1.0 - version "1.11" - author-version "3.55x2" - date "1998-08-9" - build-date "1999-02-02" + (standards-version 1.1 + version "1.13" + author-version "3.55x3" + date "1999-04-06" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "comm" dump nil description "An Emacs citation tool for News & Mail messages." - filename "supercite-1.11-pkg.tar.gz" - md5sum "816ba6aa0d984b06a0d8749fd85c4434" - size 99417 + filename "supercite-1.13-pkg.tar.gz" + md5sum "7f599f29f111dca3e62c3baeec2b2d91" + size 99547 provides (supercite) requires (mail-lib xemacs-base) type regular @@ -1322,20 +1369,20 @@ ;;;@@@ (package-get-update-base-entry (quote (mh-e - (standards-version 1.0 - version "1.09" - author-version "21.0b62" + (standards-version 1.1 + version "1.10" + author-version "21.1" date "1998-07-12" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution contrib + distribution xemacs priority low category "comm" dump nil description "Front end support for MH." - filename "mh-e-1.09-pkg.tar.gz" - md5sum "89e6f44e8dca03f6be10068391831262" - size 176469 + filename "mh-e-1.10-pkg.tar.gz" + md5sum "e04e85a9ff62282a18a06872c840e22f" + size 176436 provides (mh-e) requires (mail-lib xemacs-base) type regular @@ -1344,20 +1391,20 @@ ;;;@@@ (package-get-update-base-entry (quote (gnats - (standards-version 1.0 - version "1.08" + (standards-version 1.1 + version "1.09" author-version "3.101" date "1998-08-01" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority high category "comm" dump nil description "XEmacs bug reports." - filename "gnats-1.08-pkg.tar.gz" - md5sum "8c1e3100399aac86c63683b1836d4a61" - size 189265 + filename "gnats-1.09-pkg.tar.gz" + md5sum "0893c6cad7179a2be79744bdfc0c6932" + size 189250 provides (gnats gnats-admin send-pr) requires (mail-lib xemacs-base) type regular @@ -1366,20 +1413,20 @@ ;;;@@@ (package-get-update-base-entry (quote (footnote - (standards-version 1.0 - version "1.08" + (standards-version 1.1 + version "1.11" author-version "0.18x" - date "1998-08-27" - build-date "1999-02-02" + date "1999-03-11" + build-date "1999-07-30" maintainer "SL Baur " - distribution stable + distribution xemacs priority low category "comm" dump nil description "Footnoting in mail message editing modes." - filename "footnote-1.08-pkg.tar.gz" - md5sum "2c2377f0e702b8ba437cc8e245c08cfd" - size 13352 + filename "footnote-1.11-pkg.tar.gz" + md5sum "7aa931c602913134e5e716de752439db" + size 18364 provides (footnote) requires (mail-lib xemacs-base) type regular @@ -1388,21 +1435,21 @@ ;;;@@@ (package-get-update-base-entry (quote (eudc - (standards-version 1.0 - version "1.28" - author-version "1.28" - date "1999-02-13" - build-date "1999-03-01" - maintainer "Oscar Figueiredo " - distribution stable + (standards-version 1.1 + version "1.29" + author-version "1.29" + date "1999-07-21" + build-date "1999-07-30" + maintainer "Oscar Figueiredo " + distribution xemacs priority low category "comm" dump nil description "Emacs Unified Directory Client (LDAP, PH)." - filename "eudc-1.28-pkg.tar.gz" - md5sum "e88e7ed791d16105824812edcd743bc6" - size 62476 - provides (eudc eudc-ldap eudc-ph) + filename "eudc-1.29-pkg.tar.gz" + md5sum "23f490bd6771d873c1869fa1ac56a3a8" + size 71390 + provides (eudc eudc-ldap eudc-ph eudc-bbdb) requires (fsf-compat xemacs-base bbdb) type regular )) @@ -1410,20 +1457,20 @@ ;;;@@@ (package-get-update-base-entry (quote (net-utils - (standards-version 1.0 - version "1.11" - author-version "21.0b62" + (standards-version 1.1 + version "1.12" + author-version "21.1" date "1998-07-01" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "comm" dump nil description "Miscellaneous Networking Utilities." - filename "net-utils-1.11-pkg.tar.gz" - md5sum "f9d52e6e6b4f53ccf5cdd3521403e276" - size 107193 + filename "net-utils-1.12-pkg.tar.gz" + md5sum "49b7e1d0f2f97519eca07d3562f6a00d" + size 107202 provides (ilisp-browse-cltl2 emacsbug feedmail metamail net-utils rcompile shadowfile webjump webster-www) requires (w3 efs mail-lib xemacs-base) type single @@ -1432,20 +1479,20 @@ ;;;@@@ (package-get-update-base-entry (quote (w3 - (standards-version 1.0 - version "1.13" + (standards-version 1.1 + version "1.14" author-version "4.0pre39x1" date "1999-03-02" - build-date "1999-03-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution experimental + distribution xemacs priority high category "comm" dump nil description "A Web browser." - filename "w3-1.13-pkg.tar.gz" - md5sum "8e9f70ef2c4b43090cfbf86974517c66" - size 682040 + filename "w3-1.14-pkg.tar.gz" + md5sum "693692928758ea53e9fa76527893a483" + size 680740 provides (w3 url) requires (w3 mail-lib xemacs-base) type regular @@ -1454,20 +1501,20 @@ ;;;@@@ (package-get-update-base-entry (quote (vm - (standards-version 1.0 - version "1.17" - author-version "6.67" - date "1998-09-22" - build-date "1999-03-05" + (standards-version 1.1 + version "1.21" + author-version "6.72" + date "1999-05-13" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority medium category "comm" dump nil description "An Emacs mailer." - filename "vm-1.17-pkg.tar.gz" - md5sum "9a95c6264135124db979bce745bf0e07" - size 609688 + filename "vm-1.21-pkg.tar.gz" + md5sum "1110173b0759dbed61e9b1690d32d984" + size 619207 provides (vm) requires (mail-lib xemacs-base) type regular @@ -1476,20 +1523,20 @@ ;;;@@@ (package-get-update-base-entry (quote (sounds-wav - (standards-version 1.0 - version "1.07" - author-version "21.0b64" + (standards-version 1.1 + version "1.08" + author-version "21.1" date "1999-02-02" - build-date "1999-03-05" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority high category "libs" dump nil description "XEmacs Microsoft sound files." - filename "sounds-wav-1.07-pkg.tar.gz" - md5sum "60a70b85e8711fb1c9a1c7d0f4bf8ee0" - size 149045 + filename "sounds-wav-1.08-pkg.tar.gz" + md5sum "8d34b4f2a6cb90f3d86c94d018cc3912" + size 149046 provides () requires () type regular @@ -1498,20 +1545,20 @@ ;;;@@@ (package-get-update-base-entry (quote (sounds-au - (standards-version 1.0 - version "1.07" - author-version "21.0b64" + (standards-version 1.1 + version "1.08" + author-version "21.1" date "1999-02-02" - build-date "1999-03-05" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority high category "libs" dump nil description "XEmacs Sun sound files." - filename "sounds-au-1.07-pkg.tar.gz" - md5sum "4b5acd296b50102e50565650d9d7ec0b" - size 126184 + filename "sounds-au-1.08-pkg.tar.gz" + md5sum "8344fa28ad13a14e67accf72168ac91a" + size 126196 provides () requires () type regular @@ -1520,20 +1567,20 @@ ;;;@@@ (package-get-update-base-entry (quote (xemacs-devel - (standards-version 1.0 - version "1.21" - author-version "21.0b62" - date "1998-10-20" - build-date "1999-02-02" + (standards-version 1.1 + version "1.23" + author-version "21.1" + date "1999-05-28" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority medium category "libs" dump nil description "Emacs Lisp developer support." - filename "xemacs-devel-1.21-pkg.tar.gz" - md5sum "aa472f2d412382c2fdd3150105ca7d1c" - size 83543 + filename "xemacs-devel-1.23-pkg.tar.gz" + md5sum "f0f629aed67569b793347ca9713fc836" + size 83642 provides (docref eldoc elp find-func hide-copyleft ielm regexp-opt trace) requires (xemacs-base) type single @@ -1542,20 +1589,20 @@ ;;;@@@ (package-get-update-base-entry (quote (tooltalk - (standards-version 1.0 - version "1.09" - author-version "21.0b62" + (standards-version 1.1 + version "1.10" + author-version "21.1" date "1998-07-25" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution contrib + distribution xemacs priority low category "libs" dump nil description "Support for building with Tooltalk." - filename "tooltalk-1.09-pkg.tar.gz" - md5sum "368d6407bf82711bee9a01fa6908b576" - size 9271 + filename "tooltalk-1.10-pkg.tar.gz" + md5sum "6e73fe7a0ef9d9511e885999b806f914" + size 9279 provides () requires () type regular @@ -1564,20 +1611,20 @@ ;;;@@@ (package-get-update-base-entry (quote (elib - (standards-version 1.0 - version "1.04" + (standards-version 1.1 + version "1.05" author-version "1.0" date "1998-10-01" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution mule + distribution xemacs priority high category "libs" dump nil description "Portable Emacs Lisp utilities library." - filename "elib-1.04-pkg.tar.gz" - md5sum "d17596beb9b03292e322f8460c36eb81" - size 72834 + filename "elib-1.05-pkg.tar.gz" + md5sum "b9f0d18ae78f70a65a341c515aae2095" + size 72809 provides (avltree bintree cookie dll elib-node queue-f queue-m read stack-f stack-m string) requires () type single @@ -1586,20 +1633,20 @@ ;;;@@@ (package-get-update-base-entry (quote (edebug - (standards-version 1.0 - version "1.07" - author-version "21.0b62" + (standards-version 1.1 + version "1.08" + author-version "21.1" date "1998-03-12" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority low category "libs" dump nil description "An Emacs Lisp debugger." - filename "edebug-1.07-pkg.tar.gz" - md5sum "62d3e581feac2c3a73917ad0d81151b0" - size 112408 + filename "edebug-1.08-pkg.tar.gz" + md5sum "366450f91a308c84471f7cdb98fd907c" + size 112428 provides (edebug cl-read cust-print eval-reg cl-specs) requires (xemacs-base) type regular @@ -1608,20 +1655,20 @@ ;;;@@@ (package-get-update-base-entry (quote (Sun - (standards-version 1.0 - version "1.10" - author-version "21.0b62" + (standards-version 1.1 + version "1.11" + author-version "21.1" date "1998-07-25" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution sun + distribution xemacs priority low category "libs" dump nil description "Support for Sparcworks." - filename "Sun-1.10-pkg.tar.gz" - md5sum "54cce5cbb182d99de5562a586714e50c" - size 63693 + filename "Sun-1.11-pkg.tar.gz" + md5sum "8920cd925c5bff8b9d4a353d08c1f7ff" + size 63685 provides (sccs eos-browser eos-common eos-debugger eos-debugger eos-editor eos-init eos-load eos-menubar eos-toolbar sunpro) requires (cc-mode xemacs-base) type regular @@ -1630,20 +1677,20 @@ ;;;@@@ (package-get-update-base-entry (quote (apel - (standards-version 1.0 - version "1.09" - author-version "3.3" - date "1998-07-23" - build-date "1999-03-01" + (standards-version 1.1 + version "1.15" + author-version "9.20" + date "1999-07-26" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution mule + distribution xemacs priority high category "libs" dump nil description "A Portable Emacs Library. Used by XEmacs MIME support." - filename "apel-1.09-pkg.tar.gz" - md5sum "2030f4f38ef76da3104f77f36b797916" - size 35302 + filename "apel-1.15-pkg.tar.gz" + md5sum "503832a7c28fe700afc35dbaf7fdeb01" + size 79178 provides (atype emu-20 emu-e19 emu-x20 emu-xemacs emu file-detect filename install mule-caesar path-util richtext std11-parse std11 tinyrich) requires (fsf-compat xemacs-base) type regular @@ -1652,20 +1699,20 @@ ;;;@@@ (package-get-update-base-entry (quote (efs - (standards-version 1.0 - version "1.14" + (standards-version 1.1 + version "1.15" author-version "1.18" date "1999-01-03" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "Mike Sperber " - distribution stable + distribution xemacs priority medium category "libs" dump nil description "Treat files on remote systems the same as local files." - filename "efs-1.14-pkg.tar.gz" - md5sum "2b4128fec0dcb31834f404ef962f10ab" - size 369742 + filename "efs-1.15-pkg.tar.gz" + md5sum "4c88a1915bace153310c681f24deb14d" + size 369713 provides (efs) requires (xemacs-base vm dired) type regular @@ -1674,20 +1721,20 @@ ;;;@@@ (package-get-update-base-entry (quote (dired - (standards-version 1.0 - version "1.05" + (standards-version 1.1 + version "1.06" author-version "7.9" date "1998-12-09" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "Mike Sperber " - distribution stable + distribution xemacs priority medium category "libs" dump nil description "Manage file systems." - filename "dired-1.05-pkg.tar.gz" - md5sum "392440b1472a2415b0b9b6779df93619" - size 187654 + filename "dired-1.06-pkg.tar.gz" + md5sum "9c857aa147bf53d972ad6ac30ce34bd4" + size 187691 provides (diff dired) requires (xemacs-base) type regular @@ -1696,20 +1743,20 @@ ;;;@@@ (package-get-update-base-entry (quote (mail-lib - (standards-version 1.0 - version "1.22" - author-version "21.0b64" - date "1999-03-05" - build-date "1999-03-05" + (standards-version 1.1 + version "1.24" + author-version "21.1" + date "1999-04-13" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution stable + distribution xemacs priority medium category "libs" dump nil description "Fundamental lisp files for providing email support." - filename "mail-lib-1.22-pkg.tar.gz" - md5sum "70a947a1980887430c53032e3dfcbe4f" - size 131476 + filename "mail-lib-1.24-pkg.tar.gz" + md5sum "9428816ccc49d99be80dcbfc34d7917f" + size 131977 provides (browse-url highlight-headers mail-abbrevs mail-extr mail-utils reporter rfc822 rmail-mini rmailout sendmail smtpmail) requires (xemacs-base) type regular @@ -1718,20 +1765,20 @@ ;;;@@@ (package-get-update-base-entry (quote (fsf-compat - (standards-version 1.0 - version "1.05" - author-version "21.0b62" + (standards-version 1.1 + version "1.06" + author-version "21.1" date "1998-09-12" - build-date "1999-02-02" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution mule + distribution xemacs priority high category "libs" dump nil description "FSF Emacs compatibility files." - filename "fsf-compat-1.05-pkg.tar.gz" - md5sum "64cb1984a71974f3f40c0be1a971f441" - size 17347 + filename "fsf-compat-1.06-pkg.tar.gz" + md5sum "b167c9b6e4b6ff464d34143782d6c633" + size 17356 provides (overlay thingatpt timer x-popup-menu) requires () type single @@ -1740,20 +1787,20 @@ ;;;@@@ (package-get-update-base-entry (quote (xemacs-base - (standards-version 1.0 - version "1.30" - author-version "21.0b63" - date "1998-11-30" - build-date "1999-03-01" + (standards-version 1.1 + version "1.32" + author-version "21.1" + date "1999-07-22" + build-date "1999-07-30" maintainer "XEmacs Development Team " - distribution mule + distribution xemacs priority high category "libs" dump nil description "Fundamental XEmacs support, you almost certainly need this." - filename "xemacs-base-1.30-pkg.tar.gz" - md5sum "e0c4ffb2561c10755c8132b2b88e11b2" - size 430503 + filename "xemacs-base-1.32-pkg.tar.gz" + md5sum "ae699a67f9922ad330fc1e5d45d3ff87" + size 430787 provides (add-log advice annotations assoc case-table chistory comint-xemacs comint compile debug ebuff-menu echistory edmacro ehelp electric enriched env facemenu ffap helper imenu iso-syntax macros novice outline overlay passwd pp regi ring shell skeleton sort thing time-stamp timezone xbm-button xpm-button) requires () type regular @@ -1761,3 +1808,11 @@ )) ;;;@@@ ;; Package Index file ends here +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v0.9.8 (SunOS) +Comment: For info see http://www.gnupg.org + +iEYEARECAAYFAjehBIcACgkQEng2Tdz4C2tvvQCbBYGskNM16GwRfw/DjTS4byZN +6CIAnRGmsWGM/07NNA6mEyejc3SDD7/3 +=NjSE +-----END PGP SIGNATURE----- diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/sample.Xdefaults --- a/etc/sample.Xdefaults Mon Aug 13 11:12:06 2007 +0200 +++ b/etc/sample.Xdefaults Mon Aug 13 11:13:30 2007 +0200 @@ -75,6 +75,13 @@ ! While this one is for Athena dialog boxes. Emacs*dialog*Command*Background: WhiteSmoke +! Athena dialog boxes are sometimes built with the Xaw3d +! variant of the Athena toolkit. +! XEmacs being nice to 8bit displays, it defaults to: +Emacs*dialog*Command*beNiceToColormap: true +! If you are shocked by the ugliness of the 3d rendition, +! you may want to set (even on 8bit displays) the above to false. + ! Xlw Scrollbar colors Emacs*XlwScrollBar.Foreground: Gray30 Emacs*XlwScrollBar.Background: Gray75 diff -r f4aeb21a5bad -r 74fd4e045ea6 etc/xemacs.1 --- a/etc/xemacs.1 Mon Aug 13 11:12:06 2007 +0200 +++ b/etc/xemacs.1 Mon Aug 13 11:13:30 2007 +0200 @@ -211,6 +211,22 @@ .I XEmacs can be started with the following standard X options: .TP +.BI \-visual " " +Select the visual that XEmacs will attempt to use. +.I +should be one of the strings "StaticColor", "TrueColor", "GrayScale", +"PseudoColor" or "DirectColor", and +.I +should be the number of bits per pixel (example, "-visual TrueColor24" +for a 24bit TrueColor visual) See +.IR X (1) +for more information. +.TP +.B -privateColormap +Require XEmacs to create and use a private colormap for display. This will keep +XEmacs from taking colors from the default colormap and keeping them from other +clients. +.TP .BI \-geometry " ##x##+##+##" Specify the geometry of the initial window. The ##'s represent a number; the four numbers are width (characters), height (characters), X offset @@ -440,6 +456,16 @@ .B pointerColor (\fPclass\fB Foreground) Sets the color of the window's mouse cursor. .TP +.B emacsVisual (\fPclass\fB EmacsVisual) +Sets the default visual +.I XEmacs +will try to use (as described above). +.TP +.B privateColormap (\fPclass\fB PrivateColormap) +If set, +.I XEmacs +will default to using a private colormap. +.TP .B geometry (\fPclass\fB Geometry) Sets the geometry of the .I XEmacs @@ -716,10 +742,10 @@ Steve Baur , Martin Buchholz , Richard Mlynarik , -Hrvoje Niksic , +Hrvoje Niksic , Chuck Thompson , -Ben Wing , -Jamie Zawinski , +Ben Wing , +Jamie Zawinski , and many others. It was based on an early version of .I GNU Emacs Version diff -r f4aeb21a5bad -r 74fd4e045ea6 info/dir --- a/info/dir Mon Aug 13 11:12:06 2007 +0200 +++ b/info/dir Mon Aug 13 11:13:30 2007 +0200 @@ -44,6 +44,7 @@ * New-Users-Guide:: XEmacs New User's Guide for XEmacs 21.2. * XEmacs-FAQ:: XEmacs Frequently Asked Questions for 21.2. * Internals:: Guide to the internals of XEmacs. +* Emodules:: XEmacs dynamic loadable module support. Local Packages: diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/ChangeLog --- a/lib-src/ChangeLog Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/ChangeLog Mon Aug 13 11:13:30 2007 +0200 @@ -1,3 +1,263 @@ +2000-02-16 Martin Buchholz + + * XEmacs 21.2.29 is released. + +2000-02-13 Martin Buchholz + + * etags.c: Upgrade to version 13.44. + Only added (unsigned char) casts to calls like isspace (*cp). + +2000-02-07 Martin Buchholz + + * XEmacs 21.2.28 is released. + +2000-02-06 Martin Buchholz + + * getopt.h: + * fakemail.c: + * gnuslib.c: + * sorted-doc.c: + * yow.c: + * cvtmail.c: + * movemail.c: + * gnuclient.c: + ANSIfy. Use coding standards for function definitions. + Make C++-compilable. Modified from patch by Zack Weinberg. + +2000-01-26 Kirill 'Big K' Katsnelson + + * hexl.c: Removed MSDOS code; set binary I/O flags for NT. + +2000-01-18 Martin Buchholz + + * XEmacs 21.2.27 is released. + +2000-01-18 Martin Buchholz + + * ootags.c: Ansify. + * etags.c: + * getopt.c: + * cvtmail.c: + Remove declarations of ANSI errno, getenv(), malloc(). + +2000-01-13 Martin Buchholz + + * movemail.c (main): + * make-docfile.c (write_c_args): + Simple compiler warning fixes. + +2000-01-09 Martin Buchholz + + * *.[ch]: Change <../src/config.h> to + * ellcc.c: Always use <...> to #include files not in `.' + * Makefile.in.in: Use safer -I paths. + Use $(top_srcdir) instead of $(srcdir)/../src + Add warning comment. + +2000-01-08 Martin Buchholz + + * movemail.c: Warning removal. + +2000-01-06 Norbert Koch + + * movemail.c: Typo fix. + +2000-01-03 Michael Sperber [Mr. Preprocessor] + + * movemail.c: Overhaul of the locking code. + +2000-01-03 Martin Buchholz + + * etags.c (etags_strrchr): Ansify. + (etags_strchr): Ansify. + (get_compressor_from_suffix): Remove warning, make code cleaner. + +1999-12-31 Martin Buchholz + + * XEmacs 21.2.26 is released. + +1999-12-24 Martin Buchholz + + * XEmacs 21.2.25 is released. + +1999-12-21 Martin Buchholz + + * fakemail.c (cuserid): ((expr)) ==> (expr) + + * fakemail.c (xmalloc): ANSIfy. + +1999-12-14 Martin Buchholz + + * config.values.sh: Only update config.values.in if changed. + No external dependencies except perl. + No temporary files. + +1999-12-14 Martin Buchholz + + * XEmacs 21.2.24 is released. + +1999-12-13 Martin Buchholz + + * etags.c: Fix warning: `_GNU_SOURCE' redefined. + +1999-12-07 Martin Buchholz + + * XEmacs 21.2.23 is released. + +1999-11-29 Andreas Jaeger + + * Makefile.in.in (INSTALLABLE_SCRIPTS): Removed pstogif. + pstogif: Moved to package tm. + +1999-11-29 XEmacs Build Bot + + * XEmacs 21.2.22 is released + +1999-11-28 Martin Buchholz + + * XEmacs 21.2.21 is released. + +1999-11-20 Martin Buchholz + + * process-gnu-depends.sh: Deleted. Obsolete. + * process-depends.sh: Deleted. Obsolete. + +1999-11-20 Jan Vroonhof + + * Makefile.in.in (instvardir): Added. From + Jeff Miller + +1999-11-19 Martin Buchholz + + * etags.c: Upgrade to pot etags version 13.33. + Make `etags --version' print out `XEmacs', not `GNU Emacs' + +1999-11-17 Martin Buchholz + + * etags.c (canonicalize_filename): Typo fix + +1999-11-05 Martin Buchholz + + * etags.c: + * ../etc/etags.1: + * ../etc/NEWS: + Upgrade to etags version 13.32. + etags.c has warnings removed, in addition. + +1999-11-15 Martin Buchholz + + * gnuserv.c (ipc_spawn_watchdog): Use pid_t instead of int. + +1999-11-10 XEmacs Build Bot + + * XEmacs 21.2.20 is released + +1999-11-04 Martin Buchholz + + * gnuserv.c (handle_response): Warning suppression + +1999-09-27 Martin Buchholz + + * ellcc.c: + ANSIfy. + Remove MSDOS cruft. + Remove WINDOWS cruft. + Remove VMS cruft. + (main): The wrong number of bytes were being read during argument + processing. + Delete ANSI imitations like ellcc_strchr(). + Call functions with the right number of arguments. + Fix a typo. + Make functions static. + Remove compiler warnings. + +1999-09-22 Martin Buchholz + + * cvtmail.c (main): ANSIfy + * digest-doc.c (main): ANSIfy + * hexl.c (main): ANSIfy + + * make-path.c: Remove declaration for errno. + * mmencode.c (nextcharin): ANSIfy + * movemail.c (pop_retr): ANSIfy + +1999-07-30 Gleb Arshinov + + * pop.c (pop_quit): use CLOSESOCKET() instead of close() + + * run.c (build_cmdline): Fix NT native build unreferenced variable + warning + (WinMain): Fix release mode build unreferenced variable warning + +1999-07-30 XEmacs Build Bot + + * XEmacs 21.2.19 is released + +1999-07-22 SL Baur + + * Makefile.in.in (datadir): Add. + From Jeff Miller + +1999-07-13 XEmacs Build Bot + + * XEmacs 21.2.18 is released + +1999-06-22 XEmacs Build Bot + + * XEmacs 21.2.17 is released + +1999-06-11 XEmacs Build Bot + + * XEmacs 21.2.16 is released + +1999-06-04 XEmacs Build Bot + + * XEmacs 21.2.15 is released + +1999-06-03 SL Baur + + * Makefile.in.in: Move .PHONY up to force execution of `all'. + +1999-05-14 XEmacs Build Bot + + * XEmacs 21.2.14 is released + +1999-05-14 SL Baur + + * update-elc.sh (ignore_pattern): Correct ignore_dirs/ignore=dirs + european keyboard fuckage. + +1999-05-03 Hrvoje Niksic + + * update-elc.sh (ignore_pattern): Installation.el is dead. + +1999-05-03 Hrvoje Niksic + + * gnuclient.c: Include instead of <../src/sysfile.h>. + + * Makefile.in.in (cppflags): Add -I$(top_srcdir)/src. + +1999-04-29 Andy Piper + + * make-docfile.c: build fixes for mingw32. + * movemail.c: ditto. + * run.c: ditto. + * yow.c: ditto. + * profile.c: ditto. + (gettimeofday): new function copied from nt.c. + + * fakemail.c (make_file_preface): make buildable under windows. + + * Makefile.in.in: fix some build targets for when we are building + on a windows platform. + +1999-03-12 giacomo boffi + + * sorted-doc.c: corrected the outdated or plainly wrong + texinfo headers. Broken up the mega-@table that crashes (at + least RedHat's) TeX with: + "! TeX capacity exceeded, sorry [save size=4000]." + 1999-03-12 XEmacs Build Bot * XEmacs 21.2.13 is released @@ -84,7 +344,7 @@ * pop.c: mess with includes so that it builds under native NT. From Fabrice Popineau - + 1998-12-16 Andy Piper * XEmacs 21.2.6 is released @@ -270,7 +530,7 @@ 1998-04-19 Jan Vroonhof * gnuclient.c (main): Read eval from from stdin if just "-batch" - is given. + is given. * gnudoit: Support this. * gnuserv.1: Document this behavior. @@ -342,13 +602,13 @@ 1998-01-13 Martin Buchholz - * lib-src/add-little-package.sh: - * lib-src/add-big-package.sh: + * lib-src/add-little-package.sh: + * lib-src/add-big-package.sh: Use proper paranoid quoting for sh variables. -batch implies -q. Thu Jan 08 09:42:36 1998 - + * gnuserv.h: only set UNIX_DOMAIN_SOCKETS if HAVE_SYS_UN_H is set. @@ -492,7 +752,7 @@ missing a variable called "configuration. This messed up archilibdir. * Added highlighting to text suggesting to do "make gzip-el" in top - level Makefile.in. Added code to do make maybe-blessmail after a + level Makefile.in. Added code to do make maybe-blessmail after a make install is done. 1997-08-07 Jan Vroonhof @@ -560,7 +820,7 @@ * Makefile.in.in (INSTALLABLE_SCRIPTS): Readd Gnuattach. From Hrvoje Niksic - + 1997-06-13 Steven L Baur * update-elc.sh (mule_p): Ignore lisp/language when building diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/Makefile.in.in --- a/lib-src/Makefile.in.in Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/Makefile.in.in Mon Aug 13 11:13:30 2007 +0200 @@ -53,6 +53,9 @@ bindir=@bindir@ libdir=@libdir@ srcdir=@srcdir@ +datadir=@datadir@ +instvardir=@instvardir@ +top_srcdir=@top_srcdir@ archlibdir=@archlibdir@ configuration=@configuration@ moduledir=@moduledir@ @@ -72,8 +75,12 @@ ## Things that a user might actually run, ## which should be installed in bindir. +#ifdef WINDOWSNT +INSTALLABLES_BASE = etags ctags b2m ootags +#else INSTALLABLES_BASE = etags ctags b2m gnuclient ootags -INSTALLABLE_SCRIPTS = rcs-checkin pstogif gnudoit gnuattach +#endif +INSTALLABLE_SCRIPTS = rcs-checkin gnudoit gnuattach #ifdef HAVE_SHLIB #ifdef HAVE_MS_WINDOWS INSTALLABLES = $(INSTALLABLES_BASE) runxemacs rungnuclient ellcc @@ -84,16 +91,22 @@ #ifdef HAVE_MS_WINDOWS INSTALLABLES = $(INSTALLABLES_BASE) runxemacs rungnuclient #else -INSTALLABLES = $(INSTALLABLES_BASE) +INSTALLABLES = $(INSTALLABLES_BASE) #endif #endif ## Things that Emacs runs internally, or during the build process, ## which should not be installed in bindir. +#ifdef WINDOWSNT +UTILITIES= make-path wakeup profile make-docfile digest-doc \ + sorted-doc movemail cvtmail yow hexl \ + mmencode +#else UTILITIES= make-path wakeup profile make-docfile digest-doc \ sorted-doc movemail cvtmail fakemail yow hexl \ gnuserv mmencode +#endif ## These need to be conditional on I18N3 make-msgfile make-po ## Like UTILITIES, but they are not system-dependent, and should not be @@ -149,7 +162,13 @@ ## We need to #define emacs to get the right versions of some files. -cppflags = -Demacs -I../src $(CPPFLAGS) +## To understand the order of -I flags, consider what happens if you run +## ./configure in the source tree, and then run +## $(srcdir).2.26/configure in some other build tree. +## Where will the generated files like config.h be included from? +## This is also why you _must_ use <...> instead of "..." +## when #include'ing generated files. +cppflags = -Demacs -I. -I../src -I$(srcdir) -I$(top_srcdir)/src $(CPPFLAGS) cflags = $(CFLAGS) $(cppflags) $(c_switch_general) ldflags = $(LDFLAGS) $(ld_switch_general) $(ld_libs_general) @@ -160,6 +179,8 @@ .c.o: ${CC} -c $(cflags) $< +.PHONY : all maybe-blessmail install uninstall + all: ${UTILITIES} ${INSTALLABLES} srcdir-symlink.stamp ## Make symlinks for shell scripts if using --srcdir @@ -218,7 +239,6 @@ ## We do not need to install "wakeup" explicitly, because it will be ## copied when this whole directory is copied. -.PHONY : all maybe-blessmail install uninstall install: ${archlibdir} @echo; echo "Installing utilities for users to run." for file in ${INSTALLABLES} ; do \ @@ -265,32 +285,29 @@ ${CC} -c $(cflags) ${srcdir}/getopt.c getopt1.o: ${srcdir}/getopt1.c ${srcdir}/getopt.h ${CC} -c $(cflags) ${srcdir}/getopt1.c -alloca.o: ${srcdir}/../src/alloca.c +alloca.o: ${top_srcdir}/src/alloca.c ${CC} -c $(cflags) ${srcdir}/../src/alloca.c -regex.o: ${srcdir}/../src/regex.c ${srcdir}/../src/regex.h +regex.o: ${srcdir}/../src/regex.c ${top_srcdir}/src/regex.h $(CC) -c `echo $(cflags) | sed 's/-Demacs/ /'` \ - -DINHIBIT_STRING_HEADER ${srcdir}/../src/regex.c + -DINHIBIT_STRING_HEADER ${top_srcdir}/src/regex.c -etags_args = -I. $(cflags) -I${srcdir} -I${srcdir}/../src \ - -DVERSION='"${version}"' ${srcdir}/etags.c \ +etags_args = $(cflags) -DVERSION='"${version}"' ${srcdir}/etags.c \ $(GETOPTOBJS) regex.o $(ldflags) -etags_deps = ${srcdir}/etags.c $(GETOPTDEPS) regex.o ../src/config.h +etags_deps = ${srcdir}/etags.c $(GETOPTDEPS) regex.o ../src/config.h etags: ${etags_deps} $(CC) ${etags_args} -o $@ -ellcc_args = -I. $(cflags) -I${srcdir} -I${srcdir}/../src \ - ${srcdir}/ellcc.c $(ldflags) +ellcc_args = $(cflags) ${srcdir}/ellcc.c $(ldflags) ellcc_deps = ${srcdir}/ellcc.c ellcc.h ../src/config.h ellcc: ${ellcc_deps} $(CC) ${ellcc_args} -o $@ -run_args = -I. $(cflags) -I${srcdir} -I${srcdir}/../src \ - -DVERSION='"${version}"' ${srcdir}/run.c \ +run_args = $(cflags) -DVERSION='"${version}"' ${srcdir}/run.c \ $(ldflags) -Wl,--subsystem,windows -e _mainCRTStartup -run_deps = ${srcdir}/run.c ${srcdir}/run.h ${srcdir}/run.rc \ +run_deps = ${srcdir}/run.c ${srcdir}/run.h ${srcdir}/run.rc \ ${srcdir}/../nt/xemacs.ico ${srcdir}/../nt/file.ico \ ${srcdir}/../nt/lisp.ico @@ -305,10 +322,9 @@ rungnuclient: run cp run.exe $@.exe -ootags_args = -I. $(cflags) -I${srcdir} -I${srcdir}/../src \ - -DVERSION='"${version}"' ${srcdir}/ootags.c \ +ootags_args = $(cflags) -DVERSION='"${version}"' ${srcdir}/ootags.c \ $(GETOPTOBJS) regex.o $(ldflags) -ootags_deps = ${srcdir}/ootags.c $(GETOPTDEPS) regex.o ../src/config.h +ootags_deps = ${srcdir}/ootags.c $(GETOPTDEPS) regex.o ../src/config.h ootags: ${ootags_deps} $(CC) ${ootags_args} -o $@ diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/add-big-package.sh --- a/lib-src/add-big-package.sh Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/add-big-package.sh Mon Aug 13 11:13:30 2007 +0200 @@ -2,8 +2,8 @@ # add-big-package.sh --- Add multiple file package to Package Lisp Hierarchy # Copyright (C) 1997 Free Software Foundation, Inc. -# Author: SL Baur -# Maintainer: SL Baur +# Author: SL Baur +# Maintainer: SL Baur # Keywords: packages internal # This file is part of XEmacs. diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/b2m.c --- a/lib-src/b2m.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/b2m.c Mon Aug 13 11:13:30 2007 +0200 @@ -19,7 +19,7 @@ by Francesco Potorti` . */ #ifdef HAVE_CONFIG_H -#include <../src/config.h> +#include /* On some systems, Emacs defines static as nothing for the sake of unexec. We don't want that here since we don't use unexec. */ #undef static diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/config.values.in --- a/lib-src/config.values.in Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/config.values.in Mon Aug 13 11:13:30 2007 +0200 @@ -1,6 +1,6 @@ ;;; Do not edit this file! ;;; This file was automatically generated, by the config.values.sh script, -;;; from configure, which was itself automatically generated from configure.in +;;; from configure, which was itself automatically generated from configure.in. ;;; ;;; See lisp/util/config.el for details on how this file is used. ;;; @@ -24,9 +24,13 @@ CPPFLAGS "@CPPFLAGS@" CXXFLAGS "@CXXFLAGS@" DEFS "@DEFS@" +DOCDIR "@DOCDIR@" +DOCDIR_USER_DEFINED "@DOCDIR_USER_DEFINED@" ETCDIR "@ETCDIR@" ETCDIR_USER_DEFINED "@ETCDIR_USER_DEFINED@" EXEC_PREFIX "@EXEC_PREFIX@" +EXEC_PREFIX_USER_DEFINED "@EXEC_PREFIX_USER_DEFINED@" +FFLAGS "@FFLAGS@" INFODIR "@INFODIR@" INFODIR_USER_DEFINED "@INFODIR_USER_DEFINED@" INFOPATH "@INFOPATH@" @@ -35,6 +39,7 @@ INSTALL_ARCH_DEP_SUBDIR "@INSTALL_ARCH_DEP_SUBDIR@" INSTALL_DATA "@INSTALL_DATA@" INSTALL_PROGRAM "@INSTALL_PROGRAM@" +INSTALL_SCRIPT "@INSTALL_SCRIPT@" LDFLAGS "@LDFLAGS@" LIBS "@LIBS@" LISPDIR "@LISPDIR@" @@ -48,10 +53,12 @@ PACKAGE_PATH "@PACKAGE_PATH@" PACKAGE_PATH_USER_DEFINED "@PACKAGE_PATH_USER_DEFINED@" PREFIX "@PREFIX@" +PREFIX_USER_DEFINED "@PREFIX_USER_DEFINED@" PROGNAME "@PROGNAME@" RANLIB "@RANLIB@" RECURSIVE_MAKE "@RECURSIVE_MAKE@" SET_MAKE "@SET_MAKE@" +SHELL "@SHELL@" SITELISPDIR "@SITELISPDIR@" SITELISPDIR_USER_DEFINED "@SITELISPDIR_USER_DEFINED@" SITEMODULEDIR "@SITEMODULEDIR@" @@ -86,10 +93,13 @@ etcdir "@etcdir@" exec_prefix "@exec_prefix@" extra_objs "@extra_objs@" +have_esd_config "@have_esd_config@" includedir "@includedir@" infodir "@infodir@" infopath "@infopath@" install_pp "@install_pp@" +inststaticdir "@inststaticdir@" +instvardir "@instvardir@" internal_makefile_list "@internal_makefile_list@" ld "@ld@" ld_dynamic_link_flags "@ld_dynamic_link_flags@" diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/config.values.sh --- a/lib-src/config.values.sh Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/config.values.sh Mon Aug 13 11:13:30 2007 +0200 @@ -1,4 +1,7 @@ -#! /bin/sh +: #-*- Perl -*- +eval 'exec perl -w -S $0 ${1+"$@"}' # Portability kludge + if 0; + # config.values.sh --- create config.values.in from ../configure # Author: Martin Buchholz @@ -35,19 +38,29 @@ ## by an XEmacs Maintainer (consider yourself so blessed, if you are ## actually reading this commentary). ## -if test ! -r ./configure; then - cd .. - if test ! -r ./configure; then - echo "Can't find configure!"; - exit 1; - fi -fi + +if (! -r "./configure") { + chdir ".." or die "Can't chdir: $!"; + if (! -r "./configure") { + die "Can't find configure!"; + } +} -exec < ./configure > "lib-src/config.values.in" -cat <<\EOF -;;; Do not edit this file! +sub FileContents { + local $/ = undef; # Slurp mode + open (FILE, "< $_[0]") or die "$_[0]: $!"; + my $contents = ; + close FILE or die "$_[0]: $!"; + return $contents; +} + +my $configure_contents = FileContents "./configure"; +my $cvi_contents = FileContents "lib-src/config.values.in"; + +my $new_cvi_contents = +";;; Do not edit this file! ;;; This file was automatically generated, by the config.values.sh script, -;;; from configure, which was itself automatically generated from configure.in +;;; from configure, which was itself automatically generated from configure.in. ;;; ;;; See lisp/util/config.el for details on how this file is used. ;;; @@ -62,15 +75,27 @@ ;;; Variables defined in configure by AC_SUBST follow: ;;; (These are used in Makefiles) -EOF -sed -n '/^s%@\([A-Za-z_][A-Za-z_]*\)@%\$\1%g$/ { - s/^s%@\([A-Za-z_][A-Za-z_]*\)@%\$\1%g$/\1 "@\1@"/ - p -}' | \ -sort -u -cat <<\EOF +"; +my %done; +for my $var (sort { $a cmp $b } + $configure_contents =~ + /^s\%\@([A-Za-z0-9_]+)\@\%\$[A-Za-z0-9_]+\%g/mg) { + $new_cvi_contents .= "$var \"\@$var\@\"\n" unless exists $done{$var}; + $done{$var} = 1; +} + +$new_cvi_contents .= " ;;; Variables defined in configure by AC_DEFINE and AC_DEFINE_UNQUOTED follow: ;;; (These are used in C code) -EOF +"; + +if ($cvi_contents ne $new_cvi_contents) { + unlink "lib-src/config.values.in"; + open (CVI, "> lib-src/config.values.in") + or die "lib-src/config.values.in: $!"; + print CVI $new_cvi_contents; + close CVI + or die "lib-src/config.values.in: $!"; +} diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/cvtmail.c --- a/lib-src/cvtmail.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/cvtmail.c Mon Aug 13 11:13:30 2007 +0200 @@ -35,27 +35,20 @@ */ -#include <../src/config.h> +#include #include #include +#include -#if __STDC__ || defined(STDC_HEADERS) -# include -#else -char *malloc (); -char *getenv (); -#endif -static void *xmalloc (unsigned int); -static void *xrealloc (char *ptr, unsigned int); +static void *xmalloc (size_t); +static void *xrealloc (void *, size_t); static void skip_to_lf (FILE *stream); -static void fatal (CONST char *s1, CONST char *s2); -static void error (CONST char *s1, CONST char *s2); +static void fatal (const char *s1, const char *s2); +static void error (const char *s1, const char *s2); int -main (argc, argv) - int argc; - char *argv[]; +main (int argc, char *argv[]) { char *hd; char *md; @@ -70,7 +63,7 @@ char name[14]; int c; - hd = (char *) getenv ("HOME"); + hd = getenv ("HOME"); md = (char *) xmalloc (strlen (hd) + 10); strcpy (md, hd); @@ -118,8 +111,7 @@ } static void -skip_to_lf (stream) - FILE *stream; +skip_to_lf (FILE *stream) { register int c; while ((c = getc(stream)) != '\n') @@ -127,21 +119,18 @@ } static void * -xmalloc (size) - unsigned size; +xmalloc (size_t size) { - char *result = (char *) malloc (size); + void *result = malloc (size); if (!result) fatal ("virtual memory exhausted", 0); return result; } static void * -xrealloc (ptr, size) - char *ptr; - unsigned size; +xrealloc (void *ptr, size_t size) { - char *result = (char *) realloc (ptr, size); + void *result = realloc (ptr, size); if (!result) fatal ("virtual memory exhausted", 0); return result; @@ -150,14 +139,14 @@ /* Print error message and exit. */ static void -fatal (CONST char *s1, CONST char *s2) +fatal (const char *s1, const char *s2) { error (s1, s2); exit (1); } static void -error (CONST char *s1, CONST char *s2) +error (const char *s1, const char *s2) { fprintf (stderr, "cvtmail: "); fprintf (stderr, s1, s2); diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/digest-doc.c --- a/lib-src/digest-doc.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/digest-doc.c Mon Aug 13 11:13:30 2007 +0200 @@ -6,12 +6,12 @@ but in texinfo format and sorted by function/variable name. */ #ifdef emacs -#include <../src/config.h> +#include #endif #include int -main () +main (int argc, char *argv[]) { register int ch; register int notfirst = 0; diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/ellcc.c --- a/lib-src/ellcc.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/ellcc.c Mon Aug 13 11:13:30 2007 +0200 @@ -24,8 +24,8 @@ /* Here's the scoop. We would really like this to be a shell script, but -the various Windows platforms dont have reliable scripting that suits -our needs. We dont want to reply on perl or some other such language +the various Windows platforms don't have reliable scripting that suits +our needs. We don't want to rely on perl or some other such language so we have to roll our own executable to act as a front-end for the compiler. @@ -58,87 +58,31 @@ See the samples for more details. */ +#include #include #include - -#ifdef MSDOS -# include -# include -# include -# ifndef HAVE_CONFIG_H -# define DOS_NT -# include -# endif -#endif /* MSDOS */ - -#ifdef WINDOWSNT -# include -# include -# include -# include -# define MAXPATHLEN _MAX_PATH -# ifdef HAVE_CONFIG_H -# undef HAVE_NTGUI -# else -# define DOS_NT -# define HAVE_GETCWD -# endif /* not HAVE_CONFIG_H */ -#endif /* WINDOWSNT */ - -#ifdef HAVE_CONFIG_H -# include - /* On some systems, Emacs defines static as nothing for the sake - of unexec. We don't want that here since we don't use unexec. */ -# undef static -#endif /* HAVE_CONFIG_H */ - -#if !defined (WINDOWSNT) && defined (STDC_HEADERS) -#include #include -#endif +#include +#include +#include #ifdef HAVE_UNISTD_H # include -#else -# ifdef HAVE_GETCWD - extern char *getcwd (); -# endif #endif /* HAVE_UNISTD_H */ -#include -#include -#include -#ifndef errno - extern int errno; -#endif -#include -#include - #define EMODULES_GATHER_VERSION -#include "emodules.h" -#include "ellcc.h" -#if !defined (S_ISREG) && defined (S_IFREG) -# define S_ISREG(m) (((m) & S_IFMT) == S_IFREG) -#endif - -/* Exit codes for success and failure. */ -#ifdef VMS -# define GOOD 1 -# define BAD 0 -#else -# define GOOD 0 -# define BAD 1 -#endif +#include +#include /* Generated files must be included using <...> */ #define DEBUG #ifndef HAVE_SHLIB int -main() +main (int argc, char *argv[]) { fprintf (stderr, "Dynamic modules not supported on this platform\n"); - return (BAD); + return EXIT_FAILURE; } #else @@ -163,11 +107,12 @@ # define xnew(n,Type) ((Type *) xmalloc ((n) * sizeof (Type))) # define xrnew(op,n,Type) ((Type *) xrealloc ((op), (n) * sizeof (Type))) #endif -long *xmalloc (), *xrealloc (); -void fatal (), pfatal (); -char *ellcc_strchr (), *ellcc_strrchr (); -void add_to_argv (); -void do_compile_mode(), do_link_mode(), do_init_mode(); +static void *xmalloc (size_t); +static void fatal (char *, char *); +static void add_to_argv (const char *); +static void do_compile_mode (void); +static void do_link_mode (void); +static void do_init_mode (void); #define SSTR(S) ((S)?(S):"") @@ -196,9 +141,7 @@ STR = DFLT int -main (argc, argv) - int argc; - char *argv[]; +main (int argc, char *argv[]) { char *tmp; int i, done_mode = 0; @@ -207,11 +150,11 @@ prog_argv = argv; #if defined(MSDOS) || defined(WINDOWSNT) - tmp = ellcc_strrchr (argv[0], '\\'); + tmp = strrchr (argv[0], '\\'); if (tmp != (char *)0) tmp++; #elif !defined (VMS) - tmp = ellcc_strrchr (argv[0], '/'); + tmp = strrchr (argv[0], '/'); if (tmp != (char *)0) tmp++; #else @@ -248,7 +191,7 @@ char *modeopt = argv[i] + 7; if (done_mode && strcmp (modeopt, "verbose")) - fatal ("more than one mode specified"); + fatal ("more than one mode specified", (char *) 0); if (strcmp (modeopt, "link") == 0) { done_mode++; @@ -287,13 +230,13 @@ printf ("%s\n", ELLCC_CONFIG); return 0; } - else if (strncmp (argv[i], "--mod-name=", 10) == 0) + else if (strncmp (argv[i], "--mod-name=", 11) == 0) mod_name = argv[i] + 11; - else if (strncmp (argv[i], "--mod-title=", 11) == 0) + else if (strncmp (argv[i], "--mod-title=", 12) == 0) mod_title = argv[i] + 12; - else if (strncmp (argv[i], "--mod-version=", 13) == 0) + else if (strncmp (argv[i], "--mod-version=", 14) == 0) mod_version = argv[i] + 14; - else if (strncmp (argv[i], "--mod-output=", 12) == 0) + else if (strncmp (argv[i], "--mod-output=", 13) == 0) mod_output = argv[i] + 13; else { @@ -339,7 +282,7 @@ #endif if (exec_argc < 2) - fatal ("too few arguments"); + fatal ("too few arguments", (char *) 0); /* * Get the over-rides from the environment @@ -378,83 +321,23 @@ } /* Like malloc but get fatal error if memory is exhausted. */ -long * -xmalloc (size) - unsigned int size; +static void * +xmalloc (size_t size) { - long *result = (long *) malloc (size); + void *result = malloc (size); if (result == NULL) - fatal ("virtual memory exhausted", (char *)NULL); - return result; -} - -long * -xrealloc (ptr, size) - char *ptr; - unsigned int size; -{ - long *result = (long *) realloc (ptr, size); - if (result == NULL) - fatal ("virtual memory exhausted", (char *)NULL); + fatal ("virtual memory exhausted", (char *)0); return result; } /* Print error message and exit. */ -void -fatal (s1, s2) - char *s1, *s2; +static void +fatal (char *s1, char *s2) { fprintf (stderr, "%s: ", progname); fprintf (stderr, s1, s2); fprintf (stderr, "\n"); - exit (BAD); -} - -void -pfatal (s1) - char *s1; -{ - perror (s1); - exit (BAD); -} - -/* - * Return the ptr in sp at which the character c last - * appears; NULL if not found - * - * Identical to System V strrchr, included for portability. - */ -char * -ellcc_strrchr (sp, c) - register char *sp, c; -{ - register char *r; - - r = NULL; - do - { - if (*sp == c) - r = sp; - } while (*sp++); - return r; -} - -/* - * Return the ptr in sp at which the character c first - * appears; NULL if not found - * - * Identical to System V strchr, included for portability. - */ -char * -ellcc_strchr (sp, c) - register char *sp, c; -{ - do - { - if (*sp == c) - return sp; - } while (*sp++); - return NULL; + exit (EXIT_FAILURE); } /* @@ -462,14 +345,13 @@ * to the compiler or linker. We need to split individual words into * arguments, taking quoting into account. This can get ugly. */ -void -add_to_argv (str) - CONST char *str; +static void +add_to_argv (const char *str) { int sm = 0; - CONST char *s = (CONST char *)0; + const char *s = (const char *)0; - if ((str == (CONST char *)0) || (str[0] == '\0')) + if ((str == (const char *)0) || (str[0] == '\0')) return; while (*str) @@ -477,7 +359,7 @@ switch (sm) { case 0: /* Start of case - string leading whitespace */ - if (isspace (*str)) + if (isspace ((unsigned char) *str)) str++; else { @@ -487,7 +369,7 @@ break; case 1: /* Non-whitespace character. Mark the start */ - if (isspace (*str)) + if (isspace ((unsigned char) *str)) { /* Reached the end of the argument. Add it. */ int l = str-s; @@ -496,7 +378,7 @@ exec_argv[real_argc][l] = '\0'; real_argc++; sm = 0; /* Back to start state */ - s = (CONST char *)0; + s = (const char *)0; break; } else if (*str == '\\') @@ -541,14 +423,14 @@ } } - if (s != (CONST char *)0) + if (s != (const char *)0) { int l = str-s; exec_argv[real_argc] = xnew (l+2, char); strncpy (exec_argv[real_argc], s, l); exec_argv[real_argc][l] = '\0'; real_argc++; - s = (CONST char *)0; + s = (const char *)0; } } @@ -557,8 +439,8 @@ * is build up the argument vector and exec() it. We must just make sure * that we get all of the required arguments in place. */ -void -do_compile_mode() +static void +do_compile_mode (void) { int i; char ts[4096]; /* Plenty big enough */ @@ -587,8 +469,8 @@ * all of the provided arguments, then the final post arguments. Once * all of this has been done, the argument vector is ready to run. */ -void -do_link_mode() +static void +do_link_mode (void) { int i,x; char *t, ts[4096]; /* Plenty big enough */ @@ -648,8 +530,8 @@ * the header information first, as make-doc will append to the file by * special dispensation. */ -void -do_init_mode() +static void +do_init_mode (void) { int i; char ts[4096]; /* Plenty big enough */ diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/etags.c --- a/lib-src/etags.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/etags.c Mon Aug 13 11:13:30 2007 +0200 @@ -1,5 +1,5 @@ /* Tags file maker to go with GNU Emacs - Copyright (C) 1984, 87, 88, 89, 93, 94, 95, 98 + Copyright (C) 1984, 87, 88, 89, 93, 94, 95, 98, 99 Free Software Foundation, Inc. and Ken Arnold This file is not considered part of GNU Emacs. @@ -28,10 +28,10 @@ * Francesco Potorti` reorganised C and C++ based on work by Joe Wells. * Regexp tags by Tom Tromey. * - * Francesco Potorti` (F.Potorti@cnuce.cnr.it) is the current maintainer. + * Francesco Potorti` (pot@gnu.org) is the current maintainer. */ -char pot_etags_version[] = "@(#) pot revision number is 13.7"; +char pot_etags_version[] = "@(#) pot revision number is 13.44"; #define TRUE 1 #define FALSE 0 @@ -40,29 +40,11 @@ # define DEBUG FALSE #endif -#ifdef MSDOS -# include -# include -# include -# ifndef HAVE_CONFIG_H -# define DOS_NT -# include -# endif -#endif /* MSDOS */ - -#ifdef WINDOWSNT -# include -# include -# include -# include -# define MAXPATHLEN _MAX_PATH -# ifdef HAVE_CONFIG_H -# undef HAVE_NTGUI -# else -# define DOS_NT -# define HAVE_GETCWD -# endif /* not HAVE_CONFIG_H */ -#endif /* WINDOWSNT */ +#if defined(__STDC__) && (__STDC__ || defined(__SUNPRO_C)) +# define P_(proto) proto +#else +# define P_(proto) () +#endif #ifdef HAVE_CONFIG_H # include @@ -73,16 +55,53 @@ # define LONG_OPTIONS /* accept long options */ #endif /* HAVE_CONFIG_H */ -#if !defined (WINDOWSNT) && defined (STDC_HEADERS) -#include -#include +#ifndef _GNU_SOURCE +# define _GNU_SOURCE 1 /* enables some compiler checks on GNU */ #endif +#ifdef MSDOS +# undef MSDOS +# define MSDOS TRUE +# include +# include +# include +# ifndef HAVE_CONFIG_H +# define DOS_NT +# include +# endif +#else +# define MSDOS FALSE +#endif /* MSDOS */ + +#ifdef WINDOWSNT +# include +# include +# include +# include +# include +# define MAXPATHLEN _MAX_PATH +# ifdef HAVE_CONFIG_H +# undef HAVE_NTGUI +# else +# define DOS_NT +# endif /* not HAVE_CONFIG_H */ +# ifndef HAVE_GETCWD +# define HAVE_GETCWD +# endif /* undef HAVE_GETCWD */ +#else /* !WINDOWSNT */ +# ifdef STDC_HEADERS +# include +# include +# else + extern char *getenv (); +# endif +#endif /* !WINDOWSNT */ + #ifdef HAVE_UNISTD_H # include #else -# ifdef HAVE_GETCWD - extern char *getcwd (); +# if defined (HAVE_GETCWD) && !WINDOWSNT + extern char *getcwd (char *buf, size_t size); # endif #endif /* HAVE_UNISTD_H */ @@ -171,12 +190,11 @@ typedef int bool; -typedef void Lang_function (); +typedef void Lang_function P_((FILE *)); typedef struct { char *suffix; - int sufflen; char *command; /* Takes one arg and decompresses to stdout */ } compressor; @@ -188,67 +206,109 @@ char **interpreters; } language; -extern char *getenv (); +typedef struct node_st +{ /* sorting structure */ + char *name; /* function or type name */ + char *file; /* file name */ + bool is_func; /* use pattern or line no */ + bool been_warned; /* set if noticed dup */ + int lno; /* line number tag is on */ + long cno; /* character number line starts on */ + char *pat; /* search pattern */ + struct node_st *left, *right; /* left and right sons */ +} node; + +/* + * A `linebuffer' is a structure which holds a line of text. + * `readline_internal' reads a line from a stream into a linebuffer + * and works regardless of the length of the line. + * SIZE is the size of BUFFER, LEN is the length of the string in + * BUFFER after readline reads it. + */ +typedef struct +{ + long size; + int len; + char *buffer; +} linebuffer; /* Many compilers barf on this: - Lang_function Asm_labels; + Lang_function Ada_funcs; so let's write it this way */ -void Asm_labels (); -void C_entries (); -void default_C_entries (); -void plain_C_entries (); -void Cjava_entries (); -void Cobol_paragraphs (); -void Cplusplus_entries (); -void Cstar_entries (); -void Erlang_functions (); -void Fortran_functions (); -void Yacc_entries (); -void Lisp_functions (); -void Pascal_functions (); -void Perl_functions (); -void Postscript_functions (); -void Prolog_functions (); -void Python_functions (); -void Scheme_functions (); -void TeX_functions (); -void just_read_file (); - -compressor *get_compressor_from_suffix (); -language *get_language_from_name (); -language *get_language_from_interpreter (); -language *get_language_from_suffix (); -int total_size_of_entries (); -long readline (), readline_internal (); +static void Ada_funcs P_((FILE *)); +static void Asm_labels P_((FILE *)); +static void C_entries P_((int c_ext, FILE *)); +static void default_C_entries P_((FILE *)); +static void plain_C_entries P_((FILE *)); +static void Cjava_entries P_((FILE *)); +static void Cobol_paragraphs P_((FILE *)); +static void Cplusplus_entries P_((FILE *)); +static void Cstar_entries P_((FILE *)); +static void Erlang_functions P_((FILE *)); +static void Fortran_functions P_((FILE *)); +static void Yacc_entries P_((FILE *)); +static void Lisp_functions P_((FILE *)); +static void Pascal_functions P_((FILE *)); +static void Perl_functions P_((FILE *)); +static void Postscript_functions P_((FILE *)); +static void Prolog_functions P_((FILE *)); +static void Python_functions P_((FILE *)); +static void Scheme_functions P_((FILE *)); +static void TeX_functions P_((FILE *)); +static void just_read_file P_((FILE *)); + +static void print_language_names P_((void)); +static void print_version P_((void)); +static void print_help P_((void)); +int main P_((int, char **)); +static int number_len P_((long)); + +static compressor *get_compressor_from_suffix P_((char *, char **)); +static language *get_language_from_name P_((char *)); +static language *get_language_from_interpreter P_((char *)); +static language *get_language_from_suffix P_((char *)); +static int total_size_of_entries P_((node *)); +static long readline P_((linebuffer *, FILE *)); +static long readline_internal P_((linebuffer *, FILE *)); +static void get_tag P_((char *)); + #ifdef ETAGS_REGEXPS -void analyse_regex (); -void add_regex (); -void free_patterns (); +static void analyse_regex P_((char *, bool)); +static void add_regex P_((char *, bool, language *)); +static void free_patterns P_((void)); #endif /* ETAGS_REGEXPS */ -void error (); -void suggest_asking_for_help (); -void fatal (), pfatal (); -void add_node (); - -void init (); -void initbuffer (); -void find_entries (); -void free_tree (); -void pfnote (), new_pfnote (); -void process_file (); -void put_entries (); -void takeprec (); - -char *concat (); -char *skip_spaces (), *skip_non_spaces (); -char *savenstr (), *savestr (); -char *etags_strchr (), *etags_strrchr (); -char *etags_getcwd (); -char *relative_filename (), *absolute_filename (), *absolute_dirname (); -bool filename_is_absolute (); -void canonicalize_filename (); -void grow_linebuffer (); -long *xmalloc (), *xrealloc (); +static void error P_((const char *, const char *)); +static void suggest_asking_for_help P_((void)); +static void fatal P_((char *, char *)); +static void pfatal P_((char *)); +static void add_node P_((node *, node **)); + +static void init P_((void)); +static void initbuffer P_((linebuffer *)); +static void find_entries P_((char *, FILE *)); +static void free_tree P_((node *)); +static void pfnote P_((char *, bool, char *, int, int, long)); +static void new_pfnote P_((char *, int, bool, char *, int, int, long)); +static void process_file P_((char *)); +static void put_entries P_((node *)); +static void takeprec P_((void)); + +static char *concat P_((char *, char *, char *)); +static char *skip_spaces P_((char *)); +static char *skip_non_spaces P_((char *)); +static char *savenstr P_((char *, int)); +static char *savestr P_((char *)); +static char *etags_strchr P_((const char *, int)); +static char *etags_strrchr P_((const char *, int)); +static char *etags_getcwd P_((void)); +static char *relative_filename P_((char *, char *)); +static char *absolute_filename P_((char *, char *)); +static char *absolute_dirname P_((char *, char *)); +static bool filename_is_absolute P_((char *f)); +static void canonicalize_filename P_((char *)); +static void grow_linebuffer P_((linebuffer *, int)); +static long *xmalloc P_((unsigned int)); +static long *xrealloc P_((char *, unsigned int)); char searchar = '/'; /* use /.../ searches */ @@ -267,34 +327,8 @@ long linecharno; /* charno of start of current line */ char *dbp; /* pointer to start of current tag */ -typedef struct node_st -{ /* sorting structure */ - char *name; /* function or type name */ - char *file; /* file name */ - bool is_func; /* use pattern or line no */ - bool been_warned; /* set if noticed dup */ - int lno; /* line number tag is on */ - long cno; /* character number line starts on */ - char *pat; /* search pattern */ - struct node_st *left, *right; /* left and right sons */ -} node; - node *head; /* the head of the binary tree of tags */ -/* - * A `linebuffer' is a structure which holds a line of text. - * `readline_internal' reads a line from a stream into a linebuffer - * and works regardless of the length of the line. - * SIZE is the size of BUFFER, LEN is the length of the string in - * BUFFER after readline reads it. - */ -typedef struct -{ - long size; - int len; - char *buffer; -} linebuffer; - linebuffer lb; /* the current line */ linebuffer token_name; /* used by C_entries as a temporary area */ struct @@ -307,7 +341,7 @@ bool _wht[CHARS], _nin[CHARS], _itk[CHARS], _btk[CHARS], _etk[CHARS]; char /* white chars */ - *white = " \f\t\n\r", + *white = " \f\t\n\r\v", /* not in a name */ *nonam = " \f\t\n\r(=,[;", /* token ending chars */ @@ -319,13 +353,14 @@ bool append_to_tagfile; /* -a: append to tags */ /* The following four default to TRUE for etags, but to FALSE for ctags. */ -bool typedefs; /* -t: create tags for C typedefs */ +bool typedefs; /* -t: create tags for C and Ada typedefs */ bool typedefs_and_cplusplus; /* -T: create tags for C typedefs, level */ /* 0 struct/enum/union decls, and C++ */ /* member functions. */ bool constantypedefs; /* -d: create tags for C #define, enum */ /* constants and variables. */ /* -D: opposite of -d. Default under ctags. */ +bool declarations; /* --declarations: tag them and extern in C&Co*/ bool globals; /* create tags for global variables */ bool members; /* create tags for C member variables */ bool update; /* -u: update tags */ @@ -334,37 +369,41 @@ bool cxref_style; /* -x: create cxref style output */ bool cplusplus; /* .[hc] means C++, not C */ bool noindentypedefs; /* -I: ignore indentation in C */ +bool packages_only; /* --packages-only: in Ada, only tag packages*/ #ifdef LONG_OPTIONS struct option longopts[] = { - { "append", no_argument, NULL, 'a' }, - { "backward-search", no_argument, NULL, 'B' }, - { "c++", no_argument, NULL, 'C' }, - { "cxref", no_argument, NULL, 'x' }, - { "defines", no_argument, NULL, 'd' }, - { "no-defines", no_argument, NULL, 'D' }, - { "globals", no_argument, &globals, TRUE }, - { "no-globals", no_argument, &globals, FALSE }, - { "help", no_argument, NULL, 'h' }, - { "help", no_argument, NULL, 'H' }, - { "ignore-indentation", no_argument, NULL, 'I' }, - { "include", required_argument, NULL, 'i' }, - { "language", required_argument, NULL, 'l' }, - { "members", no_argument, &members, TRUE }, - { "no-members", no_argument, &members, FALSE }, - { "no-warn", no_argument, NULL, 'w' }, - { "output", required_argument, NULL, 'o' }, -#ifdef ETAGS_REGEXPS - { "regex", required_argument, NULL, 'r' }, - { "no-regex", no_argument, NULL, 'R' }, -#endif /* ETAGS_REGEXPS */ - { "typedefs", no_argument, NULL, 't' }, - { "typedefs-and-c++", no_argument, NULL, 'T' }, - { "update", no_argument, NULL, 'u' }, - { "version", no_argument, NULL, 'V' }, - { "vgrind", no_argument, NULL, 'v' }, - { 0 } + { "packages-only", no_argument, &packages_only, TRUE }, + { "append", no_argument, NULL, 'a' }, + { "backward-search", no_argument, NULL, 'B' }, + { "c++", no_argument, NULL, 'C' }, + { "cxref", no_argument, NULL, 'x' }, + { "defines", no_argument, NULL, 'd' }, + { "declarations", no_argument, &declarations, TRUE }, + { "no-defines", no_argument, NULL, 'D' }, + { "globals", no_argument, &globals, TRUE }, + { "no-globals", no_argument, &globals, FALSE }, + { "help", no_argument, NULL, 'h' }, + { "help", no_argument, NULL, 'H' }, + { "ignore-indentation", no_argument, NULL, 'I' }, + { "include", required_argument, NULL, 'i' }, + { "language", required_argument, NULL, 'l' }, + { "members", no_argument, &members, TRUE }, + { "no-members", no_argument, &members, FALSE }, + { "no-warn", no_argument, NULL, 'w' }, + { "output", required_argument, NULL, 'o' }, +#ifdef ETAGS_REGEXPS + { "regex", required_argument, NULL, 'r' }, + { "no-regex", no_argument, NULL, 'R' }, + { "ignore-case-regex", required_argument, NULL, 'c' }, +#endif /* ETAGS_REGEXPS */ + { "typedefs", no_argument, NULL, 't' }, + { "typedefs-and-c++", no_argument, NULL, 'T' }, + { "update", no_argument, NULL, 'u' }, + { "version", no_argument, NULL, 'V' }, + { "vgrind", no_argument, NULL, 'v' }, + { NULL } }; #endif /* LONG_OPTIONS */ @@ -382,17 +421,22 @@ bool error_signaled; } pattern; -/* Array of all regexps. */ +/* List of all regexps. */ pattern *p_head = NULL; + +/* How many characters in the character set. (From regex.c.) */ +#define CHAR_SET_SIZE 256 +/* Translation table for case-insensitive matching. */ +char lc_trans[CHAR_SET_SIZE]; #endif /* ETAGS_REGEXPS */ compressor compressors[] = { - { "z", 1, "gzip -d -c"}, - { "Z", 1, "gzip -d -c"}, - { "gz", 2, "gzip -d -c"}, - { "GZ", 2, "gzip -d -c"}, - { "bz2", 3, "bzip2 -d -c" }, + { "z", "gzip -d -c"}, + { "Z", "gzip -d -c"}, + { "gz", "gzip -d -c"}, + { "GZ", "gzip -d -c"}, + { "bz2", "bzip2 -d -c" }, { NULL } }; @@ -403,6 +447,10 @@ /* Non-NULL if language fixed. */ language *forced_lang = NULL; +/* Ada code */ +char *Ada_suffixes [] = + { "ads", "adb", "ada", NULL }; + /* Assembly code */ char *Asm_suffixes [] = { "a", /* Unix assembler */ "asm", /* Microcontroller assembly */ @@ -459,7 +507,7 @@ NULL }; char *Postscript_suffixes [] = - { "ps", NULL }; + { "ps", "psw", NULL }; /* .psw is for PSWrap */ char *Prolog_suffixes [] = { "prolog", NULL }; @@ -486,6 +534,7 @@ language lang_names [] = { + { "ada", Ada_funcs, Ada_suffixes, NULL }, { "asm", Asm_labels, Asm_suffixes, NULL }, { "c", default_C_entries, default_C_suffixes, NULL }, { "c++", Cplusplus_entries, Cplusplus_suffixes, NULL }, @@ -509,7 +558,7 @@ { NULL, NULL } /* end of list */ }; -void +static void print_language_names () { language *lang; @@ -534,20 +583,23 @@ Compressed files are supported using gzip and bzip2."); } +#ifndef EMACS_NAME +# define EMACS_NAME "GNU Emacs" +#endif #ifndef VERSION -# define VERSION "20" +# define VERSION "21" #endif -void +static void print_version () { - printf ("%s (GNU Emacs %s)\n", (CTAGS) ? "ctags" : "etags", VERSION); - puts ("Copyright (C) 1996 Free Software Foundation, Inc. and Ken Arnold"); + printf ("%s (%s %s)\n", (CTAGS) ? "ctags" : "etags", EMACS_NAME, VERSION); + puts ("Copyright (C) 1999 Free Software Foundation, Inc. and Ken Arnold"); puts ("This program is distributed under the same terms as Emacs"); exit (GOOD); } -void +static void print_help () { printf ("Usage: %s [options] [[regex-option ...] file-name] ...\n\ @@ -568,6 +620,9 @@ puts ("-a, --append\n\ Append tag entries to existing tags file."); + puts ("--packages-only\n\ + For Ada files, only generate tags for packages ."); + if (CTAGS) puts ("-B, --backward-search\n\ Write the search commands for the tag entries using '?', the\n\ @@ -576,6 +631,14 @@ puts ("-C, --c++\n\ Treat files whose name suffix defaults to C language as C++ files."); + puts ("--declarations\n\ + In C and derived languages, create tags for function declarations,"); + if (CTAGS) + puts ("\tand create tags for extern variables if --globals is used."); + else + puts + ("\tand create tags for extern variables unless --no-globals is used."); + if (CTAGS) puts ("-d, --defines\n\ Create tag entries for C #define constants and enum constants, too."); @@ -607,12 +670,15 @@ #ifdef ETAGS_REGEXPS puts ("-r /REGEXP/, --regex=/REGEXP/ or --regex=@regexfile\n\ - Make a tag for each line matching pattern REGEXP in the\n\ - following files. regexfile is a file containing one REGEXP\n\ - per line. REGEXP is anchored (as if preceded by ^).\n\ - The form /REGEXP/NAME/ creates a named tag. For example Tcl\n\ - named tags can be created with:\n\ + Make a tag for each line matching pattern REGEXP in the following\n\ + files. {LANGUAGE}/REGEXP/ uses REGEXP for LANGUAGE files only.\n\ + regexfile is a file containing one REGEXP per line.\n\ + REGEXP is anchored (as if preceded by ^).\n\ + The form /REGEXP/NAME/ creates a named tag.\n\ + For example Tcl named tags can be created with:\n\ --regex=/proc[ \\t]+\\([^ \\t]+\\)/\\1/."); + puts ("-c /REGEXP/, --ignore-case-regex=/REGEXP/ or --ignore-case-regex=@regexfile\n\ + Like -r, --regex but ignore case when matching expressions."); puts ("-R, --no-regex\n\ Don't create tags from regexps for the following files."); #endif /* ETAGS_REGEXPS */ @@ -627,7 +693,7 @@ if (CTAGS) { puts ("-t, --typedefs\n\ - Generate tag entries for C typedefs."); + Generate tag entries for C and Ada typedefs."); puts ("-T, --typedefs-and-c++\n\ Generate tag entries for C typedefs, C struct/enum/union tags,\n\ and C++ member functions."); @@ -660,7 +726,7 @@ print_language_names (); puts (""); - puts ("Report bugs to bug-gnu-emacs@prep.ai.mit.edu"); + puts ("Report bugs to bug-gnu-emacs@gnu.org"); exit (GOOD); } @@ -670,7 +736,8 @@ { at_language, at_regexp, - at_filename + at_filename, + at_icregexp }; /* This structure helps us allow mixing of --lang and file names. */ @@ -713,7 +780,7 @@ #include #include #define OUTSIZE MAX_FILE_SPEC_LEN -short +static short fn_exp (out, in) vspec *out; char *in; @@ -758,7 +825,7 @@ v1.01 nmm 19-Aug-85 gfnames - return in successive calls the name of each file specified by the provided arg expanding wildcards. */ -char * +static char * gfnames (arg, p_error) char *arg; bool *p_error; @@ -839,12 +906,15 @@ #ifdef ETAGS_REGEXPS /* Set syntax for regular expression routines. */ re_set_syntax (RE_SYNTAX_EMACS | RE_INTERVALS); + /* Translation table for case-insensitive search. */ + for (i = 0; i < CHAR_SET_SIZE; i++) + lc_trans[i] = lowcase (i); #endif /* ETAGS_REGEXPS */ /* * If etags, always find typedefs and structure tags. Why not? * Also default is to find macro constants, enum constants and - * global variables. + * global variables. */ if (!CTAGS) { @@ -859,7 +929,7 @@ char *optstring; #ifdef ETAGS_REGEXPS - optstring = "-aCdDf:Il:o:r:RStTi:BuvxwVhH"; + optstring = "-aCdDf:Il:o:r:c:RStTi:BuvxwVhH"; #else optstring = "-aCdDf:Il:o:StTi:BuvxwVhH"; #endif /* ETAGS_REGEXPS */ @@ -896,7 +966,7 @@ case 'o': if (tagfile) { - error ("-%c option may only be given once.", opt); + error ("-o option may only be given once.", (char *)NULL); suggest_asking_for_help (); } tagfile = optarg; @@ -927,6 +997,11 @@ argbuffer[current_arg].what = NULL; ++current_arg; break; + case 'c': + argbuffer[current_arg].arg_type = at_icregexp; + argbuffer[current_arg].what = optarg; + ++current_arg; + break; #endif /* ETAGS_REGEXPS */ case 'V': print_version (); @@ -969,7 +1044,7 @@ if (nincluded_files == 0 && file_count == 0) { - error ("no input files specified.", 0); + error ("no input files specified.", (char *)NULL); suggest_asking_for_help (); } @@ -1025,7 +1100,10 @@ break; #ifdef ETAGS_REGEXPS case at_regexp: - analyse_regex (argbuffer[i].what); + analyse_regex (argbuffer[i].what, FALSE); + break; + case at_icregexp: + analyse_regex (argbuffer[i].what, TRUE); break; #endif case at_filename: @@ -1117,23 +1195,42 @@ /* - * Return a compressor given the file name. + * Return a compressor given the file name. If EXTPTR is non-zero, + * return a pointer into FILE where the compressor-specific + * extension begins. If no compressor is found, NULL is returned + * and EXTPTR is not significant. * Idea by Vladimir Alexiev */ -compressor * -get_compressor_from_suffix (file) +static compressor * +get_compressor_from_suffix (file, extptr) char *file; + char **extptr; { compressor *compr; - char *suffix; - + char *slash, *suffix; + + /* This relies on FN to be after canonicalize_filename, + so we don't need to consider backslashes on DOS_NT. */ + slash = etags_strrchr (file, '/'); suffix = etags_strrchr (file, '.'); - if (suffix == NULL) + if (suffix == NULL || suffix < slash) return NULL; + if (extptr != NULL) + *extptr = suffix; suffix += 1; - for (compr = compressors; compr->suffix != NULL; compr++) - if (streq (compr->suffix, suffix)) - return compr; + /* Let those poor souls who live with DOS 8+3 file name limits get + some solace by treating foo.cgz as if it were foo.c.gz, etc. + Only the first do loop is run if not MSDOS */ + do + { + for (compr = compressors; compr->suffix != NULL; compr++) + if (streq (compr->suffix, suffix)) + return compr; + if (!MSDOS) + break; /* do it only once: not really a loop */ + if (extptr != NULL) + *extptr = ++suffix; + } while (*suffix != '\0'); return NULL; } @@ -1142,7 +1239,7 @@ /* * Return a language given the name. */ -language * +static language * get_language_from_name (name) char *name; { @@ -1165,7 +1262,7 @@ /* * Return a language given the interpreter name. */ -language * +static language * get_language_from_interpreter (interpreter) char *interpreter; { @@ -1188,7 +1285,7 @@ /* * Return a language given the file name. */ -language * +static language * get_language_from_suffix (file) char *file; { @@ -1212,7 +1309,7 @@ /* * This routine is called on each file argument. */ -void +static void process_file (file) char *file; { @@ -1220,7 +1317,8 @@ FILE *inf; compressor *compr; char *compressed_name, *uncompressed_name; - char *real_name; + char *ext, *real_name; + canonicalize_filename (file); if (streq (file, tagfile) && !streq (tagfile, "-")) @@ -1228,7 +1326,7 @@ error ("skipping inclusion of %s in self.", file); return; } - if ((compr = get_compressor_from_suffix (file)) == NULL) + if ((compr = get_compressor_from_suffix (file, &ext)) == NULL) { compressed_name = NULL; real_name = uncompressed_name = savestr (file); @@ -1236,8 +1334,29 @@ else { real_name = compressed_name = savestr (file); - uncompressed_name = savenstr (file, strlen(file) - compr->sufflen - 1); + uncompressed_name = savenstr (file, ext - file); } + + /* If the canonicalised uncompressed name has already be dealt with, + skip it silently, else add it to the list. */ + { + typedef struct processed_file + { + char *filename; + struct processed_file *next; + } processed_file; + static processed_file *pf_head = NULL; + register processed_file *fnp; + + for (fnp = pf_head; fnp != NULL; fnp = fnp->next) + if (streq (uncompressed_name, fnp->filename)) + goto exit; + fnp = pf_head; + pf_head = xnew (1, struct processed_file); + pf_head->filename = savestr (uncompressed_name); + pf_head->next = fnp; + } + if (stat (real_name, &stat_buf) != 0) { /* Reset real_name and try with a different name. */ @@ -1253,7 +1372,26 @@ { compressed_name = concat (file, ".", compr->suffix); if (stat (compressed_name, &stat_buf) != 0) - free (compressed_name); + { + if (MSDOS) + { + char *suf = compressed_name + strlen (file); + size_t suflen = strlen (compr->suffix) + 1; + for ( ; suf[1]; suf++, suflen--) + { + memmove (suf, suf + 1, suflen); + if (stat (compressed_name, &stat_buf) == 0) + { + real_name = compressed_name; + break; + } + } + if (real_name != NULL) + break; + } /* MSDOS */ + free (compressed_name); + compressed_name = NULL; + } else { real_name = compressed_name; @@ -1279,7 +1417,7 @@ inf = popen (cmd, "r"); free (cmd); } - else + else inf = fopen (real_name, "r"); if (inf == NULL) { @@ -1330,7 +1468,7 @@ * subscripted by the chars in "white" are set to TRUE. Thus "_wht" * of a char is TRUE if it is the string "white", else FALSE. */ -void +static void init () { register char *sp; @@ -1340,13 +1478,12 @@ iswhite(i) = notinname(i) = begtoken(i) = intoken(i) = endtoken(i) = FALSE; for (sp = white; *sp != '\0'; sp++) iswhite (*sp) = TRUE; for (sp = nonam; *sp != '\0'; sp++) notinname (*sp) = TRUE; + notinname('\0') = notinname('\n'); for (sp = begtk; *sp != '\0'; sp++) begtoken (*sp) = TRUE; + begtoken('\0') = begtoken('\n'); for (sp = midtk; *sp != '\0'; sp++) intoken (*sp) = TRUE; + intoken('\0') = intoken('\n'); for (sp = endtk; *sp != '\0'; sp++) endtoken (*sp) = TRUE; - iswhite('\0') = iswhite('\n'); - notinname('\0') = notinname('\n'); - begtoken('\0') = begtoken('\n'); - intoken('\0') = intoken('\n'); endtoken('\0') = endtoken('\n'); } @@ -1356,7 +1493,7 @@ */ node *last_node = NULL; -void +static void find_entries (file, inf) char *file; FILE *inf; @@ -1443,7 +1580,7 @@ } /* Record a tag. */ -void +static void pfnote (name, is_func, linestart, linelen, lno, cno) char *name; /* tag name, or NULL if unnamed */ bool is_func; /* tag is a function */ @@ -1513,7 +1650,7 @@ * `nonam'. */ #define traditional_tag_style TRUE -void +static void new_pfnote (name, namelen, is_func, linestart, linelen, lno, cno) char *name; /* tag name, or NULL if unnamed */ int namelen; /* tag length */ @@ -1543,7 +1680,7 @@ named = FALSE; /* use unnamed tag */ } } - + if (named) name = savenstr (name, namelen); else @@ -1555,7 +1692,7 @@ * free_tree () * recurse on left children, iterate on right children. */ -void +static void free_tree (np) register node *np; { @@ -1580,7 +1717,7 @@ * add_node is the only function allowed to add nodes, so it can * maintain state. */ -void +static void add_node (np, cur_node_p) node *np, **cur_node_p; { @@ -1638,7 +1775,7 @@ } } -void +static void put_entries (np) register node *np; { @@ -1705,7 +1842,7 @@ } /* Length of a number's decimal representation. */ -int +static int number_len (num) long num; { @@ -1722,7 +1859,7 @@ * is irrelevant with the new tags.el, but is still supplied for * backward compatibility. */ -int +static int total_size_of_entries (np) register node *np; { @@ -1757,14 +1894,23 @@ st_C_ignore, st_C_javastruct, st_C_operator, - st_C_struct, st_C_enum, st_C_define, st_C_typedef, st_C_typespec + st_C_struct, st_C_extern, st_C_enum, st_C_define, st_C_typedef, st_C_typespec }; +static unsigned int hash P_((const char *, unsigned int)); +static struct C_stab_entry * in_word_set P_((const char *, unsigned int)); +static enum sym_type C_symtype P_((char *, int, int)); + /* Feed stuff between (but not including) %[ and %] lines to: gperf -c -k 1,3 -o -p -r -t %[ struct C_stab_entry { char *name; int c_ext; enum sym_type type; } %% +if, 0, st_C_ignore +for, 0, st_C_ignore +while, 0, st_C_ignore +switch, 0, st_C_ignore +return, 0, st_C_ignore @interface, 0, st_C_objprot @protocol, 0, st_C_objprot @implementation,0, st_C_objimpl @@ -1780,6 +1926,7 @@ domain, C_STAR, st_C_struct union, 0, st_C_struct struct, 0, st_C_struct +extern, 0, st_C_extern enum, 0, st_C_enum typedef, 0, st_C_typedef define, 0, st_C_define @@ -1795,7 +1942,6 @@ unsigned, 0, st_C_typespec auto, 0, st_C_typespec void, 0, st_C_typespec -extern, 0, st_C_typespec static, 0, st_C_typespec const, 0, st_C_typespec volatile, 0, st_C_typespec @@ -1814,113 +1960,152 @@ %] and replace lines between %< and %> with its output. */ /*%<*/ -/* C code produced by gperf version 2.5 (GNU C++ version) */ +/* C code produced by gperf version 2.7.1 (19981006 egcs) */ /* Command-line: gperf -c -k 1,3 -o -p -r -t */ struct C_stab_entry { char *name; int c_ext; enum sym_type type; }; -#define TOTAL_KEYWORDS 41 -#define MIN_WORD_LENGTH 3 +#define TOTAL_KEYWORDS 46 +#define MIN_WORD_LENGTH 2 #define MAX_WORD_LENGTH 15 -#define MIN_HASH_VALUE 20 -#define MAX_HASH_VALUE 136 -/* maximum key range = 117, duplicates = 0 */ - +#define MIN_HASH_VALUE 13 +#define MAX_HASH_VALUE 123 +/* maximum key range = 111, duplicates = 0 */ + +#ifdef __GNUC__ +__inline +#endif static unsigned int hash (str, len) - register char *str; - register int unsigned len; + register const char *str; + register unsigned int len; { static unsigned char asso_values[] = { - 137, 137, 137, 137, 137, 137, 137, 137, 137, 137, - 137, 137, 137, 137, 137, 137, 137, 137, 137, 137, - 137, 137, 137, 137, 137, 137, 137, 137, 137, 137, - 137, 137, 137, 137, 137, 137, 137, 137, 137, 137, - 137, 137, 137, 137, 137, 137, 137, 137, 137, 137, - 137, 137, 137, 137, 137, 137, 137, 137, 137, 137, - 137, 137, 137, 137, 58, 137, 137, 137, 38, 37, - 45, 137, 137, 137, 137, 137, 137, 137, 137, 137, - 62, 137, 137, 14, 16, 137, 137, 137, 137, 137, - 137, 137, 137, 137, 137, 137, 137, 26, 16, 51, - 18, 61, 5, 19, 137, 23, 137, 137, 32, 63, - 54, 10, 26, 137, 24, 42, 30, 18, 46, 137, - 137, 137, 137, 137, 137, 137, 137, 137, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 3, 124, 124, 124, 43, 6, + 11, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 11, 124, 124, 58, 7, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 124, 124, 124, 57, 7, 42, + 4, 14, 52, 0, 124, 53, 124, 124, 29, 11, + 6, 35, 32, 124, 29, 34, 59, 58, 51, 24, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, + 124, 124, 124, 124, 124, 124 }; - return len + asso_values[str[2]] + asso_values[str[0]]; + register int hval = len; + + switch (hval) + { + default: + case 3: + hval += asso_values[(unsigned char)str[2]]; + case 2: + case 1: + hval += asso_values[(unsigned char)str[0]]; + break; + } + return hval; } -struct C_stab_entry * +#ifdef __GNUC__ +__inline +#endif +static struct C_stab_entry * in_word_set (str, len) - register char *str; + register const char *str; register unsigned int len; { static struct C_stab_entry wordlist[] = { - {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, - {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, - {"",}, {"",}, - {"float", 0, st_C_typespec}, - {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, - {"define", 0, st_C_define}, - {"bool", C_PLPL, st_C_typespec}, - {"",}, {"",}, {"",}, - {"friend", C_PLPL, st_C_ignore}, - {"SYSCALL", 0, st_C_gnumacro}, - {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, - {"double", 0, st_C_typespec}, - {"",}, {"",}, {"",}, - {"union", 0, st_C_struct}, - {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, - {"import", C_JAVA, st_C_ignore}, - {"int", 0, st_C_typespec}, - {"short", 0, st_C_typespec}, - {"ENTRY", 0, st_C_gnumacro}, - {"implements", C_JAVA, st_C_javastruct}, - {"auto", 0, st_C_typespec}, - {"",}, - {"interface", C_JAVA, st_C_struct}, - {"typedef", 0, st_C_typedef}, - {"typename", C_PLPL, st_C_typespec}, - {"",}, {"",}, - {"signed", 0, st_C_typespec}, - {"unsigned", 0, st_C_typespec}, - {"",}, {"",}, {"",}, - {"struct", 0, st_C_struct}, - {"void", 0, st_C_typespec}, - {"static", 0, st_C_typespec}, - {"",}, {"",}, {"",}, {"",}, - {"operator", C_PLPL, st_C_operator}, - {"",}, - {"char", 0, st_C_typespec}, - {"class", C_PLPL, st_C_struct}, - {"enum", 0, st_C_enum}, - {"package", C_JAVA, st_C_ignore}, - {"",}, - {"volatile", 0, st_C_typespec}, - {"domain", C_STAR, st_C_struct}, - {"DEFUN", 0, st_C_gnumacro}, - {"",}, - {"long", 0, st_C_typespec}, - {"@protocol", 0, st_C_objprot}, - {"",}, {"",}, {"",}, - {"explicit", C_PLPL, st_C_typespec}, - {"",}, - {"extern", 0, st_C_typespec}, - {"extends", C_JAVA, st_C_javastruct}, - {"",}, - {"mutable", C_PLPL, st_C_typespec}, - {"",}, {"",}, {"",}, {"",}, - {"PSEUDO", 0, st_C_gnumacro}, - {"",}, {"",}, {"",}, {"",}, - {"const", 0, st_C_typespec}, - {"",}, {"",}, {"",}, {"",}, {"",}, - {"@end", 0, st_C_objend}, - {"",}, {"",}, {"",}, {"",}, {"",}, - {"@interface", 0, st_C_objprot}, - {"",}, {"",}, {"",}, - {"namespace", C_PLPL, st_C_struct}, - {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, - {"@implementation", 0, st_C_objimpl}, + {""}, {""}, {""}, {""}, {""}, {""}, {""}, {""}, {""}, + {""}, {""}, {""}, {""}, + {"@end", 0, st_C_objend}, + {""}, {""}, {""}, {""}, + {"ENTRY", 0, st_C_gnumacro}, + {"@interface", 0, st_C_objprot}, + {""}, + {"domain", C_STAR, st_C_struct}, + {""}, + {"PSEUDO", 0, st_C_gnumacro}, + {""}, {""}, + {"namespace", C_PLPL, st_C_struct}, + {""}, {""}, + {"@implementation",0, st_C_objimpl}, + {""}, {""}, {""}, {""}, {""}, {""}, {""}, {""}, {""}, + {"long", 0, st_C_typespec}, + {"signed", 0, st_C_typespec}, + {"@protocol", 0, st_C_objprot}, + {""}, {""}, {""}, {""}, + {"bool", C_PLPL, st_C_typespec}, + {""}, {""}, {""}, {""}, {""}, {""}, + {"const", 0, st_C_typespec}, + {"explicit", C_PLPL, st_C_typespec}, + {"if", 0, st_C_ignore}, + {""}, + {"operator", C_PLPL, st_C_operator}, + {""}, + {"DEFUN", 0, st_C_gnumacro}, + {""}, {""}, + {"define", 0, st_C_define}, + {""}, {""}, {""}, {""}, {""}, + {"double", 0, st_C_typespec}, + {"struct", 0, st_C_struct}, + {""}, {""}, {""}, {""}, + {"short", 0, st_C_typespec}, + {""}, + {"enum", 0, st_C_enum}, + {"mutable", C_PLPL, st_C_typespec}, + {""}, + {"extern", 0, st_C_extern}, + {"extends", C_JAVA, st_C_javastruct}, + {"package", C_JAVA, st_C_ignore}, + {"while", 0, st_C_ignore}, + {""}, + {"for", 0, st_C_ignore}, + {""}, {""}, {""}, + {"volatile", 0, st_C_typespec}, + {""}, {""}, + {"import", C_JAVA, st_C_ignore}, + {"float", 0, st_C_typespec}, + {"switch", 0, st_C_ignore}, + {"return", 0, st_C_ignore}, + {"implements", C_JAVA, st_C_javastruct}, + {""}, + {"static", 0, st_C_typespec}, + {"typedef", 0, st_C_typedef}, + {"typename", C_PLPL, st_C_typespec}, + {"unsigned", 0, st_C_typespec}, + {""}, {""}, + {"char", 0, st_C_typespec}, + {"class", C_PLPL, st_C_struct}, + {""}, {""}, {""}, + {"void", 0, st_C_typespec}, + {""}, {""}, + {"friend", C_PLPL, st_C_ignore}, + {""}, {""}, {""}, + {"int", 0, st_C_typespec}, + {"union", 0, st_C_struct}, + {""}, {""}, {""}, + {"auto", 0, st_C_typespec}, + {"interface", C_JAVA, st_C_struct}, + {""}, + {"SYSCALL", 0, st_C_gnumacro} }; if (len <= MAX_WORD_LENGTH && len >= MIN_WORD_LENGTH) @@ -1929,9 +2114,9 @@ if (key <= MAX_HASH_VALUE && key >= 0) { - register char *s = wordlist[key].name; - - if (*s == *str && !strncmp (str + 1, s + 1, len - 1)) + register const char *s = wordlist[key].name; + + if (*str == *s && !strncmp (str + 1, s + 1, len - 1)) return &wordlist[key]; } } @@ -1939,7 +2124,7 @@ } /*%>*/ -enum sym_type +static enum sym_type C_symtype (str, len, c_ext) char *str; int len; @@ -1968,6 +2153,7 @@ vignore /* var-like: ignore until ';' */ } fvdef; +bool fvextern; /* func or var: extern keyword seen; */ /* * typedefs are recognized using a simple finite automaton. @@ -1976,7 +2162,8 @@ enum { tnone, /* nothing seen */ - ttypedseen, /* typedef keyword seen */ + tkeyseen, /* typedef keyword seen */ + ttypeseen, /* defined type seen */ tinbody, /* inside typedef body */ tend, /* just before typedef tag */ tignore /* junk after typedef tag */ @@ -2075,6 +2262,9 @@ */ int methodlen; +static bool consider_token P_((char *, int, int, int, int, int, bool *)); +static void make_C_tag P_((bool)); + /* * consider_token () * checks to see if the current token is at the start of a @@ -2093,11 +2283,11 @@ * next_token_is_func IN OUT */ -bool +static bool consider_token (str, len, c, c_ext, cblev, parlev, is_func_or_var) register char *str; /* IN: token pointer */ register int len; /* IN: token length */ - register char c; /* IN: first char after the token */ + register int c; /* IN: first char after the token */ int c_ext; /* IN: C extensions mask */ int cblev; /* IN: curly brace level */ int parlev; /* IN: parenthesis level */ @@ -2149,20 +2339,20 @@ if (toktype == st_C_typedef) { if (typedefs) - typdef = ttypedseen; + typdef = tkeyseen; + fvextern = FALSE; fvdef = fvnone; return FALSE; } break; - case ttypedseen: + case tkeyseen: switch (toktype) { case st_none: case st_C_typespec: - typdef = tend; - break; case st_C_struct: case st_C_enum: + typdef = ttypeseen; break; } /* Do not return here, so the structdef stuff has a chance. */ @@ -2196,7 +2386,7 @@ return FALSE; case st_C_struct: case st_C_enum: - if (typdef == ttypedseen + if (typdef == tkeyseen || (typedefs_and_cplusplus && cblev == 0 && structdef == snone)) { structdef = skeyseen; @@ -2217,16 +2407,14 @@ return TRUE; } - /* Avoid entering fvdef stuff if typdef is going on. */ if (typdef != tnone) - { - definedef = dnone; - return FALSE; - } + definedef = dnone; /* Detect GNU macros. - DEFUN note for writers of emacs C code: + Writers of emacs code are recommended to put the + first two args of a DEFUN on the same line. + The DEFUN macro, used in emacs C source code, has a first arg that is a string (the lisp function name), and a second arg that is a C function name. Since etags skips strings, the second arg @@ -2236,8 +2424,7 @@ removing the initial 'F' character and substituting '-' for '_'. Anyway, this assumes that the conventions of naming lisp functions will never change. Currently, this method is not - implemented, so writers of emacs code are recommended to put the - first two args of a DEFUN on the same line. */ + implemented. */ if (definedef == dnone && toktype == st_C_gnumacro) { next_token_is_func = TRUE; @@ -2326,11 +2513,15 @@ /* A function, variable or enum constant? */ switch (toktype) { + case st_C_extern: + fvextern = TRUE; + /* FALLTHRU */ case st_C_typespec: - if (fvdef != finlist && fvdef != fignore && fvdef != vignore) - fvdef = fvnone; /* should be useless */ + if (fvdef != finlist && fvdef != fignore && fvdef != vignore) + fvdef = fvnone; /* should be useless */ return FALSE; case st_C_ignore: + fvextern = FALSE; fvdef = vignore; return FALSE; case st_C_operator: @@ -2338,6 +2529,12 @@ *is_func_or_var = TRUE; return TRUE; case st_none: + if ((c_ext & C_PLPL) && strneq (str+len-10, "::operator", 10)) + { + fvdef = foperator; + *is_func_or_var = TRUE; + return TRUE; + } if (constantypedefs && structdef == sinbody && structtype == st_C_enum) return TRUE; if (fvdef == fvnone) @@ -2346,6 +2543,7 @@ *is_func_or_var = TRUE; return TRUE; } + break; } return FALSE; @@ -2355,7 +2553,7 @@ * C_entries () * This routine finds functions, variables, typedefs, * #define's, enum constants and struct/union/enum definitions in - * #C syntax and adds them to the list. + * C syntax and adds them to the list. */ #define current_lb_is_new (newndx == curndx) #define switch_line_buffers() (curndx = 1 - curndx) @@ -2390,7 +2588,7 @@ } while (0) -void +static void make_C_tag (isfun) bool isfun; { @@ -2419,7 +2617,7 @@ } -void +static void C_entries (c_ext, inf) int c_ext; /* extension of C */ FILE *inf; /* input file */ @@ -2434,7 +2632,7 @@ int cblev; /* current curly brace level */ int parlev; /* current parenthesis level */ bool incomm, inquote, inchar, quotednl, midtoken; - bool cplpl, cjava; + bool purec, cplpl, cjava; token savetok; /* token saved during preprocessor handling */ @@ -2445,13 +2643,14 @@ lp = curlb.buffer; *lp = 0; - fvdef = fvnone; typdef = tnone; structdef = snone; - definedef = dnone; objdef = onone; + fvdef = fvnone; fvextern = FALSE; typdef = tnone; + structdef = snone; definedef = dnone; objdef = onone; next_token_is_func = yacc_rules = FALSE; midtoken = inquote = inchar = incomm = quotednl = FALSE; tok.valid = savetok.valid = FALSE; cblev = 0; parlev = 0; + purec = !(c_ext & ~YACC); /* no extensions (apart from possibly yacc) */ cplpl = (c_ext & C_PLPL) == C_PLPL; cjava = (c_ext & C_JAVA) == C_JAVA; if (cjava) @@ -2530,12 +2729,18 @@ case '"': inquote = TRUE; if (fvdef != finlist && fvdef != fignore && fvdef !=vignore) - fvdef = fvnone; + { + fvextern = FALSE; + fvdef = fvnone; + } continue; case '\'': inchar = TRUE; if (fvdef != finlist && fvdef != fignore && fvdef !=vignore) - fvdef = fvnone; + { + fvextern = FALSE; + fvdef = fvnone; + } continue; case '/': if (*lp == '*') @@ -2556,7 +2761,7 @@ { /* entering or exiting rules section in yacc file */ lp++; - definedef = dnone; fvdef = fvnone; + definedef = dnone; fvdef = fvnone; fvextern = FALSE; typdef = tnone; structdef = snone; next_token_is_func = FALSE; midtoken = inquote = inchar = incomm = quotednl = FALSE; @@ -2598,7 +2803,7 @@ if ((definedef != dnone || (cblev == 0 && structdef != scolonseen) || (cblev == 1 && cplpl && structdef == sinbody) - || (structdef == sinbody && structtype == st_C_enum)) + || (structdef == sinbody && purec)) && typdef != tignore && definedef != dignorerest && fvdef != finlist) @@ -2607,42 +2812,46 @@ { if (endtoken (c)) { - if (c == ':' && cplpl && *lp == ':' && begtoken(*(lp + 1))) + bool funorvar = FALSE; + + if (c == ':' && cplpl && *lp == ':' && begtoken (lp[1])) { /* * This handles :: in the middle, but not at the - * beginning of an identifier. + * beginning of an identifier. Also, space-separated + * :: is not recognised. */ lp += 2; - toklen += 3; + toklen += 2; + c = lp[-1]; + goto intok; } else { - bool funorvar = FALSE; - if (yacc_rules || consider_token (newlb.buffer + tokoff, toklen, c, c_ext, cblev, parlev, &funorvar)) { + if (fvdef == foperator) + { + char *oldlp = lp; + lp = skip_spaces (lp-1); + if (*lp != '\0') + lp += 1; + while (*lp != '\0' + && !iswhite (*lp) && *lp != '(') + lp += 1; + c = *lp++; + toklen += lp - oldlp; + } tok.named = FALSE; - if (structdef == sinbody + if (!purec + && funorvar && definedef == dnone - && funorvar) + && structdef == sinbody) /* function or var defined in C++ class body */ { - int len; - if (fvdef == foperator) - { - char *oldlp = lp; - lp = skip_spaces (lp-1); - while (*lp != '\0' - && !isspace (*lp) && *lp != '(') - lp += 1; - c = *lp++; - toklen += lp - oldlp; - } - - len = strlen (structtag) + qlen + toklen; + int len = strlen (structtag) + qlen + toklen; grow_linebuffer (&token_name, len + 1); strcpy (token_name.buffer, structtag); strcat (token_name.buffer, qualifier); @@ -2677,11 +2886,15 @@ newlb.buffer + tokoff, toklen); token_name.buffer[toklen] = '\0'; token_name.len = toklen; - /* Name macros. */ + /* Name macros and members. */ tok.named = (structdef == stagseen + || typdef == ttypeseen || typdef == tend || (funorvar - && definedef == dignorerest)); + && definedef == dignorerest) + || (funorvar + && definedef == dnone + && structdef == sinbody)); } tok.lineno = lineno; tok.linelen = tokoff + toklen + 1; @@ -2706,6 +2919,7 @@ } } /* if (endtoken (c)) */ else if (intoken (c)) + intok: { toklen++; continue; @@ -2781,6 +2995,7 @@ } break; case fstartlist: + fvextern = FALSE; fvdef = fvnone; break; } @@ -2802,10 +3017,19 @@ case fignore: break; case fvnameseen: - if ((globals && cblev == 0) || (members && cblev == 1)) + if ((members && cblev == 1) + || (globals && cblev == 0 && (!fvextern || declarations))) make_C_tag (FALSE); /* a variable */ + fvextern = FALSE; + fvdef = fvnone; + tok.valid = FALSE; + break; + case flistseen: + if (declarations && (cblev == 0 || cblev == 1)) + make_C_tag (TRUE); /* a function declaration */ /* FALLTHRU */ default: + fvextern = FALSE; fvdef = fvnone; /* The following instruction invalidates the token. Probably the token should be invalidated in all @@ -2834,7 +3058,8 @@ case vignore: break; case fvnameseen: - if ((globals && cblev == 0) || (members && cblev == 1)) + if ((members && cblev == 1) + || (globals && cblev == 0 && (!fvextern || declarations))) make_C_tag (FALSE); /* a variable */ break; default: @@ -2860,7 +3085,8 @@ case vignore: break; case fvnameseen: - if ((globals && cblev == 0) || (members && cblev == 1)) + if ((members && cblev == 1) + || (globals && cblev == 0 && (!fvextern || declarations))) make_C_tag (FALSE); /* a variable */ /* FALLTHRU */ default: @@ -2876,23 +3102,19 @@ objdef = oparenseen; switch (fvdef) { - case fvnone: - switch (typdef) + case fvnameseen: + if (typdef == ttypeseen + && tok.valid + && *lp != '*' + && structdef != sinbody) { - case ttypedseen: - case tend: - if (tok.valid && *lp != '*') - { - /* This handles constructs like: - typedef void OperatorFun (int fun); */ - make_C_tag (FALSE); - typdef = tignore; - } - break; - } /* switch (typdef) */ - break; - case foperator: /* operator() is not handled */ - case fvnameseen: + /* This handles constructs like: + typedef void OperatorFun (int fun); */ + make_C_tag (FALSE); + typdef = tignore; + } + /* FALLTHRU */ + case foperator: fvdef = fstartlist; break; case flistseen: @@ -2918,7 +3140,7 @@ fvdef = flistseen; break; } - if (cblev == 0 && typdef == tend) + if (cblev == 0 && (typdef == tend)) { typdef = tignore; make_C_tag (FALSE); /* a typedef */ @@ -2930,7 +3152,7 @@ case '{': if (definedef != dnone) break; - if (typdef == ttypedseen) + if (typdef == ttypeseen) typdef = tinbody; switch (structdef) { @@ -3015,7 +3237,8 @@ case vignore: break; case fvnameseen: - if ((globals && cblev == 0) || (members && cblev == 1)) + if ((members && cblev == 1) + || (globals && cblev == 0 && (!fvextern || declarations))) make_C_tag (FALSE); /* a variable */ /* FALLTHRU */ default: @@ -3067,7 +3290,7 @@ * Process either a C++ file or a C file depending on the setting * of a global flag. */ -void +static void default_C_entries (inf) FILE *inf; { @@ -3075,7 +3298,7 @@ } /* Always do plain ANSI C. */ -void +static void plain_C_entries (inf) FILE *inf; { @@ -3083,7 +3306,7 @@ } /* Always do C++. */ -void +static void Cplusplus_entries (inf) FILE *inf; { @@ -3091,7 +3314,7 @@ } /* Always do Java. */ -void +static void Cjava_entries (inf) FILE *inf; { @@ -3099,7 +3322,7 @@ } /* Always do C*. */ -void +static void Cstar_entries (inf) FILE *inf; { @@ -3107,14 +3330,14 @@ } /* Always do Yacc. */ -void +static void Yacc_entries (inf) FILE *inf; { C_entries (YACC, inf); } -/* A useful macro. */ +/* A useful macro. */ #define LOOP_ON_INPUT_LINES(file_pointer, line_buffer, char_pointer) \ for (lineno = charno = 0; /* loop initialization */ \ !feof (file_pointer) /* loop test */ \ @@ -3130,7 +3353,7 @@ * Read a file, but do no processing. This is used to do regexp * matching on files that have no language defined. */ -void +static void just_read_file (inf) FILE *inf; { @@ -3142,15 +3365,19 @@ /* Fortran parsing */ -bool +static bool tail P_((char *)); +static void takeprec P_((void)); +static void getit P_((FILE *)); + +static bool tail (cp) char *cp; { register int len = 0; - while (*cp && lowcase(*cp) == lowcase(dbp[len])) + while (*cp != '\0' && lowcase (*cp) == lowcase (dbp[len])) cp++, len++; - if (*cp == '\0' && !intoken(dbp[len])) + if (*cp == '\0' && !intoken (dbp[len])) { dbp += len; return TRUE; @@ -3158,7 +3385,7 @@ return FALSE; } -void +static void takeprec () { dbp = skip_spaces (dbp); @@ -3171,17 +3398,17 @@ dbp += 3; return; } - if (!isdigit (*dbp)) + if (!isdigit ((unsigned char) *dbp)) { --dbp; /* force failure */ return; } do dbp++; - while (isdigit (*dbp)); + while (isdigit ((unsigned char) *dbp)); } -void +static void getit (inf) FILE *inf; { @@ -3199,18 +3426,16 @@ dbp += 6; dbp = skip_spaces (dbp); } - if (!isalpha (*dbp) - && *dbp != '_' - && *dbp != '$') + if (!isalpha ((unsigned char) *dbp) && *dbp != '_' && *dbp != '$') return; - for (cp = dbp + 1; *cp && intoken (*cp); cp++) + for (cp = dbp + 1; *cp != '\0' && intoken (*cp); cp++) continue; pfnote (savenstr (dbp, cp-dbp), TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno); } -void +static void Fortran_functions (inf) FILE *inf; { @@ -3268,10 +3493,6 @@ if (tail ("entry")) getit (inf); continue; - case 'p': - if (tail ("program") || tail ("procedure")) - getit (inf); - continue; case 'b': if (tail ("blockdata") || tail ("block data")) { @@ -3288,11 +3509,179 @@ } /* + * Philippe Waroquiers , 1998-04-24 + * Ada parsing + */ + +static void adagetit P_((FILE *, char *)); + +/* Once we are positioned after an "interesting" keyword, let's get + the real tag value necessary. */ +static void +adagetit (inf, name_qualifier) + FILE *inf; + char *name_qualifier; +{ + register char *cp; + char *name; + char c; + + while (!feof (inf)) + { + dbp = skip_spaces (dbp); + if (*dbp == '\0' + || (dbp[0] == '-' && dbp[1] == '-')) + { + lineno++; + linecharno = charno; + charno += readline (&lb, inf); + dbp = lb.buffer; + } + switch (*dbp) + { + case 'b': + case 'B': + if (tail ("body")) + { + /* Skipping body of procedure body or package body or .... + resetting qualifier to body instead of spec. */ + name_qualifier = "/b"; + continue; + } + break; + case 't': + case 'T': + /* Skipping type of task type or protected type ... */ + if (tail ("type")) + continue; + break; + } + if (*dbp == '"') + { + dbp += 1; + for (cp = dbp; *cp != '\0' && *cp != '"'; cp++) + continue; + } + else + { + dbp = skip_spaces (dbp); + for (cp = dbp; + (*cp != '\0' + && (isalpha ((unsigned char) *cp) || isdigit ((unsigned char) *cp) || *cp == '_' || *cp == '.')); + cp++) + continue; + if (cp == dbp) + return; + } + c = *cp; + *cp = '\0'; + name = concat (dbp, name_qualifier, ""); + *cp = c; + pfnote (name, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno); + if (c == '"') + dbp = cp + 1; + return; + } +} + +static void +Ada_funcs (inf) + FILE *inf; +{ + bool inquote = FALSE; + + LOOP_ON_INPUT_LINES (inf, lb, dbp) + { + while (*dbp != '\0') + { + /* Skip a string i.e. "abcd". */ + if (inquote || (*dbp == '"')) + { + dbp = etags_strchr ((inquote) ? dbp : dbp+1, '"'); + if (dbp != NULL) + { + inquote = FALSE; + dbp += 1; + continue; /* advance char */ + } + else + { + inquote = TRUE; + break; /* advance line */ + } + } + + /* Skip comments. */ + if (dbp[0] == '-' && dbp[1] == '-') + break; /* advance line */ + + /* Skip character enclosed in single quote i.e. 'a' + and skip single quote starting an attribute i.e. 'Image. */ + if (*dbp == '\'') + { + dbp++ ; + if (*dbp != '\0') + dbp++; + continue; + } + + /* Search for beginning of a token. */ + if (!begtoken (*dbp)) + { + dbp++; + continue; /* advance char */ + } + + /* We are at the beginning of a token. */ + switch (*dbp) + { + case 'f': + case 'F': + if (!packages_only && tail ("function")) + adagetit (inf, "/f"); + else + break; /* from switch */ + continue; /* advance char */ + case 'p': + case 'P': + if (!packages_only && tail ("procedure")) + adagetit (inf, "/p"); + else if (tail ("package")) + adagetit (inf, "/s"); + else if (tail ("protected")) /* protected type */ + adagetit (inf, "/t"); + else + break; /* from switch */ + continue; /* advance char */ + case 't': + case 'T': + if (!packages_only && tail ("task")) + adagetit (inf, "/k"); + else if (typedefs && !packages_only && tail ("type")) + { + adagetit (inf, "/t"); + while (*dbp != '\0') + dbp += 1; + } + else + break; /* from switch */ + continue; /* advance char */ + } + + /* Look for the end of the token. */ + while (!endtoken (*dbp)) + dbp++; + + } /* advance char */ + } /* advance line */ +} + +/* * Bob Weiner, Motorola Inc., 4/3/94 * Unix and microcontroller assembly tag handling * look for '^[a-zA-Z_.$][a-zA_Z0-9_.$]*[: ^I^J]' */ -void +static void Asm_labels (inf) FILE *inf; { @@ -3302,16 +3691,16 @@ { /* If first char is alphabetic or one of [_.$], test for colon following identifier. */ - if (isalpha (*cp) || *cp == '_' || *cp == '.' || *cp == '$') + if (isalpha ((unsigned char) *cp) || *cp == '_' || *cp == '.' || *cp == '$') { /* Read past label. */ cp++; - while (isalnum (*cp) || *cp == '_' || *cp == '.' || *cp == '$') + while (isalnum ((unsigned char) *cp) || *cp == '_' || *cp == '.' || *cp == '$') cp++; - if (*cp == ':' || isspace (*cp)) + if (*cp == ':' || iswhite (*cp)) { /* Found end of label, so copy it and add it to the table. */ - pfnote ((CTAGS) ? savenstr(lb.buffer, cp-lb.buffer) : NULL, TRUE, + pfnote (savenstr(lb.buffer, cp-lb.buffer), TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno); } } @@ -3324,7 +3713,7 @@ * Perl sub names: look for /^sub[ \t\n]+[^ \t\n{]+/ * Perl variable names: /^(my|local).../ */ -void +static void Perl_functions (inf) FILE *inf; { @@ -3334,18 +3723,18 @@ { if (*cp++ == 's' && *cp++ == 'u' - && *cp++ == 'b' && isspace (*cp++)) + && *cp++ == 'b' && iswhite (*cp++)) { cp = skip_spaces (cp); if (*cp != '\0') { char *sp = cp; while (*cp != '\0' - && !isspace (*cp) && *cp != '{' && *cp != '(') + && !iswhite (*cp) && *cp != '{' && *cp != '(') cp++; pfnote (savenstr (sp, cp-sp), TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno); - } + } } else if (globals /* only if tagging global vars is enabled */ && ((cp = lb.buffer, @@ -3357,7 +3746,7 @@ && *cp++ == 'c' && *cp++ == 'a' && *cp++ == 'l')) - && (*cp == '(' || isspace (*cp))) + && (*cp == '(' || iswhite (*cp))) { /* After "my" or "local", but before any following paren or space. */ char *varname = NULL; @@ -3366,7 +3755,7 @@ if (*cp == '$' || *cp == '@' || *cp == '%') { char* varstart = ++cp; - while (isalnum (*cp) || *cp == '_') + while (isalnum ((unsigned char) *cp) || *cp == '_') cp++; varname = savenstr (varstart, cp-varstart); } @@ -3377,7 +3766,7 @@ while (*cp != '\0' && *cp != ';' && *cp != '=' && *cp != ')') cp++; } - + /* Perhaps I should back cp up one character, so the TAGS table doesn't mention (and so depend upon) the following char. */ pfnote ((CTAGS) ? savenstr (lb.buffer, cp-lb.buffer) : varname, @@ -3390,7 +3779,7 @@ * Python support by Eric S. Raymond * Look for /^def[ \t\n]+[^ \t\n(:]+/ or /^class[ \t\n]+[^ \t\n(:]+/ */ -void +static void Python_functions (inf) FILE *inf; { @@ -3400,10 +3789,10 @@ { if (*cp++ == 'd' && *cp++ == 'e' - && *cp++ == 'f' && isspace (*cp++)) + && *cp++ == 'f' && iswhite (*cp++)) { cp = skip_spaces (cp); - while (*cp != '\0' && !isspace (*cp) && *cp != '(' && *cp != ':') + while (*cp != '\0' && !iswhite (*cp) && *cp != '(' && *cp != ':') cp++; pfnote (NULL, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno); @@ -3414,10 +3803,10 @@ && *cp++ == 'l' && *cp++ == 'a' && *cp++ == 's' - && *cp++ == 's' && isspace (*cp++)) + && *cp++ == 's' && iswhite (*cp++)) { cp = skip_spaces (cp); - while (*cp != '\0' && !isspace (*cp) && *cp != '(' && *cp != ':') + while (*cp != '\0' && !iswhite (*cp) && *cp != '(' && *cp != ':') cp++; pfnote (NULL, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno); @@ -3430,7 +3819,7 @@ * We could look for anything that could be a paragraph name. * i.e. anything that starts in column 8 is one word and ends in a full stop. */ -void +static void Cobol_paragraphs (inf) FILE *inf; { @@ -3443,10 +3832,10 @@ bp += 8; /* If eoln, compiler option or comment ignore whole line. */ - if (bp[-1] != ' ' || !isalnum (bp[0])) + if (bp[-1] != ' ' || !isalnum ((unsigned char) bp[0])) continue; - for (ep = bp; isalnum (*ep) || *ep == '-'; ep++) + for (ep = bp; isalnum ((unsigned char) *ep) || *ep == '-'; ep++) continue; if (*ep++ == '.') pfnote (savenstr (bp, ep-bp), TRUE, @@ -3463,7 +3852,7 @@ * "forward" immediately following the procedure statement; if found, * the tag is skipped. */ -void +static void Pascal_functions (inf) FILE *inf; { @@ -3498,8 +3887,8 @@ inparms = FALSE; /* found '(' after "proc" */ verify_tag = FALSE; /* check if "extern" is ahead */ - - while (!feof (inf)) /* long main loop to get next char */ + + while (!feof (inf)) /* long main loop to get next char */ { c = *dbp++; if (c == '\0') /* if end of line */ @@ -3640,7 +4029,12 @@ * lisp tag functions * look for (def or (DEF, quote or QUOTE */ -int + +static int L_isdef P_((char *)); +static int L_isquote P_((char *)); +static void L_getit P_((void)); + +static int L_isdef (strp) register char *strp; { @@ -3649,7 +4043,7 @@ && (strp[3] == 'f' || strp[3] == 'F')); } -int +static int L_isquote (strp) register char *strp; { @@ -3658,10 +4052,10 @@ && (*++strp == 'o' || *strp == 'O') && (*++strp == 't' || *strp == 'T') && (*++strp == 'e' || *strp == 'E') - && isspace (*++strp)); + && iswhite (*++strp)); } -void +static void L_getit () { register char *cp; @@ -3678,7 +4072,7 @@ } for (cp = dbp /*+1*/; - *cp != '\0' && *cp != '(' && *cp != ' ' && *cp != ')'; + *cp != '\0' && *cp != '(' && !iswhite(*cp) && *cp != ')'; cp++) continue; if (cp == dbp) @@ -3688,7 +4082,7 @@ lb.buffer, cp - lb.buffer + 1, lineno, linecharno); } -void +static void Lisp_functions (inf) FILE *inf; { @@ -3707,7 +4101,7 @@ /* Check for (foo::defmumble name-defined ... */ do dbp++; - while (*dbp != '\0' && !isspace (*dbp) + while (*dbp != '\0' && !iswhite (*dbp) && *dbp != ':' && *dbp != '(' && *dbp != ')'); if (*dbp == ':') { @@ -3731,8 +4125,10 @@ * Postscript tag functions * Just look for lines where the first character is '/' * Richard Mlynarik + * Also look at "defineps" for PSWrap + * suggested by Masatake YAMATO */ -void +static void Postscript_functions (inf) FILE *inf; { @@ -3746,9 +4142,15 @@ *ep != '\0' && *ep != ' ' && *ep != '{'; ep++) continue; - pfnote ((CTAGS) ? savenstr (bp, ep-bp) : NULL, TRUE, + pfnote (savenstr (bp, ep-bp), TRUE, lb.buffer, ep - lb.buffer + 1, lineno, linecharno); } + else if (strneq (bp, "defineps", 8)) + { + bp = skip_non_spaces (bp); + bp = skip_spaces (bp); + get_tag (bp); + } } } @@ -3761,54 +4163,38 @@ * look for (set! xyzzy */ -void get_scheme (); - -void +static void Scheme_functions (inf) FILE *inf; { - LOOP_ON_INPUT_LINES (inf, lb, dbp) + register char *bp; + + LOOP_ON_INPUT_LINES (inf, lb, bp) { - if (dbp[0] == '(' - && (dbp[1] == 'D' || dbp[1] == 'd') - && (dbp[2] == 'E' || dbp[2] == 'e') - && (dbp[3] == 'F' || dbp[3] == 'f')) + if (bp[0] == '(' + && (bp[1] == 'D' || bp[1] == 'd') + && (bp[2] == 'E' || bp[2] == 'e') + && (bp[3] == 'F' || bp[3] == 'f')) { - dbp = skip_non_spaces (dbp); + bp = skip_non_spaces (bp); /* Skip over open parens and white space */ - while (isspace (*dbp) || *dbp == '(') - dbp++; - get_scheme (); + while (iswhite (*bp) || *bp == '(') + bp++; + get_tag (bp); } - if (dbp[0] == '(' - && (dbp[1] == 'S' || dbp[1] == 's') - && (dbp[2] == 'E' || dbp[2] == 'e') - && (dbp[3] == 'T' || dbp[3] == 't') - && (dbp[4] == '!' || dbp[4] == '!') - && (isspace (dbp[5]))) + if (bp[0] == '(' + && (bp[1] == 'S' || bp[1] == 's') + && (bp[2] == 'E' || bp[2] == 'e') + && (bp[3] == 'T' || bp[3] == 't') + && (bp[4] == '!' || bp[4] == '!') + && (iswhite (bp[5]))) { - dbp = skip_non_spaces (dbp); - dbp = skip_spaces (dbp); - get_scheme (); + bp = skip_non_spaces (bp); + bp = skip_spaces (bp); + get_tag (bp); } } } - -void -get_scheme () -{ - register char *cp; - - if (*dbp == '\0') - return; - /* Go till you get to white space or a syntactic break */ - for (cp = dbp + 1; - *cp != '\0' && *cp != '(' && *cp != ')' && !isspace (*cp); - cp++) - continue; - pfnote (savenstr (dbp, cp-dbp), TRUE, - lb.buffer, cp - lb.buffer + 1, lineno, linecharno); -} /* Find tags in TeX and LaTeX input files. */ @@ -3830,9 +4216,9 @@ :chapter:section:subsection:subsubsection:eqno:label:ref:cite:bibitem\ :part:appendix:entry:index"; -void TEX_mode (); -struct TEX_tabent *TEX_decode_env (); -int TEX_Token (); +static void TEX_mode P_((FILE *)); +static struct TEX_tabent *TEX_decode_env P_((char *, char *)); +static int TEX_Token P_((char *)); char TEX_esc = '\\'; char TEX_opgrp = '{'; @@ -3841,7 +4227,7 @@ /* * TeX/LaTeX scanning loop. */ -void +static void TeX_functions (inf) FILE *inf; { @@ -3888,7 +4274,7 @@ /* Figure out whether TeX's escapechar is '\\' or '!' and set grouping chars accordingly. */ -void +static void TEX_mode (inf) FILE *inf; { @@ -3923,7 +4309,7 @@ /* Read environment and prepend it to the default string. Build token table. */ -struct TEX_tabent * +static struct TEX_tabent * TEX_decode_env (evarname, defenv) char *evarname; char *defenv; @@ -3980,7 +4366,7 @@ Otherwise return -1. Keep the capital `T' in `token' for dumb truncating compilers (this distinguishes it from `TEX_toktab' */ -int +static int TEX_Token (cp) char *cp; { @@ -3996,13 +4382,13 @@ * Prolog support (rewritten) by Anders Lindgren, Mar. 96 * * Assumes that the predicate starts at column 0. - * Only the first clause of a predicate is added. + * Only the first clause of a predicate is added. */ -int prolog_pred (); -void prolog_skip_comment (); -int prolog_atom (); - -void +static int prolog_pred P_((char *, char *)); +static void prolog_skip_comment P_((linebuffer *, FILE *)); +static int prolog_atom P_((char *, int)); + +static void Prolog_functions (inf) FILE *inf; { @@ -4018,7 +4404,7 @@ { if (cp[0] == '\0') /* Empty line */ continue; - else if (isspace (cp[0])) /* Not a predicate */ + else if (iswhite (cp[0])) /* Not a predicate */ continue; else if (cp[0] == '/' && cp[1] == '*') /* comment. */ prolog_skip_comment (&lb, inf); @@ -4038,7 +4424,7 @@ } -void +static void prolog_skip_comment (plb, inf) linebuffer *plb; FILE *inf; @@ -4066,7 +4452,7 @@ * Return the size of the name of the predicate, or 0 if no header * was found. */ -int +static int prolog_pred (s, last) char *s; char *last; /* Name of last clause. */ @@ -4091,8 +4477,7 @@ || len != (int)strlen (last) || !strneq (s, last, len)) { - pfnote ((CTAGS) ? savenstr (s, len) : NULL, TRUE, - s, pos, lineno, linecharno); + pfnote (savenstr (s, len), TRUE, s, pos, lineno, linecharno); return len; } } @@ -4108,7 +4493,7 @@ * - A quoted arbitrary string. Single quotes can escape themselves. * Backslash quotes everything. */ -int +static int prolog_atom (s, pos) char *s; int pos; @@ -4117,11 +4502,11 @@ origpos = pos; - if (islower(s[pos]) || (s[pos] == '_')) + if (islower((unsigned char) s[pos]) || (s[pos] == '_')) { /* The atom is unquoted. */ pos++; - while (isalnum(s[pos]) || (s[pos] == '_')) + while (isalnum((unsigned char) s[pos]) || (s[pos] == '_')) { pos++; } @@ -4131,7 +4516,7 @@ { pos++; - while (1) + while (1) { if (s[pos] == '\'') { @@ -4158,18 +4543,18 @@ return -1; } -/* +/* * Support for Erlang -- Anders Lindgren, Feb 1996. * * Generates tags for functions, defines, and records. * * Assumes that Erlang functions start at column 0. */ -int erlang_func (); -void erlang_attribute (); -int erlang_atom (); - -void +static int erlang_func P_((char *, char *)); +static void erlang_attribute P_((char *)); +static int erlang_atom P_((char *, int)); + +static void Erlang_functions (inf) FILE *inf; { @@ -4185,7 +4570,7 @@ { if (cp[0] == '\0') /* Empty line */ continue; - else if (isspace (cp[0])) /* Not function nor attribute */ + else if (iswhite (cp[0])) /* Not function nor attribute */ continue; else if (cp[0] == '%') /* comment */ continue; @@ -4198,7 +4583,7 @@ } else if ((len = erlang_func (cp, last)) > 0) { - /* + /* * Function. Store the function name so that we only * generates a tag for the first clause. */ @@ -4224,7 +4609,7 @@ * Return the size of the name of the function, or 0 if no function * was found. */ -int +static int erlang_func (s, last) char *s; char *last; /* Name of last clause. */ @@ -4245,8 +4630,7 @@ || len != (int)strlen (last) || !strneq (s, last, len))) { - pfnote ((CTAGS) ? savenstr (s, len) : NULL, TRUE, - s, pos, lineno, linecharno); + pfnote (savenstr (s, len), TRUE, s, pos, lineno, linecharno); return len; } @@ -4255,7 +4639,7 @@ /* - * Handle attributes. Currently, tags are generated for defines + * Handle attributes. Currently, tags are generated for defines * and records. * * They are on the form: @@ -4263,7 +4647,7 @@ * -define(Foo(M, N), M+N). * -record(graph, {vtab = notable, cyclic = true}). */ -void +static void erlang_attribute (s) char *s; { @@ -4273,12 +4657,12 @@ if (strneq (s, "-define", 7) || strneq (s, "-record", 7)) { pos = skip_spaces (s + 7) - s; - if (s[pos++] == '(') + if (s[pos++] == '(') { pos = skip_spaces (s + pos) - s; len = erlang_atom (s, pos); if (len != 0) - pfnote ((CTAGS) ? savenstr (& s[pos], len) : NULL, TRUE, + pfnote (savenstr (& s[pos], len), TRUE, s, pos + len, lineno, linecharno); } } @@ -4290,7 +4674,7 @@ * Consume an Erlang atom (or variable). * Return the number of bytes consumed, or -1 if there was an error. */ -int +static int erlang_atom (s, pos) char *s; int pos; @@ -4299,11 +4683,11 @@ origpos = pos; - if (isalpha (s[pos]) || s[pos] == '_') + if (isalpha ((unsigned char) s[pos]) || s[pos] == '_') { /* The atom is unquoted. */ pos++; - while (isalnum (s[pos]) || s[pos] == '_') + while (isalnum ((unsigned char) s[pos]) || s[pos] == '_') pos++; return pos - origpos; } @@ -4311,7 +4695,7 @@ { pos++; - while (1) + while (1) { if (s[pos] == '\'') { @@ -4338,13 +4722,18 @@ #ifdef ETAGS_REGEXPS +static char *scan_separators P_((char *)); +static void analyse_regex P_((char *, bool)); +static void add_regex P_((char *, bool, language *)); +static char *substitute P_((char *, char *, struct re_registers *)); + /* Take a string like "/blah/" and turn it into "blah", making sure that the first and last characters are the same, and handling quoted separator characters. Actually, stops on the occurrence of an unquoted separator. Also turns "\t" into a Tab character. Returns pointer to terminating separator. Works in place. Null terminates name string. */ -char * +static char * scan_separators (name) char *name; { @@ -4383,9 +4772,10 @@ /* Look at the argument of --regex or --no-regex and do the right thing. Same for each line of a regexp file. */ -void -analyse_regex (regex_arg) +static void +analyse_regex (regex_arg, ignore_case) char *regex_arg; + bool ignore_case; { if (regex_arg == NULL) free_patterns (); /* --no-regex: remove existing regexps */ @@ -4416,7 +4806,7 @@ } initbuffer (®exbuf); while (readline_internal (®exbuf, regexfp) > 0) - analyse_regex (regexbuf.buffer); + analyse_regex (regexbuf.buffer, ignore_case); free (regexbuf.buffer); fclose (regexfp); } @@ -4439,22 +4829,23 @@ lang = get_language_from_name (lang_name); if (lang == NULL) return; - add_regex (cp + 1, lang); + add_regex (cp + 1, ignore_case, lang); } break; /* Regexp to be used for any language. */ default: - add_regex (regex_arg, NULL); + add_regex (regex_arg, ignore_case, NULL); break; } } /* Turn a name, which is an ed-style (but Emacs syntax) regular expression, into a real regular expression by compiling it. */ -void -add_regex (regexp_pattern, lang) +static void +add_regex (regexp_pattern, ignore_case, lang) char *regexp_pattern; + bool ignore_case; language *lang; { char *name; @@ -4477,7 +4868,8 @@ (void) scan_separators (name); patbuf = xnew (1, struct re_pattern_buffer); - patbuf->translate = NULL; + /* Translation table to fold case if appropriate. */ + patbuf->translate = (ignore_case) ? lc_trans : NULL; patbuf->fastmap = NULL; patbuf->buffer = NULL; patbuf->allocated = 0; @@ -4503,7 +4895,7 @@ * Do the substitutions indicated by the regular expression and * arguments. */ -char * +static char * substitute (in, out, regs) char *in, *out; struct re_registers *regs; @@ -4520,7 +4912,7 @@ for (t = etags_strchr (out, '\\'); t != NULL; t = etags_strchr (t + 2, '\\')) - if (isdigit (t[1])) + if (isdigit ((unsigned char) t[1])) { dig = t[1] - '0'; diglen = regs->end[dig] - regs->start[dig]; @@ -4533,7 +4925,7 @@ result = xnew (size + 1, char); for (t = result; *out != '\0'; out++) - if (*out == '\\' && isdigit (*++out)) + if (*out == '\\' && isdigit ((unsigned char) *++out)) { /* Using "dig2" satisfies my debugger. Bleah. */ dig = *out - '0'; @@ -4552,7 +4944,7 @@ } /* Deallocate all patterns. */ -void +static void free_patterns () { pattern *pp; @@ -4567,9 +4959,26 @@ return; } +static void +get_tag (bp) + register char *bp; +{ + register char *cp; + + if (*bp == '\0') + return; + /* Go till you get to white space or a syntactic break */ + for (cp = bp + 1; + *cp != '\0' && *cp != '(' && *cp != ')' && !iswhite (*cp); + cp++) + continue; + pfnote (savenstr (bp, cp-bp), TRUE, + lb.buffer, cp - lb.buffer + 1, lineno, linecharno); +} + #endif /* ETAGS_REGEXPS */ /* Initialize a linebuffer for use */ -void +static void initbuffer (lbp) linebuffer *lbp; { @@ -4587,7 +4996,7 @@ * platforms (for text files, it translates CR-NL to NL as it reads in the * file). */ -long +static long readline_internal (lbp, stream) linebuffer *lbp; register FILE *stream; @@ -4651,7 +5060,7 @@ * Like readline_internal, above, but in addition try to match the * input line against relevant regular expressions. */ -long +static long readline (lbp, stream) linebuffer *lbp; FILE *stream; @@ -4704,7 +5113,7 @@ } } #endif /* ETAGS_REGEXPS */ - + return result; } @@ -4712,7 +5121,7 @@ * Return a pointer to a space of size strlen(cp)+1 allocated * with xnew where the string CP has been copied. */ -char * +static char * savestr (cp) char *cp; { @@ -4723,7 +5132,7 @@ * Return a pointer to a space of size LEN+1 allocated with xnew where * the string CP has been copied for at most the first LEN characters. */ -char * +static char * savenstr (cp, len) char *cp; int len; @@ -4740,13 +5149,14 @@ * Return the ptr in sp at which the character c last * appears; NULL if not found * - * Identical to System V strrchr, included for portability. + * Identical to POSIX strrchr, included for portability. */ -char * +static char * etags_strrchr (sp, c) - register char *sp, c; + register const char *sp; + register int c; { - register char *r; + register const char *r; r = NULL; do @@ -4754,7 +5164,7 @@ if (*sp == c) r = sp; } while (*sp++); - return r; + return (char *)r; } @@ -4762,42 +5172,43 @@ * Return the ptr in sp at which the character c first * appears; NULL if not found * - * Identical to System V strchr, included for portability. + * Identical to POSIX strchr, included for portability. */ -char * +static char * etags_strchr (sp, c) - register char *sp, c; + register const char *sp; + register int c; { do { if (*sp == c) - return sp; + return (char *)sp; } while (*sp++); return NULL; } /* Skip spaces, return new pointer. */ -char * +static char * skip_spaces (cp) char *cp; { - while (isspace (*cp)) /* isspace('\0')==FALSE */ + while (iswhite (*cp)) cp++; return cp; } /* Skip non spaces, return new pointer. */ -char * +static char * skip_non_spaces (cp) char *cp; { - while (!iswhite (*cp)) /* iswhite('\0')==TRUE */ + while (*cp != '\0' && !iswhite (*cp)) cp++; return cp; } /* Print error message and exit. */ -void +static void fatal (s1, s2) char *s1, *s2; { @@ -4805,7 +5216,7 @@ exit (BAD); } -void +static void pfatal (s1) char *s1; { @@ -4813,7 +5224,7 @@ exit (BAD); } -void +static void suggest_asking_for_help () { fprintf (stderr, "\tTry `%s %s' for a complete list of options.\n", @@ -4828,9 +5239,9 @@ } /* Print error message. `s1' is printf control string, `s2' is arg for it. */ -void +static void error (s1, s2) - char *s1, *s2; + const char *s1, *s2; { fprintf (stderr, "%s: ", progname); fprintf (stderr, s1, s2); @@ -4839,7 +5250,7 @@ /* Return a newly-allocated string whose contents concatenate those of s1, s2, s3. */ -char * +static char * concat (s1, s2, s3) char *s1, *s2, *s3; { @@ -4856,7 +5267,7 @@ /* Does the same work as the system V getcwd, but does not need to guess the buffer size in advance. */ -char * +static char * etags_getcwd () { #ifdef HAVE_GETCWD @@ -4905,7 +5316,7 @@ /* Return a newly allocated string containing the file name of FILE relative to the absolute directory DIR (which should end with a slash). */ -char * +static char * relative_filename (file, dir) char *file, *dir; { @@ -4919,6 +5330,10 @@ while (*fp++ == *dp++) continue; fp--, dp--; /* back to the first differing char */ +#ifdef DOS_NT + if (fp == afn && afn[0] != '/') /* cannot build a relative name */ + return afn; +#endif do /* look at the equal chars until '/' */ fp--, dp--; while (*fp != '/'); @@ -4941,7 +5356,7 @@ /* Return a newly allocated string containing the absolute file name of FILE given DIR (which should end with a slash). */ -char * +static char * absolute_filename (file, dir) char *file, *dir; { @@ -4993,7 +5408,7 @@ slashp = etags_strchr (slashp + 1, '/'); } - + if (res[0] == '\0') return savestr ("/"); else @@ -5003,7 +5418,7 @@ /* Return a newly allocated string containing the absolute file name of dir where FILE resides given DIR (which should end with a slash). */ -char * +static char * absolute_dirname (file, dir) char *file, *dir; { @@ -5024,7 +5439,7 @@ /* Whether the argument string is an absolute file name. The argument string must have been canonicalized with canonicalize_filename. */ -bool +static bool filename_is_absolute (fn) char *fn; { @@ -5036,11 +5451,15 @@ } /* Translate backslashes into slashes. Works in place. */ -void +static void canonicalize_filename (fn) register char *fn; { #ifdef DOS_NT + /* Canonicalize drive letter case. */ + if (islower (fn[0])) + fn[0] = toupper (fn[0]); + /* Convert backslashes to slashes. */ for (; *fn != '\0'; fn++) if (*fn == '\\') *fn = '/'; @@ -5051,7 +5470,7 @@ } /* Increase the size of a linebuffer. */ -void +static void grow_linebuffer (lbp, toksize) linebuffer *lbp; int toksize; @@ -5062,7 +5481,7 @@ } /* Like malloc but get fatal error if memory is exhausted. */ -long * +static long * xmalloc (size) unsigned int size; { @@ -5072,7 +5491,7 @@ return result; } -long * +static long * xrealloc (ptr, size) char *ptr; unsigned int size; diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/fakemail.c --- a/lib-src/fakemail.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/fakemail.c Mon Aug 13 11:13:30 2007 +0200 @@ -21,7 +21,7 @@ /* Synched up with: FSF 19.28. */ #define NO_SHORTNAMES -#include <../src/config.h> +#include #if defined (BSD) && !defined (BSD4_1) && !defined (USE_FAKEMAIL) /* This program is not used in BSD, so just avoid loader complaints. */ @@ -116,7 +116,7 @@ struct linebuffer { - long size; + size_t size; char *buffer; }; @@ -144,7 +144,7 @@ #define MAIL_PROGRAM_NAME "/bin/mail" #endif -static CONST char *my_name; +static const char *my_name; static char *the_date; static char *the_user; static line_list file_preface; @@ -162,7 +162,7 @@ extern unsigned short geteuid (); static struct passwd *my_entry; #define cuserid(s) \ -(my_entry = getpwuid (((int) geteuid ())), \ +(my_entry = getpwuid ((int) geteuid ()), \ my_entry->pw_name) #endif @@ -171,7 +171,7 @@ /* Print error message. `s1' is printf control string, `s2' is arg for it. */ static void -error (CONST char *s1, CONST char *s2) +error (const char *s1, const char *s2) { printf ("%s: ", my_name); printf (s1, s2); @@ -182,7 +182,7 @@ /* Print error message and exit. */ static void -fatal (CONST char *s1, CONST char *s2) +fatal (const char *s1, const char *s2) { error (s1, s2); exit (1); @@ -190,20 +190,20 @@ /* Like malloc but get fatal error if memory is exhausted. */ -static char * +static void * xmalloc (size_t size) { - char *result = malloc (((unsigned) size)); - if (result == ((char *) NULL)) + void *result = malloc (size); + if (result == NULL) fatal ("virtual memory exhausted", (char *) 0); return result; } -static char * -xrealloc (char *ptr, size_t size) +static void * +xrealloc (void *ptr, size_t size) { - char *result = realloc (ptr, ((unsigned) size)); - if (result == ((char *) NULL)) + void *result = realloc (ptr, size); + if (result == NULL) fatal ("virtual memory exhausted", (char *) 0); return result; } @@ -214,7 +214,7 @@ init_linebuffer (struct linebuffer *linebuffer) { linebuffer->size = INITIAL_LINE_SIZE; - linebuffer->buffer = ((char *) xmalloc (INITIAL_LINE_SIZE)); + linebuffer->buffer = (char *) xmalloc (INITIAL_LINE_SIZE); } /* Read a line of text from `stream' into `linebuffer'. @@ -234,8 +234,7 @@ if (p == end) { linebuffer->size *= 2; - buffer = ((char *) xrealloc ((char *) buffer, - (size_t) (linebuffer->size))); + buffer = (char *) xrealloc (buffer, linebuffer->size); p = buffer + (p - linebuffer->buffer); end = buffer + linebuffer->size; linebuffer->buffer = buffer; @@ -279,7 +278,7 @@ has_keyword (char *field) { char *ignored; - return (get_keyword (field, &ignored) != ((char *) NULL)); + return (get_keyword (field, &ignored) != (char *) NULL); } static char * @@ -323,7 +322,11 @@ /* the_date has an unwanted newline at the end */ date_length = strlen (the_date) - 1; the_date[date_length] = '\0'; +#ifdef WINDOWSNT + temp = "(null)"; +#else temp = cuserid ((char *) NULL); +#endif user_length = strlen (temp); the_user = alloc_string ((size_t) (user_length + 1)); strcpy (the_user, temp); @@ -396,7 +399,7 @@ if (the_stream != ((FILE *) NULL)) { add_a_stream (the_stream, my_fclose); - if (the_user == ((char *) NULL)) + if (the_user == (char *) NULL) file_preface = make_file_preface (); write_line_list (file_preface, the_stream); return true; @@ -416,20 +419,20 @@ } static void -put_line (CONST char *string) +put_line (const char *string) { register stream_list rem; for (rem = the_streams; rem != ((stream_list) NULL); rem = rem->rest_streams) { - CONST char *s = string; + const char *s = string; int column = 0; /* Divide STRING into lines. */ while (*s != 0) { - CONST char *breakpos; + const char *breakpos; /* Find the last char that fits. */ for (breakpos = s; *breakpos && column < 78; ++breakpos) @@ -634,10 +637,6 @@ register int size; FILE *the_pipe; -#if !(__STDC__ || defined(STDC_HEADERS)) - extern char *getenv (); -#endif - mail_program_name = getenv ("FAKEMAILER"); if (!(mail_program_name && *mail_program_name)) mail_program_name = (char *) MAIL_PROGRAM_NAME; @@ -645,8 +644,8 @@ my_name = MY_NAME; the_streams = ((stream_list) NULL); - the_date = ((char *) NULL); - the_user = ((char *) NULL); + the_date = (char *) NULL; + the_user = (char *) NULL; the_header = read_header (); command_line = alloc_string ((size_t) (name_length + @@ -656,7 +655,7 @@ the_pipe = popen (command_line, "w"); if (the_pipe == ((FILE *) NULL)) - fatal ("cannot open pipe to real mailer", (char *) 0); + fatal ("cannot open pipe to real mailer", (char *) NULL); add_a_stream (the_pipe, pclose); diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/getopt.c --- a/lib-src/getopt.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/getopt.c Mon Aug 13 11:13:30 2007 +0200 @@ -31,7 +31,7 @@ #endif #ifdef HAVE_CONFIG_H -#include <../src/config.h> +#include #endif #include @@ -202,11 +202,6 @@ #define my_index strchr #else -/* Avoid depending on library functions or files - whose names are inconsistent. */ - -char *getenv (); - static char * my_index (const char *str, int chr) { diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/getopt.h --- a/lib-src/getopt.h Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/getopt.h Mon Aug 13 11:13:30 2007 +0200 @@ -98,15 +98,14 @@ #define required_argument 1 #define optional_argument 2 -#if defined (__STDC__) && __STDC__ -#ifdef __GNU_LIBRARY__ +#if defined (__GNU_LIBRARY__) || defined (__cplusplus) /* Many other libraries have conflicting prototypes for getopt, with differences in the consts, in stdlib.h. To avoid compilation errors, only prototype getopt for the GNU C library. */ extern int getopt (int argc, char *const *argv, const char *shortopts); -#else /* not __GNU_LIBRARY__ */ +#else /* not __GNU_LIBRARY__ || C++ */ extern int getopt (); -#endif /* __GNU_LIBRARY__ */ +#endif /* __GNU_LIBRARY__ || C++ */ extern int getopt_long (int argc, char *const *argv, const char *shortopts, const struct option *longopts, int *longind); extern int getopt_long_only (int argc, char *const *argv, @@ -118,13 +117,6 @@ const char *shortopts, const struct option *longopts, int *longind, int long_only); -#else /* not __STDC__ */ -extern int getopt (); -extern int getopt_long (); -extern int getopt_long_only (); - -extern int _getopt_internal (); -#endif /* __STDC__ */ #ifdef __cplusplus } diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/getopt1.c --- a/lib-src/getopt1.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/getopt1.c Mon Aug 13 11:13:30 2007 +0200 @@ -20,7 +20,7 @@ USA. */ #ifdef HAVE_CONFIG_H -#include <../src/config.h> +#include #endif #include "getopt.h" diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/gnuclient.c --- a/lib-src/gnuclient.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/gnuclient.c Mon Aug 13 11:13:30 2007 +0200 @@ -48,6 +48,8 @@ #include #include #include +#define DONT_ENCAPSULATE +#include #ifdef HAVE_STRING_H #include @@ -89,7 +91,9 @@ /* Why is SYSV so retarded? */ /* We want emacs to realize that we are resuming */ +#ifdef SIGCONT signal(SIGCONT, tell_emacs_to_resume); +#endif connect_type = make_connection (NULL, (u_short) 0, &s); @@ -129,8 +133,10 @@ signal (SIGWINCH, pass_signal_to_emacs); #endif +#ifdef SIGCONT /* We want emacs to realize that we are resuming */ signal (SIGCONT, tell_emacs_to_resume); +#endif } @@ -225,13 +231,13 @@ /* Encase the string in quotes, escape all the backslashes and quotes in string. */ static char * -clean_string (CONST char *s) +clean_string (const char *s) { int i = 0; char *p, *res; { - CONST char *const_p; + const char *const_p; for (const_p = s; *const_p; const_p++, i++) { if (*const_p == '\\' || *const_p == '\"') @@ -285,14 +291,14 @@ over = 1; \ } while (0) -/* A strdup immitation. */ +/* A strdup imitation. */ static char * -my_strdup (CONST char *s) +my_strdup (const char *s) { - char *new = malloc (strlen (s) + 1); - if (new) - strcpy (new, s); - return new; + char *new_s = (char *) malloc (strlen (s) + 1); + if (new_s) + strcpy (new_s, s); + return new_s; } int @@ -654,7 +660,7 @@ } filename_expand (fullpath, argv[i]); #ifdef INTERNET_DOMAIN_SOCKETS - path = malloc (strlen (remotepath) + strlen (fullpath) + 1); + path = (char *) malloc (strlen (remotepath) + strlen (fullpath) + 1); sprintf (path, "%s%s", remotepath, fullpath); #else path = my_strdup (fullpath); diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/gnuserv.c --- a/lib-src/gnuserv.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/gnuserv.c Mon Aug 13 11:13:30 2007 +0200 @@ -73,7 +73,7 @@ #ifdef SYSV_IPC int ipc_qid = 0; /* ipc message queue id */ -int ipc_wpid = 0; /* watchdog task pid */ +pid_t ipc_wpid = 0; /* watchdog task pid */ /* @@ -111,7 +111,7 @@ { if ((ipc_wpid = fork ()) == 0) { /* child process */ - int ppid = getppid (); /* parent's process id */ + pid_t ppid = getppid (); /* parent's process id */ setpgrp(); /* gnu kills process group on exit */ @@ -323,7 +323,7 @@ char buf[GSERV_BUFSZ+1]; int offset=0; int s; - int len; + int len = 0; int result_len; /* read in "n/m:" (n=client fd, m=message length) */ @@ -699,7 +699,7 @@ memset((char *)&peer,0,sizeof(struct sockaddr_in)); - if ((s = accept(ls,(struct sockaddr *)&peer, (void *) &addrlen)) == -1) + if ((s = accept(ls,(struct sockaddr *)&peer, &addrlen)) == -1) { perror(progname); fprintf(stderr,"%s: unable to accept\n",progname); @@ -819,7 +819,7 @@ server.sun_family = AF_UNIX; - if ((s = accept(ls,(struct sockaddr *)&server, (void *)&len)) < 0) + if ((s = accept(ls,(struct sockaddr *)&server, &len)) < 0) { perror(progname); fprintf(stderr,"%s: unable to accept\n",progname); diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/gnuserv.h --- a/lib-src/gnuserv.h Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/gnuserv.h Mon Aug 13 11:13:30 2007 +0200 @@ -43,7 +43,7 @@ #define NO_SHORTNAMES /* gnuserv should not be compiled using SOCKS */ #define DO_NOT_SOCKSIFY -#include <../src/config.h> +#include #undef read #undef write #undef open @@ -216,7 +216,7 @@ void disconnect_from_ipc_server(); #endif #if defined(INTERNET_DOMAIN_SOCKETS) || defined(UNIX_DOMAIN_SOCKETS) -void send_string (int s, CONST char *msg); +void send_string (int s, const char *msg); void disconnect_from_server (int s, int echo); int read_line (int s, char *dest); #endif diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/gnuslib.c --- a/lib-src/gnuslib.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/gnuslib.c Mon Aug 13 11:13:30 2007 +0200 @@ -76,10 +76,8 @@ char *progname = NULL; -int make_connection(hostarg, portarg, s) - char *hostarg; - int portarg; - int *s; +int +make_connection (char *hostarg, int portarg, int *s) { #ifdef INTERNET_DOMAIN_SOCKETS char *ptr; @@ -130,7 +128,8 @@ connect_to_ipc_server -- establish connection with server process via SYSV IPC Returns msqid for server if successful. */ -static int connect_to_ipc_server (void) +static int +connect_to_ipc_server (void) { int s; /* connected msqid */ key_t key; /* message key */ @@ -160,10 +159,8 @@ disconnect_from_ipc_server -- inform the server that sending has finished, and wait for its reply. */ -void disconnect_from_ipc_server(s,msgp,echo) - int s; - struct msgbuf *msgp; - int echo; +void +disconnect_from_ipc_server (int s, struct msgbuf *msgp, int echo) { int len; /* length of received message */ @@ -196,9 +193,8 @@ /* send_string -- send string to socket. */ -void send_string(s,msg) - int s; - CONST char *msg; +void +send_string (int s, const char *msg) { #if 0 if (send(s,msg,strlen(msg),0) < 0) { @@ -227,7 +223,8 @@ /* read_line -- read a \n terminated line from a socket */ -int read_line(int s, char *dest) +int +read_line (int s, char *dest) { int length; int offset=0; @@ -252,7 +249,8 @@ domain socket. Returns socket descriptor for server if successful. */ -static int connect_to_unix_server (void) +static int +connect_to_unix_server (void) { int s; /* connected socket descriptor */ struct sockaddr_un server; /* for unix connections */ @@ -286,8 +284,8 @@ internet_addr -- return the internet addr of the hostname or internet address passed. Return -1 on error. */ -int internet_addr(host) - char *host; +int +internet_addr (char *host) { struct hostent *hp; /* pointer to host info for remote host */ IN_ADDR numeric_addr; /* host address */ @@ -314,7 +312,8 @@ an internet domain socket. Returns socket descriptor for server if successful. */ -static int connect_to_internet_server (char *serverhost, u_short port) +static int +connect_to_internet_server (char *serverhost, u_short port) { int s; /* connected socket descriptor */ struct servent *sp; /* pointer to service information */ @@ -395,9 +394,8 @@ disconnect_from_server -- inform the server that sending has finished, and wait for its reply. */ -void disconnect_from_server(s,echo) - int s; - int echo; +void +disconnect_from_server (int s, int echo) { #if 0 char buffer[REPLYSIZ+1]; diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/gzip-el.sh --- a/lib-src/gzip-el.sh Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/gzip-el.sh Mon Aug 13 11:13:30 2007 +0200 @@ -2,8 +2,8 @@ ### gzip-el.sh --- compress superfluous installed source lisp # Author: Jeff Miller -# Author: Hrvoje Niksic -# Maintainer: Steve Baur +# Author: Hrvoje Niksic +# Maintainer: Steve Baur # Created: 13 Feb 1997 # Version: 1.0 # Keywords: internal diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/hexl.c --- a/lib-src/hexl.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/hexl.c Mon Aug 13 11:13:30 2007 +0200 @@ -1,10 +1,11 @@ /* Synched up with: FSF 19.28. */ -#include <../src/config.h> +#include #include #include -#ifdef MSDOS +#ifdef WINDOWSNT +#include #include #endif @@ -29,9 +30,7 @@ void usage (void); int -main(argc, argv) - int argc; - char *argv[]; +main (int argc, char *argv[]) { register long address; char string[18]; @@ -143,9 +142,8 @@ { char buf[18]; -#ifdef MSDOS - (stdout)->_flag &= ~_IOTEXT; /* print binary */ - _setmode (fileno (stdout), O_BINARY); +#ifdef WINDOWSNT + _setmode (_fileno (stdout), O_BINARY); #endif for (;;) { @@ -187,9 +185,8 @@ } else { -#ifdef MSDOS - (fp)->_flag &= ~_IOTEXT; /* read binary */ - _setmode (fileno (fp), O_BINARY); +#ifdef WINDOWSNT + _setmode (_fileno (fp), O_BINARY); #endif address = 0; string[0] = ' '; diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/make-docfile.c --- a/lib-src/make-docfile.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/make-docfile.c Mon Aug 13 11:13:30 2007 +0200 @@ -40,7 +40,7 @@ */ #define NO_SHORTNAMES /* Tell config not to load remap.h */ -#include <../src/config.h> +#include #include #include @@ -51,8 +51,6 @@ #include #endif -#include - #if defined(MSDOS) || defined(__CYGWIN32__) #include #endif /* MSDOS */ @@ -63,6 +61,8 @@ #include #endif /* WINDOWSNT */ +#include + #if defined(DOS_NT) || defined(__CYGWIN32__) #define READ_TEXT "rt" #define READ_BINARY "rb" @@ -91,14 +91,14 @@ c_file } Current_file_type; -static int scan_file (CONST char *filename); +static int scan_file (const char *filename); static int read_c_string (FILE *, int, int); -static void write_c_args (FILE *out, CONST char *func, char *buf, int minargs, +static void write_c_args (FILE *out, const char *func, char *buf, int minargs, int maxargs); -static int scan_c_file (CONST char *filename, CONST char *mode); +static int scan_c_file (const char *filename, const char *mode); static void skip_white (FILE *); static void read_lisp_symbol (FILE *, char *); -static int scan_lisp_file (CONST char *filename, CONST char *mode); +static int scan_lisp_file (const char *filename, const char *mode); #define C_IDENTIFIER_CHAR_P(c) \ (('A' <= c && c <= 'Z') || \ @@ -115,7 +115,7 @@ /* Print error message. `s1' is printf control string, `s2' is arg for it. */ static void -error (CONST char *s1, CONST char *s2) +error (const char *s1, const char *s2) { fprintf (stderr, "%s: ", progname); fprintf (stderr, s1, s2); @@ -125,7 +125,7 @@ /* Print error message and exit. */ static void -fatal (CONST char *s1, CONST char *s2) +fatal (const char *s1, const char *s2) { error (s1, s2); exit (1); @@ -274,7 +274,7 @@ /* Return 1 if file is not found, 0 if it is found. */ static int -scan_file (CONST char *filename) +scan_file (const char *filename) { int len = strlen (filename); if (ellcc == 0 && len > 4 && !strcmp (filename + len - 4, ".elc")) @@ -396,7 +396,7 @@ MINARGS and MAXARGS are the minimum and maximum number of arguments. */ static void -write_c_args (FILE *out, CONST char *func, char *buff, int minargs, +write_c_args (FILE *out, const char *func, char *buff, int minargs, int maxargs) { register char *p; @@ -429,10 +429,10 @@ static char lo[] = "Lisp_Object"; if ((C_IDENTIFIER_CHAR_P (c) != in_ident) && !in_ident && (strncmp (p, lo, sizeof (lo) - 1) == 0) && - isspace(*(p + sizeof (lo) - 1))) + isspace((unsigned char) (* (p + sizeof (lo) - 1)))) { p += (sizeof (lo) - 1); - while (isspace (*p)) + while (isspace ((unsigned char) (*p))) p++; c = *p; } @@ -496,7 +496,7 @@ Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED. */ static int -scan_c_file (CONST char *filename, CONST char *mode) +scan_c_file (const char *filename, const char *mode) { FILE *infile; register int c; @@ -787,7 +787,7 @@ } static int -scan_lisp_file (CONST char *filename, CONST char *mode) +scan_lisp_file (const char *filename, const char *mode) { FILE *infile; register int c; @@ -915,7 +915,7 @@ /* Skip until the first newline; remember the two previous chars. */ while (c != '\n' && c >= 0) { - /* ### Kludge -- Ignore any ESC x x ISO2022 sequences */ + /* #### Kludge -- Ignore any ESC x x ISO2022 sequences */ if (c == 27) { getc (infile); diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/make-msgfile.lex --- a/lib-src/make-msgfile.lex Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/make-msgfile.lex Mon Aug 13 11:13:30 2007 +0200 @@ -223,7 +223,7 @@ "string" ... ;###translate where the magic token ";###translate" on a line means that the string - constant on this line should go into the message catalog. This is analagous + constant on this line should go into the message catalog. This is analogous to the magic ";###autoload" comments, and to the magic comments used in the EPSF structuring conventions. diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/make-path.c --- a/lib-src/make-path.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/make-path.c Mon Aug 13 11:13:30 2007 +0200 @@ -27,7 +27,7 @@ that option. */ #ifdef emacs -#include <../src/config.h> +#include #endif #include @@ -35,8 +35,6 @@ #include #include -extern int errno; - char *prog_name; static int touchy_mkdir (char *path) diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/mmencode.c --- a/lib-src/mmencode.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/mmencode.c Mon Aug 13 11:13:30 2007 +0200 @@ -18,6 +18,7 @@ #include #include #include +#include static void output64chunk(int c1, int c2, int c3, int pads, FILE *outfile); @@ -52,9 +53,7 @@ static int InNewline=0; static int -nextcharin(infile, PortableNewlines) -FILE *infile; -int PortableNewlines; +nextcharin (FILE *infile, int PortableNewlines) { int c; diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/movemail.c --- a/lib-src/movemail.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/movemail.c Mon Aug 13 11:13:30 2007 +0200 @@ -1,35 +1,41 @@ /* movemail foo bar -- move file foo to file bar, - locking file foo the way /bin/mail respects. + locking file foo. Copyright (C) 1986, 1992, 1993, 1994, 1996 Free Software Foundation, Inc. -This file is part of GNU Emacs. +This file is part of XEmacs. -GNU Emacs is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2, or (at your option) -any later version. +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. You should have received a copy of the GNU General Public License -along with GNU Emacs; see the file COPYING. If not, write to +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. */ +Boston, MA 02111-1307, USA. + + Please mail bugs and suggestions to the XEmacs maintainer. +*/ -/* Important notice: defining MAIL_USE_FLOCK or MAIL_USE_LOCKF *will - cause loss of mail* if you do it on a system that does not normally - use flock as its way of interlocking access to inbox files. The - setting of MAIL_USE_FLOCK and MAIL_USE_LOCKF *must agree* with the - system's own conventions. It is not a choice that is up to you. +/* Important notice: + * + * You *must* coordinate the locking method used by movemail with that + * used by your mail delivery agent, as well as that of the other mail + * user agents on your system. movemail allows you to do this at run + * time via the -m flag. Moreover, it uses a default determined by + * the MAIL_LOCK_DOT, MAIL_LOCK_LOCKF, MAIL_LOCK_FLOCK, + * MAIL_LOCK_LOCKING, and MAIL_LOCK_MMDF preprocessor settings. + */ - So, if your system uses lock files rather than flock, then the only way - you can get proper operation is to enable movemail to write lockfiles there. - This means you must either give that directory access modes - that permit everyone to write lockfiles in it, or you must make movemail - a setuid or setgid program. */ +/* + * Mike Sperber reorganized + * everything that has to with locking in December 1999. + */ /* * Modified January, 1986 by Michael R. Gretzinger (Project Athena) @@ -56,10 +62,9 @@ #define NO_SHORTNAMES /* Tell config not to load remap.h */ #define DONT_ENCAPSULATE -#include <../src/config.h> +#include #include #include -#include #include #include #include "../src/sysfile.h" @@ -107,7 +112,7 @@ #include #endif /* WINDOWSNT */ -#if defined (HAVE_UNISTD_H) || defined (USG) +#if defined (HAVE_UNISTD_H) #include #endif /* unistd.h */ #ifndef F_OK @@ -117,23 +122,15 @@ #define R_OK 4 #endif /* No F_OK */ -#if defined (HAVE_FCNTL_H) || defined (USG) +#if defined (HAVE_FCNTL_H) #include #endif /* fcntl.h */ -#if defined (XENIX) || defined (WINDOWSNT) +#ifdef HAVE_LOCKING #include #endif -#ifdef MAIL_USE_LOCKF -#define MAIL_USE_SYSTEM_LOCK -#endif - -#ifdef MAIL_USE_FLOCK -#define MAIL_USE_SYSTEM_LOCK -#endif - -#ifdef MAIL_USE_MMDF +#ifdef HAVE_MMDF extern int lk_open (), lk_close (); #endif @@ -145,13 +142,15 @@ static void fatal (char *, char*); static void error (char *, char *, char *); +static void usage(int); static void pfatal_with_name (char *); static void pfatal_and_delete (char *); static char *concat (char *, char *, char *); static long *xmalloc (unsigned int); #ifdef MAIL_USE_POP static int popmail (char *, char *, char *); -static int pop_retr (popserver server, int msgno, int (*action)(), void *arg); +static int pop_retr (popserver server, int msgno, + int (*action)(char *, FILE *), FILE *arg); static int mbx_write (char *, FILE *); static int mbx_delimit_begin (FILE *); static int mbx_delimit_end (FILE *); @@ -160,9 +159,6 @@ struct re_pattern_buffer* regexp); #endif -/* Nonzero means this is name of a lock file to delete on fatal error. */ -char *delete_lockname; - int verbose=0; #ifdef MAIL_USE_POP int reverse=0; @@ -184,10 +180,35 @@ { "regex", required_argument, NULL, 'r' }, { "match-lines", required_argument, NULL, 'l' }, #endif + { "lock-method", required_argument, NULL, 'm' }, + { "help", no_argument, NULL, 'h' }, { "verbose", no_argument, NULL, 'v' }, { 0 } }; +#define DOTLOCKING 0 +#define FLOCKING 1 +#define LOCKFING 2 +#define MMDF 3 +#define LOCKING 4 + +#if defined(MAIL_LOCK_FLOCK) && defined(HAVE_FLOCK) +#define DEFAULT_LOCKING FLOCKING +#elif defined(MAIL_LOCK_LOCKF) && defined(HAVE_LOCKF) +#define DEFAULT_LOCKING LOCKFING +#elif defined(MAIL_LOCK_MMDF) && defined(HAVE_MMDF) +#define DEFAULT_LOCKING MMDF +#elif defined(MAIL_LOCK_LOCKING) && defined(HAVE_LOCKING) +#define DEFAULT_LOCKING LOCKING +#else +#define DEFAULT_LOCKING DOTLOCKING +#endif + +static void lock_dot(char *); +static void unlock_dot(char *); +static int parse_lock_method(char *); +static char *unparse_lock_method(int); + int main (int argc, char *argv[]) { @@ -198,23 +219,23 @@ int status; #endif -#ifndef MAIL_USE_SYSTEM_LOCK - struct stat st; - long now; - int tem; - char *lockname, *p; - char *tempname; - int desc; -#endif /* not MAIL_USE_SYSTEM_LOCK */ + int lock_method = DEFAULT_LOCKING; + + char *maybe_lock_env; - delete_lockname = 0; + maybe_lock_env = getenv("EMACSLOCKMETHOD"); + if (maybe_lock_env) + { + printf("maybe-lock_env: %s\n", maybe_lock_env); + lock_method = parse_lock_method(maybe_lock_env); + } - while (1) + for (;;) { #ifdef MAIL_USE_POP - char* optstring = "i:o:p:l:r:xvk"; + char* optstring = "i:o:m:p:l:r:xvhk"; #else - char* optstring = "i:o:v"; + char* optstring = "i:o:m:vh"; #endif int opt = getopt_long (argc, argv, optstring, longopts, 0); @@ -255,7 +276,16 @@ regexp_pattern = compile_regex (optarg); break; #endif - case 'v': verbose = 1; break; + + case 'm': + lock_method = parse_lock_method(optarg); + break; + case 'h': + usage(lock_method); + exit(0); + case 'v': + verbose = 1; + break; } } @@ -272,17 +302,19 @@ if (!inname || !outname) { - fprintf (stderr, "Usage: movemail [-rvxk] [-l lines ] [-i] inbox [-o] destfile [[-p] POP-password]\n"); + usage(lock_method); exit(1); } -#ifdef MAIL_USE_MMDF - mmdf_init (argv[0]); +#ifdef HAVE_MMDF + if (lock_method == MMDF) + mmdf_init (argv[0]); #endif if (*outname == 0) fatal ("Destination file name is empty", 0); + VERBOSE(("checking access to output file\n")); /* Check access to output file. */ if (access (outname, F_OK) == 0 && access (outname, W_OK) != 0) pfatal_with_name (outname); @@ -320,34 +352,238 @@ if (access (inname, R_OK | W_OK) != 0) pfatal_with_name (inname); -#ifndef MAIL_USE_MMDF -#ifndef MAIL_USE_SYSTEM_LOCK - /* Use a lock file named after our first argument with .lock appended: - If it exists, the mail file is locked. */ - /* Note: this locking mechanism is *required* by the mailer - (on systems which use it) to prevent loss of mail. + + if (fork () == 0) + { + setuid (getuid ()); + + VERBOSE(("opening input file\n")); + + switch (lock_method) + { + case DOTLOCKING: + indesc = open (inname, O_RDONLY); + break; +#ifdef HAVE_LOCKF + case LOCKFING: + indesc = open (inname, O_RDWR); + break; +#endif +#ifdef HAVE_FLOCK + case FLOCKING: + indesc = open (inname, O_RDWR); + break; +#endif +#ifdef HAVE_LOCKING + case LOCKING: + indesc = open (inname, O_RDWR); + break; +#endif +#ifdef HAVE_MMDF + case MMDF: + indesc = lk_open (inname, O_RDONLY, 0, 0, 10); + break; +#endif + default: abort(); + } + + if (indesc < 0) + pfatal_with_name (inname); + +#ifdef HAVE_UMASK + /* In case movemail is setuid to root, make sure the user can + read the output file. */ + umask (umask (0) & 0333); +#endif + + outdesc = open (outname, O_WRONLY | O_CREAT | O_EXCL, 0666); + if (outdesc < 0) + pfatal_with_name (outname); + + VERBOSE(("locking input file\n")); - On systems that use a lock file, extracting the mail without locking - WILL occasionally cause loss of mail due to timing errors! + switch (lock_method) + { +#ifdef HAVE_LOCKF + case LOCKFING: + if (lockf (indesc, F_LOCK, 0) < 0) + pfatal_with_name (inname); + break; +#endif +#ifdef HAVE_FLOCK + case FLOCKING: + if (flock (indesc, LOCK_EX) < 0) + pfatal_with_name (inname); + break; +#endif +#ifdef HAVE_LOCKING + case LOCKING: + if (locking (indesc, LK_RLCK, -1L) < 0) + pfatal_with_name (inname); + break; +#endif + case DOTLOCKING: + lock_dot(inname); + break; + } + + VERBOSE(("copying input file to output file\n")); + + { + char buf[1024]; + + while (1) + { + nread = read (indesc, buf, sizeof buf); + if (nread != write (outdesc, buf, nread)) + { + int saved_errno = errno; + unlink (outname); + errno = saved_errno; + pfatal_with_name (outname); + } + if (nread < sizeof buf) + break; + } + } + +#ifdef HAVE_FSYNC + if (fsync (outdesc) < 0) + pfatal_and_delete (outname); +#endif + + /* Check to make sure no errors before we zap the inbox. */ + if (close (outdesc) != 0) + pfatal_and_delete (outname); + + VERBOSE(("deleting or truncating input file\n")); - So, if creation of the lock file fails - due to access permission on the mail spool directory, - you simply MUST change the permission - and/or make movemail a setgid program - so it can create lock files properly. + switch (lock_method) + { + case LOCKFING: + case FLOCKING: + case LOCKING: +#ifdef HAVE_FTRUNCATE + ftruncate (indesc, 0L); +#else + close (open (inname, O_CREAT | O_TRUNC | O_RDWR, 0666)); +#endif + close (indesc); + break; +#ifdef HAVE_MMDF + case MMDF: + lk_close (indesc, 0, 0, 0); + break; +#endif + case DOTLOCKING: + creat (inname, 0600); + break; + } + + exit (0); + } - You might also wish to verify that your system is one - which uses lock files for this purpose. Some systems use other methods. + wait (&status); + if (!WIFEXITED (status)) + exit (1); + else if (WEXITSTATUS (status) != 0) + exit (WEXITSTATUS (status)); + + if (lock_method == DOTLOCKING) + unlock_dot(inname); + +#endif /* not DISABLE_DIRECT_ACCESS */ + + return 0; +} + +static void +usage(int lock_method) +{ + printf ("Usage: movemail [-rvxkh] [-l lines ] [-m method ] [-i] inbox [-o] destfile [[-p] POP-password]\n"); + printf("where method is one of: dot"); +#ifdef HAVE_LOCKF + printf(", lockf"); +#endif +#ifdef HAVE_FLOCK + printf(", flock"); +#endif +#ifdef HAVE_MMDF + printf(", mmdf"); +#endif +#ifdef HAVE_LOCKING + printf(", locking"); +#endif + printf("\nDefault is: %s\n", unparse_lock_method(lock_method)); + +} - If your system uses the `flock' system call for mail locking, - define MAIL_USE_SYSTEM_LOCK in config.h or the s-*.h file - and recompile movemail. If the s- file for your system - should define MAIL_USE_SYSTEM_LOCK but does not, send a bug report - to bug-gnu-emacs@prep.ai.mit.edu so we can fix it. */ +static char * +unparse_lock_method(int lock_method) +{ + switch (lock_method) + { + case DOTLOCKING: return "dot"; + case FLOCKING: return "flock"; + case LOCKFING: return "lockf"; + case LOCKING: return "locking"; + case MMDF: return "mmdf"; + default: abort();return 0; + } +} - lockname = concat (inname, ".lock", ""); - tempname = (char *) xmalloc (strlen (inname) + strlen ("EXXXXXX") + 1); - strcpy (tempname, inname); +static int +parse_lock_method(char *method_name) +{ + if (!strcmp("dot", method_name) || !strcmp("file", method_name)) + return DOTLOCKING; +#ifdef HAVE_LOCKF + else if (!strcmp("lockf", method_name)) + return LOCKFING; +#endif +#ifdef HAVE_FLOCK + else if (!strcmp("flock", method_name)) + return FLOCKING; +#endif +#ifdef HAVE_MMDF + else if (!strcmp("mmdf", method_name)) + return MMDF; +#endif +#ifdef HAVE_LOCKING + else if (!strcmp("locking", method_name)) + return LOCKING; +#endif + else + fatal("invalid lock method: %s", method_name); + return 0; /* unreached */ +} + +static char * +dot_filename(char *filename) +{ + return concat (filename, ".lock", ""); +} + +static char *dotlock_filename = NULL; + +static void +lock_dot(char *filename) +{ + struct stat st; + long now; + int tem; + char *lockname, *p; + char *tempname; + int desc; + + dotlock_filename = (char *) xmalloc(strlen(filename) + 1); + + /* Use a lock file named after our first argument with .lock appended: + If it exists, the mail file is locked. */ + + lockname = dot_filename(filename); + tempname = (char *) xmalloc (strlen (filename) + strlen ("EXXXXXX") + 1); + strcpy (tempname, filename); p = tempname + strlen (tempname); while (p != tempname && !IS_DIRECTORY_SEP (p[-1])) p--; @@ -356,7 +592,7 @@ mktemp (tempname); unlink (tempname); - while (1) + for (;;) { /* Create the lock file, but not under the lock file name. */ /* Give up if cannot do that. */ @@ -387,132 +623,28 @@ unlink (lockname); } } - - delete_lockname = lockname; -#endif /* not MAIL_USE_SYSTEM_LOCK */ -#endif /* not MAIL_USE_MMDF */ - - if (fork () == 0) - { - setuid (getuid ()); - -#ifndef MAIL_USE_MMDF -#ifdef MAIL_USE_SYSTEM_LOCK - indesc = open (inname, O_RDWR); -#else /* if not MAIL_USE_SYSTEM_LOCK */ - indesc = open (inname, O_RDONLY); -#endif /* not MAIL_USE_SYSTEM_LOCK */ -#else /* MAIL_USE_MMDF */ - indesc = lk_open (inname, O_RDONLY, 0, 0, 10); -#endif /* MAIL_USE_MMDF */ - - if (indesc < 0) - pfatal_with_name (inname); - -#if defined (BSD) || defined (XENIX) - /* In case movemail is setuid to root, make sure the user can - read the output file. */ - /* This is desirable for all systems - but I don't want to assume all have the umask system call */ - umask (umask (0) & 0333); -#endif /* BSD or Xenix */ - outdesc = open (outname, O_WRONLY | O_CREAT | O_EXCL, 0666); - if (outdesc < 0) - pfatal_with_name (outname); -#ifdef MAIL_USE_SYSTEM_LOCK -#ifdef MAIL_USE_LOCKF - if (lockf (indesc, F_LOCK, 0) < 0) pfatal_with_name (inname); -#else /* not MAIL_USE_LOCKF */ -#ifdef XENIX - if (locking (indesc, LK_RLCK, 0L) < 0) pfatal_with_name (inname); -#else -#ifdef WINDOWSNT - if (locking (indesc, LK_RLCK, -1L) < 0) pfatal_with_name (inname); -#else - if (flock (indesc, LOCK_EX) < 0) pfatal_with_name (inname); -#endif -#endif -#endif /* not MAIL_USE_LOCKF */ -#endif /* MAIL_USE_SYSTEM_LOCK */ - - { - char buf[1024]; + strcpy(dotlock_filename, filename); +} - while (1) - { - nread = read (indesc, buf, sizeof buf); - if (nread != write (outdesc, buf, nread)) - { - int saved_errno = errno; - unlink (outname); - errno = saved_errno; - pfatal_with_name (outname); - } - if (nread < sizeof buf) - break; - } - } - -#ifdef BSD - if (fsync (outdesc) < 0) - pfatal_and_delete (outname); -#endif - - /* Check to make sure no errors before we zap the inbox. */ - if (close (outdesc) != 0) - pfatal_and_delete (outname); - -#ifdef MAIL_USE_SYSTEM_LOCK -#if defined (STRIDE) || defined (XENIX) || defined (WINDOWSNT) - /* Stride, xenix have file locking, but no ftruncate. This mess will do. */ - close (open (inname, O_CREAT | O_TRUNC | O_RDWR, 0666)); -#else - ftruncate (indesc, 0L); -#endif /* STRIDE or XENIX */ -#endif /* MAIL_USE_SYSTEM_LOCK */ +static void +unlock_dot(char *filename) +{ + unlink(dot_filename(filename)); +} -#ifdef MAIL_USE_MMDF - lk_close (indesc, 0, 0, 0); -#else - close (indesc); -#endif - -#ifndef MAIL_USE_SYSTEM_LOCK - /* Delete the input file; if we can't, at least get rid of its - contents. */ -#ifdef MAIL_UNLINK_SPOOL - /* This is generally bad to do, because it destroys the permissions - that were set on the file. Better to just empty the file. */ - if (unlink (inname) < 0 && errno != ENOENT) -#endif /* MAIL_UNLINK_SPOOL */ - creat (inname, 0600); -#endif /* not MAIL_USE_SYSTEM_LOCK */ +static void +maybe_unlock_dot(void) +{ + if (dotlock_filename) + unlock_dot(dotlock_filename); +} - exit (0); - } - - wait (&status); - if (!WIFEXITED (status)) - exit (1); - else if (WEXITSTATUS (status) != 0) - exit (WEXITSTATUS (status)); - -#if !defined (MAIL_USE_MMDF) && !defined (MAIL_USE_SYSTEM_LOCK) - unlink (lockname); -#endif /* not MAIL_USE_MMDF and not MAIL_USE_SYSTEM_LOCK */ - -#endif /* ! DISABLE_DIRECT_ACCESS */ - - return 0; -} - /* Print error message and exit. */ static void fatal (char *s1, char *s2) { - if (delete_lockname) - unlink (delete_lockname); + maybe_unlock_dot(); error (s1, s2, NULL); exit (1); } @@ -568,7 +700,7 @@ fatal ("virtual memory exhausted", 0); return result; } - + /* This is the guts of the interface to the Post Office Protocol. */ #ifdef MAIL_USE_POP @@ -605,7 +737,7 @@ FILE *mbf; popserver server; - VERBOSE(("opening server\r")); + VERBOSE(("opening server\n")); server = pop_open (0, user, password, POP_NO_GETPASS); if (! server) { @@ -613,7 +745,7 @@ return (1); } - VERBOSE(("stat'ing messages\r")); + VERBOSE(("stat'ing messages\n")); if (pop_stat (server, &nmsgs, &nbytes)) { error (pop_error, NULL, NULL); @@ -639,7 +771,7 @@ return (1); } #if !defined(__CYGWIN32__) && !defined(WINDOWSNT) - fchown (mbfi, getuid (), -1); + fchown (mbfi, getuid (), (gid_t) -1); #endif if ((mbf = fdopen (mbfi, "wb")) == NULL) @@ -654,13 +786,13 @@ for (idx = 0; idx < nmsgs; idx++) { i = reverse ? nmsgs - idx : idx + 1; - VERBOSE(("checking message %d \r", i)); + VERBOSE(("checking message %d \n", i)); if (!regexp_pattern || pop_search_top (server, i, match_lines, regexp_pattern) == POP_RETRIEVED) { - VERBOSE(("retrieving message %d \r", i)); + VERBOSE(("retrieving message %d \n", i)); mbx_delimit_begin (mbf); if (pop_retr (server, i, mbx_write, mbf) != POP_RETRIEVED) { @@ -689,7 +821,7 @@ * directories have lost mail when over quota because these checks were * not made in previous versions of movemail. */ -#ifdef BSD +#ifdef HAVE_FSYNC if (fsync (mbfi) < 0) { error ("Error in fsync: %s", strerror (errno), NULL); @@ -709,7 +841,7 @@ { if (retrieved_list[i] == 1) { - VERBOSE(("deleting message %d \r", i)); + VERBOSE(("deleting message %d \n", i)); if (pop_delete (server, i)) { error (pop_error, NULL, NULL); @@ -731,7 +863,7 @@ } static int -pop_retr (popserver server, int msgno, int (*action)(), void *arg) +pop_retr (popserver server, int msgno, int (*action)(char *, FILE *), FILE *arg) { char *line; int ret; @@ -877,7 +1009,7 @@ #endif /* MAIL_USE_POP */ - + #ifndef HAVE_STRERROR char * strerror (int errnum) diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/ootags.c --- a/lib-src/ootags.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/ootags.c Mon Aug 13 11:13:30 2007 +0200 @@ -104,9 +104,6 @@ #include #include #include -#ifndef errno - extern int errno; -#endif #include #include @@ -176,9 +173,9 @@ #ifdef OO_BROWSER #define set_construct(construct) \ if (!oo_browser_construct) oo_browser_construct = construct -void oo_browser_clear_all_globals(); -void oo_browser_clear_some_globals(); -void oo_browser_check_and_clear_structtype(); +void oo_browser_clear_all_globals(void); +void oo_browser_clear_some_globals(void); +void oo_browser_check_and_clear_structtype(void); #endif /* @@ -200,7 +197,7 @@ typedef int bool; -typedef void Lang_function (); +typedef void Lang_function (FILE *); typedef struct { @@ -860,9 +857,7 @@ int -main (argc, argv) - int argc; - char *argv[]; +main (int argc, char *argv[]) { int i; unsigned int nincluded_files; @@ -1654,8 +1649,7 @@ #endif void -put_entries (np) - register node *np; +put_entries (node *np) { register char *sp; @@ -1889,9 +1883,7 @@ /* maximum key range = 117, duplicates = 0 */ static unsigned int -hash (str, len) - register char *str; - register int unsigned len; +hash (char *str, unsigned int len) { static unsigned char asso_values[] = { @@ -1909,13 +1901,13 @@ 10, 62, 59, 130, 28, 27, 50, 19, 3, 130, 130, 130, 130, 130, 130, 130, 130, 130, }; - return len + asso_values[str[2]] + asso_values[str[0]]; + return len + + asso_values[(unsigned char) str[2]] + + asso_values[(unsigned char) str[0]]; } -struct C_stab_entry * -in_word_set (str, len) - register char *str; - register unsigned int len; +static struct C_stab_entry * +in_word_set (char *str, unsigned int len) { static struct C_stab_entry wordlist[] = { @@ -2077,7 +2069,7 @@ #ifdef OO_BROWSER void -oo_browser_check_and_clear_structtype() +oo_browser_check_and_clear_structtype(void) { /* Allow for multiple enum_label tags. */ if (structtype != st_C_enum) @@ -2156,7 +2148,7 @@ #ifdef OO_BROWSER void -oo_browser_clear_all_globals() +oo_browser_clear_all_globals(void) { /* Initialize globals so there is no carry over between files. */ oo_browser_construct = C_NULL; @@ -2167,7 +2159,7 @@ } void -oo_browser_clear_some_globals() +oo_browser_clear_some_globals(void) { oo_browser_construct = C_NULL; structtype = st_none; @@ -3638,8 +3630,7 @@ * look for '^[a-zA-Z_.$][a-zA_Z0-9_.$]*[: ^I^J]' */ void -Asm_labels (inf) - FILE *inf; +Asm_labels (FILE *inf) { register char *cp; diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/pop.c --- a/lib-src/pop.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/pop.c Mon Aug 13 11:13:30 2007 +0200 @@ -21,7 +21,7 @@ #ifdef HAVE_CONFIG_H #define NO_SHORTNAMES /* Tell config not to load remap.h */ -#include <../src/config.h> +#include #else #define MAIL_USE_POP #endif @@ -922,7 +922,7 @@ ret = -1; } - close (server->file); + CLOSESOCKET (server->file); } if (server->buffer) diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/process-depends.sh --- a/lib-src/process-depends.sh Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,68 +0,0 @@ -## Process the output of makedepend. -## Copyright (c) 1994 Amdahl Corporation. -## Written by Ben Wing, December 1994. - -## This file is used as part of 'make depend', to produce the -## dependency list for src/Makefile.in.in. - -## Unfortunately, makedepend (at least the one that comes as part -## of Open Windows under Solaris) is stupid and doesn't follow the -## documented behavior. So we have to force the definitions of -## certain options through -D flags (even though it's supposed to -## pick this up), and post-process the output to get rid of stuff -## we don't want. - -## The sed stage gets rid of include files in other directories, -## except for lwlib.h (makedepend puts system include files in, -## which is pretty stupid). We also get rid of some standard -## include files that are in every or pretty much every file -## and where changes in those files don't usually merit -## recompilation of everything. Finally, we eliminate entirely -## the dependencies for some files (such as unex*.c) that get -## screwed up by makedepend. We just put those in by hand at -## the top of the dependency list. - -## For Mule, we need to do some additional processing: conversion -## to MULESRCDIR (at least so that the include files don't get -## wiped out by the next stage) and removing the mule/ prefix -## from the object file names. - -## The awk stage puts one dependency per line. Then we pass -## the result through sort and uniq (makedepend is supposed -## to not put in duplicate dependencies, but it does so -## occasionally). - -## After running 'make depend', verify that the output (in -## depend.out) is reasonable and then replace the stuff in -## Makefile.in.in marked "generated by 'make depend'". - -sed -e ' -1d -s/ \/[^ ]*\/lwlib\// $(LWLIBSRCDIR)\//g -s/\.\.\/etc\//${srcdir}\/${etcdir}/g -s/^mule\///g -s/ mule\// $(MULESRCDIR)\/mule\//g -s/ \/[^ ]*\.h//g -s/ \/[^ ]*gray//g -s/ [a-z][^ ]*\/[^ ]*\.h//g -s/ lisp\.h//g -s/ lisp-union\.h//g -s/ lisp-disunion\.h//g -s/ lrecord\.h//g -s/ emacsfns\.h//g -s/ symeval\.h//g -s/ symsinit\.h//g -s/ syssignal\.h//g -s/ intl\.h//g -s/ tt_c\.h//g -s/ descrip\.h//g -/^unex/d -/^sgiplay/d -/^Extern/d -/^extw/d -/^[^ ]*\.o:$/d -' | awk ' -{ for (i = 2; i <= NF; i++) - printf ("%s %s\n", $1, $i) -} -' | sort | uniq diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/process-gnu-depends.sh --- a/lib-src/process-gnu-depends.sh Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,49 +0,0 @@ -#!/bin/sh - -perl -e ' -while (<>) -{ - chop; - $foo .= $_; - if (!/\\$/) - { - @foo = split (/[ \\:\n]+/, $foo); - $filename = $foo[0]; - if (($filename =~ /^unex/) || - ($filename =~ /^sgiplay/) || - ($filename =~ /^Extern/) || - ($filename =~ /^extw/)) - { - $foo = ""; - next; - } - @foo = grep (!/\.c$/, @foo); - @foo = grep ((s/\/.*lwlib\//\$(LWLIBSRCDIR)\//, 1), @foo); - @foo = grep (!/lisp\.h/, @foo); - @foo = grep (!/lisp\.h/, @foo); - @foo = grep (!/lisp-union\.h/, @foo); - @foo = grep (!/lisp-disunion\.h/, @foo); - @foo = grep (!/lrecord\.h/, @foo); - @foo = grep (!/emacsfns\.h/, @foo); - @foo = grep (!/symeval\.h/, @foo); - @foo = grep (!/symsinit\.h/, @foo); - @foo = grep (!/syssignal\.h/, @foo); - @foo = grep (!/intl\.h/, @foo); - @foo = grep (!/tt_c\.h/, @foo); - @foo = grep (!/descrip\.h/, @foo); - shift @foo; - if (!$#foo) - { - next; - } - foreach $i (0 .. $#foo) - { - $foo[$i] = $filename . ": " . $foo[$i]; - } - print $filename . ": config.h\n"; - print join ("\n", @foo); - print "\n"; - $foo = ""; - } -} -' | sort | uniq \ No newline at end of file diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/profile.c --- a/lib-src/profile.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/profile.c Mon Aug 13 11:13:30 2007 +0200 @@ -32,7 +32,7 @@ ** abstraction : a stopwatch ** operations: reset_watch, get_time */ -#include <../src/config.h> +#include #include #include #include "../src/systime.h" @@ -41,6 +41,25 @@ static int watch_not_started = 1; /* flag */ static char time_string[30]; +#ifdef WINDOWSNT +#include +/* Emulate gettimeofday (Ulrich Leodolter, 1/11/95). */ +void +gettimeofday (struct timeval *tv, struct timezone *tz) +{ + struct _timeb tb; + _ftime (&tb); + + tv->tv_sec = tb.time; + tv->tv_usec = tb.millitm * 1000L; + if (tz) + { + tz->tz_minuteswest = tb.timezone; /* minutes west of Greenwich */ + tz->tz_dsttime = tb.dstflag; /* type of dst correction */ + } +} +#endif + /* Reset the stopwatch to zero. */ static void diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/pstogif --- a/lib-src/pstogif Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,189 +0,0 @@ -: # -*-Perl-*- -eval 'exec perl -w -S $0 ${1+"$@"}' # Portability kludge - if 0; -# -# pstogif.pl v1.0, July 1994, by Nikos Drakos -# Computer Based Learning Unit, University of Leeds. -# -# Accompanies LaTeX2HTML Version 96.1 -# -# Script to convert an arbitrary PostScript image to a cropped GIF image -# suitable for incorporation into HTML documents as inlined images to be -# viewed with WWW browsers. -# -# This is based on the pstoepsi script -# by Doug Crabill dgc@cs.purdue.edu -# -# Please note the following: -# - The source PostScript file must end -# in a .ps extention. This is a GhostScript requirement, not mine... -# - The -density argument has no effect unless the -# color depth (set with the -depth argument) is equal to 1. -# - Valid arguments for -depth are 1,8, or 24. -# -# This software is provided as is without any guarantee. -# -# Nikos Drakos (ND), nikos@cbl.leeds.ac.uk -# Computer Based Learning Unit, University of Leeds. -# -# 15 Jan 96 HS Call ppmquant only if needed. Fixed bug relative to -# V 95.3 . -# -# 15 Dec 95 HS (Herbert Swan Added support for -# the flip=option. This allows images to be oriented differently -# in the paper versus the electronic media -# -# 1 Nov 95 jmn - modified for use with gs ppm driver - from jhrg's patches -# note that ppmtops.ps and ppmtops3.ps are no longer needed -# -# 20 JUL 94 ND Converted to Perl and made several changes eg it now accepts -# parameters from environment variables or from command line or will use -# default ones. -# -# 1 APR 94 ND Changed the suffixes of multi-page files from xbm to gif (oops!) -# -# - -##################################################################### -$| =1; -&read_args; - -### You may need to specify some pathnames here if you want to -### run the script without LaTeX2HTML - -# Ghostscript -$GS= $ENV{'GS'} || 'gs'; - -# Comes with LaTeX2HTML (For ghostscript versions greater than 3.0 -# you need the newer pstoppm.ps) -#$PSTOPPM= $ENV{'PSTOPPM'} || -# 'pstoppm.ps'; - -# Available in the PBMPLUS library -$PNMCROP=$ENV{'PNMCROP'} || 'pnmcrop' ; - -# Also in PBMPLUS -$PNMFLIP=$ENV{'PNMFLIP'} || 'pnmflip' ; - -# Also in PBMPPLUS -$PPMTOGIF=$ENV{'PPMTOGIF'} || 'ppmtogif' ; - -# Also in PBMPPLUS -$REDUCE_COLOR=$ENV{'PPMQUANT'} || 'ppmquant 256' ; - -$OUTFILE = $ENV{'OUTFILE'} || $out; - -# Valid choices for $COLOR_DEPTH are 1, 8 or 24. -$DEPTH = $ENV{'DEPTH'} || $depth || 24; - -#Default density is 72 -$DENSITY = $ENV{'DENSITY'} || $density || 72; - -# Valid choices are any numbers greater than zero -# Useful choices are numbers between 0.1 - 5 -# Large numbers may generate very large intermediate files -# and will take longer to process -$SCALE = $ENV{'SCALE'} || $scale; # No default value - -$PAPERSIZE = $ENV{'PAPERSIZE'} || $papersize; # No default value; - -$DEBUG = $ENV{'DEBUG'} || $DEBUG || 0; - -###################################################################### - -&main; - -sub read_args { - local($_); - local($color); - while ($ARGV[0] =~ /^-/) { - $_ = shift @ARGV; - if (/^-h(elp)?$/) { - &usage; exit} - elsif (/^-out$/) { - $out = shift @ARGV; - } - elsif (/^-(.*)$/) { - eval "\$$1 = shift \@ARGV"; # Create and set a flag $ - } - } -} - -sub main { - local($base, $outfile, $i, $j); - $base = &test_args; - $outfile = $OUTFILE || "$base.gif"; - open(STDERR, ">/dev/null") unless $DEBUG; - &convert($base); - if (-f "$base.ppm") { - &crop_scale_etc("$base.ppm", $outfile); - } - else { - foreach $i (<$base.[1-9]*ppm>) { - $j = $i; - $j =~ s/\.(.*)ppm/$1.gif/; - &crop_scale_etc($i, $j)} - } - &cleanup($base); -} - -sub crop_scale_etc { - local($in, $out) = @_; - local($tmp) = $in . ".tmp"; - open(STDERR, ">/dev/null") unless $DEBUG; - - if ($flip) { - rename($tmp, $in) unless system("$PNMFLIP -$flip $in > $tmp"); - } - system("$PNMCROP $in > $tmp"); - - if (system("$PPMTOGIF $tmp > $out")) { - print "Running ppmquant for $out\n"; - system("$REDUCE_COLOR < $tmp|$PPMTOGIF - > $out"); - } - unlink $tmp; - print "Writing $out\n"; -} - -sub test_args { - local($file) = $ARGV[0]; - if (! ($file =~ s/\.ps$//)) { - print "The name of the input file must end in '.ps'\n"; - exit} - elsif (! ( -f "$file.ps")) { - print "Cannot find file $file.ps\n."; - exit} - elsif (! ($DEPTH =~ /^(1|8|24)$/)) { - print "The color depth must be 1 or 8 or 24. You specified $DEPTH\n"; - exit - } - if (defined $SCALE) { - if ($SCALE > 0) { - $DENSITY = int($SCALE * $DENSITY)} - else { - print "Error: The scale must be greater than 0.\n" . - "You specified $SCALE\n"; - exit} - } - $file; -} - -sub convert { - local($base) = @_; - local($paperopt) = "-sPAPERSIZE=$PAPERSIZE" if $PAPERSIZE; - local($ppmtype) = join('', "ppm",$DEPTH,"run"); - local($density) = "-r$DENSITY" if ($DENSITY != 72); - open (GS, "|$GS -q -dNOPAUSE -dNO_PAUSE -sDEVICE=ppmraw $density -sOutputFile=$base.ppm $paperopt $base.ps"); - close GS; -} - -sub cleanup { - local($base) = @_; - unlink <$base[0-9.]*ppm>; -} - -sub usage { - print "Usage: pstogif [-h(elp)] [-out ] [-depth ] [-flip ] [-density ] .ps\n\n"; -} - - diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/run.c --- a/lib-src/run.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/run.c Mon Aug 13 11:13:30 2007 +0200 @@ -65,10 +65,14 @@ char execpath[MAX_PATH]; char* argv[MAX_ARGS+1]; /* leave extra slot for compact_invocation argv[0] */ int argc; - int i,j; + int i; char exec[MAX_PATH + FILENAME_MAX + 100]; char cmdline2[MAX_ARGS * MAX_PATH]; +#ifdef Debug + int j; +#endif + compact_invocation = get_exec_name_and_path(execname,execpath); if (compact_invocation) @@ -121,7 +125,6 @@ { STARTUPINFO start; SECURITY_ATTRIBUTES sec_attrs; - SECURITY_DESCRIPTOR sec_desc; PROCESS_INFORMATION child; int retval; @@ -158,7 +161,9 @@ char* p; char* p2; char exec2[MAX_PATH + FILENAME_MAX + 100]; +#if defined(__CYGWIN__) char tmp[MAX_PATH + FILENAME_MAX + 100]; +#endif strcpy(exec2,exec); /* this depends on short-circuit evaluation */ if ( ((p = strrchr(exec2,'\\')) && stricmp(p,"\\xemacs") == 0) || @@ -240,7 +245,6 @@ char buf[MAX_PATH + FILENAME_MAX + 100]; int i,j; - int len = 0; /* * STARTS WITH / or \ * execpath NOT used @@ -625,7 +629,6 @@ char *ptr; char *tdirs; char returnval[MAX_PATH + FILENAME_MAX + 100]; - char *recursive_name; int foundit = FALSE; returnval[0] = '\0'; diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/sorted-doc.c --- a/lib-src/sorted-doc.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/sorted-doc.c Mon Aug 13 11:13:30 2007 +0200 @@ -7,33 +7,22 @@ /* Synched up with: FSF 19.28. */ -#include <../src/config.h> +#include #include #include -#if __STDC__ || defined(STDC_HEADERS) -# include /* for qsort() and malloc() */ -# include -static void *xmalloc (int); -# ifndef CONST -# define CONST const -# endif -#else -extern char *malloc (); -static void *xmalloc (); -# ifndef CONST -# define CONST -# endif -#endif +#include /* for qsort() and malloc() */ +#include +static void *xmalloc (size_t); #define NUL '\0' #define MARKER '\037' #define DEBUG 0 -typedef struct line LINE; +typedef struct LINE LINE; -struct line +struct LINE { LINE *next; /* ptr to next or NULL */ char *line; /* text of the line */ @@ -72,9 +61,9 @@ /* Like malloc but get fatal error if memory is exhausted. */ static void * -xmalloc (int size) +xmalloc (size_t size) { - char *result = malloc ((unsigned)size); + void *result = malloc (size); if (result == NULL) fatal ("%s", "virtual memory exhausted"); return result; @@ -83,9 +72,9 @@ static char * strsav (char *str) { - char *buf = xmalloc (strlen (str) + 1); - (void) strcpy (buf, str); - return (buf); + char *buf = (char *) xmalloc (strlen (str) + 1); + strcpy (buf, str); + return buf; } /* Comparison function for qsort to call. */ @@ -104,7 +93,7 @@ WAITING, BEG_NAME, NAME_GET, BEG_DESC, DESC_GET }; -CONST char *states[] = +const char *states[] = { "WAITING", "BEG_NAME", "NAME_GET", "BEG_DESC", "DESC_GET" }; @@ -209,12 +198,7 @@ /* sort the array by name; within each name, by type */ qsort ((char*)array, cnt, sizeof (DOCSTR*), - /* was cast to (int (*)(CONST void *, CONST void *)) - but that loses on HP because CONST_IS_LOSING. */ - /* This one loses too: (int (*)()) */ - /* Ok, so let's try const instead of CONST. Fuck me!!! */ - (int (*)(const void *, const void *)) - cmpdoc); + (int (*)(const void *, const void *)) cmpdoc); /* write the output header */ @@ -224,7 +208,8 @@ printf ("@unnumbered Command Summary for GNU Emacs\n"); printf ("@table @asis\n"); printf ("\n"); - printf ("@let@ITEM@item\n"); + printf ("@iftex\n"); + printf ("@global@let@ITEM=@item\n"); printf ("@def@item{@filbreak@vskip5pt@ITEM}\n"); printf ("@font@tensy cmsy10 scaled @magstephalf\n"); printf ("@font@teni cmmi10 scaled @magstephalf\n"); @@ -237,6 +222,7 @@ printf ("@chardef@@64\n"); printf ("@catcode43=12\n"); printf ("@tableindent-0.2in\n"); + printf ("@end iftex\n"); /* print each function from the array */ @@ -260,6 +246,7 @@ putchar ('\n'); } printf("@end display\n"); + if ( i%200 == 0 && i != 0 ) printf("@end table\n\n@table @asis\n"); } printf ("@end table\n"); diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/update-autoloads.sh --- a/lib-src/update-autoloads.sh Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/update-autoloads.sh Mon Aug 13 11:13:30 2007 +0200 @@ -58,6 +58,7 @@ echo "Rebuilding autoloads in $CANON_PWD" echo " with $REAL..." +#### echon really sucks! if [ "`uname -r | sed 's/\(.\).*/\1/'`" -gt 4 ]; then echon() { diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/update-elc.sh --- a/lib-src/update-elc.sh Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/update-elc.sh Mon Aug 13 11:13:30 2007 +0200 @@ -48,6 +48,7 @@ echo " (using $EMACS)" # fuckin' sysv, man... +# Nuke this function... if [ "`uname -r | sed 's/[^0-9]*\([0-9]*\).*/\1/'`" -gt 4 ]; then echon() { @@ -106,7 +107,7 @@ mule_p="`$EMACS -batch -vanilla -eval \"$lisp_prog\"`" if test "$mule_p" = nil ; then echo No - ignore_dirs="$ignore=dirs mule" + ignore_dirs="$ignore_dirs mule" else echo Yes fi @@ -176,7 +177,6 @@ \!/site-init.el$!d \!/version.el$!d \!/very-early-lisp.el$!d -\!/Installation.el$!d ' echo "Compiling files without .elc..." diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/wakeup.c --- a/lib-src/wakeup.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/wakeup.c Mon Aug 13 11:13:30 2007 +0200 @@ -1,6 +1,6 @@ /* Program to produce output at regular intervals. */ -#include <../src/config.h> +#include #if __STDC__ || defined(STDC_HEADERS) #include diff -r f4aeb21a5bad -r 74fd4e045ea6 lib-src/yow.c --- a/lib-src/yow.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lib-src/yow.c Mon Aug 13 11:13:30 2007 +0200 @@ -9,7 +9,8 @@ /* Synched up with: FSF 19.28. */ -#include <../src/config.h> +#define DONT_ENCAPSULATE +#include #include #include @@ -90,8 +91,7 @@ /* Sets len and header_len */ void -setup_yow(fp) - FILE *fp; +setup_yow (FILE *fp) { int c; @@ -119,8 +119,7 @@ /* go to a random place in the file and print the quotation there */ void -yow (fp) - FILE *fp; +yow (FILE *fp) { long offset; int c, i = 0; diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/.cvsignore --- a/lisp/.cvsignore Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/.cvsignore Mon Aug 13 11:13:30 2007 +0200 @@ -1,1 +1,2 @@ +ChangeLog.font-menu finder-inf.el diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/ChangeLog --- a/lisp/ChangeLog Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/ChangeLog Mon Aug 13 11:13:30 2007 +0200 @@ -1,3 +1,2477 @@ +2000-02-16 Martin Buchholz + + * XEmacs 21.2.29 is released. + +2000-02-09 Martin Buchholz + + * cl-extra.el (getf): This is now identical to `plist-get', so + just defalias it. + * cl-macs.el: Make getf an alias to plist-get, at the + byte-compiler level, using define-compiler-macro. + +2000-02-08 Martin Buchholz + + * cl-extra.el (cl-remprop): Remove. remprop is now in C. + +2000-02-07 Kyle Jones + + * lisp/etags.el (find-tag-internal): set exact-tagname to + a regular expression that matches against the tagname + part of the tag entry first instead of only looking in + the context area. + +2000-01-23 Björn Torkelsson + + * gutter-items.el: fixed typo(s) in customizing default-gutter-position + * toobar.el: fixed typo(s) in customizing default-toolbar-position + +2000-02-07 Martin Buchholz + + * XEmacs 21.2.28 is released. + +2000-02-07 Martin Buchholz + + * cl-extra.el (getf): Just call `get', never `get*'. + Make arglist match docstring. + Fix bug: (getf nil t t) ==> Lisp nesting exceeds `max-lisp-eval-depth' + * cl-macs.el (get* compiler macro): Simply replace `get*' by `get'. + * byte-optimize.el: remove references to `get*'. + +2000-02-06 Martin Buchholz + + * mule/european.el: Add syntax information for Latin3 and Latin4. + +2000-02-02 Martin Buchholz + + * byte-optimize.el: Byte-optimize (length "foo") + +2000-02-03 Daiki Ueno + + * window.el (shrink-window-if-larger-than-buffer): Rewrite full + width check using `window-leftmost-p' and `window-rightmost-p'. + +2000-02-02 Per Abrahamsen + + * wid-edit.el (widget-match-inline): An atom never matches a + list. + +2000-01-29 Kirill 'Big K' Katsnelson + + * modeline.el: Consolidated 'x and 'mswindows specification under + 'win tag. + +2000-01-29 Andy Piper + + * gutter-items.el: (format-buffers-tab-line): Try and be + intelligent about buffer naming when we have duplicates. + +2000-01-29 Andy Piper + + * gutter-items.el (gutter-visible-p): Make sure the gutter gets + updated when it becomes visible. + +2000-01-26 Kirill 'Big K' Katsnelson + + * bytecomp.el (byte-compile-insert-header): Properly set coding + system under MULE and file-coding. + +2000-01-28 Martin Buchholz + + * coding.el (dontusethis-set-value-file-name-coding-system-handler): + (dontusethis-set-value-terminal-coding-system-handler): + (dontusethis-set-value-keyboard-coding-system-handler): + Never undefine coding system aliases. Emergency fix for gnus. + +2000-01-26 Hrvoje Niksic + + * files.el (abbreviate-file-name): Use directory-sep-char instead + of hard-coded "/". + +2000-01-27 Hrvoje Niksic + + * startup.el (user-init-file-base-list): New variable, replacing + user-init-file-base. + (find-user-init-file): New function. + (command-line-early): Use it. + (load-user-init-file): Ditto. + +2000-01-26 Kirill 'Big K' Katsnelson + + * gutter-items.el (update-tab-in-gutter): Use proper locale when + calling valid-image-instantiator-format-p + +2000-01-26 Hrvoje Niksic + + * isearch-mode.el (isearch-mode): The variable is + isearch-unhidden-extents, not isearch-opened-extents. + +2000-01-26 Hrvoje Niksic + + * minibuf.el (next-history-element): Modify error message if a + default value is available. + +2000-01-26 Martin Buchholz + + * bytecomp.el (byte-compile-file): Don't unconditionally write + .elc files in binary - might contain non-Latin1. + +2000-01-24 Kirill 'Big K' Katsnelson + + * process.el (shell-quote-argument): Use (nt-quote-process-args) + for windows-nt. + + * version.el: + * startup.el (user-init-file-base): + * process.el (call-process-region): + * files.el (make-backup-file-name): + (backup-file-name-p): + (file-relative-name): + (abbreviate-file-name): + (set-auto-mode): + * code-process.el (call-process-region): Removed unnecessary + branching on 'windows-nt and 'ms-dos system types. Phased 'ms-dos + support out of the universe. + + * process.el: + * code-process.el: + * bytecomp.el (byte-compile-file): Removed reference to + buffer-file-type, and commented usage of binary-process-output + NTEmacs variables. + +2000-01-24 Yoshiki Hayashi + + * help.el (function-arglist): Add case for macro. + +2000-01-22 Kirill 'Big K' Katsnelson + + * cus-edit.el (custom-display): Removed "MS-DOS" and added Windows + printers. + (custom-display): Added a menu for printer/display tags. + + * frame.el (frame-type): + * device.el (device-type): Added 'msprinter to the doc string, and + removed 'pc -- it is not going to be implemented ever. + (call-device-method): Fixed docstring typo. + Defined specifier tags 'printer and 'display. + +2000-01-22 Kyle Jones + + * lisp/itimer.el (itimer-run-expired-timers): (consp + last-command-event-time) instead of (consp + 'last-command-event-time). + +2000-01-21 Kirill 'Big K' Katsnelson + + * msw-glyphs.el: Removed obsolete commentary. + +2000-01-21 Hrvoje Niksic + + * minibuf.el (read-file-name): Use abbreviate-file-name to produce + better default value. + +2000-01-21 Hrvoje Niksic + + * minibuf.el (read-expression): Add a DEFAULT-VALUE argument. + (read-string): Ditto. + (eval-minibuffer): Ditto. + (read-command): Ditto. + (read-function): Ditto. + (read-variable): Ditto. + (read-number): Ditto. + (read-shell-command): Ditto. + (read-number): Record history. + +2000-01-20 Yoshiki Hayashi + + * etags.el (find-tag-tag): Use DEFAULT of completing-read. + +2000-01-20 Yoshiki Hayashi + + * faces.el (startup-initialize-custom-faces): New function. + Reset all faces created during auto-autoloads loading time + by defface. + * startup.el (command-line): Call it. + +2000-01-19 Yoshiki Hayashi + + * about.el (about-hackers): Add myself to contributors list. + +2000-01-12 Kirill 'Big K' Katsnelson + + * menubar-items.el (maybe-add-init-button): Removed an argument in + a call to load-user-init-file, as the function managed to lose its + formal parameter a few betas ago. + +2000-01-18 Martin Buchholz + + * XEmacs 21.2.27 is released. + +2000-01-18 Martin Buchholz + + * process.el (shell-command-to-string): Use the FSF docstring. + Make shell-command-to-string the standard function, and + exec-to-string the (deprecated) alias. + + * startup.el: typo fix. + +2000-01-16 Martin Buchholz + + * mule/mule-misc.el (char-octet): Move back into mule-charset.c. + +2000-01-14 Yoshiki Hayashi + + * menubar-items.el (sort-buffers-menu-alphabetically): Put invisible + buffers after visible buffers. + (sort-buffers-menu-by-mode-then-alphabetically): Ditto. + +2000-01-17 Yoshiki Hayashi + + * info.el (Info-extract-menu-node-name): Stop at a dot + followed by whitespace or right parenthesis. + +2000-01-15 Hrvoje Niksic + + * info.el (Info-directory-list): Warn against using Customize with + Info-directory-list. + +2000-01-15 Adrian Aichner + + * minibuf.el (read-file-name): doc fix. + + * autoload.el (update-file-autoloads): doc fix. + + * about.el (about-hackers): Change my E-mail address. + +2000-01-13 Martin Buchholz + + * info.el (Info-visit-file): Just use the `f' interactive spec to + read a filename in the standard way. + +2000-01-13 Andy Piper + + * gutter-items.el (gutter-buffers-tab-orientation): new variable. + (gutter-buffers-tab-extent): new variable. + (update-tab-in-gutter): call add-tab-to-gutter again if the + orientation has changed. + (add-tab-to-gutter): cope with different orientations. + +2000-01-11 Didier Verna + + * info.el (Info-following-node-name): backward-skip dots as well + as spaces (dots at the end of a node name aren't part of it). + (Info-extract-menu-node-name): don't skip dots. There could be + some in the node name. + (Info-index): allow dots to be part of a node name. + +2000-01-12 Andreas Jaeger + + * files.el (auto-mode-alist): Added idlwave-mode. + Patch by Carsten Dominik . + +1999-12-22 Yoshiki Hayashi + + * info.el (Info-search): Show default value. + +1999-12-20 Yoshiki Hayashi + + * info.el (Info-read-node-completion-table): New variable. + (Info-read-node-name-1): New function. + (Info-read-node-name): Use it. + (Info-follow-reference): Use DEFAULT argument of completing-read. + (Info-menu): Ditto. + +1999-12-27 Yoshiki Hayashi + + * hyper-apropos.el (hyper-describe-key-briefly): Save + window configuration. + (hyper-describe-face): Use DEFAULT of completing-read. + (hyper-apropos-read-variable-symbol): Ditto. + (hyper-apropos-read-function-symbol): Ditto. + +1999-12-27 Yoshiki Hayashi + + * mule/mule-cmds.el (set-default-coding-system): Set + comint-exec-hook to use coding-system-for-read and + coding-system-for-write so that C-x RET c works. + +1999-12-27 Yoshiki Hayashi + + * minibuf.el (minibuffer-confirm-incomplete): Customize. + (previous-matching-history-element): Increment + minibuffer-max-depth by 1. + (next-matching-history-element): Ditto. + +2000-01-11 Andy Piper + + * gutter-items.el (buffers-tab): Create a new face for the buffers + tab. + (buffers-tab-face): use it. + +2000-01-10 Didier Verna + + * modeline.el (modeline-scrolling-method): change modeline X + cursor appearance according to the value. + +2000-01-07 Andreas Jaeger + + * about.el (about-hackers): Moved my entry to contributor list. + (xemacs-hackers): Added myself. + (about-maintainer-info): Added description of myself. + + +2000-01-07 Didier Verna + + * modeline.el (modeline-scrolling-method): new variable. + (mouse-drag-modeline): add reference to it in the docstring. + (mouse-drag-modeline): handle it. + +2000-01-08 Andy Piper + + * gutter-items.el (update-tab-in-gutter): remove resize-subwindow + calls. + (remove-buffer-from-gutter-tab): ditto. + +2000-01-06 Per Abrahamsen + + * cus-edit.el (custom-hook-convert-widget): Fix comment. + (custom-face-edit): Fix grammatical error in help message. + +2000-01-03 Michael Sperber [Mr. Preprocessor] + + * movemail.el: Added. + + * dumped-lisp.el (preloaded-file-list): Added movemail.el. + +2000-01-03 Didier Verna + + * modeline.el (mouse-drag-modeline): remove the code related to + the modeline horizontal scrolling facility. + +1999-12-31 Martin Buchholz + + * XEmacs 21.2.26 is released. + +1999-12-28 Andy Piper + + * wid-edit.el (widget-push-button-value-create): The gui cache + does not agree with native widgets which can only be displayed + once per window. The reasons for caching are diminished now that + we don't hog resources when creating buttons. + (widget-push-button-cache) deleted. + +1999-12-24 Martin Buchholz + + * XEmacs 21.2.25 is released. + +1999-12-24 Yoshiki Hayashi + + * hyper-apropos.el (hyper-apropos): Toggle + hyper-apropos-programming-apropos correctly. + Set REGEXP when user accepts default value. + +1999-12-22 Yoshiki Hayashi + + * minibuf.el (read-from-minibuffer): Bind minibuffer-default. + (read-file-name-2): Use DEFAULT argument of read-from-minibuffer. + +1999-12-22 Yoshiki Hayashi + + * mule/mule-category.el (undefined-category-designator): + Return char instead of character. Search for undefined one. + (describe-category): Use with-displaying-help-buffer. + +1999-12-21 Martin Buchholz + + * byte-optimize.el (byte-optimize-plus): + Optimize (+ 1) to 1 instead of (1+ nil). + + * files.el (basic-save-buffer): Rewrite for clarity. Use (char-before). + + * byte-optimize.el (byte-compile-butlast): Remove. Use butlast instead. + + * byte-optimize.el (byte-optimize-char-before): New function. + Remove performance penalty for using (char-before) instead of (char-after). + +1999-12-20 Yoshiki Hayashi + + * mule/mule-category.el (char-category-list): Return character + instead of integer. + +1999-12-17 Yoshiki Hayashi + + * minibuf.el (read-buffer): Check default is buffer object. + +1999-11-25 Andy Piper + + * cus-edit.el (custom-buffer-create-buttons): Use native widgets + for buttons. + +1999-12-16 Andreas Jaeger + + * package-get.el (package-get-maybe-save-index): Fixed typo. + Patch by Jeff Miller . + +1999-12-13 Charles G Waldman + + * gnuserv.el (gnuserv-process-filter): don't call + gnuserv-write-to-client when gnuserv-current-client is nil + +1999-12-14 Martin Buchholz + + * XEmacs 21.2.24 is released. + +1999-12-12 Gunnar Evermann + + * about.el (about-hackers): Update my email address. + +1999-12-07 Martin Buchholz + + * XEmacs 21.2.23 is released. + +1999-11-06 Jason R Mastaler + + * package-get.el (package-get-download-sites): Removed several + defunct download sites, added many new ones, and corrected a few + incorrect directory-on-site entries. Added physical locations to + site-description. + +1999-11-30 Gunnar Evermann + + * finder.el (finder-commentary): add DOC string and fix + interactive spec + +1999-12-04 Hrvoje Niksic + + * help.el (describe-function): Don't forget to intern the string + completing-read returns. + (describe-variable): Ditto. + +1999-11-16 Adrian Aichner + + * hyper-apropos.el (hyper-apropos-this-symbol): Handle + `hyper-apropos-help-mode' here to find symbol to customize + irregardless of cursor position and simplify + `hyper-apropos-set-variable', `hyper-apropos-find-function', and + `hyper-apropos-popup-menu'. + +1999-11-21 Yoshiki Hayashi + + * apropos.el (apropos-mode-map): Add return to call + apropos-follow. + (apropos-print): Call apropos-mode to have better + command reference. Put keymap text-poperty to + symbole name. + +1999-11-22 Alastair Burt + + * help.el: (describe-bindings-1): Added handling of keymaps for + the extents at point. + +1999-12-02 Mark Thomas + + * gutter-items.el (buffers-tab-items): Wrap the function in a + save-match-data + +1999-12-04 Hrvoje Niksic + + * help.el (describe-function): Use the DEFAULT argument to + completing-read. + (describe-variable): Ditto. + +1999-11-26 Yoshiki Hayashi + + * minibuf.el (read-from-minibuffer): Add optional argument + DEFAULT to have better mini-buffer history support. + (completing-read): Pass default to read-from-minibuffer. + (read-buffer): Pass default to completing-read. + +1999-12-04 Hrvoje Niksic + + * font-lock.el (font-lock-doc-string-face): Document the + `font-lock-lisp-like' property. + +1999-11-29 Hrvoje Niksic + + * lisp-mode.el: Specify `font-lock-lisp-like'. + + * font-lock.el (font-lock-lisp-like): New function. + (font-lock-fontify-syntactically-region): Use it. + +1999-11-29 XEmacs Build Bot + + * XEmacs 21.2.22 is released + +1999-11-28 Martin Buchholz + + * XEmacs 21.2.21 is released. + +1999-11-18 Yoshiki Hayashi + + * minibuf.el (read-coding-system): Accept symbol and + coding-system object as a default-coding-system. + +1999-11-16 Yoshiki Hayashi + + * minibuf.el (read-coding-system): Accept symbol as + a default-coding-system. + +1999-10-06 Yoshiki Hayashi + + * apropos.el (apropos-documentation): Use insert instead + of princ. + +1999-11-07 William M. Perry + + * gpm.el: New gpm-minor-mode to turn GPM mouse support on & off + for the linux console. + + * mouse.el (mouse-consolidated-yank): Allow the mouse-yanking + stuff to work when you are not on a window system, since the GPM + mouse support now allows pasting from outside of XEmacs. + +1999-11-10 XEmacs Build Bot + + * XEmacs 21.2.20 is released + +1999-11-06 Hrvoje Niksic + + * setup-paths.el (paths-default-info-directories): Add + /usr/share/info and /usr/local/share/info. + +1999-10-30 Hrvoje Niksic + + * about.el: Updated Vladimir Ivanovic's info. + +11999-08-28 Jan Vroonhof + + * auto-show.el (auto-show-truncationp): Remove. + + * auto-show.el (auto-show-should-take-action-p): Use window-truncated-p + +999-09-23 Gunnar Evermann + + * indent.el (indent-line-to): fix bug: spaces were not replaced + with tab if column is multiple of tab-width + From dhn@qedinc.com + +1999-10-24 Jan Vroonhof + + * mule/mule-cmds.el (read-input-method-name): Accept symbols + correctly. Patch from Mikio Nakajima + + * package-get.el (package-get-package-provider): Be verbose when + interactive. Patch from Robert Pluim + +1999-08-23 Mike McEwan + + * info.el (Info-suffix-list): Add ".info.bz2" to the recognised + info file suffixes. + +1999-08-19 Stephen Tse + + * process.el (open-network-stream): Add a new optional parameter + PROTOCOL to support udp; fix a minor typo and add an explanation + in docstring for udp programming. + + * code-process.el (open-network-stream): Add a new optional + parameter PROTOCOL to support udp; fix a minor typo and add an + explanation in docstring for udp programming. + +1999-10-18 Andy Piper + + * gui.el (make-gui-button): be more precise about how we call + callbacks. + + * wid-edit.el (widget-push-button-value-create): Use the new form + of native gui-button. + +1999-10-14 Yoshiki Hayashi + + * info.el (Info-page-prev): Don't do (sit-for 0). + +1999-10-13 Andy Piper + + * gutter-items.el (progress-abort-glyph): new glyph for showing + abort status. + (append-progress): dispatch-event rather than sit-for. + (abort-progress): new function. Show the abort glyph with an + appropriate message. + (raw-append-progress): dispatch-event rather than sit-for. + (display-progress): cope with aborts. + + * gui.el (make-gui-button): Use native widgets for buttons + unconditionally. + (insert-gui-button): ditto. + (gui-button-p): ditto. + + * xbm-button.el: remove from core. + + * xpm-button.el: remove from core. + +1999-10-07 Olivier Galibert + + * faces.el (init-device-faces): Don't initialize the random faces + on the stream device. + +1999-10-06 Andy Piper + + * files.el (recover-file): Don't use ls under windows for revert buffer. + +1999-09-25 Adrian Aichner + + * package-get.el (package-get-download-menu): Make menu really + toggle download sites. + (package-get-download-sites): Add autoload cookie. + +1999-09-29 Michael Sperber [Mr. Preprocessor] + + * setup-paths.el (paths-find-module-directory): Ditto. + +1999-09-29 Werner Fink + + * setup-paths.el (paths-find-exec-directory): Add missing nil + parameter for environment. + +1999-09-27 Martin Buchholz + + * modeline.el (modeline-format): + Only purecopy the strings. Else + (nsublis '(("%p" . "%P")) (default-value 'modeline-format) :test 'equal) + barfs. + +1999-08-28 Mike Woolley + + * winnt.el: Removed nt-shell-mode-hook, which was preventing the + user setting comint-completion-addsuffix and + comint-process-echoes. + +1999-09-22 Andy Piper + + * gutter-items.el (update-tab-in-gutter): use + last-nonminibuf-window instead of selected-window. + +1999-09-18 Andy Piper + + * gnuserv.el (gnuserv-edit-files): select frame we are going to + display on. + + * subr.el (record-buffer-hook): new variable so that the hook gets + some documentation. + +1999-09-16 Andy Piper + + * gutter-items.el (update-tab-in-gutter): only update when the + gutter is visible. + (remove-buffer-from-gutter-tab): ditto. + +1999-09-17 Hrvoje Niksic + + * simple.el (do-auto-fill): Commented out part of Kinsoku + processing. + +1999-09-14 Hrvoje Niksic + + * isearch-mode.el (isearch-highlightify-region): Give the + highlighting extents a high priority. + (isearch-make-extent): Give the main highlighting extent an even + higher priority. + +1999-09-13 Michael Sperber [Mr. Preprocessor] + + * packages.el (packages-compute-package-locations): Fix typo from + -u rationalization. + +1999-09-11 Michael Sperber [Mr. Preprocessor] + + * setup-paths.el (paths-find-doc-directory): Respect value of + `configure-doc-directory.' + + * find-paths.el (paths-find-architecture-directory): Give + precendence `default' argument (which typically comes from + configure). + +1999-09-05 Michael Sperber [Mr. Preprocessor] + + * startup.el (command-line-early): Added options -user-init-file + and -user-init-directory. + + * files.el (user-init-file): Default to NIL so we can recognize + when it's set. + +1999-08-30 Michael Sperber [Mr. Preprocessor] + + * obsolete.el (init-file-user): + * startup.el: + * packages.el (packages-compute-package-locations): + * package-get.el (package-get-user-index-filename): + * menubar-items.el (maybe-add-init-button): + * info.el (Info-annotations-path): + * dump-paths.el: + Change `user-init-directory' to be an absolute path. + Use `user-init-directory' where appropriate. + Zap `init-file-user' and its uses. + +1999-09-09 Hrvoje Niksic + + * subr.el (copy-symbol): New function. + +1999-09-08 Hrvoje Niksic + + * isearch-mode.el (isearch-done): Be sure to restore invisible + extents in the proper buffer. + (isearch-pre-command-hook): Set this-command to the correct value + in case the buffer has changed and old overriding-local-map was + used. + (isearch-restore-extent): Use remprop instead of setting the + property to nil. + +1999-09-08 Hrvoje Niksic + + * cmdloop.el (execute-extended-command): Update zmacs region + before the delay. + (execute-extended-command): Make the message gettext-friendly. + +1999-09-07 Andy Piper + + * gutter-items.el (progress-gauge-glyph): renamed from + progress-glyph. + (progress-text-glyph): new variable. + (progress-layout-glyph): use layouts and text glyphs. + (progress-area-buffer): removed. + (progress-text-and-extent): new variable. + (progress-displayed-p): dynamically create gutter area buffer. + (clear-progress): ditto. + (raw-append-progress): ditto. + (append-progress): use new glyph names. + (raw-append-progress): only create the extent when needed. set + properties more optimally. + (progress): remove args. + +1999-09-07 Hrvoje Niksic + + * isearch-mode.el (isearch-range-invisible): Use mapc instead of + mapcar where the return value is unused. + (isearch-restore-invisible-extents): Ditto. + (isearch-highlight-all-cleanup): Ditto. + (isearch-delete-extents-in-range): Traverse the extents only once. + (isearch-highlight-all-update): Don't start over if the search + string has changed and more input is pending. + +1999-09-07 Hrvoje Niksic + + * packages.el (packages-find-package-data-path): Ditto. + + * cl.el: Use mapcar at top-level -- mapc is no longer a subr. + + * subr.el (mapc-internal): Don't make obsolete. + + * cl-extra.el (mapc): Resurrect. + +1999-09-03 Hrvoje Niksic + + * obsolete.el (isearch-yank-x-clipboard): Define it as an obsolete + alias. + + * isearch-mode.el (isearch-top-state): Restore isearch-word. + (isearch-yank-clipboard): Renamed from isearch-yank-x-clipboard. + (isearch-yank-clipboard): Use get-clipboard instead of + x-get-clipboard. + (isearch-yank-selection): Fix docstring. + +1999-09-02 Martin Buchholz + + * cl-extra.el: Obsolete hash-table-type in favor of hash-table-weakness. + +1999-09-02 Hrvoje Niksic + + * cl-macs.el (extent-start-position): Fix setf method. + (extent-end-position): Ditto. + +1999-09-02 Hrvoje Niksic + + * isearch-mode.el: End merge with FSF 20.4. + + * isearch-mode.el (search-invisible): New variable. + (isearch-hide-immediately): Ditto. + (isearch-unhidden-extents): Ditto. + (isearch-range-invisible): New function. + (isearch-unhide-extent): Ditto. + (isearch-restore-invisible-extents): Ditto. + (isearch-restore-extent): Ditto. + + * isearch-mode.el (isearch-ring-advance-edit): Use FSF + implementation. + (isearch-ring-retreat-edit): Ditto. + (isearch-forward): New argument NO-RECURSIVE-EDIT. + (isearch-forward-regexp): New arguments NOT-REGEXP and + NO-RECURSIVE-EDIT. + (isearch-backward): New argument NO-RECURSIVE-EDIT. + (isearch-backward-regexp): New arguments NOT-REGEXP and + NO-RECURSIVE-EDIT. + (isearch-mode): Return isearch-success. + (isearch-update): Use unread-command-events instead of + unread-command-event. + (isearch-abort): If an invalid regexp is encountered, keep popping + states. + (isearch-*-char): Use FSF implementation. + (isearch-whitespace-chars): Use the more robust FSF's + implementation. + (isearch-within-brackets): New variable. + (isearch-mode): Initialize it. + (isearch-edit-string): Bind it. + (isearch-search-and-update): Set it. + (isearch-push-state): Push it. + (isearch-top-state): Pop it. + (isearch-search): Set it. + (isearch-printing-char): When called by isearch-whitespace-chars, + handle M-SPC gracefully. + (isearch-message-prefix): New argument ELLIPSIS. + (isearch-message-suffix): Ditto. + (isearch-message): Use the ELLIPSIS argument when calling + isearch-message-prefix and isearch-message-suffix. + (isearch-message-prefix): Distinguish between "wrapped" and + "overwrapped" search, FWIW. + +1999-09-01 Hrvoje Niksic + + * isearch-mode.el (isearch-edit-string): Use the head of the + search ring instead of search-last-string and search-last-regexp. + (search-highlight): Renamed from isearch-highlight. + (isearch-exit): Use the new name. + (isearch-highlight): Ditto. + (isearch-dehighlight): Ditto. + (isearch-update-ring): New function. + (isearch-done): Call it. + (isearch-done): New argument EDIT. + (isearch-repeat): If search string is empty, look up at the car of + the search ring; ignore the yank pointer. + (isearch-abort): Call isearch-done with NOPUSH. + (isearch-cancel): New function. + (isearch-mode-map): Bind it to ESC ESC ESC. + + * isearch-mode.el: Begin merge with FSF 20.4. + +1999-09-01 Andy Piper + + * x-select.el (x-get-clipboard): obsolete. + (x-yank-clipboard-selection): obsolete + + * select.el (disown-selection): need to be careful to disown the + clipboard if we set it via selection. + (get-clipboard): move from x-select.el + (yank-clipboard-selection): ditto. + +1999-09-01 Hrvoje Niksic + + * isearch-mode.el (isearch-exit): Bind isearch-highlight and + isearch-highlight-all-matches to nil. + (isearch-fixed-case): New variable. + (isearch-mode): Initialize it. + (isearch-edit-string): Save it. + (isearch-toggle-case-fold): Set it. + (isearch-fix-case): Make sure isearch-toggle-case-fold works -- + need to check isearch-fixed-case. + (isearch-toggle-case-fold): Update highlighting of all matches + before the pause. + (isearch-edit-string): + +1999-09-01 Hrvoje Niksic + + * isearch-mode.el (isearch-edit-string): Call isearch-message + before reading the event so that the prompt is displayed properly. + (isearch-message): Use isearch-nonincremental when calling + isearch-message-prefix. + (minibuffer-local-isearch-map): Bind up and down to do the same as + M-p and M-n respectively. + (isearch-done): New arg NOPUSH. + (isearch-edit-string): Use it. + (isearch-edit-string): Don't bind isearch-string. + (isearch-ring-adjust): Edit string, *then* push state. + +1999-08-31 Hrvoje Niksic + + * faces.el (isearch-secondary): Make isearch-secondary look + different than default. + +1999-08-30 Hrvoje Niksic + + * isearch-mode.el (isearch-yank): Use progn instead of the inner + save-excursion. + (isearch-dehighlight): Remove TOTALLY. Simplify. + (isearch-update): Call isearch-dehighlight without arguments. + (isearch-done): Ditto. + + * isearch-mode.el (isearch-fix-case): If the search string has no + upper-case letters, allow the folding to be reenabled. + Previously, once disabled, the folding would remain that way until + the end of isearch. + (isearch-top-state): Call isearch-fix-case. + + * isearch-mode.el (isearch-yank): Use progn instead of the inner + save-excursion. + (isearch-dehighlight): Remove TOTALLY. Simplify. + +1999-08-31 Jan Vroonhof + + * xpm-button.el: + xbm-button.el: Need to exist in core because gui.el depends on + them. + +1999-08-31 Andy Piper + + * gutter-items.el (buffers-tab-face): new customizable variable. + (buffers-tab-default-buffer-line-length): new specifier for + maximum viewable characters. + (progress-stack): new variable for implementing widget-based + progress messages. + (progress-area-buffer): ditto. + (progress-glyph-height): ditto. + (progress-stop-callback): ditto. + (progress-quit-function): new function. + (progress-glyph): new variable. + (progress-layout-glyph): ditto. + (progress-displayed-p): new function, see message-displayed-p for + details. + (clear-progress): ditto. + (remove-progress): ditto. + (append-progress): ditto. + (raw-append-progress): ditto. + (display-progress): ditto. + (current-progress): ditto. + (current-progress-label): ditto. + (progress): ditto. + (lprogress): ditto. + + +1999-08-29 Hrvoje Niksic + + * obsolete.el (isearch-yank-x-selection): Define obsolete alias. + + * isearch-mode.el (isearch-yank-x-selection): Renamed to + `isearch-yank-selection'. + (isearch-mode-map): Use it. + (isearch-yank-selection): Use `get-selection' instead of + `get-x-selection'. + +1999-08-29 Hrvoje Niksic + + * faces.el (isearch-secondary): Create face here. + + * isearch-mode.el: Rewrote the "lazy highlighting" code not to use + timers. + +1999-08-27 Hrvoje Niksic + + * subr.el (buffer-string): More robust backward compatibility + check, courtesy William Perry. + +1999-08-26 Hrvoje Niksic + + * replace.el (perform-replace): Stop the search after the search + limit has been reached. + +1999-08-23 Andy Piper + + * gutter-items.el (update-tab-in-gutter): call add-tab-to-gutter + here if we don't have one. + +1999-08-15 Oscar Figueiredo + + * ldap.el (ldap-coding-system): Default to nil until we get + efficient UTF8 support + (ldap-decode-string): Guard against `decode-coding-string' not + being defined + (ldap-encode-string): Guard against `encode-coding-string' not + being defined + +1999-08-23 Didier Verna + + * rect.el: Cosmetics suggested by Dave Love . + Some doc strings improvements, and add a star to the `interactive' + calls. + +1999-08-18 Stef Epardaud + + * font-lock.el (java-font-lock-keywords-3): introduced new + keywords and regexpes for javadoc syntax 1.2. + +1999-08-17 Andy Piper + + * gutter-items.el (buffers-tab-format-buffer-line-function): use + format-buffers-tab-line. + (buffers-tab-max-buffer-line-length): new variable. + (format-buffers-tab-line): new function. truncate names if over + buffers-tab-max-buffer-line-length. + +1999-08-13 Charles G Waldman + + * cus-start.el: Customize the variable `bell-inhibit-time'. + +1999-08-16 Andy Piper + + * gutter-items.el (remove-buffer-from-gutter-tab): take a + brute-force approach to deleting the last buffer. + (buffers-tab-grouping-regexp): new customizable variable. + (select-buffers-tab-buffers-by-mode): use it. + +1999-08-13 Andy Piper + + * gutter-items.el (remove-buffer-from-gutter-tab): fix *scratch* + deletion problem. + +1999-07-30 Didier Verna + + * cus-edit.el (custom-save-variables): I said, use prin1 instead + of princ to output symbols. + (custom-save-face-internal): ditto. + (custom-save-resets): ditto. + +1999-08-09 Didier Verna + + * gutter-items.el (select-buffers-tab-buffers-by-mode): use + `regexp-quote' to protect the major mode name for use as a regular + expression (c++ needs this for instance). + +1999-08-08 Andy Piper + + * gutter-items.el (select-buffers-tab-buffers-by-mode): beef up to + cope with similar mode names. + + * gutter-items.el (buffers-tab-selection-function): new selection + function. + (select-buffers-tab-buffers-by-mode): new function. + (buffers-tab-items): use it if set to only display buffers in the + tab in the current buffer's group.. + (update-tab-in-gutter): use new api. + (remove-buffer-from-gutter-tab): ditto. + + * gutter-items.el (buffers-tab-max-size): set custom selection + default to 6. + (buffers-tab-switch-to-buffer): just switch window if the window is visible. + (add-tab-to-gutter): set face as default. + +1999-07-07 Jan Vroonhof + + * faces.el (frob-face-property): Merge the fall-back specifier + with the target, not replace it. + +1999-08-05 Andy Piper + + * gutter-items.el (update-tab-in-gutter): add frame argument for + buffer-items. + (update-tab-in-gutter): use it. + + * gutter-items.el (record-buffer-hook): set. + + * buffer.el (switch-to-buffer): back out switch-to-buffer-hook + change. + (switch-to-buffer-hook) deleted. + +1999-08-04 Andy Piper + + * gutter-items.el (update-tab-in-gutter): make sure this will work + as an argument to create-frame-hook. + +1999-07-30 Hrvoje Niksic + + * isearch-mode.el: Modified Bob and Darryl's code to use itimers + instead of timer emulation. + +1999-07-30 Darryl Okahata + + * isearch-mode.el: Merged Bob Glickstein's GNU + Emacs isearch enhancements. + +1999-07-28 Andy Piper + + * gutter-items.el (add-tab-to-gutter): put in specifier specs for + all devices that support tab controls. + (remove-buffer-from-gutter-tab): new function. to be used as a + value for kill-buffer-hook. + +1999-07-21 Sean MacLennan + + * auto-show.el (auto-show-truncationp): changed to match + `window_translation_on' + +1999-07-30 XEmacs Build Bot + + * XEmacs 21.2.19 is released + +1999-07-28 SL Baur + + * code-files.el (insert-file-contents): Fix docstring. + revert previous change. + +1999-07-26 Yoshiki Hayashi + + * fill.el (fill-region-as-paragraph): Change re-break-point to + contain word-across-newline plus one character so that filling + Japanese and Chinese works as desired. + * simple.el (do-auto-fill): Ditto. + +1999-07-26 SL Baur + + * mule/japanese.el ("Japanese"): Do not specify a default input + method. + Suggested by MORIOKA Tomohiko + +1999-07-23 Jan Vroonhof + + * custom.el ((not (fboundp 'defun*))): Insert autoload crap to be + able to use cl-macs macro in early lisp. + +1999-07-23 Jan Vroonhof + + * custom.el: + * cus-face.el: + * cus-edit.el: + Massive custom Theme API changes. + +1999-07-22 MORIOKA Tomohiko + + * code-files.el (insert-file-contents): Regard + coding-system-magic-cookie if `coding-system-for-read' is nil. + +1999-07-22 MORIOKA Tomohiko + + * mule/thai-xtis.el: Add coding: local variable, to avoid + bootstrapping problem with C locale. + +1999-07-22 Andy Piper + + * dumped-lisp.el (preloaded-file-list): guard against putting + gutter-items in a less than functional XEmacs. + * gutter-items.el: put call to `add-tab-to-gutter' back in. + +1999-07-18 Bob Weiner + + * fill.el (fill-context-prefix): Fixed bug that prevented the + setting of an adaptive fill prefix when the `dont-skip-first' was + t. + +1999-07-22 SL Baur + + * gutter-items.el: remove unguarded call to `add-tab-to-gutter'. + +1999-06-25 Karl M. Hegbloom + + * files.el (interpreter-mode-alist): add `make', `guile', and + `emacs' entries. (#!/usr/bin/make -f ought to send a file into + makefile-mode, guile is a scheme, and someday XEmacs will be + modular enough to use as an efficient scripting tool.) + +1999-07-06 MORIOKA Tomohiko + + * mule/mule-cmds.el (reset-language-environment): Regard + coding-category `utf-8' and `ucs-4' if they are available. + +1999-07-06 MORIOKA Tomohiko + + * mule/mule-cmds.el (set-default-coding-systems): Fix DOC-string. + (prefer-coding-system): Fix DOC-string. + + * mule/mule-cmds.el (coding-system-change-eol-conversion): Fix + DOC-string too. + + * mule/mule-cmds.el (mule-keymap): Change keymap name from MULE to + Mule. + (coding-system-change-eol-conversion): Fix DOC-string. + +1999-06-30 MORIOKA Tomohiko + + * mule/mule-cmds.el (mule-keymap): Use `describe-coding-system' + instead of `list-coding-system'. + +1999-06-29 MORIOKA Tomohiko + + * menubar-items.el (default-menubar): `select-input-method' was + renamed to `set-input-method'. + + * mule/mule-cmds.el (set-language-info-alist): Fix setting for + "Set Language Environment" menu. + + * mule/mule-cmds.el (set-language-info-alist): Fix setting for + "Describe Language Support" menu. + +1999-06-29 MORIOKA Tomohiko + + * mule/chinese.el ("Chinese-GB"): Rename + `chinese-gb-environment-setup-function' to + `setup-chinese-gb-environment-internal'. + +1999-06-29 MORIOKA Tomohiko + + * mule/korean.el: Use `define-coding-system-alias' instead of + `copy-coding-system'. + +1999-06-29 MORIOKA Tomohiko + + * mule/mule-cmds.el (set-language-environment-coding-systems): + Treat duplicated coding-categories. + +1999-06-29 MORIOKA Tomohiko + + * mule/japanese.el: Use `define-coding-system-alias' instead of + `copy-coding-system'. + +1999-06-29 MORIOKA Tomohiko + + * mule/vietnamese.el: Specify `iso-8-1' as a category of + coding-system `viscii'. + +1999-06-29 MORIOKA Tomohiko + + * mule/cyrillic.el: + - Specify `iso-8-1' as a category of coding-system `koi8-r'. + (cyrillic-alternativnyj-decode-table): New variable. + (cyrillic-alternativnyj-encode-table): New variable. + - Specify `iso-8-1' as a category of coding-system + `alternativnyj'. + - Abolish general Cyrillic environment. + +1999-06-29 MORIOKA Tomohiko + + * mule/chinese.el: + - Use `define-coding-system-alias' instead of `copy-coding-system'. + - Register `chinese-gb-environment-setup-function' as a + `setup-function' of "Chinese-GB" environment. + +1999-06-29 MORIOKA Tomohiko + + * mule/mule-cmds.el (set-language-info-alist): Allow dummy + optional argument `parents'. + + * mule/thai-xtis.el: Specify `tis-620' as `tutorial-coding-system' + property for Thai-XTIS. + + * mule/mule-help.el (help-with-tutorial): Use property + `tutorial-coding-system' of language-info as a coding-system to + read tutorial file. + +1999-06-29 MORIOKA Tomohiko + + * mule/thai-xtis.el: Don't setup `setup-function' and + `exit-function'. + + * mule/mule-cmds.el (set-language-environment-coding-systems): Use + `set-coding-category-system' to set up coding-system for + coding-category. + + * mule/mule-cmds.el (prefer-coding-system): Use + `set-coding-category-system' to set up coding-system for + coding-category. + +1999-06-29 MORIOKA Tomohiko + + * mule/thai-xtis.el: Specify TUTORIAL.th as the tutorial file for + Thai-XTIS environment. + + * mule/mule-cmds.el (prefer-coding-system): Use + `find-coding-system' instead of `coding-system-p'. + +1999-06-28 MORIOKA Tomohiko + + * mule/mule-cmds.el (set-language-environment-coding-systems): + Modify eol-type for XEmacs. + + * mule/thai-xtis.el: Delete unused local variable `category'. + + * mule/mule-cmds.el (coding-system-change-eol-conversion): New + function. + (prefer-coding-system): Don't call + `update-coding-systems-internal'; use function + `coding-category-list' instead of variable `coding-category-list'; + use `set-coding-priority-list' instead of `set-coding-priority'; + modify `eol-type' for XEmacs. + + * mule/mule-misc.el (string-width): Use `charset-width' instead of + `charset-columns'. + (char-width): Likewise. + +1999-06-28 MORIOKA Tomohiko + + * mule/thai-xtis.el: Specify `iso-8-1' as coding-category of + `tis-620'. + + * mule/mule-cmds.el (set-language-environment-coding-systems): Use + `set-coding-priority-list' instead of `set-coding-priority'; don't + call `update-coding-systems-internal'. + + * mule/mule-misc.el (coding-system-get): New function. + (coding-system-put): New function. + (coding-system-category): New function. + +1999-06-28 MORIOKA Tomohiko + + * dumped-lisp.el (preloaded-file-list): Load "thai-xtis-chars" + when Mule is running; load "mule/thai-xtis" instead of "thai-xtis" + to avoid conflict with leim/quail/thai-xtis. + + * mule/thai-xtis.el: Split definition of the charset `thai-xtis' + to thai-xtis-chars.el. + + * mule/thai-xtis-chars.el: New file (split from + mule/thai-xtis.el). + +1999-06-28 MORIOKA Tomohiko + + * mule/thai-xtis.el: + - Change category for the charset `thai-xtis' to `?x' from `?T'. + - Add syntax entries. + - Put `preferred-coding-system' of the charset `thai-xtis' to + `tis-620'. + +1999-06-28 TAKAHASHI Naoto + + * mule/thai-xtis.el: ccl-decode-thai-xtis and subroutines + rewritten to use write-multibyte-character. + +1999-06-28 MORIOKA Tomohiko + + mule/mule-cmds.el (view-hello-file): Use `iso-2022-7bit' instead + of `iso-2022-7'. + (prefer-coding-system): Synced up with Emacs 20.3.11 but not + ported yet. + (read-input-method-name): Treat optional argument `default'. + +1999-06-28 MORIOKA Tomohiko + + * mule/mule-cmds.el (set-language-info): Don't set up menus at + all. + (set-language-info-alist): Set up menus here. + +1999-06-28 MORIOKA Tomohiko + + * minibuf.el (completing-read): Add new optional argument + `default'. + (read-coding-system): Add new optional argument + `default-coding-system'. + +1999-06-03 Ken'ichi Handa + + * mule/vietnamese.el (ccl-encode-vscii): Typo fixed + (viet-viscii-...->viet-vscii...). + +1999-05-13 Ken'ichi Handa + + * mule/mule-cmds.el: Change MULE to Mule in docstrings + and menus. + +1999-04-12 Richard M. Stallman + + * mule/mule-cmds.el (input-method-function): Add permanent-local + property. + +1999-03-30 Dave Love + + * mule/mule-cmds.el (current-language-environment): Doc fix. + +1999-02-06 Richard Stallman + + * mule/european.el (setup-slovenian-environment): New function. + ("Slovenian"): New language environment. + +1999-01-27 Dave Love + + * mule/mule-cmds.el (current-language-environment): Provide :link, + :type (choices) and appropriate :get. + +1999-01-14 Kenichi Handa + + * mule/mule-cmds.el (describe-language-environment): Don't alter + input-method-alist. + +1999-01-06 Eli Zaretskii + + * mule/mule-cmds.el (prefer-coding-system): Call + set-coding-priority, so that the internal array of priorities is + also updated. + +1998-12-30 Eli Zaretskii + + * mule/mule-cmds.el (prefer-coding-system): If the argument + requires specific EOL conversion type, make the default coding + systems use that. + +1998-12-17 Eli Zaretskii + + * mule/mule-cmds.el (set-language-environment): Pass the default + eol-type to set-language-environment-coding-systems. + (set-default-coding-systems): Copy the eol-type property for the + new default values of {buffer-file,process}-coding-system from the + old defaults. + (set-language-environment-coding-systems): Accept an optional + argument EOL-TYPE, and set the eol-type property of the default + coding systems accordingly. + +1998-10-26 Kenichi Handa + + * mule/chinese.el (pre-write-encode-hz): Cancel previous change, + use generate-new-buffer instead of get-buffer-create. + +1998-10-21 Kenichi Handa + + * mule/chinese.el (pre-write-encode-hz): Use with-temp-buffer. + +1998-10-16 Markus Rost + + * mule/mule-cmds.el (default-input-method): Fix custom type. + +1998-10-12 Richard Stallman + + * mule/mule-cmds.el (setup-specified-language-environment): + Add apropos-inhibit property. + (describe-specified-language-support): Likewise. + +1998-09-06 Bill Richter + + * mule/mule-cmds.el: Doc fixes. + +1998-09-02 Kenichi Handa + + * mule/mule-cmds.el (register-input-method): Doc-string + modified. + +1998-09-01 Dave Love + + * mule/mule-cmds.el (current-language-environment): Fix + setter function. + +1998-08-31 Paul Eggert + + * mule/chinese.el, mule/cyrillic.el, mule/ethiopic.el, + mule/european.el, mule/hebrew.el, mule/japanese.el, + mule/korean.el, mule/vietnamese.el: Add coding: local variable, to + avoid bootstrapping problem if you need to recompile all the Lisp + files using interpreted code. + +1998-08-26 Kenichi Handa + + * mule/european.el ("Latin-1"): Modify `documentation' key value. + ("Latin-2"): Likewise. + +1998-08-18 Per Starback + + * mule/european.el (setup-latin2-environment): Fix typo. + +1998-08-18 Kenichi Handa + + * mule/european.el: Give proper value of `input-method' key to all + lang. env. + + * mule/mule-cmds.el (activate-input-method): Handle the case that + the arg INPUT-METHOD is nil correctly. + (read-multilingual-string): Activate the specified input method + before calling read-string. Afterward, activate the original + input method. + +1998-08-15 Kenichi HANDA + + * mule/mule-cmds.el (language-info-alist): Doc-string modified. + (set-language-info-alist): Fix typo in doc-string. + + * mule/hebrew.el ("Hebrew"): Delete describe-function key. + +1998-08-09 Kenichi HANDA + + * mule/mule-cmds.el (language-info-alist): Doc-string modified. + (reset-language-environment): New function for the job that + setup-english-environment used to do. + (set-language-environment): Do more setups according to the info + in language-info-alist. + (read-language-name): Handle the case that the arg KEY is nil. + (describe-language-environment): Handle input-method property. + + * mule/: All files under this directory, which related with + specific languages (such as mule/european.el, mule/greek.el, + mule/hebrew.el, mule/misc-lang.el), modified as below. + (setup-XXX-environment): Just call set-language-environment. If + they used to do some other jobs than what done by + set-language-environment, those jobs are done in + setup-XXX-environment-internal now. + ("LANUGAGE-ENVIRONMENT"): Delete property setup-function or change + the value to setup-XXX-environment-internal. Add properties + input-method and features. + + * mule/english.el (setup-english-environment): Just call + reset-language-environment. + + * mule/european.el (setup-8-bit-environment): Function deleted. + +1998-08-08 Richard Stallman + + * mule/mule-cmds.el (input-method-exit-on-first-char) + (input-method-use-echo-area): Doc fixes. + +1998-08-06 Kenichi Handa + + * mule/mule-cmds.el (input-method-exit-on-first-char): New + variable. + (input-method-use-echo-area): New variable. + +1998-08-01 Kenichi HANDA + + * mule/mule-cmds.el (language-info-alist): Doc-string modified. + +1998-07-30 Ken'ichi Handa + + * mule/mule-cmds.el (activate-input-method): Update mode line. + (inactivate-input-method): Likewise. + +1998-07-19 Kenichi Handa + + * mule/mule-cmds.el (read-multilingual-string): Don't activate an + input method in the current buffer, but just bind + current-input-method. + +1998-07-08 Kenichi Handa + + * mule/hebrew.el ("Hebrew"): Add coding-priority. + + * mule/misc-lang.el ("IPA"): Add coding-priority and + coding-system. + +1998-06-26 Ken'ichi Handa + + * mule/greek.el: Add coding-priority. + +1998-05-23 Richard Stallman + + * mule/mule-cmds.el (register-input-method): Rename arg ENV to + LANG-ENV. + +1998-05-20 Richard Stallman + + * mule/mule-cmds.el (register-input-method): Fix previous change. + (setup-specified-language-environment): Doc fix. + +1998-05-19 Richard Stallman + + * mule/mule-cmds.el: Several doc fixes. + (get-language-info, set-language-info): Rename argument. + (set-language-info-alist): Likewise. + (register-input-method): Rename argument. + (activate-input-method): If INPUT-METHOD is nil, deactivate. + +1998-05-04 Kenichi Handa + + * mule/mule-cmds.el (toggle-input-method): Use a more appropriate + default value while reading an input method. + +1998-05-01 Kenichi Handa + + * mule/mule-cmds.el (universal-coding-system-argument): + Use buffer-file-coding-system as default. + +1998-04-14 Andreas Schwab + + * mule/korean.el ("Korean"): Doc fix. + +1998-04-11 Kenichi Handa + + * mule/mule-cmds.el (describe-language-environment): Print the + languge environment at the head. + +1998-04-06 Kenichi Handa + + * mule/japanese.el: Set exit-function to exit-japanese-environment + for Japanese environment. + +1998-03-20 Richard Stallman + + * mule/mule-cmds.el (set-language-environment): Doc fix. + (current-language-environment): Use defcustom. + (default-input-method): Specify :type. + +1998-03-02 Kenichi Handa + + * mule/mule-cmds.el (set-default-coding-systems): Doc-string + modified. + (prefer-coding-system): Doc-string modified. + +1998-01-21 Kenichi Handa + + * mule/mule-cmds.el (set-language-info): Doc-string + describes `coding-priority' KEY. + (set-language-environment-coding-systems): New function. + (select-safe-coding-system): New function. + (set-language-info): New optional args DESCRIBE-MAP and SETUP-MAP. + (set-language-info-alist): New optionla arg PARENTS. Call + set-language-info with apropriate DESCRIBE-MAP and SETUP-MAP args. + (set-language-environment-coding-systems): New function. + + * mule/chinese.el: Remove setting up of + describe-chinese-environment-map and + setup-chinese-environment-map. Exclude them in args of calls to + set-language-info-alist. Register coding-priority key in + language-info-alist. + + * mule/cyrillic.el: Remove setting up of + describe-cyrillic-environment-map and + setup-cyrillic-environment-map. Exclude them in args of calls to + set-language-info-alist. Register coding-priority key in + language-info-alist. + + * mule/english.el: Register coding-priority key in + language-info-alist. + + * mule/ethiopic.el: Register coding-priority key in + language-info-alist. + + * mule/european.el: Remove setting up of + describe-european-environment-map and + setup-european-environment-map. Exclude them in args of calls to + set-language-info-alist. Register coding-priority key in + language-info-alist. Add "German" language env. + (setup-8-bit-environment): Delete CODING-SYSTEM arg. + (setup-german-environment): New function. + + * mule/greek.el (setup-greek-environment): For Greek lang. env., + change default input method to "greek-postfix". + + * mule/japanese.el, mule/korean.el, mule/vietnamese.el: Register + coding-priority key in + +1997-12-19 Stephen Eglen + + * mule/mule-cmds.el (set-language-info): Doc fix. + (input-method-inactivate-hook): Doc fix. + +1997-11-20 Karl Heuer + + * mule/mule-cmds.el (set-input-method): Renamed from + select-input-method. + +1997-11-07 Kenichi Handa + + * mule/mule-cmds.el (set-language-environment): Run + exit-language-environment-hook before calling `exit-function' + which is specified for the language environment. + +1997-10-23 Kenichi Handa + + * mule/mule-cmds.el (set-default-coding-systems): Doc-string + modified. + (prefer-coding-system): Likewise. + (describe-language-environment): Print aliases of each coding + system. + (set-language-environment-hook): New variable. + (exit-language-environment-hook): New variable. + (set-language-environment): Call these hooks. Before setting a + new language environment, exit from the + current-language-environment if necessary. + (input-method-verbose-flag): The value can be nil, t, + complex-only, or default. + (input-method-highlight-flag): Doc-string augmented. + (activate-input-method): Check if we can run the registered + function to activate an input method. + + * mule/korean.el: Set exit-function for language environment + "Korean" to exit-korean-environment. + (setup-korean-environment): Moved to korea-util.el. + +1997-10-21 Kenichi Handa + + * mule/mule-cmds.el (read-multilingual-string): Use + current-input-method prior to default-input-method. Don't bind + current-input-method by `let', instead, activate the specified + input method in the current buffer temporarily. + +1997-10-19 John F. Whitehead + + * mule/mule-cmds.el (describe-language-environment): Fix prompt. + +1997-10-21 Kenichi Handa + + * mule/chinese.el (post-read-decode-hz): Return the result of + decode-hz-region. + (pre-write-encode-hz): Do not change the value of + last-coding-system. + +1998-09-06 Bill Richter + + * mule/mule-ccl.el: Doc fixes. + +1998-04-20 Kenichi Handa + + * mule/mule-ccl.el (declare-ccl-program): New optional arg VECTOR. + (check-ccl-program): New macro. + +1998-01-21 Kenichi Handa + + * mule/mule-ccl.el: Comment about CCL syntax modified. + (ccl-command-table): Add read-multibyte-character and + write-multibyte-character. + (ccl-code-table): Add ex-cmd. + (ccl-extended-code-table): New variable. + (ccl-embed-extended-command): New function. + (ccl-compile-read-multibyte-character, + ccl-compile-write-multibyte-character) New functions. + (ccl-dump-ex-cmd, ccl-dump-read-multibyte-character, + ccl-dump-write-multibyte-character): New functions. + +1999-07-22 SL Baur + + * config.el (config-value-file): config.values is installed into + doc-directory. + From Karl M. Hegbloom + +1999-07-19 Didier Verna + + * rect.el: all functions rewritten, except when noted. Below is a + list of interface changes. + (apply-on-rectangle): new function. Obsoletes + `operate-on-rectangle'. All functions that used to call this + function now call the new one. + (kill-rectangle): added optional prefix arg to fill lines. + (delete-rectangle): ditto. + (delete-extract-rectangle): ditto. + (open-rectangle): ditto. + (clear-rectangle): ditto. + (delete-rectangle-line): added third arg FILL. + (delete-extract-rectangle-line): ditto. + (open-rectangle-line): ditto. + (clear-rectangle-line): ditto. + +1999-07-18 Andy Piper + + * menubar-items.el (default-menubar): add gutter options. + + * gutter-items.el: new file. + (gutter): new group for custom. + (gutter-visible-p): new variable. + (default-gutter-position): ditto. + (buffers-tab): new group for the buffers tab. + (gutter-buffers-tab): widget to put in the gutter. + (buffers-tab-max-size): max number of tabs. + (buffers-tab-switch-to-buffer-function): function to call when a + tab is pressed. + (buffers-tab-omit-function): filter buffers with this function. + (buffers-tab-format-buffer-line-function): format buffer names for + inclusion in tabs. + (buffers-tab-switch-to-buffer): like switch-to-buffer but without + the record. + (build-buffers-tab-internal): build a list of tab items. + (buffers-tab-items): ditto. + (add-tab-to-gutter): put a tab in the gutter area. + (update-tab-in-gutter): reset the buffers in the tab. + + * dumped-lisp.el (preloaded-file-list): dump gutter-items. + + * buffer.el (switch-to-buffer): run switch-to-buffer-hooks. + (switch-to-buffer-hooks): new hook. + + * toolbar.el (default-toolbar-position): fix typo. + +1999-07-16 Andy Piper + + * gui.el (make-dialog-frame): turn off gutters for dialogs. + +1999-07-15 Didier Verna + + * cus-edit.el (custom-prompt-variable): optional third arg makes + prompt for a comment string. + (customize-set-value): optional prefix makes this function handle + variable comments. + (customize-set-variable): ditto. + (customize-save-variable): ditto. + (customize-customized): handle custom comments. + (customize-save-customized): ditto. + (custom-variable-state-set): ditto. + (custom-face-state-set): ditto. + (customize-saved): ditto. + (custom-variable-set): ditto. + (custom-face-set): ditto. + (custom-variable-save): ditto. + (custom-face-save): ditto. + (custom-variable-reset-saved): ditto. + (custom-face-reset-saved): ditto. + (custom-variable-reset-standard): ditto. + (custom-face-reset-standard): ditto. + (custom-comment-face): new face. + (custom-comment-tag-face): ditto. + (custom-comment): new widget. + (custom-comment-create): new function. + (custom-comment-delete): ditto. + (custom-comment-value-set): ditto. + (custom-comment-show): ditto. + (custom-comment-invisible-p): ditto. + (custom-variable-value-create): create a comment field widget. + (custom-face-value-create): ditto. + (custom-variable-menu): new entry for adding a custom comment. + (custom-face-menu): ditto. + (custom-save-variables): possibly save custom comments. + (custom-save-faces): ditto. + + * cus-face.el (custom-set-faces): the arguments can now have a + custom comment as fourth argument. + + * custom.el (custom-set-variables): the arguments can now have a + custom comment as fifth element. + +1999-07-13 XEmacs Build Bot + + * XEmacs 21.2.18 is released + +1999-07-13 SL Baur + + * lib-complete.el (read-library-name): Revert previous change. + (read-library): Ditto. + +1999-06-24 Karl M. Hegbloom + + * packages.el (packages-package-list): Capitalize docstring. + + * packages.el (packages-find-package-library-path): Use #'nconc + rather than #'append to reduce consing -- #'mapcar uses Flist, + which returns a freshly consed list. #'append would create yet + another fresh list, using Fmake_list in concat. + + * packages.el (package-provide): Use setq with remassq like it + says in its docstring. + +1999-07-06 SL Baur + + * lib-complete.el (progn-with-message): Fix typo. + +1999-07-06 SL Baur + + * mule/mule-misc.el (char-octet): Make function match docstring. + From Katsumi Yamaoka + +1999-06-15 Karl M. Hegbloom + + * wid-edit.el (widget-documentation): corrected spelling error. + +1999-06-23 Jonathan Marten + + * x-win-sun.el (x-win-init-sun): Don't rebind Find and Sh-find + keys if already bound + +1999-07-06 SL Baur + + * lib-complete.el (progn-with-message): Revert previous changes. + +1999-06-24 Bob Weiner + + * lib-complete.el (find-library): + (find-library-other-window): + (find-library-other-frame): Completely rewrote + so that these functions actually work when called non-interactively. + Also made them handle LIBRARY arguments which end with .el or .elc. + +1999-06-24 Bob Weiner + + * simple.el (indent-new-comment-line): Locally bound + `block-comment-start' to `comstart' or else when this is called + from do-auto-fill, e.g. in Lisp mode, it will insert any non-nil + `block-comment-start' value, ignoring any existing spacing after a + comment prefix in the previous line and producing ugly comments. + +1999-06-23 Bob Weiner + + * list-mode.el (mouse-choose-completion): + (choose-completion): + (completion-switch-to-minibuffer): Added. + ([Tab]): [Tab] previously switched to the minibuffer + but since [space] does that and since most applications in the + world use [Tab] to select the next item in a list, do that in the + *Completions* buffer too. This will cause the least confusion + among the largest population of users. -- Bob Weiner, BeOpen.com, + 06/23/1999. + +1999-06-22 Bob Weiner + + * help.el (help-buffer-name): Added support for a null value + of `help-buffer-prefix-string' since some buffers require no + prefix. + +1999-06-20 Bob Weiner + + * list-mode.el (completion-list-mode-quit): Added and bound to {q} + in the completion-list-mode-map to bury the completions buffer + even when the minibuffer is no longer active. + +1999-06-20 Bob Weiner + + * list-mode.el (list-mode): It is visually disconcerting to have + the text cursor disappear within list buffers, especially when + moving from window to window, so leave it visible. + +1999-07-01 SL Baur + + * menubar-items.el (default-menubar): Conditionalize the bug + report menu item (which may not be possible in this XEmacs). + Reported by: Ken'ichi Handa + +1999-06-30 SL Baur + + * subr.el (with-current-buffer): DOC string fix. + Suggested by Bob Weiner + +1999-06-25 Charles G Waldman + + * cus-face.el (custom-face-italic): insert missing args + +1999-06-24 Michael Sperber [Mr. Preprocessor] + + * packages.el (package-locations): Changed default early package + hierarchies to ~/.xemacs/mule-packages and + ~/.xemacs/xemacs-packages. + +1999-06-23 SL Baur + + * mule/mule-category.el (Top Level): ASCII is also latin-1. + +1999-06-15 Michael Sperber [Mr. Preprocessor] + + * packages.el (package-locations): Changed default early package + hierarchy to ~/.xemacs/packages. + (package-locations): Removed `packages' as a possible name for a + late package hierarchy. + +1999-06-20 MORIOKA Tomohiko + + * mule/mule-category.el (word-combining-categories): Set up new + variable. + (word-separating-categories): Likewise. + +1999-06-22 XEmacs Build Bot + + * XEmacs 21.2.17 is released + +1999-06-17 Robert Pluim + + * font-menu.el (font-menu-set-font): allow for nil specification + of font size. + +1999-06-16 MORIOKA Tomohiko + + * mule/thai-xtis.el: Specify `columns' of the charset `thai-xtis' + is 1. + +1999-06-12 MORIOKA Tomohiko + + * mule/cyrillic.el (cyrillic-koi8-r-decode-table): Use NBSP of ISO + 8859-5 instead of ISO 8859-1. + +1999-06-15 SL Baur + + * mule/vietnamese.el (viet-vscii-encode-table): Use split-char. + (viet-viscii-encode-table): Ditto. + + * mule/mule-misc.el: Delete split-char & split-char-or-char-int. + Make obsolete definition of char-octet. + +1999-06-14 SL Baur + + * subr.el: Move no-Mule make-char ... + * help-nomule.el (make-char): To here. + (string-width): Make Mule compatibility alias. + +1999-06-15 Andy Piper + + * select.el (get-selection-no-error): really make there be no-error. + (get-selection): revert to original. + +1999-06-11 Andy Piper + + * select.el (selection-sets-clipboard): renamed. + (own-selection): use it. + +1999-06-11 XEmacs Build Bot + + * XEmacs 21.2.16 is released + +1999-06-09 MORIOKA Tomohiko + + * mule/cyrillic.el (cyrillic-koi8-r-decode-table): Set 32 for + missing characters to avoid crash. + +1999-06-09 Jan Vroonhof + + * coding.el (set-terminal-coding-system): Only set the console + coding system on the selected console if it is a tty. + +1999-06-10 Jan Vroonhof + + * cus-face.el: + * cus-edit.el: + * faces.el: + (custom): + (face-spec-set): + * faces.el (frob-face-property): + * font-menu.el (font-menu-set-font): + Actually apply changes from 1999-03-17 + +1999-06-10 Andy Piper + + * select.el (get-selection): abstract out non error-signalling + part. + (get-selection-no-error): get-selection without signalling an + error. + (selection-is-clipboard-p): new variable. controls whether the + selection sets the clipboard. + (own-selection): use it. + + * mouse.el (insert-selection): fallback to clipboard after trying + primary selection and cutbuffer. + +1999-06-05 Andy Piper + + * x-select.el (xselect-kill-buffer-hook-1): use generalised + selection functions. + +1999-06-04 MORIOKA Tomohiko + + * code-files.el (buffer-file-coding-system): Use `raw-text' as + default value. + (load): Use `raw-text' instead of `no-conversion'. + (insert-file-contents): Likewise. + + * bytecomp.el (byte-compile-insert-header): Use `raw-text' instead + of `no-conversion'. + +1999-06-03 MORIOKA Tomohiko + + * coding.el: Don't copy `no-conversion' to `raw-text'. + +1999-06-07 Hrvoje Niksic + + * subr.el (make-char): Define it if Mule is not around. + +1999-06-07 SL Baur + + * mule/mule-help.el: Add trailing newline. Use mule keyword. + + * x-select.el (x-disown-selection-internal): Restore symbol as an + obsolete alias. + (xselect-kill-buffer-hook-1): Use disown-selection-internal. + +1999-06-04 XEmacs Build Bot + + * XEmacs 21.2.15 is released + +1999-06-02 Oscar Figueiredo + + * subr.el (split-string): Avoid infinite looping + +1999-05-30 Oscar Figueiredo + + * ldap.el (ldap-ignore-attribute-codings): New variable + (ldap-default-attribute-decoder): New variable + (ldap-coding-system): New variable + (ldap-attribute-syntax-encoders): New variable + (ldap-attribute-syntax-decoders): New variable + (ldap-attribute-syntaxes-alist): New variable + (ldap-encode-boolean): New function + (ldap-decode-boolean): New function + (ldap-encode-country-string): New function + (ldap-decode-string): New function + (ldap-decode-address): New function + (ldap-encode-address): New function + (ldap-decode-attribute): New function + (ldap-search): Use some of these + +1999-05-25 Jan Vroonhof + + * version.el (emacs-version): Make the patch level/beta come + before the XEmacs qualifier so that it gets into (funcall + emacs-version) and thus in the bug reports. + (emacs-version>=): Support patch levels. + +1999-06-03 SL Baur + + * version.el: implement x.y.z version number + From Jan Vroonhof + +1999-05-27 Yoshiki Hayashi + + * mule/mule-cmds.el (read-input-method-name): set input-method properly. + +1999-05-22 Vin Shelton + + * startup.el: Document -private and break out non-standard X options. + +1999-05-26 SL Baur + + * mule/mule-charset.el (charset-after): New function. + (charset-direction): Synch with Mule, update docstring. + (get-charset-property): New function. + (put-charset-property): New function. + (charset-plist): New function. + + * mule/mule-charset.el (compose-region): + (decompose-region): remove; these functions (which don't work + since we don't do composite characters) have been moved to + mule-util.el. + (toplevel): follow coding standards + +1999-05-26 SL Baur + + * dumped-lisp.el (preloaded-file-list): mule-files.el does not + exist any more. + + * code-files.el: Fix commentary to follow coding standards. Move + the single line left in mule-files.el to here. + + * mule/mule-files.el: delete. + +1999-05-24 SL Baur + + * info.el (Info-scroll-prev): Use event functions instead of the + old emacs 19 interface. + +1999-06-02 Andy Piper + + * x-font-menu.el (x-font-menu-load-font): + font-menu-registry-encoding -> x-font-menu-registry-encoding type. + +1999-05-31 Andy Piper + + * font-menu.el (font-menu-ignore-scaled-fonts): move to font-menu + group. + (font-menu-this-frame-only-p): ditto. + (font-menu-max-items): reinstate, from Jan Vroonhof + + (font-menu-submenu-name-format): ditto. + (font-menu-split-long-menu): ditto, for use by the family + constructor. + (font-menu-family-constructor): use it. + +1999-05-30 Andy Piper + + * msw-faces.el (mswindows-font-regexp): new font matching regexp + for use by the font menu. + + * msw-font-menu.el: new file implementing mswindows specific + font-menu behaviour. + (mswindows-font-menu-registry-encoding): new function mirroring x version. + (mswindows-font-menu-junk-families): ditto. + (hack-font-truename): ditto. + (mswindows-font-regexp-ascii): ditto. + (mswindows-reset-device-font-menus): ditto. + (mswindows-font-menu-font-data): ditto. + (mswindows-font-menu-load-font): ditto. + + * x-font-menu.el (x-reset-device-font-menus): made device specific. + (x-font-menu-font-data): ditto. + (x-font-menu-load-font): ditto. + + * font-menu.el: new file implementing generic font menu behaviour. + (font-menu-ignore-scaled-fonts): copied from x-font-menu.el and + made device independent. + (font-menu-this-frame-only-p): ditto. + (font-menu-preferred-resolution): ditto. + (font-menu-size-scaling): new variable used to determine whether + sizes are in points or tenths of a point. + (vassoc): moved from x-font-menu.el. + (device-fonts-cache): ditto. + (device-fonts-cache): ditto. + (flush-device-fonts-cache): ditto. + (reset-device-font-menus): copied from x-font-menu.el and made + device independent. Most functionality deferred to + device-dependent versions. + (font-menu-family-constructor): copied from x-font-menu.el and + made device independent. + (font-menu-size-constructor): ditto. + (font-menu-weight-constructor): ditto. + (font-menu-set-font): ditto. + (font-menu-change-face): ditto. + (font-menu-load-font): new device method. + (font-menu-font-data): ditto. + + * x-font-menu.el: The above functions deleted. + +1999-05-26 Andy Piper + + * update-elc.el: + * make-docfile.el: + * loadup.el: rehash expand-file-name usage to not use default-directory. + +1999-05-21 Andy Piper + + * x-select.el (x-select-convert-to-text): + (x-selected-text-type): + (x-get-selection): + (xselect-convert-to-string): + (xselect-convert-to-compound-text): + (xselect-convert-to-length): + (xselect-convert-to-targets): + (xselect-convert-to-delete): + (xselect-convert-to-filename): + (xselect-convert-to-charpos): + (xselect-convert-to-lineno): + (xselect-convert-to-colno): + (xselect-convert-to-sourceloc): + (xselect-convert-to-os): + (xselect-convert-to-host): + (xselect-convert-to-user): + (xselect-convert-to-class): + (xselect-convert-to-name): + (xselect-convert-to-integer): + (xselect-convert-to-atom): + (xselect-convert-to-identity): functions renamed from x-* and + moved to select.el. + (x-get-secondary-selection): use rename get-selection. + (x-get-clipboard): ditto. + (x-own-selection): moved to select.el. + (x-valid-simple-selection-p): ditto. + (x-dehilight-selection): ditto. + (x-own-clipboard): ditto. + (x-disown-selection): ditto. + + * x-mouse.el (x-yank-function): moved to mouse.el. + (x-insert-selection): ditto. + (x-set-point-and-move-selection): use renamed function. + + * select.el (selected-text-type): moved and renamed from + x-select.el. + (selection-owner-p): moved to C. + (selection-exists-p): ditto. + (get-cutbuffer): new device method. + (get-selection): generalised and moved from x-select.el. + (own-selection): moved x-own-selection functionality into here. + (dehilight-selection): renamed and moved from x-select.el. + (own-clipboard): functionality moved from x-select.el using new + generic C builtins. + (disown-clipboard): ditto. + (select-convert-to-text): + (select-convert-to-string): + (select-convert-to-compound-text): + (select-convert-to-length): + (select-convert-to-targets): + (select-convert-to-delete): + (select-convert-to-filename): + (select-convert-to-charpos): + (select-convert-to-lineno): + (select-convert-to-colno): + (select-convert-to-sourceloc): + (select-convert-to-os): + (select-convert-to-host): + (select-convert-to-user): + (select-convert-to-class): + (select-convert-to-name): + (select-convert-to-integer): + (select-convert-to-atom): + (select-convert-to-identity): new functions renamed from x-* and + moved from x-select.el. + + * mouse.el (mouse-consolidated-yank): subsume x-yank-function + into here and use as the default window-system mouse yank. + (insert-selection): generalised and moved from x-mouse.el. + (own-clipboard): moved to C. + + * msw-select.el (mswindows-selection-owned-p): deleted. + (mswindows-own-selection): generalised and moved to select.el. + (mswindows-disown-selection): generalised and moved to C. + (mswindows-selection-owner-p): ditto. + +1999-05-14 XEmacs Build Bot + + * XEmacs 21.2.14 is released + +1999-05-13 SL Baur + + * about.el: update contact info for jason and slb. + +1999-05-13 SL Baur + + * mule/european.el (setup-romanian-environment): Add Romanian + support from Emacs/Mule romanian.el. + +1999-03-17 Jan Vroonhof + + * cus-face.el: Label all custom changes with the 'custom' tag. + + * cus-edit.el: idem ditto. + + * faces.el: Added suport for adding device tags to various functions. + (custom): New device tag. + (face-spec-set): Call reset face with tags argument. No longer do + x-init-global-faces hack. + + * faces.el (frob-face-property): Use an anonymous specifier to map + frob-face-property-1 over. + + * x-font-menu.el (font-menu-set-font): Always specify all + properties to custom. + +1999-05-12 SL Baur + + * mule/european.el (setup-czech-environment): Add czech support. + From David Sauer + +1999-03-15 SL Baur + + * check-features.el: Turn hard errors into warnings. + +1999-03-21 SL Baur + + * simple.el (delete-key-deletes-forward): As per discussion on + xemacs-beta, default to t. + +1999-05-11 Hrvoje Niksic + + * loadup.el: Define Installation-string before loading anything. + +1999-05-06 Gunnar Evermann + + * files.el (auto-mode-alist): fix typo in regex for .bash_* files + From Anders Stenman + +1999-05-03 Hrvoje Niksic + + * wid-edit.el (widget-glyph-find): Ditto. + + * packages.el (locate-library): Ditto. + + * loadup.el (really-early-error-handler): Ditto. + + * lib-complete.el (read-library): Ditto. + + * faces.el (set-face-stipple): Ditto. + + * code-files.el (load): Use new calling style of locate-file. + +1999-05-03 Hrvoje Niksic + + * packages.el (packages-unbytecompiled-lisp): Installation.el is + dead. + +1999-05-03 Hrvoje Niksic + + * dumped-lisp.el (preloaded-file-list): Don't load + Installation.el. + + * loadup.el (Installation-string): Define it here. + +1999-05-03 Hrvoje Niksic + + * dumped-lisp.el (preloaded-file-list): Revert previous change -- + Installation.el needs to be loaded before `dump-paths', otherwise + the dumping process won't find it. + +1999-03-13 Adrian Aichner + + * dumped-lisp.el (preloaded-file-list): Load Installation.el after + subr so that we can use `replace-in-string' in Installation.el to + get rid of C-m chars under the native Windows build. + +1999-04-29 Andy Piper + + * make-docfile.el: canonicalize file and directory names. + + * device.el (call-device-method): new function for calling device + specific methods. + (define-device-method): new function for defining device methods. + (define-device-method*): ditto. + +1999-04-27 Hrvoje Niksic + + * subr.el (buffer-string): Support new FSFmacs 20.4 stuff. + +1999-04-08 MORIOKA Tomohiko + + * mule/cyrillic.el (cyrillic-koi8-r-decode-table): New variable. + (cyrillic-koi8-r-encode-table): Likewise. + (ccl-decode-koi8): Use `cyrillic-koi8-r-decode-table'. + (ccl-encode-koi8): Use `cyrillic-koi8-r-encode-table'. + + * mule/mule-misc.el (split-char-or-char-int): New function [moved + from vietnamese.el]. + + * mule/vietnamese.el: Move function `split-char-or-char-int' to + mule/mule-misc.el. + +1999-04-08 MORIOKA Tomohiko + + * mule/thai-xtis.el: + - Change font registry name from "Thai94x94-0" to "xtis-0". + - Change mnemonic of coding-system `tis-620' to "TIS620". + +1999-04-06 MORIOKA Tomohiko + + * mule/ethiopic.el: fixed. + +1999-03-30 MORIOKA Tomohiko + + * dumped-lisp.el: Add ethiopic, thai-xtis and vietnamese. + + * mule/thai-xtis.el: New file. + + * mule/vietnamese.el: New file. + + * mule/ethiopic.el: New file. + +1999-04-22 Hrvoje Niksic + + * bytecomp.el (byte-compile-close-variables): Leave + debug-issue-ebola-notices alone. + +1999-04-11 Oscar Figueiredo + + * ldap.el (ldap-host-parameters-alist): Make `Search Base' appear + at the top of the buffer since it is the most important thing to + customize + (ldap-get-host-parameter): New defun + (ldap-search): Add a new parameter `withdn' to retrieve the + distinguished names of entries + +1999-04-22 Kai Haberzettl + + * startup.el (splash-frame-body): Date and spelling fixes. + +1999-03-16 Colin Rafferty + + * view-less.el (toggle-truncate-lines): add autoload tag + +1999-04-19 Hrvoje Niksic + + * format.el (format-alist): Disable image stuff. + +1999-04-17 Hrvoje Niksic + + * wid-edit.el (widget-glyph-find): Search by directories, then by + suffixes rather than the other way around. + (widget-image-conversion): Renamed to + `widget-image-file-name-suffixes'. + +1999-04-16 Olivier Galibert + + * mule/mule-charset.el: Made old functions obsolete, remove the + unspeakably evil (and inexistant in fsf's) charset-leading-byte. + (charset-iso-graphic-plane): Rename from charset-graphic. + (charset-iso-final-char): Rename from charset-final. + (charset-width): Rename from charset-columns. + (charset-bytes): Added from fsf compatibility, returns always 1. + + * mule/mule-misc.el: Move charset-doc-string alias to + mule-charset.el + +1999-04-14 Colin Rafferty + + * x-faces.el (x-make-font-bold-italic): honor + *try-oblique-before-italic-fonts* + +1999-04-14 Hrvoje Niksic + + * cl-extra.el (coerce): Coerce numbers to characters correctly. + +1998-12-02 Hrvoje Niksic + + * x-faces.el (try-oblique-before-italic-fonts): Use the right + name. + +1999-04-14 Dave Gillesipe + + * cl-extra.el (equalp): Would bug out for lists. + +1999-03-12 Charles G Waldman + + * about.el (about-hackers): Change cgw's email address + 1999-03-12 XEmacs Build Bot * XEmacs 21.2.13 is released @@ -31,12 +2505,12 @@ 1999-02-19 Jan Vroonhof - * x-faces.el (x-init-global-faces): Add default tag to specifiers, + * x-faces.el (x-init-global-faces): Add default tag to specifiers, so they can be overridden by x-init-face-from-resources. Additionally specify the font name also with an x tag. 1999-03-08 Andy Piper - + * package-get.el (package-get-base): autoload. * menubar-items.el (default-menubar): add update menu item. Fix @@ -77,7 +2551,7 @@ * x-faces.el (x-init-face-from-resources): Only set fonts in the 'x locale. -1999-03-04 Adrian Aichner +1999-03-04 Adrian Aichner * package-ui.el (pui-install-selected-packages): Don't throw on `package-admin-delete-binary-package' returning nil since it's @@ -87,12 +2561,12 @@ 1999-03-03 Martin Buchholz - * menubar-items.el (default-menubar): + * menubar-items.el (default-menubar): Implement the ``Mule->Set coding system of process'' menu item. 1999-02-18 Martin Buchholz - * files.el (auto-mode-alist): Use c-mode for *.i pre-processed cpp + * files.el (auto-mode-alist): Use c-mode for *.i pre-processed cpp files - Change some `if's to `when's @@ -152,7 +2626,7 @@ * dumped-lisp.el (preloaded-file-list): Core mule files moved out of mule-base into lisp/mule. -1999-02-10 Adrian Aichner +1999-02-10 Adrian Aichner * process.el (exec-to-string): Use `shell-command-switch' in place of hard-wired "-c" (for WindowsNT). @@ -169,7 +2643,7 @@ 1999-02-15 Martin Buchholz - * paths.el: + * paths.el: - improved automounter tmp directory support. - support 4 (!) empirically discovered automounter conventions @@ -208,7 +2682,7 @@ * about.el (about-url-alist): Update my entry. (xemacs-hackers): Ditto. -1999-01-14 Adrian Aichner +1999-01-14 Adrian Aichner * buffer.el (switch-to-buffer): Fixing documentation. * minibuf.el (minibuffer-completion-table): ditto. @@ -256,7 +2730,7 @@ 1998-12-30 Martin Buchholz - * font.el (font-default-object-for-device): + * font.el (font-default-object-for-device): Oops! This `or' can't be replaced by `unless'. Fixed inability to run w3, among other things. @@ -269,7 +2743,7 @@ 1998-12-23 Hrvoje Niksic - * mouse.el (default-mouse-motion-handler): Disable help echo while + * mouse.el (default-mouse-motion-handler): Disable help echo while in the minibuffer. 1998-12-28 Martin Buchholz @@ -325,7 +2799,7 @@ 1998-11-30 Hrvoje Niksic - * cus-dep.el (Custom-make-dependencies): Be smarter about trapping + * cus-dep.el (Custom-make-dependencies): Be smarter about trapping errors. 1998-12-04 Hrvoje Niksic @@ -374,7 +2848,7 @@ bytecompile time. 1998-11-30 Martin Buchholz - + * x-win-xfree86.el: * x-win-sun.el (x-win-init-sun): * x-win-sun.el: @@ -585,7 +3059,7 @@ 1998-11-26 Jan Vroonhof - * faces.el (get-custom-frame-properties): Revert Hrvoje Niksic change + * faces.el (get-custom-frame-properties): Revert Hrvoje Niksic change of Dec 4, 1997. 1998-11-25 Hrvoje Niksic @@ -597,7 +3071,7 @@ * subr.el (buffer-substring-no-properties): Comment out. -1998-11-07 Adrian Aichner +1998-11-07 Adrian Aichner * msw-faces.el (mswindows-find-smaller-font): Turning font names into font instances first, like `x-frob-font-size' does. @@ -619,20 +3093,20 @@ (package-get-remove-copy): Default to 't' we no longer need this kludge as we do not currently use depenencies. - + (package-get-was-current): New variable. (package-get-require-base): New 'force-current' argument. (package-get-update-base): idem (package-get-package-provider): idem (package-get-locate-index-file): New 'no-remote' argument. (package-get-locate-file): idem. - + (package-get-maybe-save-index): New function. (package-get-update-base): Use it. 1998-10-28 Greg Klanderman - * package-get.el (package-get-remote): default to nil; by default, + * package-get.el (package-get-remote): default to nil; by default, don't go out to the net via EFS. They must select a download site. (package-get-download-sites): new variable. (package-get-download-menu): new function. @@ -647,22 +3121,22 @@ * package-get.el (package-get): bugfix code checking installed version for case where package is not currently installed. (package-get-require-signed-base-updates): new variable. - (package-get-update-base-from-buffer): remove REMOTE-SOURCE arg, it was + (package-get-update-base-from-buffer): remove REMOTE-SOURCE arg, it was deemed not a goot thing. Use the variable package-get-allow-unsigned-base-updates instead. 1998-10-16 Greg Klanderman - * package-get.el (package-get): Don't install an older version than + * package-get.el (package-get): Don't install an older version than we already have unless explicitly told to. Issue a warning. * package-ui.el (pui-add-required-packages): when adding dependencies, don't add packages that are up to date. - (pui-package-symbol-char): Don't consider a package out of date + (pui-package-symbol-char): Don't consider a package out of date if you have a newer version installed than the latest version in package-get-base. - * package-get.el (package-get-base-filename): document that it may + * package-get.el (package-get-base-filename): document that it may be a path relative to package-get-remote; new default value. (package-get-locate-file): new function. (package-get-update-base): use it to expand package-get-base-filename. @@ -685,7 +3159,7 @@ * cus-face.el (custom-set-face-update-spec): Add autoload cookie 1998-10-20 Malcolm Box - + * etags.el (find-tag-default): Run find-tag-hook using run-hooks rather than funcall @@ -706,7 +3180,7 @@ 1998-10-14 Jan Vroonhof * auto-save.el: expand-file 'auto-save-*-dir' at runtime not at - dump time. + dump time. 1998-10-15 Greg Klanderman @@ -745,7 +3219,7 @@ 1998-10-12 Jan Vroonhof - * menubar-items.el (default-menubar): pui-list-package has nothing + * menubar-items.el (default-menubar): pui-list-package has nothing to with Customize. Move all the package stuff to a new Item in Options. * package-ui.el (pui-menu): Add menu and Popup menu. @@ -841,9 +3315,9 @@ * package-admin.el (package-admin-delete-binary-package): General cleanup. Remove unnessary use of progn and - save-excursion. + save-excursion. (package-admin-delete-binary-package): Do NOT mess with file - modes. That is evil. + modes. That is evil. (package-admin-delete-binary-package): Wrap all deleting in condition-case. The data in MANIFEST is untrustworthy. (package-admin-delete-binary-package): Let the OS worry about non @@ -877,8 +3351,8 @@ 1998-09-29 Colin Rafferty - * sound.el (default-sound-directory-list): Initialize with all the - "sounds" directories in `data-directory-list'. It used to just be + * sound.el (default-sound-directory-list): Initialize with all the + "sounds" directories in `data-directory-list'. It used to just be the first one. * packages.el (locate-data-directory-list): Created. This gives @@ -889,7 +3363,7 @@ * minibuf.el (read-from-minibuffer): No longer bind help-form but make a binding in the local keymap until help-char handling is - improved. + improved. * help.el (help-keymap-with-help-key): Provide keymap with help binding. @@ -910,7 +3384,7 @@ 1998-09-21 Martin Buchholz - * bytecomp.el (byte-compile-buffer-substring): + * bytecomp.el (byte-compile-buffer-substring): Fix for: (byte-compile (defun f () (buffer-substring))) ==> ** buffer-substring called with 3 args, but requires 0-3 - new code not only works, but is more readable, too. @@ -988,7 +3462,7 @@ 1998-08-27 Jan Vroonhof * x-font-menu.el (font-menu-set-font): Add "pt" units to size - argument. + argument. 1998-09-03 Darryl Okahata @@ -996,14 +3470,14 @@ keyword `:completion-string', which allows the programmer to change the "Possible completions are:" prompt. - * menubar-items.el: Added new pulldown menu-pick to start up the + * menubar-items.el: Added new pulldown menu-pick to start up the visual package browser/installer: Options->Customize->List Packages * package-admin.el: Added hooks for installing under both Unix and MS Windows. Does additional error checking. No longer - calls "add-big-package.sh" to install packages under Unix; now + calls "add-big-package.sh" to install packages under Unix; now calls gunzip & tar directly. * package-get.el: Added ability to install packages from files @@ -1016,7 +3490,7 @@ Changed all occurences of `concat' to use `expand-file-name'. * package-ui.el: New file which implements the main visual - package browser/installer, which is started via a menu pick or + package browser/installer, which is started via a menu pick or M-x pui-list packages. 1998-09-03 Hrvoje Niksic @@ -1062,8 +3536,8 @@ 1998-08-19 Michael Sperber [Mr. Preprocessor] - * loadup.el: - * make-docfile.el: + * loadup.el: + * make-docfile.el: * update-elc.el: Don't set `source-directory' (now defunct as a global variable) no more. @@ -1083,7 +3557,7 @@ * faces.el (set-face-property): (set-face-dim-p): (face-dim-p): updated the doc strings now that the dim property isn't - tty-specific. + tty-specific. (face-equal): the dim property is now a common one. * cus-face.el (custom-face-attributes): New face attribute: `dim' @@ -1126,8 +3600,8 @@ 1998-08-01 Kai Haberzettl - * startup.el(startup-splash-frame-body): - Update Copyright notice in splash screen + * startup.el(startup-splash-frame-body): + Update Copyright notice in splash screen 1998-07-20 Greg Klanderman @@ -1180,7 +3654,7 @@ 1998-07-16 Colin Rafferty * menubar-items.el (default-menubar): Removed references to - `data-directory', and use `locate-data-file' instead, and made + `data-directory', and use `locate-data-file' instead, and made then greyed out if they don't exist. 1998-07-14 Oscar Figueiredo @@ -1261,7 +3735,7 @@ * Symbols that have been obsolete for at least 3 years removed. - * cl-macs.el (cl-parse-loop-clause): Delete obsolete references to + * cl-macs.el (cl-parse-loop-clause): Delete obsolete references to screen- functions. (toplevel): remove setf methods for screen functions. * cl-macs.el (extent-data): defsetf removed. @@ -1406,7 +3880,7 @@ * faces.el (xpm-color-symbols): remove hardcoded defaults these are handled by the gui-element face fallbacks now. - + * x-faces.el: default gui-element face to "background" as well as the default face. @@ -1420,7 +3894,7 @@ corresponding to `page-delim' goes first and the hack in `forward-paragraph' will work. With bug analysis from Bob Weiner - + 1998-06-29 Kyle Jones * subr.el (remove-hook): When checking the hook value @@ -1437,7 +3911,7 @@ * ldap.el (ldap-host-parameters-alist): New name of `ldap-host-parameters-plist' -1998-06-26 Adrian Aichner +1998-06-26 Adrian Aichner * package-get.el: Using (require 'package-get-base), now that it provides itself. Consequently removed all instances of (load @@ -1445,7 +3919,7 @@ 1998-06-29 Kyle Jones - * subr.el (remove-hook): Don't treat the hook value as a + * subr.el (remove-hook): Don't treat the hook value as a list unless it is both consp and not functionp. 1998-06-29 SL Baur @@ -1515,7 +3989,7 @@ 1998-06-15 Jonathan Harris - * minibuf.el: make read-color-completion-table call + * minibuf.el: make read-color-completion-table call (mswindows-color-list for mswindows devices. 1998-06-18 Sam Mikes @@ -1524,7 +3998,7 @@ (font-lock-match-c++-style-declaration-item-and-skip-to-next): Let declaration items contain non-word symbol characters. -1998-06-15 Adrian Aichner +1998-06-15 Adrian Aichner * package-get.el (package-get-package-provider): Added autoload cookie. Loading "package-get-base.el" in ALL functions that use @@ -1571,7 +4045,7 @@ (Info-save-auto-generated-dir): New variable (Info-maybe-update-dir): Use `Info-auto-generate-directory' (Info-build-dir-anew): Second parameter removed. Use - `Info-save-auto-generated-dir' + `Info-save-auto-generated-dir' (Info-rebuild-dir): Ditto 1998-06-02 Christoph Wedler @@ -1679,7 +4153,7 @@ 1998-06-02 Didier Verna * cus-face.el (custom-face-attributes): generalized the use of - toggle buttons for boolean attributes. + toggle buttons for boolean attributes. Re-ordered the items a bit. 1998-06-01 SL Baur @@ -1828,7 +4302,7 @@ * x-select.el: selection cleanup. (x-cut-copy-clear-internal) moved to (cut-copy-clear-internal) in select.el. Ditto for (x-delete-primary-selection) (x-kill-primary-selection) - (x-copy-primary-selection). + (x-copy-primary-selection). (own-clipboard): new function. * msw-select.el: use the new kill/delete/copy/cut-copy-clear @@ -1936,7 +4410,7 @@ comint-process-echoes setting to t. 1998-05-17 Michael Sperber [Mr. Preprocessor] - + * packages.el (packages-no-package-hierarchy-regexp): Introduced and used following the interface change of `paths-find-recursive-path'. @@ -1950,7 +4424,7 @@ 1998-05-16 Hrvoje Niksic - * simple.el (delete-forward-p): Make it a defun; do X garbage only + * simple.el (delete-forward-p): Make it a defun; do X garbage only on X devices, rather than on all non-TTY devices. 1998-05-16 Kirill M. Katsnelson @@ -1959,7 +4433,7 @@ * dumped-lisp.el (preloaded-file-list): Added msw-mouse.el -1998-05-17 Adrian Aichner +1998-05-17 Adrian Aichner * itimer.el (activate-itimer): Fixed usage of integers as argument to `concat'. @@ -2030,11 +4504,11 @@ 1998-05-15 Kirill M. Katsnelson - * device.el (device-pixel-width): - (device-pixel-height): - (device-mm-width): - (device-mm-height): - (device-bitplanes): + * device.el (device-pixel-width): + (device-pixel-height): + (device-mm-width): + (device-mm-height): + (device-bitplanes): (device-color-cells): Swapped parameters to device-system-metric according to the interface change. @@ -2245,8 +4719,8 @@ 1998-05-10 Kirill M. Katsnelson * device.el: (device-pixel-width): Reflected name/parameters - change to device-system-metric. - (device-pixel-height): Ditto. + change to device-system-metric. + (device-pixel-height): Ditto. (device-mm-width): Ditto. (device-mm-height): Ditto. (device-bitplanes): Ditto. @@ -2318,11 +4792,11 @@ 1998-04-18 Kirill M. Katsnelson - * device.el (device-pixel-height): - (device-pixel-width): - (device-mm-width): - (device-mm-height): - (device-bitplanes): + * device.el (device-pixel-height): + (device-pixel-width): + (device-mm-width): + (device-mm-height): + (device-bitplanes): (device-color-cells): Moved these 6 functions from device.c; they all use single (device-system-metrics) call. @@ -2331,7 +4805,7 @@ * dumped-lisp.el (preloaded-file-list): x-menubar.el and x-toolbar.el were renamed. - * menubar-items.el: + * menubar-items.el: * toolbar-items.el: Renamed from x-menubar/x-toolbar. Suggested by Hrvoje Niksic @@ -2377,12 +4851,12 @@ 1998-05-03 Hrvoje Niksic - * help.el (function-arglist): If no arguments are documented for a + * help.el (function-arglist): If no arguments are documented for a subr, print nothing rather than incorrect output. 1998-05-05 SL Baur - * cmdloop.el (command-error): Update bail-out error message to use + * cmdloop.el (command-error): Update bail-out error message to use `emacs-program-name'. * lib-complete.el: Remove reader macro cruft. @@ -2505,7 +4979,7 @@ 1998-04-30 Hrvoje Niksic - * modeline.el (defining-kbd-macro): Restore modeline indication of + * modeline.el (defining-kbd-macro): Restore modeline indication of kbd-macro being recorded. (add-minor-mode): Simplify docstring. (modeline-minor-mode-menu): Remove stuff. @@ -2513,7 +4987,7 @@ 1998-04-29 Andy Piper * code-process.el (call-process): dynamically decide process - coding type. + coding type. 1998-04-29 Jim Radford @@ -2611,7 +5085,7 @@ 1998-04-25 Oscar Figueiredo * info.el (Info-parse-dir-entries): Fixed regexp - (Info-build-dir-anew): Remove full suffix and capitalize info file + (Info-build-dir-anew): Remove full suffix and capitalize info file name for files with no @direntry (Info-batch-rebuild-dir): New function (Info-suffixed-file): Check for regular files instead of simple @@ -2694,7 +5168,7 @@ * frame.el (get-frame-for-buffer-default-instance-limit): defcustom it for options menu handling. - * font-lock.el (font-lock-mode): defcustom and autolaod the variable + * font-lock.el (font-lock-mode): defcustom and autoload the variable font-lock-mode for options menu handling. * cus-start.el: added Custom properties to overwrite-mode for @@ -2725,11 +5199,11 @@ 1998-04-19 Oscar Figueiredo * info.el (Info-maybe-update-dir): Bug fix in `conservative' behaviour - (Info-build-dir-anew): Add a final newline. - (Info-build-dir-anew): Do not issue warning when rebuilding policy + (Info-build-dir-anew): Add a final newline. + (Info-build-dir-anew): Do not issue warning when rebuilding policy is `always' (Info-rebuild-dir): Ditto - + * dumped-lisp.el (preloaded-file-list): Added ldap.el 1998-04-21 SL Baur @@ -2743,7 +5217,7 @@ 1998-04-19 SL Baur - * packages.el (package-locations): infodock-packages must override + * packages.el (package-locations): infodock-packages must override mule-packages and packages. 1998-04-19 Jonathan Harris @@ -2772,7 +5246,7 @@ * packages.el, setup-paths.el: Set various path searching depths to 1. - * packages.el (packages-hierarchy-depth): + * packages.el (packages-hierarchy-depth): (packages-load-path-depth): Introduced and used. * setup-paths.el (paths-load-path-depth): Introduced and used. @@ -2782,12 +5256,12 @@ 1998-04-15 Michael Sperber [Mr. Preprocessor] - * setup-paths.el (paths-construct-info-path): Removed + * setup-paths.el (paths-construct-info-path): Removed dependency on behavior of (file-name-as-directory ""). 1998-04-09 Oscar Figueiredo - * ldap.el (ldap-search): Adapt to the new low-level API using ldap + * ldap.el (ldap-search): Adapt to the new low-level API using ldap lisp objects 1998-04-14 Michael Sperber [Mr. Preprocessor] @@ -2799,7 +5273,7 @@ * wid-edit.el: We cannot just set the help-echo or balloon-help properties for an extent based on the :help-echo widget property, since help-echo and balloon-help cause an EXTENT to - get passed in, where :help-echo functions are expecting a WIDGET + get passed in, where :help-echo functions are expecting a WIDGET 1998-04-15 Kirill M. Katsnelson @@ -2915,7 +5389,7 @@ * dump-paths.el, startup.el: Removed package-path as a global variable. - * package-admin.el (package-admin-add-single-file-package): + * package-admin.el (package-admin-add-single-file-package): (package-admin-add-binary-package): Changed package-path to late-packages. @@ -2933,7 +5407,7 @@ * x-toolbar.el: Added toolbar-vector-xxxxxx defvars. Modified initial-toolbar-spec to use new toolbar-vector-xxxxxx defvars. This - eases the use of toolbar-add/kill-item functions. + eases the use of toolbar-add/kill-item functions. 1998-04-07 Kirill M. Katsnelson @@ -2947,11 +5421,11 @@ (Info-rebuild-dir): Appropriately parse multi-line description strings, and multi-section dir files. Issue warning when dir is rebuilt as temporary - (Info-build-dir-anew): Issue warning when dir is built as + (Info-build-dir-anew): Issue warning when dir is built as temporary 1998-04-04 Kirill M. Katsnelson - + * list-mode.el (list-mode-map): Bind highlight motion commands to standard keys left, right, C-b and C-f. @@ -2971,7 +5445,7 @@ * isearch-mode.el (isearch-just-started): New variable. (isearch-mode): Set it. - (isearch-repeat): Advance one character forward only if the search + (isearch-repeat): Advance one character forward only if the search was successful, and was not just started. (isearch-repeat): Clear isearch-just-started. @@ -3008,7 +5482,7 @@ 1998-03-30 Kyle Jones - * loaddefs.el: Don't set debug-ignored-errors; leave + * loaddefs.el: Don't set debug-ignored-errors; leave its default value set to nil. 1998-03-29 Damon Lipparelli @@ -3018,7 +5492,7 @@ 1998-03-29 Oscar Figueiredo * info.el (Info-rebuild-outdated-dir): New custom var - (Info-insert-node): Create/update dir file when needed, ie when it + (Info-insert-node): Create/update dir file when needed, ie when it does not exist or is older than some info files in directory 1998-04-01 Michael Sperber [Mr. Preprocessor] @@ -3213,7 +5687,7 @@ 1998-03-18 SL Baur * frame.el (frame-initialize): Use `delete-console' instead of - `delete-device' to delete the stream console to match the usage in + `delete-device' to delete the stream console to match the usage in Fkill_emacs. 1998-03-16 SL Baur @@ -3253,11 +5727,11 @@ 1998-03-03 Kirill M. Katsnelson * msw-glyphs.el: New file. Defines TTY-style glyphs for - mswindows. Must be reworked along with glyphs.el, or + mswindows. Must be reworked along with glyphs.el, or merged into it, after there is images support. * dumped-lisp.el (preloaded-file-list): Dump msw-glyphs.el when - 'mswindows. + 'mswindows. 1998-03-13 SL Baur @@ -3267,7 +5741,7 @@ 1998-03-11 Pete Ware - * files.el (set-auto-mode): If a mode is not fboundp, check to see + * files.el (set-auto-mode): If a mode is not fboundp, check to see if there is an existing package that handles it and warn the user about that mode. @@ -3288,7 +5762,7 @@ 1998-03-10 Glynn Clements - * files.el (backup-enable-predicate): fix breakage introduced + * files.el (backup-enable-predicate): fix breakage introduced by TMPDIR patch. 1998-03-09 Kyle Jones @@ -3466,7 +5940,7 @@ decided in `mouse-drag-modeline'. (mouse-drag-modeline): A button release event is considered a mouse click is both X (modeline scroll) and Y (modeline drag) pos - stay unchanged. + stay unchanged. 1998-02-25 SL Baur @@ -3517,18 +5991,18 @@ if it exists, becasuse with-output-to-temp-buffer will clear it. further, killing the buffer violates the rule that temp-buffer-show-function, if set, has the full responsibility of - showing the temp buffer. killing the buffer fucks with the window + showing the temp buffer. killing the buffer fucks with the window configuration, hosing temp-buffer-show-function. 1998-02-23 Didier Verna - * modeline.el (mouse-drag-modeline): + * modeline.el (mouse-drag-modeline): - Always scroll the modeline that was originally clicked on. - - Use x pixels instead of x characters (which doesn't work anyway) + - Use x pixels instead of x characters (which doesn't work anyway) as horizontal reference for modeline dragging. This allows us to keep on dragging the modeline even if the motion event occurs in - another window. + another window. 1998-02-23 Didier Verna @@ -3560,7 +6034,7 @@ 1998-02-17 Didier Verna * mouse.el (default-mouse-track-set-point-in-window): rewrote this - function to handle correctly the case of a toolbar one side of the + function to handle correctly the case of a toolbar one side of the window: scrolling will not necessarily happen. 1998-02-17 Kyle Jones @@ -3579,20 +6053,20 @@ * autoload.el (generate-file-autoloads-1): Don't force an extra line out when copying on-the-same line autoloads. - * x-menubar.el (default-menubar): Add Sokoban to the menubar if it + * x-menubar.el (default-menubar): Add Sokoban to the menubar if it is installed. 1998-02-14 Martin Buchholz - * x11/x-win-xfree86.el (x-win-init-xfree86): - * x11/x-win-sun.el (x-win-init-sun): - * x11/x-init.el (x-initialize-compose): + * x11/x-win-xfree86.el (x-win-init-xfree86): + * x11/x-win-sun.el (x-win-init-sun): + * x11/x-init.el (x-initialize-compose): * prim/simple.el: - (backward-or-forward-kill-sexp): - (backward-or-forward-kill-sentence): - (backward-or-forward-kill-word): - (backward-or-forward-delete-char): - * prim/isearch-mode.el (isearch-help-or-delete-char): + (backward-or-forward-kill-sexp): + (backward-or-forward-kill-sentence): + (backward-or-forward-kill-word): + (backward-or-forward-delete-char): + * prim/isearch-mode.el (isearch-help-or-delete-char): Use x-keysym-on-keyboard-sans-modifiers-p instead of x-keysym-on-keyboard-p to detect backspace. Use symbols instead of strings (now deprecated) with x-keysym-*-p. @@ -3691,7 +6165,7 @@ 1997-06-15 Richard Stallman * text-mode.el (text-mode): Let all-white lines separate paragraphs. - + 1997-06-11 Richard Stallman * text-mode.el (paragraph-indent-text-mode): @@ -3784,7 +6258,7 @@ * about.el: Add xemacs.org email manager. - * package-get-base.el (package-get-base): Updated with most recent + * package-get-base.el (package-get-base): Updated with most recent package updates. 1998-01-14 Jens-Ulrik Holger Petersen @@ -3801,7 +6275,7 @@ (describe-key): Use `princ' "%s" to print object. (describe-function-1): Use `princ' "%s" to print object. Commented out alias lines removed. - (help-pretty-print-limit): New variable to control pretty-printing + (help-pretty-print-limit): New variable to control pretty-printing of variable values. (help-maybe-pretty-print-value): Steve wins! Renamed back from `help-pretty-print-value' again. Only print-print when OBJECT is @@ -3820,9 +6294,9 @@ 1998-01-13 Martin Buchholz - * lisp/packages.el: - * lisp/package-admin.el: - * lisp/build-report.el: + * lisp/packages.el: + * lisp/package-admin.el: + * lisp/build-report.el: Fix typos. 1998-01-14 Christoph Wedler @@ -4005,10 +6479,10 @@ * package-get.el: Changes to work with real data. From Pete Ware - * packages.el (packages-reload-autoloads): Guard load for the time + * packages.el (packages-reload-autoloads): Guard load for the time being. - * update-elc.el ("packages.el"): Force loading packages.el instead + * update-elc.el ("packages.el"): Force loading packages.el instead of possibly out-of-date packges.elc. * make-docfile.el ("packages.el"): Ditto. @@ -4064,7 +6538,7 @@ 1997-12-29 Colin Rafferty - * packages.el (packages-find-packages-1): Made it signal a warning + * packages.el (packages-find-packages-1): Made it signal a warning for an error in an auto-autoload.el file. 1997-12-30 SL Baur @@ -4205,10 +6679,10 @@ 1997-12-18 SL Baur - * startup.el (set-default-load-path): Make sure lisp and site-lisp + * startup.el (set-default-load-path): Make sure lisp and site-lisp get trailing slashes when added to the load-path. - * x-init.el (init-x-win): Locate where XEmacs X localization files + * x-init.el (init-x-win): Locate where XEmacs X localization files are. 1997-12-18 Kyle Jones @@ -4303,11 +6777,11 @@ * startup.el (set-default-load-path): Only search package-path when not running temacs. - * dumped-lisp.el (preloaded-file-list): Remove Egg/Its dumped lisp + * dumped-lisp.el (preloaded-file-list): Remove Egg/Its dumped lisp files. * loadup.el: Correct commentary. Reformatting. - (really-early-error-handler): Use absolute path to the + (really-early-error-handler): Use absolute path to the first dumped-lisp.el file. (really-early-error-handler): Print full path name of each dumped lisp file (inherited from InfoDock). @@ -4347,7 +6821,7 @@ 1997-12-15 Hrvoje Niksic - * modeline.el (mouse-drag-modeline): Give the modeline a "pressed" + * modeline.el (mouse-drag-modeline): Give the modeline a "pressed" look. 1997-12-16 Oscar Figueiredo @@ -4363,7 +6837,7 @@ 1997-12-17 Hrvoje Niksic - * etags.el (get-tag-table-buffer): Use explicit lists as arguments + * etags.el (get-tag-table-buffer): Use explicit lists as arguments to `ecase'. 1997-12-14 SL Baur diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/about.el --- a/lisp/about.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/about.el Mon Aug 13 11:13:30 2007 +0200 @@ -4,7 +4,7 @@ ;; Keywords: extensions ;; Version: 2.4 -;; Maintainer: Hrvoje Niksic +;; Maintainer: Hrvoje Niksic ;; This file is part of XEmacs. @@ -25,8 +25,8 @@ ;;; Synched up with: Not in FSF. -;; Original code: Jamie Zawinski -;; Text: Ben Wing , Jamie Zawinski +;; Original code: Jamie Zawinski +;; Text: Ben Wing , Jamie Zawinski ;; Hard: Amiga 1000, Progressive Peripherals Frame Grabber. ;; Soft: FG 2.0, DigiPaint 3.0, pbmplus (dec 91), xv 3.0. ;; Modified for 19.11 by Eduardo Pelegri-Llopart @@ -35,7 +35,7 @@ ;; 19.13 and 19.14 updating done by Chuck Thompson. ;; 19.15 and 20.0 updating done by Steve Baur and Martin Buchholz. -;; Completely rewritten for 20.3 by Hrvoje Niksic . +;; Completely rewritten for 20.3 by Hrvoje Niksic . ;; The original had no version numbers; I numbered the rewrite as 2.0. ;; Many things in this file are to gag. Ideally, we should just use @@ -56,20 +56,21 @@ ;; `about-maintainer-info' (and maybe `about-hackers'. (defvar xemacs-hackers '((ajc "Andrew Cosgriff" "ajc@bing.wattle.id.au") + (aj "Andreas Jaeger" "aj@suse.de") (baw "Barry Warsaw" "bwarsaw@python.org") - (bw "Bob Weiner" "weiner@altrasoft.com") + (bw "Bob Weiner" "weiner@beopen.com") (chr "Christian Nybø" "chr@mediascience.no") (cthomp "Chuck Thompson" "cthomp@xemacs.org") (dmoore "David Moore" "dmoore@ucsd.edu") (dkindred "Darrell Kindred" "dkindred@cmu.edu") (dv "Didier Verna" "verna@inf.enst.fr") - (hniksic "Hrvoje Niksic" "hniksic@srce.hr") + (hniksic "Hrvoje Niksic" "hniksic@xemacs.org") (jareth "Jareth Hein" "jareth@camelot.co.jp") (jason "Jason Mastaler" "jason@xemacs.org") (jens "Jens Lautenbacher" "jens@lemcbed.lem.uni-karlsruhe.de") (jmiller "Jeff Miller" "jmiller@smart.net") (juhp "Jens-Ulrik Holger Petersen" "petersen@kurims.kyoto-u.ac.jp") - (jwz "Jamie Zawinski" "jwz@netscape.com") + (jwz "Jamie Zawinski" "jwz@jwz.org") (kazz "IENAGA Kazuyuki" "ienaga@jsys.co.jp") (kyle "Kyle Jones" "kyle_jones@wonderworks.com") (larsi "Lars Magne Ingebrigtsen" "larsi@gnus.org") @@ -89,7 +90,7 @@ (stig "Jonathan Stigelman" "stig@hackvan.com") (stigb "Stig Bjorlykke" "stigb@tihlde.hist.no") (thiessel "Marcus Thiessel" "marcus@xemacs.org") - (vladimir "Vladimir Ivanovic" "vladimir@mri.com") + (vladimir "Vladimir Ivanovic" "vladimir@acm.com") (wing "Ben Wing" "ben@xemacs.org") (wmperry "William Perry" "wmperry@aventail.com")) "Alist of XEmacs hackers.") @@ -98,29 +99,29 @@ ;; It is preferred to a simple string, because it makes maintenance ;; easier. Please add new URLs to this list. (defvar about-url-alist - '((ajc . "http://www-personal.monash.edu.au/~ajc/") - (altrasoft . "http://www.altrasoft.com/") - (ben . "http://www.666.com/ben/") + '((ajc . "http://www-personal.monash.edu.au/~ajc/") + (beopen . "http://www.beopen.com/") + (ben . "http://www.666.com/ben/") (ben-xemacs . "http://www.666.com/xemacs/") - (baw . "http://www.python.org/~bwarsaw/") - (cc-mode . "http://www.python.org/ftp/emacs/") - (chr . "http://www.xemacs.org/faq/") - (dkindred . "http://www.cs.cmu.edu/People/dkindred/me.html") - (dmoore . "http://oj.egbt.org/dmoore/") - (jason . "http://www.mastaler.com/") - (juhp . "http://www.kurims.kyoto-u.ac.jp/~petersen/") - (jwz . "http://people.netscape.com/jwz/") - (kazz . "http://www.imasy.or.jp/~kazz/") - (kyle . "http://www.wonderworks.com/kyle/") - (larsi . "http://www.ifi.uio.no/~larsi/") - (marcpa . "http://www.positron911.com/products/power.htm") - (ograf . "http://www.fga.de/~ograf/") - (pez . "http://www.dwwc.com/") - (piper . "http://www.xemacs.freeserve.co.uk/") - (vin . "http://www.upa.org/") - (stigb . "http://www.tihlde.hist.no/~stigb/") - (wget . "ftp://gnjilux.cc.fer.hr/pub/unix/util/wget/") - (xemacs . "http://www.xemacs.org/")) + (baw . "http://www.python.org/~bwarsaw/") + (cc-mode . "http://www.python.org/ftp/emacs/") + (chr . "http://www.xemacs.org/faq/") + (dkindred . "http://www.cs.cmu.edu/People/dkindred/me.html") + (dmoore . "http://oj.egbt.org/dmoore/") + (jason . "http://www.mastaler.com/") + (juhp . "http://www.kurims.kyoto-u.ac.jp/~petersen/") + (jwz . "http://www.jwz.org/") + (kazz . "http://www.imasy.or.jp/~kazz/") + (kyle . "http://www.wonderworks.com/kyle/") + (larsi . "http://www.ifi.uio.no/~larsi/") + (marcpa . "http://www.positron911.com/products/power.htm") + (ograf . "http://www.fga.de/~ograf/") + (pez . "http://www.dwwc.com/") + (piper . "http://www.xemacs.freeserve.co.uk/") + (vin . "http://www.upa.org/") + (stigb . "http://www.tihlde.hist.no/~stigb/") + (wget . "ftp://gnjilux.cc.fer.hr/pub/unix/util/wget/") + (xemacs . "http://www.xemacs.org/")) "Some of the more important URLs.") (defvar about-left-margin 3) @@ -564,13 +565,8 @@ (ecase (car entry) (slb (widget-insert "\ -I took over the maintenance of XEmacs in November of 1996 (it -seemed like a good idea at the time ...). In real life I am a -network administrator and Unix systems programmer for Calag.com, -Inc. a small, but growing ISP in California. - -My main hobby while not maintaining XEmacs or working is ... -you have got to be kidding ...") +Peaches Baur, 1986-1999. +Rest in peace") (widget-insert ".\n")) (martin (widget-insert "\ @@ -664,8 +660,8 @@ (widget-insert "Cars are evil. Ride a bike.\n")) (vladimir (widget-insert "\ -Former technical lead for XEmacs at Sun. He is now with Microtec -Research Inc., working on embedded systems development tools.\n")) +Former technical lead for XEmacs at Sun. He is now with a startup +marketing embedded Java databases.\n")) (stig (widget-insert "\ Stig is sort of a tool fetishist. He has a hate/love relationship @@ -722,12 +718,12 @@ (widget-insert "\ Author of the Hyperbole everyday information management hypertext system and the OO-Browser multi-language code browser. He also -designed the Altrasoft InfoDock integrated development environment +designed the BeOpen InfoDock integrated development environment for software engineers. It runs atop XEmacs and is available from -his firm, Altrasoft, which offers distributions, custom development, +his firm, BeOpen, which offers distributions, custom development, support, and training packages for corporate users of XEmacs, GNU Emacs and InfoDock. See ") - (about-url-link 'altrasoft "Visit Altrasoft WWW page") + (about-url-link 'beopen "Visit BeOpen WWW page") (widget-insert ". His interests include user interfaces, information management, @@ -962,8 +958,9 @@ (widget-insert ".\n")) (jason (widget-insert "\ -Beta tester and manager of the various XEmacs mailing lists. -Originator and maintainer of the gnus.org domain. +Beta tester, manager of the various XEmacs mailing lists and +binary kit manager. Also, originator and maintainer of the gnus.org +domain. Jason resides in Albuquerque, New Mexico where he keeps himself busy with studies at the university and consulting work. @@ -991,6 +988,14 @@ violation of HTML DTD's. After graduation, spring 1999, he'll be looking for a job involving lisp programming, French and Russian.") (widget-insert ".\n")) + (aj + (widget-insert "\ +In the XEmacs team I'm responsible for the packages which means mainly +applying patches and packaging the packages. + +I'm a software developer working for the SuSE Labs of the Linux +distributor SuSE. My main task is to improve the GNU C library.") + (widget-insert ".\n")) )) ;; Setup the buffer for a maintainer. @@ -1046,8 +1051,8 @@ some of the contributors. We have no doubt forgotten someone; we apologize! You can see some of our faces under the links.\n\n") (about-show-linked-info 'vladimir "\ -Former technical lead for XEmacs at Sun Microsystems. He is now with -Microtec Research Inc., working on embedded systems development tools.\n") +Former technical lead for XEmacs at Sun. He is now with a startup +marketing embedded Java databases.\n") (about-show-linked-info 'stig "\ Peripatetic uninominal Emacs hacker. Stig sometimes operates out of a big white van set up for nomadic living and hacking. Implemented the @@ -1067,9 +1072,9 @@ (about-show-linked-info 'bw "\ Author of the Hyperbole everyday information management hypertext system and the OO-Browser multi-language code browser. He also -designed the Altrasoft InfoDock integrated development environment +designed the BeOpen InfoDock integrated development environment for software engineers. It runs atop XEmacs and is available from -his firm, Altrasoft, which offers custom development and support packages +his firm, BeOpen, which offers custom development and support packages for corporate users of XEmacs, GNU Emacs and InfoDock. His interests include user interfaces, information management, CASE tools, communications and enterprise integration.\n") @@ -1201,6 +1206,9 @@ Beta tester and last hacker of calendar.\n") (about-show-linked-info 'chr "\ Maintainer of the XEmacs FAQ and proud author of `zap-up-to-char'.\n") + (about-show-linked-info 'aj "\ +`Package Patch Tender', beta tester and GNU libc developer.\n") + (flet ((print-short (name addr &optional shortinfo) (concat (about-with-face name 'italic) (about-tabs name) @@ -1267,7 +1275,7 @@ (print-short "Per Abrahamsen" "abraham@dina.kvl.dk") (print-short "Gary Adams" "gra@zeppo.East.Sun.COM") (print-short "Gennady Agranov" "agranov@csa.CS.Technion.Ac.IL") - (print-short "Adrian Aichner" "aichner@ecf.teradyne.com") + (print-short "Adrian Aichner" "adrian@xemacs.org") (print-short "Mark Allender" "allender@vnet.IBM.COM") (print-short "Stephen R. Anderson" "sra@bloch.ling.yale.edu") (print-short "Butch Anton" "butch@zaphod.uchicago.edu") @@ -1317,7 +1325,7 @@ (print-short "Jonathan Edwards" "edwards@intranet.com") (print-short "Eric Eide" "eeide@asylum.cs.utah.edu") (print-short "EKR" "ekr@terisa.com") - (print-short "Gunnar Evermann" "Gunnar.Evermann@nats.informatik.uni-hamburg.de") + (print-short "Gunnar Evermann" "ge204@eng.cam.ac.uk") (print-short "Oscar Figueiredo" "Oscar.Figueiredo@di.epfl.ch") (print-short "David Fletcher" "frodo@tsunami.com") (print-short "Paul Flinders" "ptf@delcam.co.uk") @@ -1350,6 +1358,7 @@ (print-short "ChangGil Han" "cghan@phys401.phys.pusan.ac.kr") (print-short "Derek Harding" "dharding@lssec.bt.co.uk") (print-short "Michael Harnois" "mharnois@sbt.net") + (print-short "Yoshiki Hayashi" "yoshiki@xemacs.org") (print-short "John Haxby" "J.Haxby@isode.com") (print-short "Karl M. Hegbloom" "karlheg@inetarena.com") (print-short "Benedikt Heinen" "beh@icemark.thenet.ch") @@ -1364,7 +1373,6 @@ (print-short "Tudor Hulubei" "tudor@cs.unh.edu") (print-short "Tatsuya Ichikawa" "ichikawa@hv.epson.co.jp") (print-short "Andrew Innes" "andrewi@harlequin.co.uk") - (print-short "Andreas Jaeger" "aj@arthur.rhein-neckar.de") (print-short "Markku Jarvinen" "Markku.Jarvinen@simpukka.funet.fi") (print-short "Robin Jeffries" "robin.jeffries@sun.com") (print-short "Philip Johnson" "johnson@uhics.ics.Hawaii.Edu") @@ -1492,7 +1500,7 @@ (print-short "Juan E. Villacis" "jvillaci@cs.indiana.edu") (print-short "Jan Vroonhof" "vroonhof@math.ethz.ch") (print-short "Vladimir Vukicevic" "vladimir@intrepid.com") - (print-short "Charles G. Waldman" "cgw@pgt.com") + (print-short "Charles G. Waldman" "cgw@fnal.gov") (print-short "David Walte" "djw18@cornell.edu") (print-short "Peter Ware" "ware@cis.ohio-state.edu") (print-short "Christoph Wedler" "wedler@fmi.uni-passau.de") diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/apropos.el --- a/lisp/apropos.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/apropos.el Mon Aug 13 11:13:30 2007 +0200 @@ -4,7 +4,7 @@ ;; Author: Joe Wells ;; Rewritten: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389 -;; Maintainer: SL Baur +;; Maintainer: SL Baur ;; Keywords: help ;; This file is part of XEmacs. @@ -107,6 +107,7 @@ (defvar apropos-mode-map (let ((map (make-sparse-keymap))) (define-key map [(control m)] 'apropos-follow) + (define-key map [return] 'apropos-follow) (define-key map [(button2up)] 'apropos-mouse-follow) (define-key map [(button2)] 'undefined) map) @@ -377,7 +378,7 @@ (defun apropos-documentation-check-doc-file () (let (type symbol (sepa 2) sepb beg end) - (princ ?\^_) + (insert ?\^_) (backward-char) (insert-file-contents (concat doc-directory internal-doc-file-name)) (forward-char) @@ -508,6 +509,9 @@ (let ((p apropos-accumulator) (old-buffer (current-buffer)) symbol item point1 point2) + ;; Mostly useless but to provide better keymap + ;; explanation. help-mode-map will be used instead. + (use-local-map apropos-mode-map) ;; XEmacs change from (if window-system (if (device-on-window-system-p) (progn @@ -575,6 +579,8 @@ apropos-item)) (if apropos-symbol-face (put-text-property point1 point2 'face apropos-symbol-face)) + ;; Add text-property on symbol, too. + (put-text-property point1 point2 'keymap apropos-mode-map) (apropos-print-doc 'describe-function 1 (if (commandp symbol) "Command" diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/auto-autoloads.el --- a/lisp/auto-autoloads.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/auto-autoloads.el Mon Aug 13 11:13:30 2007 +0200 @@ -572,7 +572,9 @@ it were the arg to `interactive' (which see) to interactively read the value. If VARIABLE has a `custom-type' property, it must be a widget and the -`:prompt-value' property of that widget will be used for reading the value." t nil) +`:prompt-value' property of that widget will be used for reading the value. + +If given a prefix (or a COMMENT argument), also prompt for a comment." t nil) (autoload 'customize-set-variable "cus-edit" "\ Set the default for VARIABLE to VALUE. VALUE is a Lisp object. @@ -587,7 +589,9 @@ it were the arg to `interactive' (which see) to interactively read the value. If VARIABLE has a `custom-type' property, it must be a widget and the -`:prompt-value' property of that widget will be used for reading the value. " t nil) +`:prompt-value' property of that widget will be used for reading the value. + +If given a prefix (or a COMMENT argument), also prompt for a comment." t nil) (autoload 'customize-save-variable "cus-edit" "\ Set the default for VARIABLE to VALUE, and save it for future sessions. @@ -601,7 +605,9 @@ it were the arg to `interactive' (which see) to interactively read the value. If VARIABLE has a `custom-type' property, it must be a widget and the -`:prompt-value' property of that widget will be used for reading the value. " t nil) +`:prompt-value' property of that widget will be used for reading the value. + +If given a prefix (or a COMMENT argument), also prompt for a comment." t nil) (autoload 'customize "cus-edit" "\ Select a customization buffer which you can use to set user options. @@ -698,7 +704,7 @@ ;;;*** -;;;### (autoloads (custom-set-faces custom-set-face-update-spec custom-declare-face) "cus-face" "lisp/cus-face.el") +;;;### (autoloads (custom-reset-faces custom-theme-reset-faces custom-theme-face-value custom-theme-set-faces custom-set-faces custom-set-face-update-spec custom-declare-face) "cus-face" "lisp/cus-face.el") (autoload 'custom-declare-face "cus-face" "\ Like `defface', but FACE is evaluated as a normal argument." nil nil) @@ -709,15 +715,35 @@ (autoload 'custom-set-faces "cus-face" "\ Initialize faces according to user preferences. +This asociates the setting with the USER theme. The arguments should be a list where each entry has the form: - (FACE SPEC [NOW]) + (FACE SPEC [NOW [COMMENT]]) SPEC will be stored as the saved value for FACE. If NOW is present and non-nil, FACE will also be created according to SPEC. +COMMENT is a string comment about FACE. See `defface' for the format of SPEC." nil nil) +(autoload 'custom-theme-set-faces "cus-face" "\ +Initialize faces according to settings specified by args. +Records the settings as belonging to THEME. + +See `custom-set-faces' for a description of the arguments ARGS." nil nil) + +(autoload 'custom-theme-face-value "cus-face" "\ +Return spec of FACE in THEME if the THEME modifies the +FACE. Nil otherwise." nil nil) + +(autoload 'custom-theme-reset-faces "cus-face" nil nil nil) + +(autoload 'custom-reset-faces "cus-face" "\ +Reset the value of the face to values previously defined. +Assosiate this setting with the 'user' theme. + +ARGS is defined as for `custom-theme-reset-faces'" nil nil) + ;;;*** ;;;### (autoloads (disassemble) "disass" "lisp/disass.el") @@ -1057,6 +1083,30 @@ ;;;*** +;;;### (autoloads (font-menu-weight-constructor font-menu-size-constructor font-menu-family-constructor reset-device-font-menus) "font-menu" "lisp/font-menu.el") + +(defcustom font-menu-ignore-scaled-fonts nil "*If non-nil, then the font menu will try to show only bitmap fonts." :type 'boolean :group 'font-menu) + +(defcustom font-menu-this-frame-only-p nil "*If non-nil, then changing the default font from the font menu will only\naffect one frame instead of all frames." :type 'boolean :group 'font-menu) + +(fset 'install-font-menus 'reset-device-font-menus) + +(autoload 'reset-device-font-menus "font-menu" "\ +Generates the `Font', `Size', and `Weight' submenus for the Options menu. +This is run the first time that a font-menu is needed for each device. +If you don't like the lazy invocation of this function, you can add it to +`create-device-hook' and that will make the font menus respond more quickly +when they are selected for the first time. If you add fonts to your system, +or if you change your font path, you can call this to re-initialize the menus." nil nil) + +(autoload 'font-menu-family-constructor "font-menu" nil nil nil) + +(autoload 'font-menu-size-constructor "font-menu" nil nil nil) + +(autoload 'font-menu-weight-constructor "font-menu" nil nil nil) + +;;;*** + ;;;### (autoloads (x-font-build-cache font-default-size-for-device font-default-encoding-for-device font-default-registry-for-device font-default-family-for-device font-default-object-for-device font-default-font-for-device font-create-object) "font" "lisp/font.el") (autoload 'font-create-object "font" nil nil nil) @@ -1228,6 +1278,20 @@ ;;;*** +;;;### (autoloads (mswindows-reset-device-font-menus) "msw-font-menu" "lisp/msw-font-menu.el") + +(autoload 'mswindows-reset-device-font-menus "msw-font-menu" "\ +Generates the `Font', `Size', and `Weight' submenus for the Options menu. +This is run the first time that a font-menu is needed for each device. +If you don't like the lazy invocation of this function, you can add it to +`create-device-hook' and that will make the font menus respond more quickly +when they are selected for the first time. If you add fonts to your system, +or if you change your font path, you can call this to re-initialize the menus." nil nil) + +(defun* mswindows-font-menu-font-data (face dcache) (let* ((case-fold-search t) (domain (if font-menu-this-frame-only-p (selected-frame) (selected-device))) (name (font-instance-name (face-font-instance face domain))) (truename (font-instance-truename (face-font-instance face domain (if (featurep 'mule) 'ascii)))) family size weight entry slant) (when (string-match mswindows-font-regexp name) (setq family (match-string 1 name)) (setq entry (vassoc family (aref dcache 0)))) (when (and (null entry) (string-match mswindows-font-regexp truename)) (setq family (match-string 1 truename)) (setq entry (vassoc family (aref dcache 0)))) (when (null entry) (return-from mswindows-font-menu-font-data (make-vector 5 nil))) (when (string-match mswindows-font-regexp name) (setq weight (match-string 2 name)) (setq size (string-to-int (match-string 4 name)))) (when (string-match mswindows-font-regexp truename) (when (not (member weight (aref entry 1))) (setq weight (match-string 2 truename))) (when (not (member size (aref entry 2))) (setq size (string-to-int (match-string 4 truename)))) (setq slant (match-string 5 truename))) (vector entry family size weight slant))) + +;;;*** + ;;;### (autoloads (mwheel-install) "mwheel" "lisp/mwheel.el") (autoload 'mwheel-install "mwheel" "\ @@ -1297,6 +1361,8 @@ be lexically ordered. It is debatable if it makes sense to have more than one version of a package available.") +(defcustom package-get-download-sites '(("xemacs.org" "ftp.xemacs.org" "pub/xemacs/packages") ("cso.uiuc.edu" "ftp.cso.uiuc.edu" "pub/packages/xemacs/packages") ("unicamp.br" "ftp.unicamp.br" "pub/xemacs/packages") ("sunsite.cnlab-switch.ch" "sunsite.cnlab-switch.ch" "mirror/xemacs/packages") ("tu-darmstadt.de" "ftp.tu-darmstadt.de" "pub/editors/xemacs/packages") ("sunsite.auc.dk" "sunsite.auc.dk" "pub/emacs/xemacs/packages") ("pasteur.fr" "ftp.pasteur.fr" "pub/computing/xemacs/packages") ("cenatls.cena.dgac.fr" "ftp.cenatls.cena.dgac.fr" "pub/Emacs/xemacs/packages") ("kfki.hu" "ftp.kfki.hu" "pub/packages/xemacs/packages") ("uniroma2.it" "ftp.uniroma2.it" "unix/misc/dist/XEMACS/packages") ("icm.edu.pl" "ftp.icm.edu.pl" "pub/unix/editors/xemacs/packages") ("sunet.se" "ftp.sunet.se" "pub/gnu/xemacs/packages") ("doc.ic.ac.uk" "sunsite.doc.ic.ac.uk" "packages/xemacs/packages") ("srcc.msu.su" "ftp1.srcc.msu.su" "mirror/ftp.xemacs.org/packages") ("usyd.edu.au" "ftp.usyd.edu.au" "pub/Xemacs/packages") ("netlab.is.tsukuba.ac.jp" "ftp.netlab.is.tsukuba.ac.jp" "pub/GNU/xemacs/packages") ("jaist.ac.jp" "ftp.jaist.ac.jp" "pub/GNU/xemacs/packages") ("ring.aist.go.jp" "ring.aist.go.jp" "pub/text/xemacs/packages") ("ring.asahi-net.or.jp" "ring.asahi-net.or.jp" "pub/text/xemacs/packages") ("SunSITE.sut.ac.jp" "SunSITE.sut.ac.jp" "pub/archives/packages/xemacs/packages") ("dti.ad.jp" "ftp.dti.ad.jp" "pub/unix/editor/xemacs/packages") ("kreonet.re.kr" "ftp.kreonet.re.kr" "pub/tools/emacs/xemacs/packages")) "*List of remote sites available for downloading packages.\nList format is '(site-description site-name directory-on-site).\nSITE-DESCRIPTION is a textual description of the site. SITE-NAME\nis the internet address of the download site. DIRECTORY-ON-SITE\nis the directory on the site in which packages may be found.\nThis variable is used to initialize `package-get-remote', the\nvariable actually used to specify package download sites." :tag "Package download sites" :type '(repeat (list hostname directory)) :group 'package-get) + (autoload 'package-get-download-menu "package-get" "\ Build the `Add Download Site' menu." nil nil) @@ -1474,29 +1540,38 @@ ;;;*** -;;;### (autoloads (clear-rectangle string-rectangle open-rectangle insert-rectangle yank-rectangle kill-rectangle extract-rectangle delete-extract-rectangle delete-rectangle) "rect" "lisp/rect.el") +;;;### (autoloads (clear-rectangle string-rectangle open-rectangle insert-rectangle yank-rectangle extract-rectangle delete-extract-rectangle delete-rectangle kill-rectangle) "rect" "lisp/rect.el") + +(defvar killed-rectangle nil "\ +Rectangle for `yank-rectangle' to insert.") + +(autoload 'kill-rectangle "rect" "\ +Delete the region-rectangle and save it as the last killed one. +You might prefer to use `delete-extract-rectangle' from a program. + +When called from a program, the rectangle's corners are START and END. +With a prefix (or FILL) argument, also fill lines where nothing has to be +deleted." t nil) (autoload 'delete-rectangle "rect" "\ -Delete (don't save) text in rectangle with point and mark as corners. +Delete the text in the region-rectangle without saving it. The same range of columns is deleted in each line starting with the line -where the region begins and ending with the line where the region ends." t nil) +where the region begins and ending with the line where the region ends. + +When called from a program, the rectangle's corners are START and END. +With a prefix (or FILL) argument, also fill lines where nothing has to be +deleted." t nil) (autoload 'delete-extract-rectangle "rect" "\ -Delete contents of rectangle and return it as a list of strings. -Arguments START and END are the corners of the rectangle. -The value is list of strings, one for each line of the rectangle." nil nil) +Delete the contents of the rectangle with corners at START and END, and +return it as a list of strings, one for each line of the rectangle. + +With an optional FILL argument, also fill lines where nothing has to be +deleted." nil nil) (autoload 'extract-rectangle "rect" "\ -Return contents of rectangle with corners at START and END. -Value is list of strings, one for each line of the rectangle." nil nil) - -(defvar killed-rectangle nil "\ -Rectangle for yank-rectangle to insert.") - -(autoload 'kill-rectangle "rect" "\ -Delete rectangle with corners at point and mark; save as last killed one. -Calling from program, supply two args START and END, buffer positions. -But in programs you might prefer to use `delete-extract-rectangle'." t nil) +Return the contents of the rectangle with corners at START and END, +as a list of strings, one for each line of the rectangle." nil nil) (autoload 'yank-rectangle "rect" "\ Yank the last killed rectangle with upper left corner at point." t nil) @@ -1510,21 +1585,26 @@ and point is at the lower right corner." nil nil) (autoload 'open-rectangle "rect" "\ -Blank out rectangle with corners at point and mark, shifting text right. -The text previously in the region is not overwritten by the blanks, -but instead winds up to the right of the rectangle." t nil) +Blank out the region-rectangle, shifting text right. + +When called from a program, the rectangle's corners are START and END. +With a prefix (or FILL) argument, fill with blanks even if there is no text +on the right side of the rectangle." t nil) (autoload 'string-rectangle "rect" "\ Insert STRING on each line of the region-rectangle, shifting text right. -The left edge of the rectangle specifies the column for insertion. -This command does not delete or overwrite any existing text. +The left edge of the rectangle specifies the column for insertion. This +command does not delete or overwrite any existing text. -Called from a program, takes three args; START, END and STRING." t nil) +When called from a program, the rectangle's corners are START and END." t nil) (autoload 'clear-rectangle "rect" "\ -Blank out rectangle with corners at point and mark. -The text previously in the region is overwritten by the blanks. -When called from a program, requires two args which specify the corners." t nil) +Blank out the region-rectangle. +The text previously in the region is overwritten with blanks. + +When called from a program, the rectangle's corners are START and END. +With a prefix (or FILL) argument, also fill with blanks the parts of the +rectangle which were empty." t nil) ;;;*** @@ -1615,7 +1695,7 @@ ;;;*** -;;;### (autoloads (auto-view-mode view-major-mode view-mode view-minor-mode view-buffer-other-window view-file-other-window view-buffer view-file) "view-less" "lisp/view-less.el") +;;;### (autoloads (toggle-truncate-lines auto-view-mode view-major-mode view-mode view-minor-mode view-buffer-other-window view-file-other-window view-buffer view-file) "view-less" "lisp/view-less.el") (defvar view-minor-mode-map (let ((map (make-keymap))) (set-keymap-name map 'view-minor-mode-map) (suppress-keymap map) (define-key map "-" 'negative-argument) (define-key map " " 'scroll-up) (define-key map "f" 'scroll-up) (define-key map "b" 'scroll-down) (define-key map 'backspace 'scroll-down) (define-key map 'delete 'scroll-down) (define-key map " " 'view-scroll-lines-up) (define-key map "\n" 'view-scroll-lines-up) (define-key map "e" 'view-scroll-lines-up) (define-key map "j" 'view-scroll-lines-up) (define-key map "y" 'view-scroll-lines-down) (define-key map "k" 'view-scroll-lines-down) (define-key map "d" 'view-scroll-some-lines-up) (define-key map "u" 'view-scroll-some-lines-down) (define-key map "r" 'recenter) (define-key map "t" 'toggle-truncate-lines) (define-key map "N" 'view-buffer) (define-key map "E" 'view-file) (define-key map "P" 'view-buffer) (define-key map "!" 'shell-command) (define-key map "|" 'shell-command-on-region) (define-key map "=" 'what-line) (define-key map "?" 'view-search-backward) (define-key map "h" 'view-mode-describe) (define-key map "s" 'view-repeat-search) (define-key map "n" 'view-repeat-search) (define-key map "/" 'view-search-forward) (define-key map "\\" 'view-search-backward) (define-key map "g" 'view-goto-line) (define-key map "G" 'view-last-windowful) (define-key map "%" 'view-goto-percent) (define-key map "p" 'view-goto-percent) (define-key map "m" 'point-to-register) (define-key map "'" 'register-to-point) (define-key map "C" 'view-cleanup-backspaces) (define-key map "" 'view-quit) (define-key map "" 'view-quit-toggle-ro) (define-key map "q" 'view-quit) map)) @@ -1681,6 +1761,10 @@ If the file of the current buffer is not writable, call view-mode. This is meant to be added to `find-file-hooks'." nil nil) +(autoload 'toggle-truncate-lines "view-less" "\ +Toggles the values of truncate-lines. +Positive prefix arg sets, negative disables." t nil) + ;;;*** ;;;### (autoloads (widget-minor-mode widget-browse-other-window widget-browse widget-browse-at) "wid-browse" "lisp/wid-browse.el") @@ -1715,15 +1799,9 @@ ;;;*** -;;;### (autoloads (font-menu-weight-constructor font-menu-size-constructor font-menu-family-constructor reset-device-font-menus) "x-font-menu" "lisp/x-font-menu.el") - -(defcustom font-menu-ignore-scaled-fonts t "*If non-nil, then the font menu will try to show only bitmap fonts." :type 'boolean :group 'x) +;;;### (autoloads (x-reset-device-font-menus) "x-font-menu" "lisp/x-font-menu.el") -(defcustom font-menu-this-frame-only-p nil "*If non-nil, then changing the default font from the font menu will only\naffect one frame instead of all frames." :type 'boolean :group 'x) - -(fset 'install-font-menus 'reset-device-font-menus) - -(autoload 'reset-device-font-menus "x-font-menu" "\ +(autoload 'x-reset-device-font-menus "x-font-menu" "\ Generates the `Font', `Size', and `Weight' submenus for the Options menu. This is run the first time that a font-menu is needed for each device. If you don't like the lazy invocation of this function, you can add it to @@ -1731,11 +1809,7 @@ when they are selected for the first time. If you add fonts to your system, or if you change your font path, you can call this to re-initialize the menus." nil nil) -(autoload 'font-menu-family-constructor "x-font-menu" nil nil nil) - -(autoload 'font-menu-size-constructor "x-font-menu" nil nil nil) - -(autoload 'font-menu-weight-constructor "x-font-menu" nil nil nil) +(defun* x-font-menu-font-data (face dcache) (let* ((case-fold-search t) (domain (if font-menu-this-frame-only-p (selected-frame) (selected-device))) (name (font-instance-name (face-font-instance face domain))) (truename (font-instance-truename (face-font-instance face domain (if (featurep 'mule) 'ascii)))) family size weight entry slant) (when (string-match x-font-regexp-foundry-and-family name) (setq family (capitalize (match-string 1 name))) (setq entry (vassoc family (aref dcache 0)))) (when (and (null entry) (string-match x-font-regexp-foundry-and-family truename)) (setq family (capitalize (match-string 1 truename))) (setq entry (vassoc family (aref dcache 0)))) (when (null entry) (return-from x-font-menu-font-data (make-vector 5 nil))) (when (string-match x-font-regexp name) (setq weight (capitalize (match-string 1 name))) (setq size (string-to-int (match-string 6 name)))) (when (string-match x-font-regexp truename) (when (not (member weight (aref entry 1))) (setq weight (capitalize (match-string 1 truename)))) (when (not (member size (aref entry 2))) (setq size (string-to-int (match-string 6 truename)))) (setq slant (capitalize (match-string 2 truename)))) (vector entry family size weight slant))) ;;;*** diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/auto-save.el --- a/lisp/auto-save.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/auto-save.el Mon Aug 13 11:13:30 2007 +0200 @@ -79,7 +79,7 @@ ;;; Acknowledgement: ;; This code is loosely derived from autosave-in-tmp.el by Jamie -;; Zawinski (the version I had was last modified 22 +;; Zawinski (the version I had was last modified 22 ;; dec 90 jwz) and code submitted to ange-ftp-lovers on Sun, 5 Apr ;; 92 23:20:47 EDT by drw@BOURBAKI.MIT.EDU (Dale R. Worley). ;; auto-save.el tries to cover the functionality of those two @@ -373,7 +373,7 @@ ;; save file in the same directory as FILENAME. But if this ;; directory is not writable, use auto-save-directory-fallback. ;; FILENAME is assumed to be in non-directory form (no trailing slash). - ;; It may be a name without a directory part (pesumably it really + ;; It may be a name without a directory part (presumably it really ;; comes from a buffer name then), the fallback is used then. ;; Optional PREFIX is string to use instead of "#" to prefix name. (let ((directory (file-name-directory filename))) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/auto-show.el --- a/lisp/auto-show.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/auto-show.el Mon Aug 13 11:13:30 2007 +0200 @@ -92,17 +92,6 @@ :type 'number :group 'auto-show) -(defun auto-show-truncationp () - "True if line truncation is enabled for the selected window." - ;; XEmacs change (use specifiers) - ;; ### There should be a more straightforward way to do this from elisp. - (or truncate-lines - (and truncate-partial-width-windows - (< (+ (window-width) - (specifier-instance left-margin-width) - (specifier-instance right-margin-width)) - (frame-width))))) - (defun auto-show-mode (arg) "Turn automatic horizontal scroll mode on or off. With arg, turn auto scrolling on if arg is positive, off otherwise. @@ -128,7 +117,7 @@ ;; XEmacs addition: (defun auto-show-should-take-action-p () - (and auto-show-mode (auto-show-truncationp) + (and auto-show-mode (window-truncated-p) (equal (window-buffer) (current-buffer)) (not (memq this-command auto-show-inhibiting-commands)))) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/autoload.el --- a/lisp/autoload.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/autoload.el Mon Aug 13 11:13:30 2007 +0200 @@ -359,7 +359,7 @@ (defun update-file-autoloads (file) "Update the autoloads for FILE in `generated-autoload-file' \(which FILE might bind in its local variables). -This functions refuses to update autoloads files." +This function refuses to update autoloads files." (interactive "fUpdate autoloads for file: ") (setq file (expand-file-name file)) (when (and (file-newer-than-file-p file generated-autoload-file) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/backquote.el --- a/lisp/backquote.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/backquote.el Mon Aug 13 11:13:30 2007 +0200 @@ -44,7 +44,7 @@ ;; (b) ",.foo" is the same as ". ,foo" ;; (c) because RMS isn't interested in using this version of backquote.el ;; -;; wing@666.com; added ,. support back in: +;; ben@xemacs.org added ,. support back in: ;; (a) yes, it is in CLtl2. Read closely on page 529. ;; (b) RMS in 19.30 adds C support for ,. even if it's not really ;; handled. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/build-report.el --- a/lisp/build-report.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/build-report.el Mon Aug 13 11:13:30 2007 +0200 @@ -2,8 +2,8 @@ ;; Copyright (C) 1997 Adrian Aichner -;; Author: Adrian Aichner, Teradyne GmbH Munich -;; Date: Sun., Apr. 20, 1997. +;; Author: Adrian Aichner +;; Date: Sun., Apr. 20, 1997, 1998, 1999. ;; Version: 1.35 ;; Keywords: internal diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/byte-optimize.el --- a/lisp/byte-optimize.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/byte-optimize.el Mon Aug 13 11:13:30 2007 +0200 @@ -2,7 +2,7 @@ ;;; Copyright (c) 1991, 1994 Free Software Foundation, Inc. -;; Author: Jamie Zawinski +;; Author: Jamie Zawinski ;; Hallvard Furuseth ;; Keywords: internal @@ -19,7 +19,7 @@ ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the +;; 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. @@ -32,7 +32,7 @@ ;; You can, however, make a faster pig." ;; ;; Or, to put it another way, the emacs byte compiler is a VW Bug. This code -;; makes it be a VW Bug with fuel injection and a turbocharger... You're +;; makes it be a VW Bug with fuel injection and a turbocharger... You're ;; still not going to make it go faster than 70 mph, but it might be easier ;; to get it there. ;; @@ -64,17 +64,17 @@ ;; Simple defsubsts often produce forms like ;; (let ((v1 (f1)) (v2 (f2)) ...) ;; (FN v1 v2 ...)) -;; It would be nice if we could optimize this to +;; It would be nice if we could optimize this to ;; (FN (f1) (f2) ...) ;; but we can't unless FN is dynamically-safe (it might be dynamically ;; referring to the bindings that the lambda arglist established.) ;; One of the uncountable lossages introduced by dynamic scope... ;; -;; Maybe there should be a control-structure that says "turn on +;; Maybe there should be a control-structure that says "turn on ;; fast-and-loose type-assumptive optimizations here." Then when ;; we see a form like (car foo) we can from then on assume that ;; the variable foo is of type cons, and optimize based on that. -;; But, this won't win much because of (you guessed it) dynamic +;; But, this won't win much because of (you guessed it) dynamic ;; scope. Anything down the stack could change the value. ;; (Another reason it doesn't work is that it is perfectly valid ;; to call car with a null argument.) A better approach might @@ -109,7 +109,7 @@ ;; ;; However, if there was even a single let-binding around the COND, ;; it could not be byte-compiled, because there would be an "unbind" -;; byte-op between the final "call" and "return." Adding a +;; byte-op between the final "call" and "return." Adding a ;; Bunbind_all byteop would fix this. ;; ;; (defun foo (x y z) ... (foo a b c)) @@ -131,8 +131,8 @@ ;; ;; Wouldn't it be nice if Emacs Lisp had lexical scope. ;; -;; Idea: the form (lexical-scope) in a file means that the file may be -;; compiled lexically. This proclamation is file-local. Then, within +;; Idea: the form (lexical-scope) in a file means that the file may be +;; compiled lexically. This proclamation is file-local. Then, within ;; that file, "let" would establish lexical bindings, and "let-dynamic" ;; would do things the old way. (Or we could use CL "declare" forms.) ;; We'd have to notice defvars and defconsts, since those variables should @@ -142,17 +142,17 @@ ;; in the file being compiled (doing a boundp check isn't good enough.) ;; Fdefvar() would have to be modified to add something to the plist. ;; -;; A major disadvantage of this scheme is that the interpreter and compiler -;; would have different semantics for files compiled with (dynamic-scope). +;; A major disadvantage of this scheme is that the interpreter and compiler +;; would have different semantics for files compiled with (dynamic-scope). ;; Since this would be a file-local optimization, there would be no way to -;; modify the interpreter to obey this (unless the loader was hacked +;; modify the interpreter to obey this (unless the loader was hacked ;; in some grody way, but that's a really bad idea.) ;; ;; HA! RMS removed the following paragraph from his version of ;; byte-optimize.el. ;; ;; Really the Right Thing is to make lexical scope the default across -;; the board, in the interpreter and compiler, and just FIX all of +;; the board, in the interpreter and compiler, and just FIX all of ;; the code that relies on dynamic scope of non-defvarred variables. ;; Other things to consider: @@ -166,7 +166,7 @@ ;; error free also they may act as true-constants. ;;(disassemble #'(lambda (x) (and (point) (foo)))) -;; When +;; When ;; - all but one arguments to a function are constant ;; - the non-constant argument is an if-expression (cond-expression?) ;; then the outer function can be distributed. If the guarding @@ -295,7 +295,7 @@ (cons fn (cdr form))))))) ;;; ((lambda ...) ...) -;;; +;;; (defun byte-compile-unfold-lambda (form &optional name) (or name (setq name "anonymous lambda")) (let ((lambda (car form)) @@ -350,7 +350,7 @@ (byte-compile-warn "attempt to open-code %s with too many arguments" name)) form) - (let ((newform + (let ((newform (if bindings (cons 'let (cons (nreverse bindings) body)) (cons 'progn body)))) @@ -435,28 +435,28 @@ (cons (byte-optimize-form (nth 1 form) t) (cons (byte-optimize-form (nth 2 form) for-effect) (byte-optimize-body (cdr (cdr (cdr form))) t))))) - + ((memq fn '(save-excursion save-restriction save-current-buffer)) ;; those subrs which have an implicit progn; it's not quite good ;; enough to treat these like normal function calls. ;; This can turn (save-excursion ...) into (save-excursion) which ;; will be optimized away in the lap-optimize pass. (cons fn (byte-optimize-body (cdr form) for-effect))) - + ((eq fn 'with-output-to-temp-buffer) ;; this is just like the above, except for the first argument. (cons fn (cons (byte-optimize-form (nth 1 form) nil) (byte-optimize-body (cdr (cdr form)) for-effect)))) - + ((eq fn 'if) (cons fn (cons (byte-optimize-form (nth 1 form) nil) (cons (byte-optimize-form (nth 2 form) for-effect) (byte-optimize-body (nthcdr 3 form) for-effect))))) - + ((memq fn '(and or)) ; remember, and/or are control structures. ;; take forms off the back until we can't any more. ;; In the future it could conceivably be a problem that the @@ -480,7 +480,7 @@ (byte-compile-warn "misplaced interactive spec: %s" (prin1-to-string form)) nil) - + ((memq fn '(defun defmacro function condition-case save-window-excursion)) ;; These forms are compiled as constants or by breaking out @@ -496,7 +496,7 @@ (cons fn (cons (byte-optimize-form (nth 1 form) for-effect) (cdr (cdr form))))) - + ((eq fn 'catch) ;; the body of a catch is compiled (and thus optimized) as a ;; top-level form, so don't do it here. The tag is never @@ -514,7 +514,7 @@ (setq form (macroexpand form byte-compile-macro-environment)))) (byte-optimize-form form for-effect)) - + ((not (symbolp fn)) (or (eq 'mocklisp (car-safe fn)) ; ha! (byte-compile-warn "%s is a malformed function" @@ -532,7 +532,7 @@ ;; appending a nil here might not be necessary, but it can't hurt. (byte-optimize-form (cons 'progn (append (cdr form) '(nil))) t)) - + (t ;; Otherwise, no args can be considered to be for-effect, ;; even if the called function is for-effect, because we @@ -602,7 +602,7 @@ ((keywordp ,form)))) ;; If the function is being called with constant numeric args, -;; evaluate as much as possible at compile-time. This optimizer +;; evaluate as much as possible at compile-time. This optimizer ;; assumes that the function is associative, like + or *. (defun byte-optimize-associative-math (form) (let ((args nil) @@ -699,31 +699,27 @@ (setq form (byte-optimize-delay-constants-math form 1 '+)) (if (memq 0 form) (setq form (delq 0 (copy-sequence form)))) ;;(setq form (byte-optimize-associative-two-args-math form)) - (cond ((null (cdr form)) - (condition-case () - (eval form) - (error form))) + (case (length (cdr form)) + ((0) + (condition-case () + (eval form) + (error form))) - ;; `add1' and `sub1' are a marginally fewer instructions - ;; than `plus' and `minus', so use them when possible. - ((and (null (nthcdr 3 form)) - (eq (nth 2 form) 1)) - (list '1+ (nth 1 form))) ; (+ x 1) --> (1+ x) - ((and (null (nthcdr 3 form)) - (eq (nth 1 form) 1)) - (list '1+ (nth 2 form))) ; (+ 1 x) --> (1+ x) - ((and (null (nthcdr 3 form)) - (eq (nth 2 form) -1)) - (list '1- (nth 1 form))) ; (+ x -1) --> (1- x) - ((and (null (nthcdr 3 form)) - (eq (nth 1 form) -1)) - (list '1- (nth 2 form))) ; (+ -1 x) --> (1- x) + ;; `add1' and `sub1' are a marginally fewer instructions + ;; than `plus' and `minus', so use them when possible. + ((2) + (cond + ((eq (nth 1 form) 1) `(1+ ,(nth 2 form))) ; (+ 1 x) --> (1+ x) + ((eq (nth 2 form) 1) `(1+ ,(nth 1 form))) ; (+ x 1) --> (1+ x) + ((eq (nth 1 form) -1) `(1- ,(nth 2 form))) ; (+ -1 x) --> (1- x) + ((eq (nth 2 form) -1) `(1- ,(nth 1 form))) ; (+ x -1) --> (1- x) + (t form))) -;;; It is not safe to delete the function entirely -;;; (actually, it would be safe if we know the sole arg -;;; is not a marker). -;; ((null (cdr (cdr form))) (nth 1 form)) - (t form))) + ;; It is not safe to delete the function entirely + ;; (actually, it would be safe if we know the sole arg + ;; is not a marker). + ;; ((null (cdr (cdr form))) (nth 1 form)) + (t form))) (defun byte-optimize-minus (form) ;; Put constants at the end, except the last constant. @@ -784,9 +780,6 @@ (setcar form (list '+ (car form) (car form))))) (form)))))) -(defsubst byte-compile-butlast (form) - (nreverse (cdr (reverse form)))) - (defun byte-optimize-divide (form) (setq form (byte-optimize-delay-constants-math form 2 '*)) (let ((last (car (reverse (cdr (cdr form)))))) @@ -799,20 +792,20 @@ (error nil))) (setq form (list 'progn (/ (nth 1 form) last))))) ((= last 1) - (setq form (byte-compile-butlast form))) + (setq form (butlast form))) ((numberp (nth 1 form)) (setq form (cons (car form) (cons (/ (nth 1 form) last) - (byte-compile-butlast (cdr (cdr form))))) + (butlast (cdr (cdr form))))) last nil)))) - (cond + (cond ;;; ((null (cdr (cdr form))) ;;; (nth 1 form)) ((eq (nth 1 form) 0) (append '(progn) (cdr (cdr form)) '(0))) ((eq last -1) (list '- (if (nthcdr 3 form) - (byte-compile-butlast form) + (butlast form) (nth 1 form)))) (form)))) @@ -890,6 +883,7 @@ (put 'stringp 'byte-optimizer 'byte-optimize-predicate) (put 'string< 'byte-optimizer 'byte-optimize-predicate) (put 'string-lessp 'byte-optimizer 'byte-optimize-predicate) +(put 'length 'byte-optimizer 'byte-optimize-predicate) (put 'logand 'byte-optimizer 'byte-optimize-logmumble) (put 'logior 'byte-optimizer 'byte-optimize-logmumble) @@ -902,7 +896,7 @@ (put 'cdr-safe 'byte-optimizer 'byte-optimize-predicate) -;; I'm not convinced that this is necessary. Doesn't the optimizer loop +;; I'm not convinced that this is necessary. Doesn't the optimizer loop ;; take care of this? - Jamie ;; I think this may some times be necessary to reduce eg. (quote 5) to 5, ;; so arithmetic optimizers recognize the numeric constant. - Hallvard @@ -1033,6 +1027,12 @@ (put 'if 'byte-optimizer 'byte-optimize-if) (put 'while 'byte-optimizer 'byte-optimize-while) +;; Remove any reason for avoiding `char-before'. +(defun byte-optimize-char-before (form) + `(char-after (1- ,(or (nth 1 form) '(point))) ,@(cdr (cdr form)))) + +(put 'char-before 'byte-optimizer 'byte-optimize-char-before) + ;; byte-compile-negation-optimizer lives in bytecomp.el ;(put '/= 'byte-optimizer 'byte-compile-negation-optimizer) (put 'atom 'byte-optimizer 'byte-compile-negation-optimizer) @@ -1103,7 +1103,7 @@ (setq form (list 'cdr form))) form))) -;;; enumerating those functions which need not be called if the returned +;;; enumerating those functions which need not be called if the returned ;;; value is not used. That is, something like ;;; (progn (list (something-with-side-effects) (yow)) ;;; (foo)) @@ -1141,7 +1141,7 @@ length log log10 logand logb logior lognot logxor lsh marker-buffer max member memq min mod next-window nth nthcdr number-to-string - parse-colon-path previous-window + parse-colon-path plist-get previous-window radians-to-degrees rassq regexp-quote reverse round sin sqrt string< string= string-equal string-lessp string-to-char string-to-int string-to-number substring symbol-plist @@ -1155,7 +1155,7 @@ abs expt signum last butlast ldiff pairlis gcd lcm isqrt floor* ceiling* truncate* round* mod* rem* subseq - list-length get* getf + list-length getf )) (side-effect-and-error-free-fns '(arrayp atom @@ -1381,7 +1381,7 @@ byte-current-buffer byte-interactive-p)) (defconst byte-compile-side-effect-free-ops - (nconc + (nconc '(byte-varref byte-nth byte-memq byte-car byte-cdr byte-length byte-aref byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1 byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate @@ -1413,7 +1413,7 @@ ;;; varbind pop-up-windows ;;; not ;;; -;;; we break the program, because it will appear that pop-up-windows and +;;; we break the program, because it will appear that pop-up-windows and ;;; old-pop-ups are not EQ when really they are. So we have to know what ;;; the BOOL variables are, and not perform this optimization on them. ;;; @@ -1593,7 +1593,7 @@ ;; goto-X-if-non-nil goto-Y X: --> goto-Y-if-nil X: ;; ;; it is wrong to do the same thing for the -else-pop variants. - ;; + ;; ((and (or (eq 'byte-goto-if-nil (car lap0)) (eq 'byte-goto-if-not-nil (car lap0))) ; gotoX (eq 'byte-goto (car lap1)) ; gotoY @@ -1696,7 +1696,7 @@ str (concat str " %s") i (1+ i)))) (if opt-p - (let ((tagstr + (let ((tagstr (if (eq 'TAG (car (car tmp))) (format "%d:" (car (cdr (car tmp)))) (or (car tmp) "")))) @@ -1878,7 +1878,7 @@ (byte-goto-if-not-nil-else-pop . byte-goto-if-nil-else-pop)))) newtag) - + (nth 1 newtag) ) (setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp))) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/bytecomp-runtime.el --- a/lisp/bytecomp-runtime.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/bytecomp-runtime.el Mon Aug 13 11:13:30 2007 +0200 @@ -2,7 +2,7 @@ ;; Copyright (C) 1992, 1997 Free Software Foundation, Inc. -;; Author: Jamie Zawinski +;; Author: Jamie Zawinski ;; Author: Hallvard Furuseth ;; Maintainer: XEmacs Development Team ;; Keywords: internal, dumped diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/bytecomp.el --- a/lisp/bytecomp.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/bytecomp.el Mon Aug 13 11:13:30 2007 +0200 @@ -3,7 +3,7 @@ ;;; Copyright (C) 1985-1987, 1991-1994 Free Software Foundation, Inc. ;;; Copyright (C) 1996 Ben Wing. -;; Author: Jamie Zawinski +;; Author: Jamie Zawinski ;; Hallvard Furuseth ;; Keywords: internal @@ -432,7 +432,6 @@ (defvar byte-compile-free-references) (defvar byte-compile-free-assignments) -(defvar debug-issue-ebola-notices) (defvar byte-compiler-error-flag) @@ -1298,11 +1297,7 @@ (byte-compile-warnings (if (eq byte-compile-warnings t) byte-compile-default-warnings byte-compile-warnings)) - (byte-compile-file-domain nil) - - ;; We reserve the right to compare ANY objects for equality. - (debug-issue-ebola-notices -42) - ) + (byte-compile-file-domain nil)) (prog1 (progn ,@body) (if (memq 'unused-vars byte-compile-warnings) @@ -1527,11 +1522,7 @@ (unless byte-compile-overwrite-file (ignore-file-errors (delete-file target-file))) (if (file-writable-p target-file) - (progn - (when (memq system-type '(ms-dos windows-nt)) - (defvar buffer-file-type) - (setq buffer-file-type t)) - (write-region 1 (point-max) target-file)) + (write-region 1 (point-max) target-file) ;; This is just to give a better error message than write-region (signal 'file-error (list "Opening output file" @@ -1752,18 +1743,19 @@ ;; file if under Mule. If there are any extended characters in the ;; input file, use `escape-quoted' to make sure that both binary and ;; extended characters are output properly and distinguished properly. - ;; Otherwise, use `no-conversion' for maximum portability with non-Mule + ;; Otherwise, use `raw-text' for maximum portability with non-Mule ;; Emacsen. - (when (featurep 'mule) + (when (featurep '(or mule file-coding)) (defvar buffer-file-coding-system) - (if (save-excursion - (set-buffer byte-compile-inbuffer) - (goto-char (point-min)) - ;; mrb- There must be a better way than skip-chars-forward - (skip-chars-forward (concat (char-to-string 0) "-" - (char-to-string 255))) - (eq (point) (point-max))) - (setq buffer-file-coding-system 'no-conversion) + (if (or (featurep '(not mule)) ;; Don't scan buffer if we are not muleized + (save-excursion + (set-buffer byte-compile-inbuffer) + (goto-char (point-min)) + ;; mrb- There must be a better way than skip-chars-forward + (skip-chars-forward (concat (char-to-string 0) "-" + (char-to-string 255))) + (eq (point) (point-max)))) + (setq buffer-file-coding-system 'raw-text-unix) (insert "(require 'mule)\n;;;###coding system: escape-quoted\n") (setq buffer-file-coding-system 'escape-quoted) ;; #### Lazy loading not yet implemented for MULE files @@ -1972,7 +1964,7 @@ (while (if (setq form (cdr form)) (byte-compile-constp (car form)))) (null form))) - ;; eval the macro autoload into the compilation enviroment + ;; eval the macro autoload into the compilation environment (eval form)) (if name diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/check-features.el --- a/lisp/check-features.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/check-features.el Mon Aug 13 11:13:30 2007 +0200 @@ -2,7 +2,7 @@ ;; Copyright (C) 1998 by Free Software Foundation, Inc. -;; Author: SL Baur +;; Author: SL Baur ;; Keywords: internal ;; This file is part of XEmacs. @@ -39,8 +39,8 @@ (condition-case nil (package-require 'tooltalk 1.0) (t (progn - (setq build-error 1) - (message "Error: This XEmacs is built with tooltalk support but") + ;; (setq build-error 1) + (message "Warning: This XEmacs is built with tooltalk support but") (message "does not have a tooltalk package installed. Without the") (message "tooltalk lisp package, Tooltalk support is broken."))))) @@ -48,8 +48,8 @@ (condition-case nil (package-require 'Sun 1.0) (t (progn - (setq build-error 1) - (message "Error: This XEmacs is built with sparcworks support but") + ;; (setq build-error 1) + (message "Warning: This XEmacs is built with sparcworks support but") (message "does not have the Sun package installed. Without the Sun") (message "lisp package, Sparcworks support will be broken."))))) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/cl-extra.el --- a/lisp/cl-extra.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/cl-extra.el Mon Aug 13 11:13:30 2007 +0200 @@ -76,6 +76,8 @@ ((eq type 'array) (if (arrayp x) x (vconcat x))) ((and (eq type 'character) (stringp x) (= (length x) 1)) (aref x 0)) ((and (eq type 'character) (symbolp x)) (coerce (symbol-name x) type)) + ((and (eq type 'character) (numberp x) (char-or-char-int-p x) + (int-char x))) ((eq type 'float) (float x)) ((eq type 'bit-vector) (if (bit-vector-p x) x (apply 'bit-vector (append x nil)))) @@ -108,7 +110,8 @@ (and (numberp y) (= x y))) ((consp x) ;; XEmacs change - (while (and (consp x) (consp y) (equalp (cl-pop x) (cl-pop y)))) + (while (and (consp x) (consp y) (equalp (car x) (car y))) + (cl-pop x) (cl-pop y)) (and (not (consp x)) (equalp x y))) ((vectorp x) (and (vectorp y) (= (length x) (length y)) @@ -180,16 +183,14 @@ (nreverse cl-res)))) -;; mapc is now in C, renamed from `mapc-internal'. - -;(defun mapc (cl-func cl-seq &rest cl-rest) -; "Like `mapcar', but does not accumulate values returned by the function." -; (if cl-rest -; (apply 'map nil cl-func cl-seq cl-rest) -; ;; XEmacs change: we call mapc-internal, which really doesn't -; ;; accumulate any results. -; (mapc-internal cl-func cl-seq)) -; cl-seq) +(defun mapc (cl-func cl-seq &rest cl-rest) + "Like `mapcar', but does not accumulate values returned by the function." + (if cl-rest + (apply 'map nil cl-func cl-seq cl-rest) + ;; XEmacs change: in the simplest case we call mapc-internal, + ;; which really doesn't accumulate any results. + (mapc-internal cl-func cl-seq)) + cl-seq) (defun mapl (cl-func cl-list &rest cl-rest) "Like `maplist', but does not accumulate values returned by the function." @@ -637,13 +638,7 @@ ;; XEmacs: our `get' groks DEFAULT. (defalias 'get* 'get) - -(defun getf (plist tag &optional def) - "Search PROPLIST for property PROPNAME; return its value or DEFAULT. -PROPLIST is a list of the sort returned by `symbol-plist'." - (setplist '--cl-getf-symbol-- plist) - (or (get '--cl-getf-symbol-- tag) - (and def (get* '--cl-getf-symbol-- tag def)))) +(defalias 'getf 'plist-get) (defun cl-set-getf (plist tag val) (let ((p plist)) @@ -655,29 +650,18 @@ (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p)))) (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) -(defun cl-remprop (sym tag) - "Remove from SYMBOL's plist the property PROP and its value." - (let ((plist (symbol-plist sym))) - (if (and plist (eq tag (car plist))) - (progn (setplist sym (cdr (cdr plist))) t) - (cl-do-remf plist tag)))) -(or (and (fboundp 'remprop) (subrp (symbol-function 'remprop))) - (defalias 'remprop 'cl-remprop)) - - - ;;; Hash tables. ;; The `regular' Common Lisp hash-table stuff has been moved into C. ;; Only backward compatibility stuff remains here. (defun make-hashtable (size &optional test) - (make-hash-table :size size :test test :type 'non-weak)) + (make-hash-table :test test :size size)) (defun make-weak-hashtable (size &optional test) - (make-hash-table :size size :test test :type 'weak)) + (make-hash-table :test test :size size :weakness t)) (defun make-key-weak-hashtable (size &optional test) - (make-hash-table :size size :test test :type 'key-weak)) + (make-hash-table :test test :size size :weakness 'key)) (defun make-value-weak-hashtable (size &optional test) - (make-hash-table :size size :test test :type 'value-weak)) + (make-hash-table :test test :size size :weakness 'value)) (define-obsolete-function-alias 'hashtablep 'hash-table-p) (define-obsolete-function-alias 'hashtable-fullness 'hash-table-count) @@ -690,6 +674,7 @@ (make-obsolete 'make-weak-hashtable 'make-hash-table) (make-obsolete 'make-key-weak-hashtable 'make-hash-table) (make-obsolete 'make-value-weak-hashtable 'make-hash-table) +(make-obsolete 'hash-table-type 'hash-table-weakness) (when (fboundp 'x-keysym-hash-table) (make-obsolete 'x-keysym-hashtable 'x-keysym-hash-table)) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/cl-macs.el --- a/lisp/cl-macs.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/cl-macs.el Mon Aug 13 11:13:30 2007 +0200 @@ -1647,12 +1647,12 @@ (defsetf extent-priority set-extent-priority) (defsetf extent-property (x y &optional ignored-arg) (arg) (list 'set-extent-property x y arg)) +(defsetf extent-start-position (ext) (store) + `(progn (set-extent-endpoints ,ext ,store (extent-end-position ,ext)) + ,store)) (defsetf extent-end-position (ext) (store) - (list 'progn (list 'set-extent-endpoints (list 'extent-start-position ext) - store) store)) -(defsetf extent-start-position (ext) (store) - (list 'progn (list 'set-extent-endpoints store - (list 'extent-end-position ext)) store)) + `(progn (set-extent-endpoints ,ext (extent-start-position ,ext) ,store) + ,store)) (defsetf face-background (f &optional s) (x) (list 'set-face-background f x s)) (defsetf face-background-pixmap (f &optional s) (x) (list 'set-face-background-pixmap f x s)) @@ -2744,10 +2744,11 @@ (setq form (list 'cons (car args) form))) form)) -(define-compiler-macro get* (sym prop &optional def) - (if def - (list 'getf (list 'symbol-plist sym) prop def) - (list 'get sym prop))) +(define-compiler-macro get* (sym prop &optional default) + (list 'get sym prop default)) + +(define-compiler-macro getf (sym prop &optional default) + (list 'plist-get sym prop default)) (define-compiler-macro typep (&whole form val type) (if (cl-const-expr-p type) @@ -2795,7 +2796,7 @@ ; abs expt signum last butlast ldiff ; pairlis gcd lcm ; isqrt floor* ceiling* truncate* round* mod* rem* subseq -; list-length get* getf)) +; list-length getf)) ; (put fun 'side-effect-free t)) ;;; Things that are side-effect-and-error-free. Moved to byte-optimize.el diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/cl.el --- a/lisp/cl.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/cl.el Mon Aug 13 11:13:30 2007 +0200 @@ -680,9 +680,9 @@ ;(load "cl-defs") ;;; Define data for indentation and edebug. -(mapc +(mapcar #'(lambda (entry) - (mapc + (mapcar #'(lambda (func) (put func 'lisp-indent-function (nth 1 entry)) (put func 'lisp-indent-hook (nth 1 entry)) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/cleantree.el --- a/lisp/cleantree.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/cleantree.el Mon Aug 13 11:13:30 2007 +0200 @@ -2,7 +2,7 @@ ;; Copyright (C) 1997 by Free Software Foundation, Inc. -;; Author: Steven L Baur +;; Author: Steven L Baur ;; Keywords: internal ;; This file is part of XEmacs. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/cmdloop.el --- a/lisp/cmdloop.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/cmdloop.el Mon Aug 13 11:13:30 2007 +0200 @@ -319,23 +319,36 @@ (if (and teach-extended-commands-p (interactive-p)) - ;; We need to fiddle with keys: remember the keys, run the - ;; command, and show the keys (if any). + ;; Remember the keys, run the command, and show the keys (if + ;; any). The funny variable names are a poor man's guarantee + ;; that we don't get tripped by this-command doing something + ;; funny. Quoth our forefathers: "We want lexical scope!" (let ((_execute_command_keys_ (where-is-internal this-command)) (_execute_command_name_ this-command)) ; the name can change (command-execute this-command t) - (when (and _execute_command_keys_ - ;; Wait for a while, so the user can see a message - ;; printed, if any. - (sit-for 1)) - (display-message - 'no-log - (format "Command `%s' is bound to key%s: %s" - _execute_command_name_ - (if (cdr _execute_command_keys_) "s" "") - (sorted-key-descriptions _execute_command_keys_))) - (sit-for teach-extended-commands-timeout) - (clear-message 'no-log))) + (when _execute_command_keys_ + ;; Normally the region is adjusted in post_command_hook; + ;; however, it is not called until after we finish. It + ;; looks ugly for the region to get updated after the + ;; delays, so we do it now. The code below is a Lispified + ;; copy of code in event-stream.c:post_command_hook(). + (if (and (not zmacs-region-stays) + (or (not (eq (selected-window) (minibuffer-window))) + (eq (zmacs-region-buffer) (current-buffer)))) + (zmacs-deactivate-region) + (zmacs-update-region)) + ;; Wait for a while, so the user can see a message printed, + ;; if any. + (when (sit-for 1) + (display-message + 'no-log + (format (if (cdr _execute_command_keys_) + "Command `%s' is bound to keys: %s" + "Command `%s' is bound to key: %s") + _execute_command_name_ + (sorted-key-descriptions _execute_command_keys_))) + (sit-for teach-extended-commands-timeout) + (clear-message 'no-log)))) ;; Else, just run the command. (command-execute this-command t))) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/code-files.el --- a/lisp/code-files.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/code-files.el Mon Aug 13 11:13:30 2007 +0200 @@ -6,8 +6,6 @@ ;; This file is part of XEmacs. -;; This file is very similar to mule-files.el - ;; XEmacs is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) @@ -23,16 +21,21 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Synched up with: Not synched. + ;;; Commentary: -;;; Derived from mule.el in the original Mule but heavily modified -;;; by Ben Wing. +;; Derived from mule.el in the original Mule but heavily modified +;; by Ben Wing. ;; 1997/3/11 modified by MORIOKA Tomohiko to sync with Emacs 20 API. +;; This file was derived from the former mule-files.el which has been removed +;; as of XEmacs 21.2.15. + ;;; Code: -(setq-default buffer-file-coding-system 'no-conversion) +(setq-default buffer-file-coding-system 'raw-text) (put 'buffer-file-coding-system 'permanent-local t) (define-obsolete-variable-alias @@ -271,7 +274,7 @@ (if (or (<= (length filename) 0) (null (setq path (locate-file filename load-path - (and (not nosuffix) ".elc:.el:"))))) + (and (not nosuffix) '(".elc" ".el" "")))))) (and (null noerror) (signal 'file-error (list "Cannot open load file" filename))) ;; now use the internal load to actually load the file. @@ -284,7 +287,7 @@ (save-excursion (set-buffer (get-buffer-create " *load*")) (erase-buffer) - (let ((coding-system-for-read 'no-conversion)) + (let ((coding-system-for-read 'raw-text)) (insert-file-contents path nil 1 3001)) (find-coding-system-magic-cookie)) (if elc @@ -371,9 +374,6 @@ the whole thing because (1) it preserves some marker positions and (2) it puts less data in the undo list. -NOTE: When Mule support is enabled, the REPLACE argument is -currently ignored. - The coding system used for decoding the file is determined as follows: 1. `coding-system-for-read', if non-nil. @@ -381,7 +381,7 @@ 3. The matching value for this filename from `file-coding-system-alist', if any. 4. `buffer-file-coding-system-for-read', if non-nil. -5. The coding system 'no-conversion. +5. The coding system 'raw-text. If a local value for `buffer-file-coding-system' in the current buffer does not exist, it is set to the coding system which was actually used @@ -410,7 +410,7 @@ ;; #4. buffer-file-coding-system-for-read ;; #5. - 'no-conversion)) + 'raw-text)) (if (consp coding-system) (setq return-val coding-system) (if (null (find-coding-system coding-system)) @@ -555,4 +555,9 @@ start end filename append visit lockname coding-system))) -;;; mule-files.el ends here +;;; The following was all that remained in mule-files.el, so I moved it +;;; here for neatness. -sb +(when (featurep 'mule) + (setq-default buffer-file-coding-system 'iso-2022-8)) + +;;; code-files.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/code-process.el --- a/lisp/code-process.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/code-process.el Mon Aug 13 11:13:30 2007 +0200 @@ -30,10 +30,6 @@ ;;; Code: -(eval-when-compile - (defvar buffer-file-type) - (defvar binary-process-output)) - (defvar process-coding-system-alist nil "Alist to decide a coding system to use for a process I/O operation. The format is ((PATTERN . VAL) ...), @@ -112,8 +108,7 @@ you quit again before the process exits." (let ((temp (make-temp-name - (concat (file-name-as-directory (temp-directory)) - (if (memq system-type '(ms-dos windows-nt)) "em" "emacs"))))) + (concat (file-name-as-directory (temp-directory)) "emacs")))) (unwind-protect (let (cs-r cs-w) (let (ret) @@ -137,10 +132,7 @@ (or coding-system-for-read cs-r)) (coding-system-for-write (or coding-system-for-write cs-w))) - (if (memq system-type '(ms-dos windows-nt)) - (let ((buffer-file-type binary-process-output)) - (write-region start end temp nil 'silent)) - (write-region start end temp nil 'silent)) + (write-region start end temp nil 'silent) (if deletep (delete-region start end)) (apply #'call-process program temp buffer displayp args))) (ignore-file-errors (delete-file temp))))) @@ -198,9 +190,9 @@ See also the function `find-operation-coding-system'.") -(defun open-network-stream (name buffer host service) +(defun open-network-stream (name buffer host service &optional protocol) "Open a TCP connection for a service to a host. -Returns a subprocess-object to represent the connection. +Return a subprocess-object to represent the connection. Input and output work as for subprocesses; `delete-process' closes it. Args are NAME BUFFER HOST SERVICE. NAME is name for process. It is modified if necessary to make it unique. @@ -211,7 +203,17 @@ with any buffer Third arg is name of the host to connect to, or its IP address. Fourth arg SERVICE is name of the service desired, or an integer - specifying a port number to connect to." + specifying a port number to connect to. +Fifth argument PROTOCOL is a network protocol. Currently 'tcp + (Transmission Control Protocol) and 'udp (User Datagram Protocol) are + supported. When omitted, 'tcp is assumed. + +Ouput via `process-send-string' and input via buffer or filter (see +`set-process-filter') are stream-oriented. That means UDP datagrams are +not guaranteed to be sent and received in discrete packets. (But small +datagrams around 500 bytes that are not truncated by `process-send-string' +are usually fine.) Note further that UDP protocol does not guard against +lost packets." (let (cs-r cs-w) (let (ret) (catch 'found @@ -245,6 +247,6 @@ (or coding-system-for-read cs-r)) (coding-system-for-write (or coding-system-for-write cs-w))) - (open-network-stream-internal name buffer host service)))) + (open-network-stream-internal name buffer host service protocol)))) -;;; mule-process.el ends here +;;; code-process.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/coding.el --- a/lisp/coding.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/coding.el Mon Aug 13 11:13:30 2007 +0200 @@ -21,7 +21,7 @@ ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the +;; 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. @@ -115,7 +115,9 @@ (interactive "zterminal-coding-system: ") (get-coding-system coding-system) ; correctness check (setq terminal-coding-system coding-system) - (set-console-tty-coding-system (device-console) terminal-coding-system) + ; #### should this affect all current tty consoles ? + (if (eq (device-type) 'tty) + (set-console-tty-coding-system (device-console) terminal-coding-system)) (redraw-modeline t)) (defun set-pathname-coding-system (coding-system) @@ -180,9 +182,9 @@ "Return the base coding system of CODING-SYSTEM." (if (not (coding-system-eol-type coding-system)) coding-system - (find-coding-system + (find-coding-system (intern - (substring + (substring (symbol-name (coding-system-name coding-system)) 0 (string-match "-unix$\\|-dos$\\|-mac$" @@ -195,17 +197,45 @@ "Automatic conversion." '(mnemonic "Auto")) -;; these are so that gnus and friends work when not mule -(or (featurep 'mule) - (progn - (copy-coding-system 'undecided 'iso-8859-1) - (copy-coding-system 'undecided 'iso-8859-2))) +;;; Make certain variables equivalent to coding-system aliases +(defun dontusethis-set-value-file-name-coding-system-handler (sym args fun harg handlers) + (define-coding-system-alias 'file-name (or (car args) 'binary))) + +(dontusethis-set-symbol-value-handler + 'file-name-coding-system + 'set-value + 'dontusethis-set-value-file-name-coding-system-handler) + +(defun dontusethis-set-value-terminal-coding-system-handler (sym args fun harg handlers) + (define-coding-system-alias 'terminal (or (car args) 'binary))) + +(dontusethis-set-symbol-value-handler + 'terminal-coding-system + 'set-value + 'dontusethis-set-value-terminal-coding-system-handler) + +(defun dontusethis-set-value-keyboard-coding-system-handler (sym args fun harg handlers) + (define-coding-system-alias 'keyboard (or (car args) 'binary))) + +(dontusethis-set-symbol-value-handler + 'keyboard-coding-system + 'set-value + 'dontusethis-set-value-keyboard-coding-system-handler) + +(unless (boundp 'file-name-coding-system) + (setq file-name-coding-system nil)) + +(when (not (featurep 'mule)) + ;; these are so that gnus and friends work when not mule + (copy-coding-system 'undecided 'iso-8859-1) + (copy-coding-system 'undecided 'iso-8859-2) + + (define-coding-system-alias 'ctext 'binary)) + ;; compatibility for old XEmacsen (don't use it) (copy-coding-system 'undecided 'automatic-conversion) -(copy-coding-system 'no-conversion 'raw-text) - (make-compatible-variable 'enable-multibyte-characters "Unimplemented") (define-obsolete-variable-alias diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/config.el --- a/lisp/config.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/config.el Mon Aug 13 11:13:30 2007 +0200 @@ -29,7 +29,7 @@ ;;; Code: -(defvar config-value-file (expand-file-name "config.values" exec-directory) +(defvar config-value-file (expand-file-name "config.values" doc-directory) "File containing configuration parameters and their values.") (defvar config-value-hash-table nil diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/cus-dep.el --- a/lisp/cus-dep.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/cus-dep.el Mon Aug 13 11:13:30 2007 +0200 @@ -4,8 +4,8 @@ ;; ;; Author: Per Abrahamsen , then ;; Richard Stallman , then -;; Hrvoje Niksic (rewritten for XEmacs) -;; Maintainer: Hrvoje Niksic +;; Hrvoje Niksic (rewritten for XEmacs) +;; Maintainer: Hrvoje Niksic ;; Keywords: internal ;; This file is part of XEmacs. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/cus-edit.el --- a/lisp/cus-edit.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/cus-edit.el Mon Aug 13 11:13:30 2007 +0200 @@ -1,9 +1,9 @@ ;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages. ;; -;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen -;; Maintainer: Hrvoje Niksic +;; Maintainer: Hrvoje Niksic ;; Keywords: help, faces ;; Version: 1.9960-x ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ @@ -399,7 +399,7 @@ (custom-unlispify-menu-entry symbol t))) (defun custom-prefix-add (symbol prefixes) - ;; Addd SYMBOL to list of ignored PREFIXES. + ;; Add SYMBOL to list of ignored PREFIXES. (cons (or (get symbol 'custom-prefix) (concat (symbol-name symbol) "-")) prefixes)) @@ -617,7 +617,7 @@ ;;; The Customize Commands -(defun custom-prompt-variable (prompt-var prompt-val) +(defun custom-prompt-variable (prompt-var prompt-val &optional comment) "Prompt for a variable and a value and return them as a list. PROMPT-VAR is the prompt for the variable, and PROMPT-VAL is the prompt for the value. The %s escape in PROMPT-VAL is replaced with @@ -627,10 +627,13 @@ it were the arg to `interactive' (which see) to interactively read the value. If the variable has a `custom-type' property, it must be a widget and the -`:prompt-value' property of that widget will be used for reading the value." +`:prompt-value' property of that widget will be used for reading the value. + +If optional COMMENT argument is non nil, also prompt for a comment and return +it as the third element in the list." (let* ((var (read-variable prompt-var)) - (minibuffer-help-form '(describe-variable var))) - (list var + (minibuffer-help-form '(describe-variable var)) + (val (let ((prop (get var 'variable-interactive)) (type (get var 'custom-type)) (prompt (format prompt-val var))) @@ -649,24 +652,36 @@ (symbol-value var)) (not (boundp var)))) (t - (eval-minibuffer prompt))))))) + (eval-minibuffer prompt)))))) + (if comment + (list var val + (read-string "Comment: " (get var 'variable-comment))) + (list var val)) + )) ;;;###autoload -(defun customize-set-value (var val) +(defun customize-set-value (var val &optional comment) "Set VARIABLE to VALUE. VALUE is a Lisp object. If VARIABLE has a `variable-interactive' property, that is used as if it were the arg to `interactive' (which see) to interactively read the value. If VARIABLE has a `custom-type' property, it must be a widget and the -`:prompt-value' property of that widget will be used for reading the value." +`:prompt-value' property of that widget will be used for reading the value. + +If given a prefix (or a COMMENT argument), also prompt for a comment." (interactive (custom-prompt-variable "Set variable: " - "Set %s to value: ")) - - (set var val)) + "Set %s to value: " + current-prefix-arg)) + + (set var val) + (cond ((string= comment "") + (put var 'variable-comment nil)) + (comment + (put var 'variable-comment comment)))) ;;;###autoload -(defun customize-set-variable (var val) +(defun customize-set-variable (var val &optional comment) "Set the default for VARIABLE to VALUE. VALUE is a Lisp object. If VARIABLE has a `custom-set' property, that is used for setting @@ -679,14 +694,24 @@ it were the arg to `interactive' (which see) to interactively read the value. If VARIABLE has a `custom-type' property, it must be a widget and the -`:prompt-value' property of that widget will be used for reading the value. " +`:prompt-value' property of that widget will be used for reading the value. + +If given a prefix (or a COMMENT argument), also prompt for a comment." (interactive (custom-prompt-variable "Set variable: " - "Set customized value for %s to: ")) + "Set customized value for %s to: " + current-prefix-arg)) (funcall (or (get var 'custom-set) 'set-default) var val) - (put var 'customized-value (list (custom-quote val)))) + (put var 'customized-value (list (custom-quote val))) + (cond ((string= comment "") + (put var 'variable-comment nil) + (put var 'customized-variable-comment nil)) + (comment + (put var 'variable-comment comment) + (put var 'customized-variable-comment comment)))) + ;;;###autoload -(defun customize-save-variable (var val) +(defun customize-save-variable (var val &optional comment) "Set the default for VARIABLE to VALUE, and save it for future sessions. If VARIABLE has a `custom-set' property, that is used for setting VARIABLE, otherwise `set-default' is used. @@ -698,11 +723,21 @@ it were the arg to `interactive' (which see) to interactively read the value. If VARIABLE has a `custom-type' property, it must be a widget and the -`:prompt-value' property of that widget will be used for reading the value. " +`:prompt-value' property of that widget will be used for reading the value. + +If given a prefix (or a COMMENT argument), also prompt for a comment." (interactive (custom-prompt-variable "Set and ave variable: " - "Set and save value for %s as: ")) + "Set and save value for %s as: " + current-prefix-arg)) (funcall (or (get var 'custom-set) 'set-default) var val) (put var 'saved-value (list (custom-quote val))) + (custom-push-theme 'theme-value var 'user 'set (list (custom-quote val))) + (cond ((string= comment "") + (put var 'variable-comment nil) + (put var 'saved-variable-comment nil)) + (comment + (put var 'variable-comment comment) + (put var 'saved-variable-comment comment))) (custom-save-all)) ;;;###autoload @@ -842,10 +877,12 @@ (interactive) (let ((found nil)) (mapatoms (lambda (symbol) - (and (get symbol 'customized-face) + (and (or (get symbol 'customized-face) + (get symbol 'customized-face-comment)) (find-face symbol) (push (list symbol 'custom-face) found)) - (and (get symbol 'customized-value) + (and (or (get symbol 'customized-value) + (get symbol 'customized-variable-comment)) (boundp symbol) (push (list symbol 'custom-variable) found)))) (if (not found) @@ -859,10 +896,12 @@ (interactive) (let ((found nil)) (mapatoms (lambda (symbol) - (and (get symbol 'saved-face) + (and (or (get symbol 'saved-face) + (get symbol 'saved-face-comment)) (find-face symbol) (push (list symbol 'custom-face) found)) - (and (get symbol 'saved-value) + (and (or (get symbol 'saved-value) + (get symbol 'saved-variable-comment)) (boundp symbol) (push (list symbol 'custom-variable) found)))) (if (not found ) @@ -994,7 +1033,6 @@ (widget-insert "\nOperate on everything in this buffer:\n ") (widget-create 'push-button :tag "Set" - :tag-glyph '("set-up" "set-down") :help-echo "\ Make your editing in this buffer take effect for this session" :action (lambda (widget &optional event) @@ -1002,7 +1040,6 @@ (widget-insert " ") (widget-create 'push-button :tag "Save" - :tag-glyph '("save-up" "save-down") :help-echo "\ Make your editing in this buffer take effect for future Emacs sessions" :action (lambda (widget &optional event) @@ -1038,7 +1075,6 @@ (widget-insert " ") (widget-create 'push-button :tag "Done" - :tag-glyph '("done-up" "done-down") :help-echo "Remove the buffer" :action (lambda (widget &optional event) (Custom-buffer-done))) @@ -1211,7 +1247,7 @@ (defun custom-browse-insert-prefix (prefix) "Insert PREFIX. On XEmacs convert it to line graphics." - ;; ### Unfinished. + ;; #### Unfinished. (if nil ; (string-match "XEmacs" emacs-version) (progn (insert "*") @@ -1705,6 +1741,77 @@ (delete-region start (point))) found)) +;;; The `custom-comment' Widget. + +;; like the editable field +(defface custom-comment-face '((((class grayscale color) + (background light)) + (:background "gray85")) + (((class grayscale color) + (background dark)) + (:background "dim gray")) + (t + (:italic t))) + "Face used for comments on variables or faces" + :group 'custom-faces) + +;; like font-lock-comment-face +(defface custom-comment-tag-face + '((((class color) (background dark)) (:foreground "gray80")) + (((class color) (background light)) (:foreground "blue4")) + (((class grayscale) (background light)) + (:foreground "DimGray" :bold t :italic t)) + (((class grayscale) (background dark)) + (:foreground "LightGray" :bold t :italic t)) + (t (:bold t))) + "Face used for variables or faces comment tags" + :group 'custom-faces) + +(define-widget 'custom-comment 'string + "User comment" + :tag "Comment" + :help-echo "Edit a comment here" + :sample-face 'custom-comment-tag-face + :value-face 'custom-comment-face + :value-set 'custom-comment-value-set + :create 'custom-comment-create + :delete 'custom-comment-delete) + +(defun custom-comment-create (widget) + (let (ext) + (widget-default-create widget) + (widget-put widget :comment-extent + (setq ext (make-extent (widget-get widget :from) + (widget-get widget :to)))) + (set-extent-property ext 'start-open t) + (when (equal (widget-get widget :value) "") + (set-extent-property ext 'invisible t)) + )) + +(defun custom-comment-delete (widget) + (widget-default-delete widget) + (delete-extent (widget-get widget :comment-extent))) + +(defun custom-comment-value-set (widget value) + (widget-default-value-set widget value) + (if (equal value "") + (set-extent-property (widget-get widget :comment-extent) + 'invisible t) + (set-extent-property (widget-get widget :comment-extent) + 'invisible nil))) + +;; Those functions are for the menu. WIDGET is NOT the comment widget. It's +;; the global custom one +(defun custom-comment-show (widget) + (set-extent-property + (widget-get (widget-get widget :comment-widget) :comment-extent) + 'invisible nil)) + +(defun custom-comment-invisible-p (widget) + (extent-property + (widget-get (widget-get widget :comment-widget) :comment-extent) + 'invisible)) + ;;; The `custom-variable' Widget. (defface custom-variable-tag-face '((((class color) @@ -1870,23 +1977,40 @@ :value value) children)))) (unless (eq custom-buffer-style 'tree) - ;; Now update the state. (unless (eq (preceding-char) ?\n) (widget-insert "\n")) - (if (eq state 'hidden) - (widget-put widget :custom-state state) - (custom-variable-state-set widget)) ;; Create the magic button. (let ((magic (widget-create-child-and-convert widget 'custom-magic nil))) (widget-put widget :custom-magic magic) (push magic buttons)) - ;; Update properties. - (widget-put widget :custom-form form) + ;; Insert documentation. + ;; #### NOTE: this is ugly!!!! I need to do update the :buttons property + ;; before the call to `widget-default-format-handler'. Otherwise, I + ;; loose my current `buttons'. This function shouldn't be called like + ;; this anyway. The doc string widget should be added like the others. + ;; --dv (widget-put widget :buttons buttons) + (widget-default-format-handler widget ?h) + ;; The comment field + (unless (eq state 'hidden) + (let* ((comment (get symbol 'variable-comment)) + (comment-widget + (widget-create-child-and-convert + widget 'custom-comment + :parent widget + :value (or comment "")))) + (widget-put widget :comment-widget comment-widget) + ;; Don't push it !!! Custom assumes that the first child is the + ;; value one. + (setq children (append children (list comment-widget))))) + ;; Update the rest of the properties properties. + (widget-put widget :custom-form form) (widget-put widget :children children) - ;; Insert documentation. - (widget-default-format-handler widget ?h) + ;; Now update the state. + (if (eq state 'hidden) + (widget-put widget :custom-state state) + (custom-variable-state-set widget)) ;; See also. (unless (eq state 'hidden) (when (eq (widget-get widget :custom-level) 1) @@ -1910,22 +2034,32 @@ (value (if (default-boundp symbol) (funcall get symbol) (widget-get widget :value))) + (comment (get symbol 'variable-comment)) tmp - (state (cond ((setq tmp (get symbol 'customized-value)) + temp + (state (cond ((progn (setq tmp (get symbol 'customized-value)) + (setq temp + (get symbol 'customized-variable-comment)) + (or tmp temp)) (if (condition-case nil - (equal value (eval (car tmp))) + (and (equal value (eval (car tmp))) + (equal comment temp)) (error nil)) 'set 'changed)) - ((setq tmp (get symbol 'saved-value)) + ((progn (setq tmp (get symbol 'saved-value)) + (setq temp (get symbol 'saved-variable-comment)) + (or tmp temp)) (if (condition-case nil - (equal value (eval (car tmp))) + (and (equal value (eval (car tmp))) + (equal comment temp)) (error nil)) 'saved 'changed)) ((setq tmp (get symbol 'standard-value)) (if (condition-case nil - (equal value (eval (car tmp))) + (and (equal value (eval (car tmp))) + (equal comment nil)) (error nil)) 'standard 'changed)) @@ -1945,7 +2079,8 @@ (memq (widget-get widget :custom-state) '(modified changed))))) ("Reset to Saved" custom-variable-reset-saved (lambda (widget) - (and (get (widget-value widget) 'saved-value) + (and (or (get (widget-value widget) 'saved-value) + (get (widget-value widget) 'saved-variable-comment)) (memq (widget-get widget :custom-state) '(modified set changed rogue))))) ("Reset to Standard Settings" custom-variable-reset-standard @@ -1954,6 +2089,8 @@ (memq (widget-get widget :custom-state) '(modified set changed saved rogue))))) ("---" ignore ignore) + ("Add Comment" custom-comment-show custom-comment-invisible-p) + ("---" ignore ignore) ("Don't show as Lisp expression" custom-variable-edit (lambda (widget) (eq (widget-get widget :custom-form) 'lisp))) @@ -2005,18 +2142,34 @@ (child (car (widget-get widget :children))) (symbol (widget-value widget)) (set (or (get symbol 'custom-set) 'set-default)) - val) + (comment-widget (widget-get widget :comment-widget)) + (comment (widget-value comment-widget)) + val) (cond ((eq state 'hidden) (error "Cannot set hidden variable")) ((setq val (widget-apply child :validate)) (goto-char (widget-get val :from)) (error "%s" (widget-get val :error))) ((memq form '(lisp mismatch)) + (when (equal comment "") + (setq comment nil) + ;; Make the comment invisible by hand if it's empty + (set-extent-property (widget-get comment-widget :comment-extent) + 'invisible t)) (funcall set symbol (eval (setq val (widget-value child)))) - (put symbol 'customized-value (list val))) + (put symbol 'customized-value (list val)) + (put symbol 'variable-comment comment) + (put symbol 'customized-variable-comment comment)) (t + (when (equal comment "") + (setq comment nil) + ;; Make the comment invisible by hand if it's empty + (set-extent-property (widget-get comment-widget :comment-extent) + 'invisible t)) (funcall set symbol (setq val (widget-value child))) - (put symbol 'customized-value (list (custom-quote val))))) + (put symbol 'customized-value (list (custom-quote val))) + (put symbol 'variable-comment comment) + (put symbol 'customized-variable-comment comment))) (custom-variable-state-set widget) (custom-redraw-magic widget))) @@ -2027,6 +2180,8 @@ (child (car (widget-get widget :children))) (symbol (widget-value widget)) (set (or (get symbol 'custom-set) 'set-default)) + (comment-widget (widget-get widget :comment-widget)) + (comment (widget-value comment-widget)) val) (cond ((eq state 'hidden) (error "Cannot set hidden variable")) @@ -2034,14 +2189,34 @@ (goto-char (widget-get val :from)) (error "%s" (widget-get val :error))) ((memq form '(lisp mismatch)) + (when (equal comment "") + (setq comment nil) + ;; Make the comment invisible by hand if it's empty + (set-extent-property (widget-get comment-widget :comment-extent) + 'invisible t)) (put symbol 'saved-value (list (widget-value child))) - (funcall set symbol (eval (widget-value child)))) + (custom-push-theme 'theme-value symbol 'user + 'set (list (widget-value child))) + (funcall set symbol (eval (widget-value child))) + (put symbol 'variable-comment comment) + (put symbol 'saved-variable-comment comment)) (t + (when (equal comment "") + (setq comment nil) + ;; Make the comment invisible by hand if it's empty + (set-extent-property (widget-get comment-widget :comment-extent) + 'invisible t)) (put symbol 'saved-value (list (custom-quote (widget-value child)))) - (funcall set symbol (widget-value child)))) + (custom-push-theme 'theme-value symbol 'user + 'set (list (custom-quote (widget-value + child)))) + (funcall set symbol (widget-value child)) + (put symbol 'variable-comment comment) + (put symbol 'saved-variable-comment comment))) (put symbol 'customized-value nil) + (put symbol 'customized-variable-comment nil) (custom-save-all) (custom-variable-state-set widget) (custom-redraw-magic widget))) @@ -2049,28 +2224,45 @@ (defun custom-variable-reset-saved (widget) "Restore the saved value for the variable being edited by WIDGET." (let* ((symbol (widget-value widget)) - (set (or (get symbol 'custom-set) 'set-default))) - (if (get symbol 'saved-value) - (condition-case nil - (funcall set symbol (eval (car (get symbol 'saved-value)))) - (error nil)) - (signal 'error (list "No saved value for variable" symbol))) + (set (or (get symbol 'custom-set) 'set-default)) + (comment-widget (widget-get widget :comment-widget)) + (value (get symbol 'saved-value)) + (comment (get symbol 'saved-variable-comment))) + (cond ((or value comment) + (put symbol 'variable-comment comment) + (condition-case nil + (funcall set symbol (eval (car value))) + (error nil))) + (t + (signal 'error (list "No saved value for variable" symbol)))) (put symbol 'customized-value nil) + (put symbol 'customized-variable-comment nil) (widget-put widget :custom-state 'unknown) + ;; This call will possibly make the comment invisible (custom-redraw widget))) (defun custom-variable-reset-standard (widget) "Restore the standard setting for the variable being edited by WIDGET." (let* ((symbol (widget-value widget)) - (set (or (get symbol 'custom-set) 'set-default))) + (set (or (get symbol 'custom-set) 'set-default)) + (comment-widget (widget-get widget :comment-widget))) (if (get symbol 'standard-value) (funcall set symbol (eval (car (get symbol 'standard-value)))) (signal 'error (list "No standard setting known for variable" symbol))) + (put symbol 'variable-comment nil) (put symbol 'customized-value nil) - (when (get symbol 'saved-value) + (put symbol 'customized-variable-comment nil) + (when (or (get symbol 'saved-value) (get symbol 'saved-variable-comment)) (put symbol 'saved-value nil) + (custom-push-theme 'theme-value symbol 'user 'reset 'standard) + ;; As a special optimizations we do not (explictly) + ;; save resets to standard when no theme set the value. + (if (null (cdr (get symbol 'theme-value))) + (put symbol 'theme-value nil)) + (put symbol 'saved-variable-comment nil) (custom-save-all)) (widget-put widget :custom-state 'unknown) + ;; This call will possibly make the comment invisible (custom-redraw widget))) ;;; The `custom-face-edit' Widget. @@ -2080,7 +2272,7 @@ :format "%t: %v" :tag "Attributes" :extra-offset 12 - :button-args '(:help-echo "Control whether this attribute have any effect") + :button-args '(:help-echo "Control whether this attribute has any effect") :args (mapcar (lambda (att) (list 'group :inline t @@ -2116,19 +2308,33 @@ pm) (const :format "MSWindows " :sibling-args (:help-echo "\ -Windows NT/95/97") +Microsoft Windows, displays") mswindows) - (const :format "DOS " + (const :format "MSPrinter " :sibling-args (:help-echo "\ -Plain MS-DOS") - pc) +Microsoft Windows, printers") + msprinter) (const :format "TTY%n" :sibling-args (:help-echo "\ Plain text terminals") tty))) (group :sibling-args (:help-echo "\ +Only match display or printer devices") + (const :format "Output: " + class) + (checklist :inline t + :offset 0 + (const :format "Display " + :sibling-args (:help-echo "\ +Match display devices") + display) + (const :format "Printer%n" + :sibling-args (:help-echo "\ +Match printer devices") + printer))) + (group :sibling-args (:help-echo "\ Only match the frames with the specified color support") - (const :format "Class: " + (const :format "Color support: " class) (checklist :inline t :offset 0 @@ -2225,6 +2431,7 @@ (defun custom-face-value-create (widget) "Create a list of the display specifications for WIDGET." (let ((buttons (widget-get widget :buttons)) + children (symbol (widget-get widget :value)) (tag (widget-get widget :tag)) (state (widget-get widget :custom-state)) @@ -2274,6 +2481,16 @@ (widget-put widget :buttons buttons) ;; Insert documentation. (widget-default-format-handler widget ?h) + ;; The comment field + (unless (eq state 'hidden) + (let* ((comment (get symbol 'face-comment)) + (comment-widget + (widget-create-child-and-convert + widget 'custom-comment + :parent widget + :value (or comment "")))) + (widget-put widget :comment-widget comment-widget) + (push comment-widget children))) ;; See also. (unless (eq state 'hidden) (when (eq (widget-get widget :custom-level) 1) @@ -2288,12 +2505,7 @@ (unless (widget-get widget :custom-form) (widget-put widget :custom-form custom-face-default-form)) (let* ((symbol (widget-value widget)) - (spec (or (get symbol 'customized-face) - (get symbol 'saved-face) - (get symbol 'face-defface-spec) - ;; Attempt to construct it. - (list (list t (face-custom-attributes-get - symbol (selected-frame)))))) + (spec (custom-face-get-spec symbol)) (form (widget-get widget :custom-form)) (indent (widget-get widget :indent)) (edit (widget-create-child-and-convert @@ -2312,7 +2524,8 @@ 'sexp)) :value spec))) (custom-face-state-set widget) - (widget-put widget :children (list edit))) + (push edit children) + (widget-put widget :children children)) (message "Creating face editor...done")))))) (defvar custom-face-menu @@ -2320,11 +2533,14 @@ ("Save for Future Sessions" custom-face-save) ("Reset to Saved" custom-face-reset-saved (lambda (widget) - (get (widget-value widget) 'saved-face))) + (or (get (widget-value widget) 'saved-face) + (get (widget-value widget) 'saved-face-comment)))) ("Reset to Standard Setting" custom-face-reset-standard (lambda (widget) (get (widget-value widget) 'face-defface-spec))) ("---" ignore ignore) + ("Add Comment" custom-comment-show custom-comment-invisible-p) + ("---" ignore ignore) ("Show all display specs" custom-face-edit-all (lambda (widget) (not (eq (widget-get widget :custom-form) 'all)))) @@ -2361,15 +2577,30 @@ (defun custom-face-state-set (widget) "Set the state of WIDGET." - (let ((symbol (widget-value widget))) - (widget-put widget :custom-state (cond ((get symbol 'customized-face) - 'set) - ((get symbol 'saved-face) - 'saved) - ((get symbol 'face-defface-spec) - 'standard) - (t - 'rogue))))) + (let* ((symbol (widget-value widget)) + (comment (get symbol 'face-comment)) + tmp temp) + (widget-put widget :custom-state + (cond ((progn + (setq tmp (get symbol 'customized-face)) + (setq temp (get symbol 'customized-face-comment)) + (or tmp temp)) + (if (equal temp comment) + 'set + 'changed)) + ((progn + (setq tmp (get symbol 'saved-face)) + (setq temp (get symbol 'saved-face-comment)) + (or tmp temp)) + (if (equal temp comment) + 'saved + 'changed)) + ((get symbol 'face-defface-spec) + (if (equal comment nil) + 'standard + 'changed)) + (t + 'rogue))))) (defun custom-face-action (widget &optional event) "Show the menu for `custom-face' WIDGET. @@ -2390,9 +2621,18 @@ "Make the face attributes in WIDGET take effect." (let* ((symbol (widget-value widget)) (child (car (widget-get widget :children))) - (value (widget-value child))) + (value (widget-value child)) + (comment-widget (widget-get widget :comment-widget)) + (comment (widget-value comment-widget))) + (when (equal comment "") + (setq comment nil) + ;; Make the comment invisible by hand if it's empty + (set-extent-property (widget-get comment-widget :comment-extent) + 'invisible t)) (put symbol 'customized-face value) - (face-spec-set symbol value) + (face-spec-set symbol value nil '(custom)) + (put symbol 'customized-face-comment comment) + (put symbol 'face-comment comment) (custom-face-state-set widget) (custom-redraw-magic widget))) @@ -2400,10 +2640,21 @@ "Make the face attributes in WIDGET default." (let* ((symbol (widget-value widget)) (child (car (widget-get widget :children))) - (value (widget-value child))) - (face-spec-set symbol value) + (value (widget-value child)) + (comment-widget (widget-get widget :comment-widget)) + (comment (widget-value comment-widget))) + (when (equal comment "") + (setq comment nil) + ;; Make the comment invisible by hand if it's empty + (set-extent-property (widget-get comment-widget :comment-extent) + 'invisible t)) + (face-spec-set symbol value nil '(custom)) (put symbol 'saved-face value) + (custom-push-theme 'theme-face symbol 'user 'set value) (put symbol 'customized-face nil) + (put symbol 'face-comment comment) + (put symbol 'customized-face-comment nil) + (put symbol 'saved-face-comment comment) (custom-save-all) (custom-face-state-set widget) (custom-redraw-magic widget))) @@ -2412,12 +2663,18 @@ "Restore WIDGET to the face's default attributes." (let* ((symbol (widget-value widget)) (child (car (widget-get widget :children))) - (value (get symbol 'saved-face))) - (unless value + (value (get symbol 'saved-face)) + (comment (get symbol 'saved-face-comment)) + (comment-widget (widget-get widget :comment-widget))) + (unless (or value comment) (signal 'error (list "No saved value for this face" symbol))) (put symbol 'customized-face nil) - (face-spec-set symbol value) + (put symbol 'customized-face-comment nil) + (face-spec-set symbol value nil '(custom)) + (put symbol 'face-comment comment) (widget-value-set child value) + ;; This call manages the comment visibility + (widget-value-set comment-widget (or comment "")) (custom-face-state-set widget) (custom-redraw-magic widget))) @@ -2425,15 +2682,25 @@ "Restore WIDGET to the face's standard settings." (let* ((symbol (widget-value widget)) (child (car (widget-get widget :children))) - (value (get symbol 'face-defface-spec))) + (value (get symbol 'face-defface-spec)) + (comment-widget (widget-get widget :comment-widget))) (unless value (signal 'error (list "No standard setting for this face" symbol))) (put symbol 'customized-face nil) - (when (get symbol 'saved-face) + (put symbol 'customized-face-comment nil) + (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment)) (put symbol 'saved-face nil) + (custom-push-theme 'theme-face symbol 'user 'reset 'standard) + ;; Do not explictly save resets to standards without themes. + (if (null (cdr (get symbol 'theme-face))) + (put symbol 'theme-face nil)) + (put symbol 'saved-face-comment nil) (custom-save-all)) - (face-spec-set symbol value) + (face-spec-set symbol value nil '(custom)) + (put symbol 'face-comment nil) (widget-value-set child value) + ;; This call manages the comment visibility + (widget-value-set comment-widget "") (custom-face-state-set widget) (custom-redraw-magic widget))) @@ -2503,7 +2770,7 @@ :tag "Hook") (defun custom-hook-convert-widget (widget) - ;; Handle `:custom-options'. + ;; Handle `:options'. (let* ((options (widget-get widget :options)) (other `(editable-list :inline t :entry-format "%i %d%v" @@ -2982,7 +3249,7 @@ :group 'customize) (defun custom-save-delete (symbol) - "Delete the call to SYMBOL form `custom-file'. + "Delete the call to SYMBOL form in `custom-file'. Leave point at the location of the call, or after the last expression." (let ((find-file-hooks nil) (auto-mode-alist nil)) @@ -3002,87 +3269,152 @@ (throw 'found nil)))))) (defun custom-save-variables () - "Save all customized variables in `custom-file'." - (save-excursion - (custom-save-delete 'custom-set-variables) - (let ((standard-output (current-buffer))) - (unless (bolp) - (princ "\n")) - (princ "(custom-set-variables") - (mapatoms (lambda (symbol) - (let ((value (get symbol 'saved-value)) - (requests (get symbol 'custom-requests)) - (now (not (or (get symbol 'standard-value) - (and (not (boundp symbol)) - (not (get symbol 'force-value))))))) - (when value - (princ "\n '(") - (prin1 symbol) - (princ " ") - (prin1 (car value)) - (cond (requests - (if now - (princ " t ") - (princ " nil ")) - (prin1 requests) - (princ ")")) - (now - (princ " t)")) - (t - (princ ")"))))))) + "Save all customized variables in `custom-file'." + (save-excursion + (custom-save-delete 'custom-load-themes) + (custom-save-delete 'custom-reset-variables) + (custom-save-delete 'custom-set-variables) + (custom-save-loaded-themes) + (custom-save-resets 'theme-value 'custom-reset-variables nil) + (let ((standard-output (current-buffer))) + (unless (bolp) + (princ "\n")) + (princ "(custom-set-variables") + (mapatoms (lambda (symbol) + (let ((spec (car-safe (get symbol 'theme-value))) + (requests (get symbol 'custom-requests)) + (now (not (or (get symbol 'standard-value) + (and (not (boundp symbol)) + (not (eq (get symbol 'force-value) + 'rogue)))))) + (comment (get symbol 'saved-variable-comment))) + (when (or (and spec (eq (car spec) 'user) + (eq (second spec) 'set)) comment) + (princ "\n '(") + (prin1 symbol) + (princ " ") + ;; This comment stuff is in the way #### + ;; Is (eq (third spec) (car saved-value)) ???? + ;; (prin1 (third spec)) + (prin1 (car (get symbol 'saved-value))) + (when (or now requests comment) + (princ (if now " t" " nil"))) + (when (or comment requests) + (princ " ") + (prin1 requests)) + (when comment + (princ " ") + (prin1 comment)) + (princ ")"))))) (princ ")") (unless (looking-at "\n") (princ "\n"))))) +(defvar custom-save-face-ignoring nil) + +(defun custom-save-face-internal (symbol) + (let ((theme-spec (car-safe (get symbol 'theme-face))) + (comment (get symbol 'saved-face-comment)) + (now (not (or (get symbol 'face-defface-spec) + (and (not (find-face symbol)) + (not (eq (get symbol 'force-face) 'rogue))))))) + (when (or (and (not (memq symbol custom-save-face-ignoring)) + ;; Don't print default face here. + theme-spec + (eq (car theme-spec) 'user) + (eq (second theme-spec) 'set)) comment) + (princ "\n '(") + (prin1 symbol) + (princ " ") + (prin1 (get symbol 'saved-face)) + (if (or comment now) + (princ (if now " t" " nil"))) + (when comment + (princ " ") + (prin1 comment)) + (princ ")")))) + (defun custom-save-faces () "Save all customized faces in `custom-file'." (save-excursion + (custom-save-delete 'custom-reset-faces) (custom-save-delete 'custom-set-faces) + (custom-save-resets 'theme-face 'custom-reset-faces '(default)) (let ((standard-output (current-buffer))) (unless (bolp) (princ "\n")) (princ "(custom-set-faces") - (let ((value (get 'default 'saved-face))) ;; The default face must be first, since it affects the others. - (when value - (princ "\n '(default ") - (prin1 value) - (if (or (get 'default 'face-defface-spec) - (and (not (find-face 'default)) - (not (get 'default 'force-face)))) - (princ ")") - (princ " t)")))) - (mapatoms (lambda (symbol) - (let ((value (get symbol 'saved-face))) - (when (and (not (eq symbol 'default)) - ;; Don't print default face here. - value) - (princ "\n '(") - (prin1 symbol) - (princ " ") - (prin1 value) - (if (or (get symbol 'face-defface-spec) - (and (not (find-face symbol)) - (not (get symbol 'force-face)))) - (princ ")") - (princ " t)")))))) + (custom-save-face-internal 'default) + (let ((custom-save-face-ignoring '(default))) + (mapatoms #'custom-save-face-internal)) (princ ")") (unless (looking-at "\n") (princ "\n"))))) +(defun custom-save-resets (property setter special) + (let (started-writing ignored-special) + ;; (custom-save-delete setter) Done by caller + (let ((standard-output (current-buffer)) + (mapper `(lambda (object) + (let ((spec (car-safe (get object (quote ,property))))) + (when (and (not (memq object ignored-special)) + (eq (car spec) 'user) + (eq (second spec) 'reset)) + ;; Do not write reset statements unless necessary. + (unless started-writing + (setq started-writing t) + (unless (bolp) + (princ "\n")) + (princ "(") + (princ (quote ,setter)) + (princ "\n '(") + (prin1 object) + (princ " ") + (prin1 (third spec)) + (princ ")"))))))) + (mapc mapper special) + (setq ignored-special special) + (mapatoms mapper) + (when started-writing + (princ ")\n"))))) + + +(defun custom-save-loaded-themes () + (let ((themes (reverse (get 'user 'theme-loads-themes))) + (standard-output (current-buffer))) + (when themes + (unless (bolp) (princ "\n")) + (princ "(custom-load-themes") + (mapc (lambda (theme) + (princ "\n '") + (prin1 theme)) themes) + (princ " )\n")))) + ;;;###autoload (defun customize-save-customized () "Save all user options which have been set in this session." (interactive) (mapatoms (lambda (symbol) (let ((face (get symbol 'customized-face)) - (value (get symbol 'customized-value))) + (value (get symbol 'customized-value)) + (face-comment (get symbol 'customized-face-comment)) + (variable-comment + (get symbol 'customized-variable-comment))) (when face (put symbol 'saved-face face) + (custom-push-theme 'theme-face symbol 'user 'set value) (put symbol 'customized-face nil)) (when value (put symbol 'saved-value value) - (put symbol 'customized-value nil))))) + (custom-push-theme 'theme-value symbol 'user 'set value) + (put symbol 'customized-value nil)) + (when variable-comment + (put symbol 'saved-variable-comment variable-comment) + (put symbol 'customized-variable-comment nil)) + (when face-comment + (put symbol 'saved-face-comment face-comment) + (put symbol 'customized-face-comment nil))))) ;; We really should update all custom buffers here. (custom-save-all)) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/cus-face.el --- a/lisp/cus-face.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/cus-face.el Mon Aug 13 11:13:30 2007 +0200 @@ -3,7 +3,7 @@ ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen -;; Maintainer: Hrvoje Niksic +;; Maintainer: Hrvoje Niksic ;; Keywords: help, faces ;; Version: 1.9960-x ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ @@ -30,6 +30,7 @@ "Like `defface', but FACE is evaluated as a normal argument." ;; (when (fboundp 'pureload) ;; (error "Attempt to declare a face during dump")) + ;; #### should we possibly reset force-face here? (unless (get face 'face-defface-spec) (put face 'face-defface-spec spec) (unless (find-face face) @@ -39,12 +40,12 @@ frame) ;; Create global face. (make-empty-face face) - (face-display-set face value) + (face-display-set face value nil '(custom)) ;; Create frame local faces (while frames (setq frame (car frames) frames (cdr frames)) - (face-display-set face value frame)) + (face-display-set face value frame '(custom))) (init-face-from-resources face))) (when (and doc (null (face-doc-string face))) (set-face-doc-string face doc)) @@ -69,7 +70,7 @@ custom-set-face-font-size custom-face-font-size) (:family (editable-field :format "Font Family: %v" :help-echo "\ -Name of font family to use (e.g. times).") +Name of font family to use (e.g. times).") custom-set-face-font-family custom-face-font-family) (:background-pixmap (editable-field :format "Background pixmap: %v" :help-echo "\ @@ -110,7 +111,7 @@ The GET function should take two arguments, the face to examine, and optonally the frame where the face should be examined.") -(defun face-custom-attributes-set (face frame &rest atts) +(defun face-custom-attributes-set (face frame tags &rest atts) "For FACE on FRAME set the attributes [KEYWORD VALUE].... Each keyword should be listed in `custom-face-attributes'. @@ -121,7 +122,7 @@ (fun (nth 2 (assq name custom-face-attributes)))) (setq atts (cdr (cdr atts))) (condition-case nil - (funcall fun face value frame) + (funcall fun face value frame tags) (error nil))))) (defun face-custom-attributes-get (face frame) @@ -157,11 +158,11 @@ (list (list t (face-custom-attributes-get symbol (selected-frame)))))) -(defun custom-set-face-bold (face value &optional frame) +(defun custom-set-face-bold (face value &optional frame tags) "Set the bold property of FACE to VALUE." (if value - (make-face-bold face frame) - (make-face-unbold face frame))) + (make-face-bold face frame tags) + (make-face-unbold face frame tags))) ;; Really, we should get rid of these font.el dependencies... They ;; are still presenting a problem with dumping the faces (font.el is @@ -176,11 +177,11 @@ (fontobj (font-create-object font))) (font-bold-p fontobj))) -(defun custom-set-face-italic (face value &optional frame) +(defun custom-set-face-italic (face value &optional frame tags) "Set the italic property of FACE to VALUE." (if value - (make-face-italic face frame) - (make-face-unitalic face frame))) + (make-face-italic face frame tags) + (make-face-unitalic face frame tags))) (defun custom-face-italic (face &rest args) "Return non-nil if the font of FACE is italic." @@ -196,13 +197,13 @@ (and image (image-instance-file-name image)))) -(defun custom-set-face-font-size (face size &rest args) +(defun custom-set-face-font-size (face size &optional locale tags) "Set the font of FACE to SIZE" - (let* ((font (apply 'face-font-name face args)) + (let* ((font (apply 'face-font-name face locale)) ;; Gag (fontobj (font-create-object font))) (set-font-size fontobj size) - (apply 'font-set-face-font face fontobj args))) + (apply 'font-set-face-font face fontobj locale tags))) (defun custom-face-font-size (face &rest args) "Return the size of the font of FACE as a string." @@ -211,13 +212,13 @@ (fontobj (font-create-object font))) (format "%s" (font-size fontobj)))) -(defun custom-set-face-font-family (face family &rest args) +(defun custom-set-face-font-family (face family &optional locale tags) "Set the font of FACE to FAMILY." - (let* ((font (apply 'face-font-name face args)) + (let* ((font (apply 'face-font-name face locale)) ;; Gag (fontobj (font-create-object font))) (set-font-family fontobj family) - (apply 'font-set-face-font face fontobj args))) + (apply 'font-set-face-font face fontobj locale tags))) (defun custom-face-font-family (face &rest args) "Return the name of the font family of FACE." @@ -233,40 +234,101 @@ (let ((spec (face-spec-update-all-matching (custom-face-get-spec face) display plist))) (put face 'customized-face spec) - (face-spec-set face spec))) + (face-spec-set face spec nil '(custom)))) ;;; Initializing. ;;;###autoload (defun custom-set-faces (&rest args) "Initialize faces according to user preferences. +This asociates the setting with the USER theme. The arguments should be a list where each entry has the form: - (FACE SPEC [NOW]) + (FACE SPEC [NOW [COMMENT]]) SPEC will be stored as the saved value for FACE. If NOW is present and non-nil, FACE will also be created according to SPEC. +COMMENT is a string comment about FACE. See `defface' for the format of SPEC." - (while args - (let ((entry (car args))) - (if (listp entry) - (let ((face (nth 0 entry)) - (spec (nth 1 entry)) - (now (nth 2 entry))) + (apply #'custom-theme-set-faces 'user args)) + +;;;###autoload +(defun custom-theme-set-faces (theme &rest args) + "Initialize faces according to settings specified by args. +Records the settings as belonging to THEME. + +See `custom-set-faces' for a description of the arguments ARGS." + (custom-check-theme theme) + (let ((immediate (get theme 'theme-immediate))) + (while args + (let ((entry (car args))) + (if (listp entry) + (let ((face (nth 0 entry)) + (spec (nth 1 entry)) + (now (nth 2 entry)) + (comment (nth 3 entry))) + (put face 'saved-face spec) + (custom-push-theme 'theme-face face theme 'set spec) + (put face 'saved-face-comment comment) + (when (or now immediate) + (put face 'force-face (if now 'rogue 'immediate))) + (when (or now immediate (find-face face)) + (put face 'face-comment comment) + (unless (find-face face) + (make-empty-face face)) + (face-spec-set face spec nil '(custom))) + (setq args (cdr args))) + ;; Old format, a plist of FACE SPEC pairs. + (let ((face (nth 0 args)) + (spec (nth 1 args))) (put face 'saved-face spec) - (when now - (put face 'force-face t)) - (when (or now (find-face face)) + (custom-push-theme 'theme-face face theme 'set spec)) + (setq args (cdr (cdr args)))))))) + +;;;###autoload +(defun custom-theme-face-value (face theme) + "Return spec of FACE in THEME if the THEME modifies the +FACE. Nil otherwise." + (car-safe (custom-theme-value theme (get face 'theme-face)))) + +(defun custom-theme-reset-internal-face (face to-theme) + (let ((spec (custom-theme-face-value face to-theme)) + was-in-theme) + (setq was-in-theme spec) + (setq spec (or spec (get face 'standard-value))) + (when spec + (put face 'save-face was-in-theme) + (when (or (get face 'force-face) (find-face face)) (unless (find-face face) (make-empty-face face)) - (face-spec-set face spec)) - (setq args (cdr args))) - ;; Old format, a plist of FACE SPEC pairs. - (let ((face (nth 0 args)) - (spec (nth 1 args))) - (put face 'saved-face spec)) - (setq args (cdr (cdr args))))))) + (face-spec-set face spec))) + spec)) + +;;;###autoload +(defun custom-theme-reset-faces (theme &rest args) + (custom-check-theme theme) + "Reset the value of the face to values previously defined. +Assosiate this setting with THEME. + +ARGS is a list of lists of the form + + (face to-theme) + +This means reset face to its value in to-theme." + (mapc #'(lambda (arg) + (apply #'custom-theme-reset-internal-face arg) + (custom-push-theme (car arg) 'theme-face theme 'reset (cadr arg))) + args)) + +;;;###autoload +(defun custom-reset-faces (&rest args) + "Reset the value of the face to values previously defined. +Assosiate this setting with the 'user' theme. + +ARGS is defined as for `custom-theme-reset-faces'" + (apply #'custom-theme-reset-faces 'user args)) + ;;; The End. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/cus-load.el --- a/lisp/cus-load.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/cus-load.el Mon Aug 13 11:13:30 2007 +0200 @@ -2,7 +2,7 @@ ;; Copyright (C) 1997 by Free Software Foundation, Inc. -;; Author: Steven L Baur +;; Author: Steven L Baur ;; Keywords: internal, help, faces ;; This file is part of XEmacs. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/cus-start.el --- a/lisp/cus-start.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/cus-start.el Mon Aug 13 11:13:30 2007 +0200 @@ -63,6 +63,7 @@ ;; integer (auto-save-interval auto-save integer) (bell-volume sound integer) + (bell-inhibit-time sound integer) (echo-keystrokes keyboard integer) (gc-cons-threshold alloc integer) (next-screen-context-lines display integer) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/custom-load.el --- a/lisp/custom-load.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/custom-load.el Mon Aug 13 11:13:30 2007 +0200 @@ -15,7 +15,7 @@ (custom-add-loads 'menu '("menubar-items")) (custom-add-loads 'minibuffer '("simple" "minibuf")) (custom-add-loads 'log-message '("simple")) -(custom-add-loads 'environment '("frame" "keydefs" "minibuf" "modeline" "window-xemacs" "menubar" "x-init" "toolbar-items" "cus-edit" "gnuserv" "sound")) +(custom-add-loads 'environment '("frame" "keydefs" "minibuf" "modeline" "window-xemacs" "menubar" "gutter-items" "x-init" "toolbar-items" "cus-edit" "gnuserv" "sound")) (custom-add-loads 'sound '("sound")) (custom-add-loads 'pui '("package-ui")) (custom-add-loads 'terminals '("gnuserv")) @@ -55,19 +55,21 @@ (custom-add-loads 'widget-button '("wid-edit")) (custom-add-loads 'paren-blinking '("simple")) (custom-add-loads 'find-file '("files")) +(custom-add-loads 'font-menu '("font-menu")) (custom-add-loads 'files '("files")) (custom-add-loads 'build '("build-report")) (custom-add-loads 'font-lock '("font-lock")) (custom-add-loads 'external '("process" "cus-edit")) (custom-add-loads 'development '("process" "lisp-mode" "cus-edit")) (custom-add-loads 'gnuserv '("gnuserv")) +(custom-add-loads 'gutter '("gutter-items")) (custom-add-loads 'fill-comments '("simple")) (custom-add-loads 'windows '("window" "window-xemacs")) (custom-add-loads 'widget-faces '("wid-edit")) (custom-add-loads 'languages '("lisp-mode" "cus-edit" "font-lock")) (custom-add-loads 'fill '("simple" "fill")) (custom-add-loads 'custom-magic-faces '("cus-edit")) -(custom-add-loads 'display '("toolbar" "scrollbar" "auto-show")) +(custom-add-loads 'display '("toolbar" "scrollbar" "gutter-items" "auto-show")) (custom-add-loads 'faces '("faces" "cus-edit" "font-lock" "font" "hyper-apropos" "info" "wid-edit")) (custom-add-loads 'emacs '("faces" "help" "files" "cus-edit" "package-get")) (custom-add-loads 'processes '("process" "gnuserv")) @@ -77,10 +79,11 @@ (custom-add-loads 'isearch '("isearch-mode")) (custom-add-loads 'font-lock-faces '("font-lock")) (custom-add-loads 'modeline '("modeline")) -(custom-add-loads 'editing '("simple" "abbrev" "fill" "mouse" "dragdrop" "cus-edit")) +(custom-add-loads 'editing '("simple" "abbrev" "fill" "mouse" "cus-edit" "dragdrop")) (custom-add-loads 'matching '("simple" "isearch-mode" "hyper-apropos")) (custom-add-loads 'i18n '("cus-edit")) (custom-add-loads 'info '("toolbar-items" "info")) -(custom-add-loads 'x '("x-faces" "x-font-menu")) +(custom-add-loads 'x '("x-faces" "font-menu")) +(custom-add-loads 'buffers-tab '("gutter-items")) ;;; custom-load.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/custom.el --- a/lisp/custom.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/custom.el Mon Aug 13 11:13:30 2007 +0200 @@ -3,7 +3,7 @@ ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. ;; Author: Per Abrahamsen -;; Maintainer: Hrvoje Niksic +;; Maintainer: Hrvoje Niksic ;; Keywords: help, faces, dumped ;; Version: 1.9960-x ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ @@ -31,12 +31,18 @@ ;; This file only contain the code needed to declare and initialize ;; user options. The code to customize options is autoloaded from -;; `cus-edit.el'. +;; `cus-edit.el'. ;; ;; The code implementing face declarations is in `cus-face.el' ;;; Code: +(eval-when-compile + (load "cl-macs")) + +(if (not (fboundp 'defun*)) + (autoload 'defun* "cl-macs")) + (require 'widget) (defvar custom-define-hook nil @@ -55,8 +61,8 @@ (unless (default-boundp symbol) ;; Use the saved value if it exists, otherwise the standard setting. (set-default symbol (if (get symbol 'saved-value) - (eval (car (get symbol 'saved-value))) - (eval value))))) + (eval (car (get symbol 'saved-value))) + (eval value))))) (defun custom-initialize-set (symbol value) "Initialize SYMBOL with VALUE. @@ -64,83 +70,83 @@ `:set' to initialize SYMBOL." (unless (default-boundp symbol) (funcall (or (get symbol 'custom-set) 'set-default) - symbol - (if (get symbol 'saved-value) - (eval (car (get symbol 'saved-value))) - (eval value))))) + symbol + (if (get symbol 'saved-value) + (eval (car (get symbol 'saved-value))) + (eval value))))) (defun custom-initialize-reset (symbol value) "Initialize SYMBOL with VALUE. Like `custom-initialize-set', but use the function specified by `:get' to reinitialize SYMBOL if it is already bound." (funcall (or (get symbol 'custom-set) 'set-default) - symbol - (cond ((default-boundp symbol) - (funcall (or (get symbol 'custom-get) 'default-value) - symbol)) - ((get symbol 'saved-value) - (eval (car (get symbol 'saved-value)))) - (t - (eval value))))) + symbol + (cond ((default-boundp symbol) + (funcall (or (get symbol 'custom-get) 'default-value) + symbol)) + ((get symbol 'saved-value) + (eval (car (get symbol 'saved-value)))) + (t + (eval value))))) (defun custom-initialize-changed (symbol value) "Initialize SYMBOL with VALUE. -Like `custom-initialize-reset', but only use the `:set' function if the +Like `custom-initialize-reset', but only use the `:set' function if the not using the standard setting. Otherwise, use the `set-default'." (cond ((default-boundp symbol) - (funcall (or (get symbol 'custom-set) 'set-default) - symbol - (funcall (or (get symbol 'custom-get) 'default-value) - symbol))) - ((get symbol 'saved-value) - (funcall (or (get symbol 'custom-set) 'set-default) - symbol - (eval (car (get symbol 'saved-value))))) - (t - (set-default symbol (eval value))))) + (funcall (or (get symbol 'custom-set) 'set-default) + symbol + (funcall (or (get symbol 'custom-get) 'default-value) + symbol))) + ((get symbol 'saved-value) + (funcall (or (get symbol 'custom-set) 'set-default) + symbol + (eval (car (get symbol 'saved-value))))) + (t + (set-default symbol (eval value))))) (defun custom-declare-variable (symbol value doc &rest args) "Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments." ;; Remember the standard setting. (put symbol 'standard-value (list value)) ;; Maybe this option was rogue in an earlier version. It no longer is. - (when (get symbol 'force-value) - ;; It no longer is. + (when (eq (get symbol 'force-value) 'rogue) + ;; It no longer is. (put symbol 'force-value nil)) (when doc (put symbol 'variable-documentation doc)) (let ((initialize 'custom-initialize-reset) - (requests nil)) - (while args + (requests nil)) + (while args (let ((arg (car args))) - (setq args (cdr args)) - (check-argument-type 'keywordp arg) - (let ((keyword arg) - (value (car args))) - (unless args - (signal 'error (list "Keyword is missing an argument" keyword))) - (setq args (cdr args)) - (cond ((eq keyword :initialize) - (setq initialize value)) - ((eq keyword :set) - (put symbol 'custom-set value)) - ((eq keyword :get) - (put symbol 'custom-get value)) - ((eq keyword :require) - (setq requests (cons value requests))) - ((eq keyword :type) - (put symbol 'custom-type value)) - ((eq keyword :options) - (if (get symbol 'custom-options) - ;; Slow safe code to avoid duplicates. - (mapc (lambda (option) - (custom-add-option symbol option)) - value) - ;; Fast code for the common case. - (put symbol 'custom-options (copy-sequence value)))) - (t - (custom-handle-keyword symbol keyword value - 'custom-variable)))))) + (setq args (cdr args)) + (check-argument-type 'keywordp arg) + (let ((keyword arg) + (value (car args))) + (unless args + (signal 'error (list "Keyword is missing an argument" keyword))) + (setq args (cdr args)) + (cond ((eq keyword :initialize) + (setq initialize value)) + ((eq keyword :set) + (put symbol 'custom-set value)) + ((eq keyword :get) + (put symbol 'custom-get value)) + ((eq keyword :require) + (setq requests (cons value requests))) + ((eq keyword :type) + (put symbol 'custom-type value)) + ((eq keyword :options) + (if (get symbol 'custom-options) + ;; Slow safe code to avoid duplicates. + (mapc (lambda (option) + (custom-add-option symbol option)) + value) + ;; Fast code for the common case. + (put symbol 'custom-options (copy-sequence value)))) + (t + (custom-handle-keyword symbol keyword value + 'custom-variable)))))) (put symbol 'custom-requests requests) ;; Do the actual initialization. (funcall initialize symbol value)) @@ -158,29 +164,29 @@ If SYMBOL is not already bound, initialize it to VALUE. The remaining arguments should have the form - [KEYWORD VALUE]... + [KEYWORD VALUE]... The following KEYWORD's are defined: -:type VALUE should be a widget type for editing the symbols value. - The default is `sexp'. +:type VALUE should be a widget type for editing the symbols value. + The default is `sexp'. :options VALUE should be a list of valid members of the widget type. -:group VALUE should be a customization group. +:group VALUE should be a customization group. Add SYMBOL to that group. :initialize VALUE should be a function used to initialize the - variable. It takes two arguments, the symbol and value - given in the `defcustom' call. The default is - `custom-initialize-set' -:set VALUE should be a function to set the value of the symbol. - It takes two arguments, the symbol to set and the value to - give it. The default is `set-default'. -:get VALUE should be a function to extract the value of symbol. - The function takes one argument, a symbol, and should return - the current value for that symbol. The default is - `default-value'. + variable. It takes two arguments, the symbol and value + given in the `defcustom' call. The default is + `custom-initialize-set' +:set VALUE should be a function to set the value of the symbol. + It takes two arguments, the symbol to set and the value to + give it. The default is `set-default'. +:get VALUE should be a function to extract the value of symbol. + The function takes one argument, a symbol, and should return + the current value for that symbol. The default is + `default-value'. :require VALUE should be a feature symbol. Each feature will be - required after initialization, of the the user have saved this - option. + required after initialization, of the the user have saved this + option. Read the section about customization in the Emacs Lisp manual for more information." @@ -237,7 +243,7 @@ (defun custom-declare-group (symbol members doc &rest args) "Like `defgroup', but SYMBOL is evaluated as a normal argument." - (while members + (while members (apply 'custom-add-to-group symbol (car members)) (pop members)) (put symbol 'custom-group (nconc members (get symbol 'custom-group))) @@ -248,15 +254,15 @@ (setq args (cdr args)) (check-argument-type 'keywordp arg) (let ((keyword arg) - (value (car args))) - (unless args - (signal 'error (list "Keyword is missing an argument" keyword))) - (setq args (cdr args)) - (cond ((eq keyword :prefix) - (put symbol 'custom-prefix value)) - (t - (custom-handle-keyword symbol keyword value - 'custom-group)))))) + (value (car args))) + (unless args + (signal 'error (list "Keyword is missing an argument" keyword))) + (setq args (cdr args)) + (cond ((eq keyword :prefix) + (put symbol 'custom-prefix value)) + (t + (custom-handle-keyword symbol keyword value + 'custom-group)))))) (run-hooks 'custom-define-hook) symbol) @@ -273,7 +279,7 @@ The remaining arguments should have the form - [KEYWORD VALUE]... + [KEYWORD VALUE]... The following KEYWORD's are defined: @@ -291,9 +297,9 @@ "To existing GROUP add a new OPTION of type WIDGET. If there already is an entry for that option, overwrite it." (let* ((members (get group 'custom-group)) - (old (assq option members))) + (old (assq option members))) (if old - (setcar (cdr old) widget) + (setcar (cdr old) widget) (put group 'custom-group (nconc members (list (list option widget)))))) (puthash group t custom-group-hash-table)) @@ -302,32 +308,32 @@ (defun custom-handle-all-keywords (symbol args type) "For customization option SYMBOL, handle keyword arguments ARGS. Third argument TYPE is the custom option type." - (while args + (while args (let ((arg (car args))) (setq args (cdr args)) (check-argument-type 'keywordp arg) (let ((keyword arg) - (value (car args))) - (unless args - (signal 'error (list "Keyword is missing an argument" keyword))) - (setq args (cdr args)) - (custom-handle-keyword symbol keyword value type))))) + (value (car args))) + (unless args + (signal 'error (list "Keyword is missing an argument" keyword))) + (setq args (cdr args)) + (custom-handle-keyword symbol keyword value type))))) (defun custom-handle-keyword (symbol keyword value type) "For customization option SYMBOL, handle KEYWORD with VALUE. Fourth argument TYPE is the custom option type." (cond ((eq keyword :group) - (custom-add-to-group value symbol type)) - ((eq keyword :version) - (custom-add-version symbol value)) - ((eq keyword :link) - (custom-add-link symbol value)) - ((eq keyword :load) - (custom-add-load symbol value)) - ((eq keyword :tag) - (put symbol 'custom-tag value)) - (t - (signal 'error (list "Unknown keyword" keyword))))) + (custom-add-to-group value symbol type)) + ((eq keyword :version) + (custom-add-version symbol value)) + ((eq keyword :link) + (custom-add-link symbol value)) + ((eq keyword :load) + (custom-add-load symbol value)) + ((eq keyword :tag) + (put symbol 'custom-tag value)) + (t + (signal 'error (list "Unknown keyword" keyword))))) (defun custom-add-option (symbol option) "To the variable SYMBOL add OPTION. @@ -356,46 +362,278 @@ (unless (member load loads) (put symbol 'custom-loads (cons load loads))))) +;;; deftheme macro + +(defvar custom-known-themes '(user standard) + "Themes that have been defthemed.") + +;; #### add strings for group +;; #### during bootstrap we cannot use cl-macs stuff +(defun* custom-define-theme (theme feature &optional doc + &key short-description immediate variable-reset-string + variable-set-string face-set-string face-reset-string + &allow-other-keys) + (push theme custom-known-themes) + (put theme 'theme-feature feature) + (put theme 'theme-documentation doc) + (if immediate (put theme 'theme-immediate immediate)) + (if variable-reset-string + (put theme 'theme-variable-reset-string variable-reset-string )) + (if variable-set-string + (put theme 'theme-variable-set-string variable-set-string )) + (if face-reset-string + (put theme 'theme-face-reset-string face-reset-string )) + (if face-set-string + (put theme 'theme-face-set-string face-set-string )) + (if short-description + (put theme 'theme-short-description short-description ))) + +(defun custom-make-theme-feature (theme) + (intern (concat (symbol-name theme) "-theme"))) + +(defmacro deftheme (theme &rest body) + "(deftheme THEME &optional DOC &key KEYWORDS) + +Define a theme labeled by SYMBOL THEME. The optional argument DOC is a +doc string describing the the theme. It is optionally followed by the +following keyboard arguments + +:short-description DESC + DESC is a short (one line) description of the theme. If not given DOC + is used. +:immediate FLAG + If FLAG is non-nil variables set in this theme are bound + immediately when loading the theme. +:variable-set-string VARIABLE_-SET-STRING + A string used by the UI to indicate that the value takes it + setting from this theme. It is passed to FORMAT with the + name of the theme a additional argument. + If not given, a generic description is used. +:variable-reset-string VARIABLE-RESET-STRING + As above but used in the case the variable has been forced to + the value in this theme. +:face-set-string FACE-SET-STRING +:face-reset-string FACE-RESET-STRING + As above but for faces." + (let ((feature (custom-make-theme-feature theme))) + `(custom-define-theme (quote ,theme) (quote ,feature) ,@body))) + +(defsubst custom-theme-p (theme) + "Non-nil when THEME has been defined." + (memq theme custom-known-themes)) + +(defsubst custom-check-theme (theme) + "Check whether THEME is valid and signal an error if NOT" + (unless (custom-theme-p theme) + (error "Unknown theme `%s'" theme))) + + +; #### do we need to deftheme 'user and/or 'standard here to make the +; code in cus-edit cleaner?. + ;;; Initializing. +(defun custom-push-theme (prop symbol theme mode value) + (let ((old (get symbol prop))) + (if (eq (car-safe (car-safe old)) theme) + (setq old (cdr old))) + (put symbol prop (cons (list theme mode value) old)))) + (defun custom-set-variables (&rest args) - "Initialize variables according to user preferences. - + "Initialize variables according to user preferences. +The settings are registered as theme `user'. The arguments should be a list where each entry has the form: - (SYMBOL VALUE [NOW]) + (SYMBOL VALUE [NOW [REQUEST [COMMENT]]]) The unevaluated VALUE is stored as the saved value for SYMBOL. If NOW is present and non-nil, VALUE is also evaluated and bound as -the default value for the SYMBOL." - (while args - (let ((entry (car args))) - (if (listp entry) - (let* ((symbol (nth 0 entry)) - (value (nth 1 entry)) - (now (nth 2 entry)) - (requests (nth 3 entry)) - (set (or (get symbol 'custom-set) 'set-default))) - (put symbol 'saved-value (list value)) - (cond (now - ;; Rogue variable, set it now. - (put symbol 'force-value t) - (funcall set symbol (eval value))) - ((default-boundp symbol) - ;; Something already set this, overwrite it. - (funcall set symbol (eval value)))) - (when requests - (put symbol 'custom-requests requests) - (mapc 'require requests)) - (setq args (cdr args))) - ;; Old format, a plist of SYMBOL VALUE pairs. - (message "Warning: old format `custom-set-variables'") - (ding) - (sit-for 2) - (let ((symbol (nth 0 args)) - (value (nth 1 args))) - (put symbol 'saved-value (list value))) - (setq args (cdr (cdr args))))))) +the default value for the SYMBOL. +REQUEST is a list of features we must 'require for SYMBOL. +COMMENT is a comment string about SYMBOL." + (apply 'custom-theme-set-variables 'user args)) + +(defun custom-theme-set-variables (theme &rest args) + "Initialize variables according to settings specified by args. +Records the settings as belonging to THEME. + +See `custom-set-variables' for a description of the arguments ARGS." + (custom-check-theme theme) + (let ((immediate (get theme 'theme-immediate))) + (while args * etc/custom/example-themes/example-theme.el: + (let ((entry (car args))) + (if (listp entry) + (let* ((symbol (nth 0 entry)) + (value (nth 1 entry)) + (now (nth 2 entry)) + (requests (nth 3 entry)) + (comment (nth 4 entry)) + (set (or (get symbol 'custom-set) 'set-default))) + (put symbol 'saved-value (list value)) + (custom-push-theme 'theme-value symbol theme 'set value) + (put symbol 'saved-variable-comment comment) + (cond ((or now immediate) + ;; Rogue variable, set it now. + (put symbol 'force-value (if now 'rogue 'immediate)) + (funcall set symbol (eval value))) + ((default-boundp symbol) + ;; Something already set this, overwrite it. + (funcall set symbol (eval value)))) + (and (or now (default-boundp symbol)) + (put symbol 'variable-comment comment)) + (when requests + (put symbol 'custom-requests requests) + (mapc 'require requests)) + (setq args (cdr args))) + ;; Old format, a plist of SYMBOL VALUE pairs. + (message "Warning: old format `custom-set-variables'") + (ding) + (sit-for 2) + (let ((symbol (nth 0 args)) + (value (nth 1 args))) + (put symbol 'saved-value (list value)) + (custom-push-theme 'theme-value symbol theme 'set value)) + (setq args (cdr (cdr args)))))))) + +(defvar custom-loaded-themes nil + "Themes in the order they are loaded.") + +(defun custom-theme-loaded-p (theme) + "Return non-nil when THEME has been loaded." + (memq theme custom-loaded-themes)) + +(defun provide-theme (theme) + "Indicate that this file provides THEME." + (custom-check-theme theme) + (provide (get theme 'theme-feature)) + (push theme custom-loaded-themes)) + +(defun require-theme (theme &optional soft) + "Try to load a theme by requiring its feature." + ;; Note we do no check for validity of the theme here. + ;; This allows to pull in themes by a file-name convention + (require (get theme 'theme-feature (custom-make-theme-feature theme)))) + +(defun custom-do-theme-reset (theme) + ; #### untested! slow! + (let (spec-list) + (mapatoms (lambda (symbol) + (setq spec-list (get symbol 'theme-value)) + (when spec-list + (setq spec-list (delete-if (lambda (elt) + (eq (car elt) theme)) + spec-list)) + (put symbol 'theme-value spec-list) + (custom-theme-reset-internal symbol 'user)) + (setq spec-list (get symbol 'theme-face)) + (when spec-list + (setq spec-list (delete-if (lambda (elt) + (eq (car elt) theme)) + spec-list)) + (put symbol 'theme-face spec-list) + (custom-theme-reset-internal-face symbol 'user)))))) + +(defun custom-theme-load-themes (by-theme &rest body) + "Load the themes specified by BODY and record them as required by +theme BY-THEME. BODY is a secuence of + - a SYMBOL + require the theme SYMBOL + - a list (reset THEME) + Undo all the settings made by THEME. + - a list (hidden THEME) + require the THEME but hide it from the user." + (custom-check-theme by-theme) + (dolist (theme body) + (cond ((and (consp theme) (eq (car theme) 'reset)) + (custom-do-theme-reset (cadr theme))) + ((and (consp theme) (eq (car theme) 'hidden)) + (require-theme (cadr theme)) + (unless (custom-theme-loaded-p (cadr theme)) + (put (cadr theme) 'theme-hidden t))) + (t + (require-theme theme) + (remprop theme 'theme-hidden))) + (push theme (get by-theme 'theme-loads-themes)))) + +(defun custom-load-themes (&rest body) + "Load themes for the USER theme as specified by BODY. + +BODY is as with custom-theme-load-themes." + (apply #'custom-theme-load-themes 'user body)) + + + + +(defsubst copy-upto-last (elt list) + "Copy all the elements of the list upto the last occurence of elt" + ;; Is it faster to do more work in C than to do less in elisp? + (nreverse (cdr (member elt (reverse list))))) + +(defun custom-theme-value (theme theme-spec-list) + "Determine the value for THEME defined by THEME-SPEC-LIST. +Returns (list value) if found. Nil otherwise." + ;; Note we do _NOT_ signal an error if the theme is unknown + ;; it might have gone away without the user knowing. + (let ((theme-or-lower (memq theme (cons 'user custom-loaded-themes))) + value) + (mapc #'(lambda (theme-spec) + (when (member (car theme-spec) theme-or-lower) + (setq value (cdr theme-spec)) + ;; We need to continue because if theme =A and we found + ;; B then if the load order is B A C B + ;; we actually want the value in C. + (setq theme-or-lower (copy-upto-last (car theme-spec) + theme-or-lower)) + ;; We could should circuit if this is now nil. + )) + theme-spec-list) + (if value + (if (eq (car value) 'set) + (list (cadr value)) + ;; Yet another reset spec. car value = reset + (custom-theme-value (cadr value) theme-spec-list))))) + + +(defun custom-theme-variable-value (variable theme) + "Return (list value) value of VARIABLE in THEME if the THEME modifies the +VARIABLE. Nil otherwise." + (custom-theme-value theme (get variable 'theme-value))) + +(defun custom-theme-reset-internal (symbol to-theme) + (let ((value (custom-theme-variable-value symbol to-theme)) + was-in-theme) + (setq was-in-theme value) + (setq value (or value (get symbol 'standard-value))) + (when value + (put symbol 'saved-value was-in-theme) + (if (or (get 'force-value symbol) (default-boundp symbol)) + (funcall (get symbol 'custom-set 'set-default) symbol + (eval (car value))))) + value)) + + +(defun custom-theme-reset-variables (theme &rest args) + "Reset the value of the variables to values previously defined. +Assosiate this setting with THEME. + +ARGS is a list of lists of the form + + (variable to-theme) + +This means reset variable to its value in to-theme." + (custom-check-theme theme) + (mapc #'(lambda (arg) + (apply #'custom-theme-reset-internal arg) + (custom-push-theme 'theme-value (car arg) theme 'reset (cadr arg))) + args)) + +(defun custom-reset-variables (&rest args) + "Reset the value of the variables to values previously defined. +Assosiate this setting with the `user' theme. + +The ARGS are as in `custom-theme-reset-variables'." + (apply #'custom-theme-reset-variables 'user args)) + ;;; The End. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/device.el --- a/lisp/device.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/device.el Mon Aug 13 11:13:30 2007 +0200 @@ -31,6 +31,18 @@ ;;; Code: +;;; Initialization + +; Specifier tag 'printer which matches printers +(define-specifier-tag 'printer (function device-printer-p)) + +; Specifier tag 'display which matches displays +(define-specifier-tag 'display (function + (lambda (device) + (not (device-printer-p device))))) + +;;; Functions + (defun device-list () "Return a list of all devices." (apply 'nconc (mapcar 'console-device-list (console-list)))) @@ -41,8 +53,8 @@ Value is `tty' for a tty device (a character-only terminal), `x' for a device that is a screen on an X display, `ns' for a device that is a NeXTstep connection (not yet implemented), -`mswindows' for a device that is a Windows or Windows NT connection, -`pc' for a device that is a direct-write MS-DOS screen (not yet implemented), +`mswindows' for a device that is a MS Windows workstation, +`msprinter' for a device that is a MS Windows printer connection, `stream' for a stream device (which acts like a stdio stream), and `dead' for a deleted device." (or device (setq device (selected-device))) @@ -106,6 +118,29 @@ (or device (setq device (selected-device))) (console-on-window-system-p (device-console device))) +(defun call-device-method (name device &rest args) + "Call a DEVICE-specific function with the generic name NAME. +If DEVICE is not provided then the selected device is used." + (or device (setq device (selected-device))) + (or (symbolp name) (error "function name must be a symbol")) + (let ((devmeth (intern (concat (symbol-name + (device-type device)) "-" (symbol-name name))))) + (if (functionp devmeth) + (if args + (apply devmeth args) + (funcall devmeth)) + nil))) + +(defmacro define-device-method (name &optional docstring) + "Define NAME to be a device method." + `(defun ,name (&rest arglist) ,docstring + (apply 'call-device-method (quote ,name) nil arglist))) + +(defmacro define-device-method* (name &optional docstring) + "Define NAME to be a device method." + `(defun* ,name (&rest arglist) ,docstring + (apply 'call-device-method (quote ,name) nil arglist))) + (defalias 'valid-device-type-p 'valid-console-type-p) (defalias 'device-type-list 'console-type-list) (defalias 'device-pixel-depth 'device-bitplanes) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/disass.el --- a/lisp/disass.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/disass.el Mon Aug 13 11:13:30 2007 +0200 @@ -3,8 +3,8 @@ ;;; Copyright (C) 1986, 1991-1994 Free Software Foundation, Inc. ;; Author: Doug Cutting -;; Jamie Zawinski -;; Maintainer: Jamie Zawinski +;; Jamie Zawinski +;; Maintainer: XEmacs Development Team ;; Keywords: internal ;; This file is part of XEmacs. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/dump-paths.el --- a/lisp/dump-paths.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/dump-paths.el Mon Aug 13 11:13:30 2007 +0200 @@ -39,7 +39,12 @@ (princ (format "XEmacs thinks the roots of its hierarchy are:\n%S\n" roots))) - (let ((stuff (packages-find-packages roots))) + (let* ((package-locations + (packages-compute-package-locations + ;; temporary kludge: + ;; this should be synched with startup.el + (paths-construct-path '("~" ".xemacs")))) + (stuff (packages-find-packages roots package-locations))) (setq late-packages (car (cdr stuff)))) (setq late-package-load-path (packages-find-package-load-path late-packages)) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/dumped-lisp.el --- a/lisp/dumped-lisp.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/dumped-lisp.el Mon Aug 13 11:13:30 2007 +0200 @@ -2,7 +2,6 @@ (assemble-list "backquote" ; needed for defsubst etc. "bytecomp-runtime" ; define defsubst - "Installation.el" "find-paths" "packages" ; Bootstrap run-time lisp environment "setup-paths" @@ -33,7 +32,7 @@ "events" "text-props" "process" ;; This is bad. network-streams may not be defined. - (when-feature multicast "multicast") ; #+network-streams implicitely true + (when-feature multicast "multicast") ; #+network-streams implicitly true "frame" ; move up here cause some stuff needs it here "map-ynp" "simple" @@ -80,7 +79,7 @@ "text-mode" "fill" "auto-save" ; Added for 20.4 - + "movemail" ; Added for 21.2 (when-feature windows-nt "winnt") (when-feature lisp-float-type "float-sup") "itimer" ; for vars auto-save-timeout and @@ -95,7 +94,6 @@ (when-feature mule "mule-coding") ;; Handle I/O of files with extended characters. (when-feature file-coding "code-files") - (when-feature mule "mule-files") ;; Handle process with encoding/decoding non-ascii coding-system. (when-feature file-coding "code-process") (when-feature mule "mule-help") @@ -128,16 +126,17 @@ (when-feature mule "chinese") (when-feature mule "mule/cyrillic") ; overloaded in leim/quail (when-feature mule "english") -;; (when-feature mule "ethiopic") + (when-feature mule "ethiopic") (when-feature mule "european") (when-feature mule "mule/greek") ; overloaded in leim/quail (when-feature mule "hebrew") (when-feature mule "japanese") (when-feature mule "korean") (when-feature mule "misc-lang") -;; (when-feature mule "thai") + (when-feature mule "thai-xtis-chars") + (when-feature mule "mule/thai-xtis") ; overloaded in leim/quail (when-feature mule "viet-chars") -;; (when-feature mule "vietnamese") + (when-feature mule "vietnamese") ;; Specialized language support (when-feature (and mule CANNA) "canna-leim") @@ -166,6 +165,7 @@ (when-feature (and (not infodock) (or x mswindows) menubar) "menubar-items") (when-feature (and infodock (or x mswindows) menubar) "id-menus") + (when-feature (and gutter menubar window-system) "gutter-items") (when-feature x "x-faces") (when-feature x "x-iso8859-1") (when-feature x "x-mouse") diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/easymenu.el --- a/lisp/easymenu.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/easymenu.el Mon Aug 13 11:13:30 2007 +0200 @@ -24,7 +24,7 @@ ;; 02111-1307, USA. ;;; Synched up with: Not synched with FSF but coordinated with the FSF -;;; easymenu maintor for compatability with FSF 20.4. +;;; easymenu maintor for compatibility with FSF 20.4. ;;; Please: Coordinate changes with Inge Frick ;; Commentary: diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/etags.el --- a/lisp/etags.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/etags.el Mon Aug 13 11:13:30 2007 +0200 @@ -52,7 +52,7 @@ ;; Kyle Jones ;; added "Exact match, then inexact" code ;; added support for include directive. -;; Hrvoje Niksic +;; Hrvoje Niksic ;; various changes. @@ -598,11 +598,8 @@ (format "%s(default %s) " prompt default) prompt) tag-completion-table 'tag-completion-predicate nil nil - 'find-tag-history)) - (if (string-equal tag-name "") - ;; #### - This is a really LAME way of doing it! --Stig - default ;indicate exact symbol match - tag-name))) + 'find-tag-history default)) + tag-name)) (defvar last-tag-data nil "Information for continuing a tag search. @@ -641,7 +638,7 @@ (t (setq tag-table-currently-matching-exact t))) ;; \_ in the tagname is used to indicate a symbol boundary. - (setq exact-tagname (concat "\\_" tagname "\\_")) + (setq exact-tagname (format "\C-?\\_%s\\_\C-a\\|\\_%s\\_" tagname tagname)) (while (string-match "\\\\_" exact-tagname) (aset exact-tagname (1- (match-end 0)) ?b)) (save-excursion @@ -674,7 +671,9 @@ ;; tag searches? (while (re-search-forward tag-target nil t) (and (save-match-data - (looking-at "[^\n\C-?]*\C-?")) + (save-excursion + (goto-char (match-beginning 0)) + (looking-at "[^\n\C-?]*\C-?"))) ;; If we're looking for inexact matches, skip ;; exact matches since we've visited them ;; already. @@ -693,6 +692,7 @@ (if next "more " "") (if exact "matching" "containing") tagname)) + (beginning-of-line) (search-forward "\C-?") (setq file (expand-file-name (file-of-tag) ;; In XEmacs, this needs to be diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/faces.el --- a/lisp/faces.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/faces.el Mon Aug 13 11:13:30 2007 +0200 @@ -31,7 +31,7 @@ ;; This file is dumped with XEmacs. ;; face implementation #1 (used Lisp vectors and parallel C vectors; -;; FSFmacs still uses this) authored by Jamie Zawinski +;; FSFmacs still uses this) authored by Jamie Zawinski ;; pre Lucid-Emacs 19.0. ;; face implementation #2 (used one face object per frame per face) @@ -794,7 +794,7 @@ ;; WE DEMAND LEXICAL SCOPING!!! ;; WE DEMAND LEXICAL SCOPING!!! ;; WE DEMAND LEXICAL SCOPING!!! -(defun frob-face-property (face property func &optional locale) +(defun frob-face-property (face property func &optional locale tags) "Change the specifier for FACE's PROPERTY according to FUNC, in LOCALE. This function is ugly and messy and is primarily used as an internal helper function for `make-face-bold' et al., so you probably don't @@ -814,13 +814,14 @@ the specification; otherwise, the process just outlined is iterated over each existing device and the concatenated results substituted for the specification." - (let ((sp (face-property face property))) + (let ((sp (face-property face property)) + temp-sp) (if (valid-specifier-domain-p locale) ;; this is easy. (let* ((inst (face-property-instance face property locale)) (name (and inst (funcall func inst (dfw-device locale))))) (when name - (add-spec-to-specifier sp name locale))) + (add-spec-to-specifier sp name locale tags))) ;; otherwise, map over all specifications ... ;; but first, some further kludging: ;; (1) if we're frobbing the global property, make sure @@ -832,33 +833,40 @@ ;; (2) if we're frobbing a particular locale, nothing would ;; happen if that locale has no instantiators. So signal ;; an error to indicate this. + + + (setq temp-sp (copy-specifier sp)) (if (and (or (eq locale 'global) (eq locale 'all) (not locale)) (not (face-property face property 'global))) (copy-specifier (face-property 'default property) - (face-property face property) - 'global)) + temp-sp 'global)) (if (and (valid-specifier-locale-p locale) - (not (face-property face property locale))) + (not (specifier-specs temp-sp locale))) (error "Property must have a specification in locale %S" locale)) (map-specifier - sp - (lambda (sp locale inst-list func) + temp-sp + (lambda (sp-arg locale inst-list func) (let* ((device (dfw-device locale)) ;; if a device can be derived from the locale, ;; call frob-face-property-1 for that device. ;; Otherwise map frob-face-property-1 over each device. (result (if device - (list (frob-face-property-1 sp device inst-list func)) + (list (frob-face-property-1 sp-arg device inst-list func)) (mapcar (lambda (device) - (frob-face-property-1 sp device + (frob-face-property-1 sp-arg device inst-list func)) (device-list)))) new-result) ;; remove duplicates and nils from the obtained list of - ;; instantiators. + ;; instantiators. Also add tags amd remove 'defaults'. (mapcar (lambda (arg) - (when (and arg (not (member arg new-result))) + (when arg + (if (not (consp arg)) + (setq arg (cons tags arg)) + (setcar arg (append tags (delete 'default + (car arg)))))) + (when (and arg (not (member arg new-result))) (setq new-result (cons arg new-result)))) result) ;; add back in. @@ -886,7 +894,7 @@ (setq inst-list (cdr inst-list))) (or result first-valid))) -(defun frob-face-font-2 (face locale unfrobbed-face frobbed-face +(defun frob-face-font-2 (face locale tags unfrobbed-face frobbed-face tty-thunk x-thunk standard-face-mapping) ;; another kludge to make things more intuitive. If we're ;; inheriting from a standard face in this locale, frob the @@ -934,9 +942,9 @@ (not (equal (face-property-instance face 'font domain) (face-property-instance unfrobbed-face 'font domain))) (set-face-property face 'font (vector frobbed-face) - the-locale)))))) + the-locale tags)))))) -(defun make-face-bold (face &optional locale) +(defun make-face-bold (face &optional locale tags) "Make FACE bold in LOCALE, if possible. This will attempt to make the font bold for X locales and will set the highlight flag for TTY locales. @@ -965,24 +973,24 @@ circumstances." (interactive (list (read-face-name "Make which face bold: "))) (frob-face-font-2 - face locale 'default 'bold + face locale tags 'default 'bold (lambda () ;; handle TTY specific entries (when (featurep 'tty) - (set-face-highlight-p face t locale 'tty))) + (set-face-highlight-p face t locale (cons 'tty tags)))) (lambda () ;; handle X specific entries (when (featurep 'x) - (frob-face-property face 'font 'x-make-font-bold locale)) + (frob-face-property face 'font 'x-make-font-bold locale tags)) (when (featurep 'mswindows) - (frob-face-property face 'font 'mswindows-make-font-bold locale)) + (frob-face-property face 'font 'mswindows-make-font-bold locale tags)) ) '(([default] . [bold]) ([bold] . t) ([italic] . [bold-italic]) ([bold-italic] . t)))) -(defun make-face-italic (face &optional locale) +(defun make-face-italic (face &optional locale tags) "Make FACE italic in LOCALE, if possible. This will attempt to make the font italic for X locales and will set the underline flag for TTY locales. @@ -990,24 +998,24 @@ for more specifics on exactly how this function works." (interactive (list (read-face-name "Make which face italic: "))) (frob-face-font-2 - face locale 'default 'italic + face locale tags 'default 'italic (lambda () ;; handle TTY specific entries (when (featurep 'tty) - (set-face-underline-p face t locale 'tty))) + (set-face-underline-p face t locale (cons 'tty tags)))) (lambda () ;; handle X specific entries (when (featurep 'x) - (frob-face-property face 'font 'x-make-font-italic locale)) + (frob-face-property face 'font 'x-make-font-italic locale tags)) (when (featurep 'mswindows) - (frob-face-property face 'font 'mswindows-make-font-italic locale)) + (frob-face-property face 'font 'mswindows-make-font-italic locale tags)) ) '(([default] . [italic]) ([bold] . [bold-italic]) ([italic] . t) ([bold-italic] . t)))) -(defun make-face-bold-italic (face &optional locale) +(defun make-face-bold-italic (face &optional locale tags) "Make FACE bold and italic in LOCALE, if possible. This will attempt to make the font bold-italic for X locales and will set the highlight and underline flags for TTY locales. @@ -1015,25 +1023,25 @@ for more specifics on exactly how this function works." (interactive (list (read-face-name "Make which face bold-italic: "))) (frob-face-font-2 - face locale 'default 'bold-italic + face locale tags 'default 'bold-italic (lambda () ;; handle TTY specific entries (when (featurep 'tty) - (set-face-highlight-p face t locale 'tty) - (set-face-underline-p face t locale 'tty))) + (set-face-highlight-p face t locale (cons 'tty tags)) + (set-face-underline-p face t locale (cons 'tty tags)))) (lambda () ;; handle X specific entries (when (featurep 'x) - (frob-face-property face 'font 'x-make-font-bold-italic locale)) + (frob-face-property face 'font 'x-make-font-bold-italic locale tags)) (when (featurep 'mswindows) - (frob-face-property face 'font 'mswindows-make-font-bold-italic locale)) + (frob-face-property face 'font 'mswindows-make-font-bold-italic locale tags)) ) '(([default] . [italic]) ([bold] . [bold-italic]) ([italic] . [bold-italic]) ([bold-italic] . t)))) -(defun make-face-unbold (face &optional locale) +(defun make-face-unbold (face &optional locale tags) "Make FACE non-bold in LOCALE, if possible. This will attempt to make the font non-bold for X locales and will unset the highlight flag for TTY locales. @@ -1041,24 +1049,24 @@ for more specifics on exactly how this function works." (interactive (list (read-face-name "Make which face non-bold: "))) (frob-face-font-2 - face locale 'bold 'default + face locale tags 'bold 'default (lambda () ;; handle TTY specific entries (when (featurep 'tty) - (set-face-highlight-p face nil locale 'tty))) + (set-face-highlight-p face nil locale (cons 'tty tags)))) (lambda () ;; handle X specific entries (when (featurep 'x) - (frob-face-property face 'font 'x-make-font-unbold locale)) + (frob-face-property face 'font 'x-make-font-unbold locale tags)) (when (featurep 'mswindows) - (frob-face-property face 'font 'mswindows-make-font-unbold locale)) + (frob-face-property face 'font 'mswindows-make-font-unbold locale tags)) ) '(([default] . t) ([bold] . [default]) ([italic] . t) ([bold-italic] . [italic])))) -(defun make-face-unitalic (face &optional locale) +(defun make-face-unitalic (face &optional locale tags) "Make FACE non-italic in LOCALE, if possible. This will attempt to make the font non-italic for X locales and will unset the underline flag for TTY locales. @@ -1066,17 +1074,17 @@ for more specifics on exactly how this function works." (interactive (list (read-face-name "Make which face non-italic: "))) (frob-face-font-2 - face locale 'italic 'default + face locale tags 'italic 'default (lambda () ;; handle TTY specific entries (when (featurep 'tty) - (set-face-underline-p face nil locale 'tty))) + (set-face-underline-p face nil locale (cons 'tty tags)))) (lambda () ;; handle X specific entries (when (featurep 'x) - (frob-face-property face 'font 'x-make-font-unitalic locale)) + (frob-face-property face 'font 'x-make-font-unitalic locale tags)) (when (featurep 'mswindows) - (frob-face-property face 'font 'mswindows-make-font-unitalic locale)) + (frob-face-property face 'font 'mswindows-make-font-unitalic locale tags)) ) '(([default] . t) ([bold] . t) @@ -1197,27 +1205,32 @@ ;; Old name, used by custom. Also, FSFmacs name. (defvaralias 'initialize-face-resources 'init-face-from-resources) -(defun face-spec-set (face spec &optional frame) +;; Make sure all custom setting are added with this tag so we can +;; identify-them +(define-specifier-tag 'custom) + +(defun face-spec-set (face spec &optional frame tags) "Set FACE's face attributes according to the first matching entry in SPEC. If optional FRAME is non-nil, set it for that frame only. If it is nil, then apply SPEC to each frame individually. See `defface' for information about SPEC." (if frame (progn - (reset-face face frame) - (face-display-set face spec frame) + (reset-face face frame tags) + (face-display-set face spec frame tags) (init-face-from-resources face frame)) (let ((frames (relevant-custom-frames))) - (reset-face face) - (if (and (eq 'default face) (featurep 'x)) - (x-init-global-faces)) - (face-display-set face spec) + (reset-face face nil tags) + ;; This should not be needed. We only remove our own specifiers + ;; (if (and (eq 'default face) (featurep 'x)) + ;; (x-init-global-faces)) + (face-display-set face spec nil tags) (while frames - (face-display-set face spec (car frames)) + (face-display-set face spec (car frames) tags) (pop frames)) (init-face-from-resources face)))) -(defun face-display-set (face spec &optional frame) +(defun face-display-set (face spec &optional frame tags) "Set FACE to the attributes to the first matching entry in SPEC. Iff optional FRAME is non-nil, set it for that frame only. See `defface' for information about SPEC." @@ -1228,7 +1241,7 @@ (when (face-spec-set-match-display display frame) ;; Avoid creating frame local duplicates of the global face. (unless (and frame (eq display (get face 'custom-face-display))) - (apply 'face-custom-attributes-set face frame atts)) + (apply 'face-custom-attributes-set face frame tags atts)) (unless frame (put face 'custom-face-display display)) (setq spec nil))))) @@ -1347,6 +1360,24 @@ (get-custom-frame-properties frame)) (initialize-custom-faces frame))) +(defun startup-initialize-custom-faces () + "Reset faces created by defface. Only called at startup. +Don't use this function in your program." + (when default-custom-frame-properties + ;; Reset default value to the actual frame, not stream. + (setq default-custom-frame-properties + (extract-custom-frame-properties (selected-frame))) + ;; like initialize-custom-faces but removes property first. + (mapc (lambda (symbol) + (let ((spec (or (get symbol 'saved-face) + (get symbol 'face-defface-spec)))) + (when spec + ;; Reset faces created during auto-autoloads loading. + (reset-face symbol) + ;; And set it according to the spec. + (face-display-set symbol spec nil)))) + (face-list)))) + (defun make-empty-face (name &optional doc-string temporary) "Like `make-face', but doesn't query the resource database." @@ -1397,7 +1428,8 @@ (mswindows-init-device-faces device)) ;; Nothing to do for TTYs? ) - (init-other-random-faces device))) + (or (eq 'stream (device-type device)) + (init-other-random-faces device)))) (defun init-frame-faces (frame) (when init-face-from-resources @@ -1507,7 +1539,7 @@ ;; It's unreasonable to expect to be able to make a font italic all ;; the time. For many languages, italic is an alien concept. ;; Basically, because italic is not a globally meaningful concept, - ;; the use of the italic face should really be oboleted. + ;; the use of the italic face should really be obsoleted. ;; I disagree with above. In many languages, the concept of capital ;; letters is just as alien, and yet we use them. Italic is here to @@ -1575,7 +1607,7 @@ in that frame; otherwise change each frame." (while (not (find-face face)) (setq face (signal 'wrong-type-argument (list 'facep face)))) - (locate-file pixmap x-bitmap-file-path ".xbm:" 4) + (locate-file pixmap x-bitmap-file-path '(".xbm" "")) (while (cond ((stringp pixmap) (unless (file-readable-p pixmap) (setq pixmap `[xbm :file ,pixmap])) @@ -1605,6 +1637,7 @@ (set-face-underline-p 'underline t 'global '(default))) (make-face 'zmacs-region "Used on highlightes region between point and mark.") (make-face 'isearch "Used on region matched by isearch.") +(make-face 'isearch-secondary "Face to use for highlighting all matches.") (make-face 'list-mode-item-selected "Face for the selected list item in list-mode.") (make-face 'highlight "Highlight face.") @@ -1694,6 +1727,13 @@ ((mswindows default color) . "green")) 'global) +;; #### This should really, I mean *really*, be converted to some form +;; of `defface' one day. +(set-face-foreground 'isearch-secondary + '(((x default color) . "red3") + ((mswindows default color) . "red3")) + 'global) + ;; Define some logical color names to be used when reading the pixmap files. (if (featurep 'xpm) (setq xpm-color-symbols diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/files.el --- a/lisp/files.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/files.el Mon Aug 13 11:13:30 2007 +0200 @@ -794,29 +794,36 @@ (setq tail (cdr tail)))) (when hack-homedir ;; Compute and save the abbreviated homedir name. - ;; We defer computing this until the first time it's needed, to - ;; give time for directory-abbrev-alist to be set properly. - ;; We include a slash at the end, to avoid spurious matches - ;; such as `/usr/foobar' when the home dir is `/usr/foo'. + ;; We defer computing this until the first time it's needed, + ;; to give time for directory-abbrev-alist to be set properly. + ;; We include the separator at the end, to avoid spurious + ;; matches such as `/usr/foobar' when the home dir is + ;; `/usr/foo'. (or abbreviated-home-dir (setq abbreviated-home-dir (let ((abbreviated-home-dir "$foo")) - (concat "\\`" (regexp-quote (abbreviate-file-name - (expand-file-name "~"))) - "\\(/\\|\\'\\)")))) + (concat "\\`" + (regexp-quote + (abbreviate-file-name (expand-file-name "~"))) + "\\(" + (regexp-quote (string directory-sep-char)) + "\\|\\'\\)")))) ;; If FILENAME starts with the abbreviated homedir, ;; make it start with `~' instead. (if (and (string-match abbreviated-home-dir filename) ;; If the home dir is just /, don't change it. - (not (and (= (match-end 0) 1) ;#### unix-specific - (= (aref filename 0) ?/))) - (not (and (memq system-type '(ms-dos windows-nt)) + (not (and (= (match-end 0) 1) + (= (aref filename 0) directory-sep-char))) + (not (and (eq system-type 'windows-nt) (save-match-data - (string-match "^[a-zA-Z]:/$" filename))))) + (string-match (concat "\\`[a-zA-Z]:" + (regexp-quote + (string directory-sep-char)) + "\\'") + filename))))) (setq filename (concat "~" - (substring filename - (match-beginning 1) (match-end 1)) + (match-string 1 filename) (substring filename (match-end 0)))))) filename))) @@ -1157,8 +1164,9 @@ ("\\.m\\(?:[mes]\\|an\\)\\'" . nroff-mode) ("\\.icn\\'" . icon-mode) ("\\.\\(?:[ckz]?sh\\|shar\\)\\'" . sh-mode) + ("\\.pro\\'" . idlwave-mode) ;; #### Unix-specific! - ("/\\.\\(?:bash_\\|z\\)?\\(profile\\|login\||logout\\)\\'" . sh-mode) + ("/\\.\\(?:bash_\\|z\\)?\\(profile\\|login\\|logout\\)\\'" . sh-mode) ("/\\.\\(?:[ckz]sh\\|bash\\|tcsh\\|es\\|xinit\\|startx\\)rc\\'" . sh-mode) ("/\\.\\(?:[kz]shenv\\|xsession\\)\\'" . sh-mode) ;; The following come after the ChangeLog pattern for the sake of @@ -1221,7 +1229,9 @@ ("python" . python-mode) ("awk\\b" . awk-mode) ("rexx" . rexx-mode) - ("scm" . scheme-mode) + ("scm\\|guile" . scheme-mode) + ("emacs" . emacs-lisp-mode) + ("make" . makefile-mode) ("^:" . sh-mode)) "Alist mapping interpreter names to major modes. This alist is used to guess the major mode of a file based on the @@ -1270,7 +1280,7 @@ from the end of the file name anything that matches one of these regexps.") (defvar user-init-file - "" ; set by command-line + nil ; set by command-line "File name including directory of user's initialization file.") (defun set-auto-mode (&optional just-from-file-name) @@ -1309,9 +1319,15 @@ (setq keep-going nil) (let ((alist auto-mode-alist) (mode nil)) + ;; Find first matching alist entry. + + ;; #### This is incorrect. In NT, case sensitivity is a volume + ;; property. For instance, NFS mounts *are* case sensitive. + ;; Need internal function (file-name-case-sensitive f), F + ;; being file or directory name. - kkm (let ((case-fold-search - (memq system-type '(windows-nt)))) + (eq system-type 'windows-nt))) (while (and (not mode) alist) (if (string-match (car (car alist)) name) (if (and (consp (cdr (car alist))) @@ -1869,7 +1885,7 @@ (let ((delete-old-versions ;; If have old versions to maybe delete, ;; ask the user to confirm now, before doing anything. - ;; But don't actually delete til later. + ;; But don't actually delete till later. (and targets (or (eq delete-old-versions t) (eq delete-old-versions nil)) @@ -1987,21 +2003,13 @@ (defun make-backup-file-name (file) "Create the non-numeric backup file name for FILE. This is a separate function so you can redefine it for customization." - (if (eq system-type 'ms-dos) - (let ((fn (file-name-nondirectory file))) - (concat (file-name-directory file) - (if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn) - (substring fn 0 (match-end 1))) - ".bak")) - (concat file "~"))) + (concat file "~")) (defun backup-file-name-p (file) "Return non-nil if FILE is a backup file name (numeric or not). This is a separate function so you can redefine it for customization. You may need to redefine `file-name-sans-versions' as well." - (if (eq system-type 'ms-dos) - (string-match "\\.bak\\'" file) - (string-match "~\\'" file))) + (string-match "~\\'" file)) ;; This is used in various files. ;; The usage of bv-length is not very clean, @@ -2081,7 +2089,7 @@ (expand-file-name (or directory default-directory)))) ;; On Microsoft OSes, if FILENAME and DIRECTORY have different ;; drive names, they can't be relative, so return the absolute name. - (if (and (memq system-type '(ms-dos windows-nt)) + (if (and (eq system-type 'windows-nt) (not (string-equal (substring fname 0 2) (substring directory 0 2)))) filename @@ -2211,19 +2219,21 @@ (error "Save not confirmed")) (save-restriction (widen) - (and (> (point-max) 1) - (/= (char-after (1- (point-max))) ?\n) - (not (and (eq selective-display t) - (= (char-after (1- (point-max))) ?\r))) - (or (eq require-final-newline t) - (and require-final-newline - (y-or-n-p - (format "Buffer %s does not end in newline. Add one? " - (buffer-name))))) - (save-excursion - (goto-char (point-max)) - (insert ?\n))) - ;; + + ;; Add final newline if required. See `require-final-newline'. + (when (and (not (eq (char-before (point-max)) ?\n)) ; common case + (char-before (point-max)) ; empty buffer? + (not (and (eq selective-display t) + (eq (char-before (point-max)) ?\r))) + (or (eq require-final-newline t) + (and require-final-newline + (y-or-n-p + (format "Buffer %s does not end in newline. Add one? " + (buffer-name)))))) + (save-excursion + (goto-char (point-max)) + (insert ?\n))) + ;; Run the write-file-hooks until one returns non-null. ;; Bind after-save-hook to nil while running the ;; write-file-hooks so that if this function is called @@ -2680,7 +2690,7 @@ file-name))) (run-hooks 'before-revert-hook) ;; If file was backed up but has changed since, - ;; we shd make another backup. + ;; we should make another backup. (and (not auto-save-p) (not (verify-visited-file-modtime (current-buffer))) (setq buffer-backed-up nil)) @@ -2751,11 +2761,12 @@ (not (file-exists-p file-name))) (error "Auto-save file %s not current" file-name)) ((save-window-excursion - (with-output-to-temp-buffer "*Directory*" - (buffer-disable-undo standard-output) - (call-process "ls" nil standard-output nil - (if (file-symlink-p file) "-lL" "-l") - file file-name)) + (if (not (eq system-type 'windows-nt)) + (with-output-to-temp-buffer "*Directory*" + (buffer-disable-undo standard-output) + (call-process "ls" nil standard-output nil + (if (file-symlink-p file) "-lL" "-l") + file file-name))) (yes-or-no-p (format "Recover auto save file %s? " file-name))) (switch-to-buffer (find-file-noselect file t)) (let ((buffer-read-only nil)) @@ -3130,6 +3141,8 @@ (funcall handler 'insert-directory file switches wildcard full-directory-p) (cond + ;; #### mswindows-insert-directory should be called + ;; nt-insert-directory - kkm. ((and (fboundp 'mswindows-insert-directory) (eq system-type 'windows-nt)) (mswindows-insert-directory file switches wildcard full-directory-p)) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/fill.el --- a/lisp/fill.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/fill.el Mon Aug 13 11:13:30 2007 +0200 @@ -33,7 +33,7 @@ ;; 97/3/14 Jareth Hein (jhod@po.iijnet.or.jp) added functions for kinsoku (asian text ;; line break processing) -;; 97/06/11 Steve Baur (steve@altair.xemacs.org) converted broken +;; 97/06/11 Steve Baur (steve@xemacs.org) converted broken ;; following-char/preceding-char calls to char-after/char-before. ;;; Code: @@ -226,9 +226,10 @@ ;; XEmacs change (if (not dont-skip-first) (forward-line 1)) - (if (>= (point) to) - (goto-char firstline) - (setq at-second t)) + (cond ((>= (point) to) + (goto-char firstline)) + ((/= (point) from) + (setq at-second t))) (move-to-left-margin) ;; XEmacs change (let ((start (point)) @@ -236,7 +237,7 @@ ;(eol (save-excursion (end-of-line) (point))) ) (setq result - (if (not (looking-at paragraph-start)) + (if (or dont-skip-first (not (looking-at paragraph-start))) (cond ((and adaptive-fill-regexp (looking-at adaptive-fill-regexp)) (buffer-substring-no-properties start (match-end 0))) (adaptive-fill-function (funcall adaptive-fill-function))))) @@ -382,7 +383,7 @@ (skip-chars-forward " \t") ;; Then change all newlines to spaces. ;;; 97/3/14 jhod: Kinsoku change - ;; Spacing is not necessary for charcters of no word-separater. + ;; Spacing is not necessary for characters of no word-separator. ;; The regexp word-across-newline is used for this check. (defvar word-across-newline) (if (not (and (featurep 'mule) @@ -429,7 +430,8 @@ ;; This is the actual filling loop. (let ((prefixcol 0) linebeg (re-break-point (if (featurep 'mule) - (concat "[ \n\t]\\|" word-across-newline) + (concat "[ \n\t]\\|" word-across-newline + ".\\|." word-across-newline) "[ \n\t]"))) (while (not (eobp)) (setq linebeg (point)) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/find-paths.el --- a/lisp/find-paths.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/find-paths.el Mon Aug 13 11:13:30 2007 +0200 @@ -218,13 +218,13 @@ ;; from more to less specific (paths-find-version-directory roots (concat base system-configuration) - envvar) + envvar default) (paths-find-version-directory roots base envvar) (paths-find-version-directory roots system-configuration - envvar default))) + envvar))) (defun construct-emacs-version-name () "Construct the raw XEmacs version number." diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/finder.el --- a/lisp/finder.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/finder.el Mon Aug 13 11:13:30 2007 +0200 @@ -285,8 +285,12 @@ found))) (defun finder-commentary (file) - (interactive) - (let* ((str (lm-commentary (finder-find-library file)))) + "Display FILE's commentary section. +FILE should be in a form suitable for passing to `locate-library'." + (interactive "sLibrary name: ") + (let* ((str (lm-commentary (or (finder-find-library file) + (finder-find-library (concat file ".el")) + (error "Can't find library %s" file))))) (if (null str) (error "Can't find any Commentary section")) (pop-to-buffer "*Finder*") diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/font-lock.el --- a/lisp/font-lock.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/font-lock.el Mon Aug 13 11:13:30 2007 +0200 @@ -4,7 +4,7 @@ ;; Copyright (C) 1995 Amdahl Corporation. ;; Copyright (C) 1996 Ben Wing. -;; Author: Jamie Zawinski , for the LISPM Preservation Society. +;; Author: Jamie Zawinski , for the LISPM Preservation Society. ;; Minimally merged with FSF 19.34 by Barry Warsaw ;; Then (partially) synched with FSF 19.30, leading to: ;; Next Author: RMS @@ -611,7 +611,11 @@ '((((class color) (background dark)) (:foreground "light coral")) (((class color) (background light)) (:foreground "green4")) (t (:bold t))) - "Font Lock mode face used to highlight documentation strings." + "Font Lock mode face used to highlight documentation strings. +This is currently supported only in Lisp-like modes, which are those +with \"lisp\" or \"scheme\" in their name. You can explicitly make +a mode Lisp-like by putting a non-nil `font-lock-lisp-like' property +on the major mode's symbol." :group 'font-lock-faces) (defface font-lock-keyword-face @@ -1284,6 +1288,16 @@ ; ;; Clean up. ; (and prev (remove-text-properties prev end '(face nil))))) +(defun font-lock-lisp-like (mode) + ;; Note: (or (get mode 'font-lock-lisp-like) (string-match ...)) is + ;; not enough because the property needs to be able to specify a nil + ;; value. + (if (plist-member (symbol-plist mode) 'font-lock-lisp-like) + (get mode 'font-lock-lisp-like) + ;; If the property is not specified, guess. Similar logic exists + ;; in add-log, but I think this encompasses more modes. + (string-match "lisp\\|scheme" (symbol-name mode)))) + (defun font-lock-fontify-syntactically-region (start end &optional loudly) "Put proper face on each string and comment between START and END. START should be at the beginning of a line." @@ -1296,21 +1310,24 @@ (font-lock-unfontify-region start end loudly) (goto-char start) (if (> end (point-max)) (setq end (point-max))) - (syntactically-sectionize - #'(lambda (s e context depth) - (let (face) - (cond ((eq context 'string) - ;;#### Should only do this is Lisp-like modes! - (setq face - (if (= depth 1) - ;; really we should only use this if - ;; in position 3 depth 1, but that's - ;; too expensive to compute. - 'font-lock-doc-string-face - 'font-lock-string-face))) - ((or (eq context 'comment) - (eq context 'block-comment)) - (setq face 'font-lock-comment-face) + (let ((lisp-like (font-lock-lisp-like major-mode))) + (syntactically-sectionize + #'(lambda (s e context depth) + (let (face) + (cond ((eq context 'string) + (setq face + ;; #### It would be nice if we handled + ;; Python and other non-Lisp languages with + ;; docstrings correctly. + (if (and lisp-like (= depth 1)) + ;; really we should only use this if + ;; in position 3 depth 1, but that's + ;; too expensive to compute. + 'font-lock-doc-string-face + 'font-lock-string-face))) + ((or (eq context 'comment) + (eq context 'block-comment)) + (setq face 'font-lock-comment-face) ; ;; Don't fontify whitespace at the beginning of lines; ; ;; otherwise comment blocks may not line up with code. ; ;; (This is sometimes a good idea, sometimes not; in any @@ -1323,9 +1340,9 @@ ; (skip-chars-forward " \t\n") ; (setq s (point))) )) - (font-lock-set-face s e face))) - start end) - )) + (font-lock-set-face s e face))) + start end) + ))) ;;; Additional text property functions. @@ -2444,11 +2461,11 @@ (goto-char (match-end 1)) (goto-char (match-end 0)) (1 font-lock-variable-name-face)))))) - + ;; Modifier keywords and Java doc tags (setq java-font-lock-keywords-3 (append - + '( ;; Feature scoping: ;; These must come first or the Modifiers from keywords-1 will @@ -2458,11 +2475,11 @@ ("\\" 0 font-lock-preprocessor-face) ("\\" 0 font-lock-reference-face)) java-font-lock-keywords-2 - + (list ;; Java doc tags - '("@\\(author\\|exception\\|param\\|return\\|see\\|version\\)\\s " + '("@\\(author\\|exception\\|throws\\|deprecated\\|param\\|return\\|see\\|since\\|version\\)\\s " 0 font-lock-keyword-face t) ;; Doc tag - Parameter identifiers @@ -2470,7 +2487,17 @@ 1 'font-lock-variable-name-face t) ;; Doc tag - Exception types - (list (concat "@exception\\ s*" + (list (concat "@exception\\s +" + java-font-lock-identifier-regexp) + '(1 (if (equal (char-after (match-end 0)) ?.) + font-lock-reference-face font-lock-type-face) t) + (list (concat "\\=\\." java-font-lock-identifier-regexp) + '(goto-char (match-end 0)) nil + '(1 (if (equal (char-after (match-end 0)) ?.) + 'font-lock-reference-face 'font-lock-type-face) t))) + + ;; Doc tag - Exception types + (list (concat "@exception\\s +" java-font-lock-identifier-regexp) '(1 (if (equal (char-after (match-end 0)) ?.) font-lock-reference-face font-lock-type-face) t) @@ -2482,7 +2509,14 @@ ;; Doc tag - Cross-references, usually to methods '("@see\\s +\\(\\S *[^][ \t\n\r\f(){},.;:]\\)" 1 font-lock-function-name-face t) - + + ;; Doc tag - Links + '("{@link\\s +\\([^}]*\\)}" + 0 font-lock-keyword-face t) + ;; Doc tag - Links + '("{@link\\s +\\(\\S +\\s +\\S +\\)}" + 1 font-lock-function-name-face t) + ))) ) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/font-menu.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/font-menu.el Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,457 @@ +;; font-menu.el --- Managing menus of fonts. + +;; Copyright (C) 1994 Free Software Foundation, Inc. +;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp. +;; Copyright (C) 1997 Sun Microsystems + +;; Adapted from x-font-menu.el by Andy Piper + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;; This file contains the device-nospecific font menu stuff + +;;; Commentary: +;;; +;;; Creates three menus, "Font", "Size", and "Weight", and puts them on the +;;; "Options" menu. The contents of these menus are the superset of those +;;; properties available on any fonts, but only the intersection of the three +;;; sets is selectable at one time. +;;; +;;; Known Problems: +;;; =============== +;;; Items on the Font menu are selectable if and only if that font exists in +;;; the same size and weight as the current font. This means that some fonts +;;; are simply not reachable from some other fonts - if only one font comes +;;; in only one point size (like "Nil", which comes only in 2), you will never +;;; be able to select it. It would be better if the items on the Fonts menu +;;; were always selectable, and selecting them would set the size to be the +;;; closest size to the current font's size. +;;; +;;; This attempts to change all other faces in an analogous way to the change +;;; that was made to the default face; if it can't, it will skip over the face. +;;; However, this could leave incongruous font sizes around, which may cause +;;; some nonreversibility problems if further changes are made. Perhaps it +;;; should remember the initial fonts of all faces, and derive all subsequent +;;; fonts from that initial state. +;;; +;;; xfontsel(1) is a lot more flexible (but probably harder to understand). +;;; +;;; The code to construct menus from all of the x11 fonts available from the +;;; server is autoloaded and executed the very first time that one of the Font +;;; menus is selected on each device. That is, if XEmacs has frames on two +;;; different devices, then separate font menu information will be maintained +;;; for each X display. If the font path changes after emacs has already +;;; asked the X server on a particular display for its list of fonts, this +;;; won't notice. Also, the first time that a font menu is posted on each +;;; display will entail a lengthy delay, but that's better than slowing down +;;; XEmacs startup. At any time (i.e.: after a font-path change or +;;; immediately after device creation), you can call +;;; `reset-device-font-menus' to rebuild the menus from all currently +;;; available fonts. +;;; +;;; There is knowledge here about the regexp match numbers in +;;; `mswindows-font-regexp' and `mswindows-font-regexp-foundry-and-family' defined in +;;; mswindows-faces.el. +;;; +;;; There are at least three kinds of fonts under X11r5: +;;; +;;; - bitmap fonts, which can be assumed to look as good as possible; +;;; - bitmap fonts which have been (or can be) automatically scaled to +;;; a new size, and which almost always look awful; +;;; - and true outline fonts, which should look ok at any size, but in +;;; practice (on at least some systems) look awful at any size, and +;;; even in theory are unlikely ever to look as good as non-scaled +;;; bitmap fonts. +;;; +;;; It would be nice to get this code to look for non-scaled bitmap fonts +;;; first, then outline fonts, then scaled bitmap fonts as a last resort. +;;; But it's not clear to me how to tell them apart based on their truenames +;;; and/or the result of XListFonts(). I welcome any and all explanations +;;; of the subtleties involved... +;;; +;;; +;;; If You Think You'Re Seeing A Bug: +;;; ================================= +;;; When reporting problems, send the following information: +;;; +;;; - Exactly what behavior you're seeing; +;;; - The output of the `xlsfonts' program; +;;; - The value of the variable `device-fonts-cache'; +;;; - The values of the following expressions, both before and after +;;; making a selection from any of the fonts-related menus: +;;; (face-font 'default) +;;; (font-truename (face-font 'default)) +;;; (font-properties (face-font 'default)) +;;; - The values of the following variables after making a selection: +;;; font-menu-preferred-resolution +;;; font-menu-registry-encoding +;;; +;;; There is a common misconception that "*-courier-medium-r-*-11-*", also +;;; known as "-adobe-courier-medium-r-normal--11-80-100-100-m-60-iso8859-1", +;;; is an 11-point font. It is not -- it is an 11-pixel font at 100dpi, +;;; which is an 8-point font (the number after -11- is the size in tenths +;;; of points). So if you expect to be seeing an "11" entry in the "Size" +;;; menu and are not, this may be why. +;;; +;;; In the real world (aka Solaris), one has to deal with fonts that +;;; appear to be medium-i but are really light-r, and fonts that +;;; resolve to different resolutions depending on the charset: +;;; +;;; (font-instance-truename +;;; (make-font-instance "-*-mincho-medium-i-normal-*-*-*-*-*-*-*-jisx0201*-*")) +;;; ==> +;;; "-morisawa-ryumin light kl-light-r-normal--10-100-72-72-m-50-jisx0201.1976-0" +;;; +;;; (list-fonts "-dt-interface user-medium-r-normal-s*-*-*-*-*-*-*-*-*") +;;; ==> +;;; ("-dt-interface user-medium-r-normal-s sans-12-120-72-72-m-70-iso8859-1" +;;; "-dt-interface user-medium-r-normal-s-14-120-75-75-m-120-jisx0208.1983-0" +;;; "-dt-interface user-medium-r-normal-s-14-120-75-75-m-60-jisx0201.1976-0") + +;;;###autoload +(defcustom font-menu-ignore-scaled-fonts nil + "*If non-nil, then the font menu will try to show only bitmap fonts." + :type 'boolean + :group 'font-menu) + +;;;###autoload +(defcustom font-menu-this-frame-only-p nil + "*If non-nil, then changing the default font from the font menu will only +affect one frame instead of all frames." + :type 'boolean + :group 'font-menu) + +(defcustom font-menu-max-items 25 + "*Maximum number of items in the font menu +If number of entries in a menu is larger than this value, split menu +into submenus of nearly equal length. If nil, never split menu into +submenus." + :group 'font-menu + :type '(choice (const :tag "no submenus" nil) + (integer))) + +(defcustom font-menu-submenu-name-format "%-12.12s ... %.12s" + "*Format specification of the submenu name. +Used by `font-menu-split-long-menu' if the number of entries in a menu is +larger than `font-menu-menu-max-items'. +This string should contain one %s for the name of the first entry and +one %s for the name of the last entry in the submenu. +If the value is a function, it should return the submenu name. The +function is be called with two arguments, the names of the first and +the last entry in the menu." + :group 'font-menu + :type '(choice (string :tag "Format string") + (function))) + +(defvar font-menu-preferred-resolution + (make-specifier-and-init 'generic '((global ((mswindows) . ":") + ((x) . "*-*"))) t) + "Preferred horizontal and vertical font menu resolution (e.g. \"75:75\").") + +(defvar font-menu-size-scaling + (make-specifier-and-init 'integer '((global ((mswindows) . 1) + ((x) . 10))) t) + "Scale factor used in defining font sizes.") + +(defun vassoc (key valist) + "Search VALIST for a vector whose first element is equal to KEY. +See also `assoc'." + ;; by Stig@hackvan.com + (let (el) + (catch 'done + (while (setq el (pop valist)) + (and (equal key (aref el 0)) + (throw 'done el)))))) + +;; only call XListFonts (and parse) once per device. +;; ( (device . [parsed-list-fonts family-menu size-menu weight-menu]) ...) +(defvar device-fonts-cache nil) + +(defsubst device-fonts-cache () + (or (cdr (assq (selected-device) device-fonts-cache)) + (and (reset-device-font-menus (selected-device)) + (cdr (assq (selected-device) device-fonts-cache))))) + +;;;###autoload +(fset 'install-font-menus 'reset-device-font-menus) +(make-obsolete 'install-font-menus 'reset-device-font-menus) + +;;;###autoload +(defun reset-device-font-menus (&optional device debug) + "Generates the `Font', `Size', and `Weight' submenus for the Options menu. +This is run the first time that a font-menu is needed for each device. +If you don't like the lazy invocation of this function, you can add it to +`create-device-hook' and that will make the font menus respond more quickly +when they are selected for the first time. If you add fonts to your system, +or if you change your font path, you can call this to re-initialize the menus." + (message "Getting list of fonts from server... ") + (if (or noninteractive + (not (or device (setq device (selected-device))))) + nil + (call-device-method 'reset-device-font-menus device device debug) + (message "Getting list of fonts from server... done."))) + +(defun font-menu-split-long-menu (menu) + "Split MENU according to `font-menu-max-items'." + (let ((len (length menu))) + (if (or (null font-menu-max-items) + (null (featurep 'lisp-float-type)) + (<= len font-menu-max-items)) + menu + ;; Submenu is max 2 entries longer than menu, never shorter, number of + ;; entries in submenus differ by at most one (with longer submenus first) + (let* ((outer (floor (sqrt len))) + (inner (/ len outer)) + (rest (% len outer)) + (result nil)) + (setq menu (reverse menu)) + (while menu + (let ((in inner) + (sub nil) + (to (car menu))) + (while (> in 0) + (setq in (1- in) + sub (cons (car menu) sub) + menu (cdr menu))) + (setq result + (cons (cons (if (stringp font-menu-submenu-name-format) + (format font-menu-submenu-name-format + (aref (car sub) 0) (aref to 0)) + (funcall font-menu-submenu-name-format + (aref (car sub) 0) (aref to 0))) + sub) + result) + rest (1+ rest)) + (if (= rest outer) (setq inner (1+ inner))))) + result)))) + +;;;###autoload +(defun font-menu-family-constructor (ignored) + (catch 'menu + (unless (console-on-window-system-p) + (throw 'menu '(["Cannot parse current font" ding nil]))) + (let* ((dcache (device-fonts-cache)) + (font-data (font-menu-font-data 'default dcache)) + (entry (aref font-data 0)) + (family (aref font-data 1)) + (size (aref font-data 2)) + (weight (aref font-data 3)) + f) + (unless family + (throw 'menu '(["Cannot parse current font" ding nil]))) + ;; Items on the Font menu are enabled iff that font exists in + ;; the same size and weight as the current font (scalable fonts + ;; exist in every size). Only the current font is marked as + ;; selected. + (font-menu-split-long-menu + (mapcar + (lambda (item) + (setq f (aref item 0) + entry (vassoc f (aref dcache 0))) + (if (and (or (member weight (aref entry 1)) + ;; mswindows often allows any weight + (member "" (aref entry 1))) + (or (member size (aref entry 2)) + (and (not font-menu-ignore-scaled-fonts) + (member 0 (aref entry 2))))) + (enable-menu-item item) + (disable-menu-item item)) + (if (string-equal family f) + (select-toggle-menu-item item) + (deselect-toggle-menu-item item)) + item) + (aref dcache 1)))))) + +(define-device-method* font-menu-font-data) + +;;;###autoload +(defun font-menu-size-constructor (ignored) + (catch 'menu + (unless (console-on-window-system-p) + (throw 'menu '(["Cannot parse current font" ding nil]))) + (let* ((dcache (device-fonts-cache)) + (font-data (font-menu-font-data 'default dcache)) + (entry (aref font-data 0)) + (family (aref font-data 1)) + (size (aref font-data 2)) + ;;(weight (aref font-data 3)) + s) + (unless family + (throw 'menu '(["Cannot parse current font" ding nil]))) + ;; Items on the Size menu are enabled iff current font has + ;; that size. Only the size of the current font is selected. + ;; (If the current font comes in size 0, it is scalable, and + ;; thus has every size.) + (mapcar + (lambda (item) + (setq s (nth 3 (aref item 1))) + (if (or (member s (aref entry 2)) + (and (not font-menu-ignore-scaled-fonts) + (member 0 (aref entry 2)))) + (enable-menu-item item) + (disable-menu-item item)) + (if (eq size s) + (select-toggle-menu-item item) + (deselect-toggle-menu-item item)) + item) + (aref dcache 2))))) + +;;;###autoload +(defun font-menu-weight-constructor (ignored) + (catch 'menu + (unless (console-on-window-system-p) + (throw 'menu '(["Cannot parse current font" ding nil]))) + (let* ((dcache (device-fonts-cache)) + (font-data (font-menu-font-data 'default dcache)) + (entry (aref font-data 0)) + (family (aref font-data 1)) + ;;(size (aref font-data 2)) + (weight (aref font-data 3)) + w) + (unless family + (throw 'menu '(["Cannot parse current font" ding nil]))) + ;; Items on the Weight menu are enabled iff current font + ;; has that weight. Only the weight of the current font + ;; is selected. + (mapcar + (lambda (item) + (setq w (aref item 0)) + (if (member w (aref entry 1)) + (enable-menu-item item) + (disable-menu-item item)) + (if (string-equal weight w) + (select-toggle-menu-item item) + (deselect-toggle-menu-item item)) + item) + (aref dcache 3))))) + + +;;; Changing font sizes + +(defun font-menu-set-font (family weight size) + ;; This is what gets run when an item is selected from any of the three + ;; fonts menus. It needs to be rather clever. + ;; (size is measured in 10ths of points.) + (let* ((dcache (device-fonts-cache)) + (font-data (font-menu-font-data 'default dcache)) + (from-family (aref font-data 1)) + (from-size (aref font-data 2)) + (from-weight (aref font-data 3)) + (from-slant (aref font-data 4)) + (face-list-to-change (delq 'default (face-list))) + new-default-face-font + new-props) + (unless from-family + (signal 'error '("couldn't parse font name for default face"))) + (when weight + (signal 'error '("Setting weight currently not supported"))) + (setq new-default-face-font + (font-menu-load-font + (or family from-family) + (or weight from-weight) + (or size from-size) + from-slant + (specifier-instance + font-menu-preferred-resolution (selected-device)))) + ;; This is such a gross hack. The border-glyph face under + ;; mswindows is in a symbol font. Thus it will not appear in the + ;; cache - being a junk family. What we should do is change the + ;; size but not the family, but this is more work than I care to + ;; invest at the moment. + (when (eq (device-type) 'mswindows) + (setq face-list-to-change + (delq 'border-glyph face-list-to-change))) + (dolist (face face-list-to-change) + (when (face-font-instance face) + (message "Changing font of `%s'..." face) + (condition-case c + (font-menu-change-face face + from-family from-weight from-size + family weight size) + (error + (display-error c nil) + (sit-for 1))))) + ;; Set the default face's font after hacking the other faces, so that + ;; the frame size doesn't change until we are all done. + + ;; If we need to be frame local we do the changes ourselves. + (if font-menu-this-frame-only-p + ;;; WMP - we need to honor font-menu-this-frame-only-p here! + (set-face-font 'default new-default-face-font + (and font-menu-this-frame-only-p (selected-frame))) + ;; OK Let Customize do it. + (custom-set-face-update-spec 'default + (list (list 'type (device-type))) + (list :family family + :size (concat + (int-to-string + (/ (or size from-size) + (specifier-instance font-menu-size-scaling + (selected-device)))) + "pt"))) + (message "Font %s" (face-font-name 'default))))) + + +(defun font-menu-change-face (face + from-family from-weight from-size + to-family to-weight to-size) + (or (symbolp face) (signal 'wrong-type-argument (list 'symbolp face))) + (let* ((dcache (device-fonts-cache)) + (font-data (font-menu-font-data face dcache)) + (face-family (aref font-data 1)) + (face-size (aref font-data 2)) + (face-weight (aref font-data 3)) + (face-slant (aref font-data 4))) + + (or face-family + (signal 'error (list "couldn't parse font name for face" face))) + + ;; If this face matches the old default face in the attribute we + ;; are changing, then change it to the new attribute along that + ;; dimension. Also, the face must have its own global attribute. + ;; If its value is inherited, we don't touch it. If any of this + ;; is not true, we leave it alone. + (when (and (face-font face 'global) + (cond + (to-family (string-equal face-family from-family)) + (to-weight (string-equal face-weight from-weight)) + (to-size (= face-size from-size)))) + (set-face-font face + (font-menu-load-font (or to-family face-family) + (or to-weight face-weight) + (or to-size face-size) + face-slant + (specifier-instance + font-menu-preferred-resolution + (selected-device))) + (and font-menu-this-frame-only-p + (selected-frame)))))) + +(define-device-method font-menu-load-font) + +(defun flush-device-fonts-cache (device) + ;; by Stig@hackvan.com + (let ((elt (assq device device-fonts-cache))) + (and elt + (setq device-fonts-cache (delq elt device-fonts-cache))))) + +(add-hook 'delete-device-hook 'flush-device-fonts-cache) + +(provide 'font-menu) + +;; font-menu ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/format.el --- a/lisp/format.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/format.el Mon Aug 13 11:13:30 2007 +0200 @@ -69,20 +69,21 @@ (put 'buffer-file-format 'permanent-local t) (defvar format-alist - '((image/jpeg "JPEG image" "\377\330\377\340\000\020JFIF" - image-decode-jpeg nil t image-mode) - (image/gif "GIF image" "GIF8[79]" - image-decode-gif nil t image-mode) - (image/png "Portable Network Graphics" "\211PNG" - image-decode-png nil t image-mode) - (image/x-xpm "XPM image" "/\\* XPM \\*/" - image-decode-xpm nil t image-mode) + '( +; (image/jpeg "JPEG image" "\377\330\377\340\000\020JFIF" +; image-decode-jpeg nil t image-mode) +; (image/gif "GIF image" "GIF8[79]" +; image-decode-gif nil t image-mode) +; (image/png "Portable Network Graphics" "\211PNG" +; image-decode-png nil t image-mode) +; (image/x-xpm "XPM image" "/\\* XPM \\*/" +; image-decode-xpm nil t image-mode) - ;; TIFF files have lousy magic - (image/tiff "TIFF image" "II\\*\000" - image-decode-tiff nil t image-mode) ;; TIFF 6.0 big-endian - (image/tiff "TIFF image" "MM\000\\*" - image-decode-tiff nil t image-mode) ;; TIFF 6.0 little-endian +; ;; TIFF files have lousy magic +; (image/tiff "TIFF image" "II\\*\000" +; image-decode-tiff nil t image-mode) ;; TIFF 6.0 big-endian +; (image/tiff "TIFF image" "MM\000\\*" +; image-decode-tiff nil t image-mode) ;; TIFF 6.0 little-endian (text/enriched "Extended MIME text/enriched format." "Content-[Tt]ype:[ \t]*text/enriched" diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/frame.el --- a/lisp/frame.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/frame.el Mon Aug 13 11:13:30 2007 +0200 @@ -502,14 +502,14 @@ Emacs uses this to avoid overriding explicit moves and resizings from the user during startup." (setq plist (canonicalize-lax-plist (copy-sequence plist))) - (mapcar #'(lambda (propname) - (if (lax-plist-member plist propname) + (mapcar #'(lambda (property) + (if (lax-plist-member plist property) (progn (setq frame-initial-geometry-arguments - (cons propname - (cons (lax-plist-get plist propname) + (cons property + (cons (lax-plist-get plist property) frame-initial-geometry-arguments))) - (setq plist (lax-plist-remprop plist propname))))) + (setq plist (lax-plist-remprop plist property))))) '(height width top left user-size user-position)) plist) @@ -571,8 +571,8 @@ Value is `tty' for a tty frame (a character-only terminal), `x' for a frame that is an X window, `ns' for a frame that is a NeXTstep window (not yet implemented), -`mswindows' for a frame that is a Windows NT or Windows 95/97 window, -`pc' for a frame that is a direct-write MS-DOS frame (not yet implemented), +`mswindows' for a frame that is a MS Windows desktop window, +`msprinter' for a frame that is a MS Windows print job, `stream' for a stream frame (which acts like a stdio stream), and `dead' for a deleted frame." (or frame (setq frame (selected-frame))) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/gnuserv.el --- a/lisp/gnuserv.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/gnuserv.el Mon Aug 13 11:13:30 2007 +0200 @@ -3,9 +3,9 @@ ;; Version: 3.11 ;; Author: Andy Norman (ange@hplb.hpl.hp.com), originally based on server.el -;; Hrvoje Niksic +;; Hrvoje Niksic ;; Maintainer: Jan Vroonhof , -;; Hrvoje Niksic +;; Hrvoje Niksic ;; Keywords: environment, processes, terminals ;; This file is part of XEmacs. @@ -73,7 +73,7 @@ ;; Jan Vroonhof ;; Customized. ;; -;; Hrvoje Niksic May/1997 +;; Hrvoje Niksic May/1997 ;; Completely rewritten. Now uses `defstruct' and other CL stuff ;; to define clients cleanly. Many thanks to Dave Gillespie! ;; @@ -348,11 +348,13 @@ ;; In case of an error, write the description to the ;; client, and then signal it. (error (setq gnuserv-string "") - (gnuserv-write-to-client gnuserv-current-client oops) + (when gnuserv-current-client + (gnuserv-write-to-client gnuserv-current-client oops)) (setq gnuserv-current-client nil) (signal (car oops) (cdr oops))) (quit (setq gnuserv-string "") - (gnuserv-write-to-client gnuserv-current-client oops) + (when gnuserv-current-client + (gnuserv-write-to-client gnuserv-current-client oops)) (setq gnuserv-current-client nil) (signal 'quit nil))) (setq gnuserv-string ""))) @@ -440,6 +442,7 @@ (client (make-gnuclient :id gnuserv-current-client :device device :frame new-frame))) + (select-frame frame) (setq gnuserv-current-client nil) ;; If the device was created by this client, push it to the list. (and (/= old-device-num (length (device-list))) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/gpm.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gpm.el Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,82 @@ +;;; gpm.el --- Support the mouse when emacs run on a Linux console. + +;; Copyright (C) 1999 Free Software Foundation + +;; Author: William Perry +;; Keywords: mouse, terminals + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +(defvar gpm-enabled-devices (make-hash-table :test 'eq + :size 13 + :weakness 'key) + "A hash table of devices with GPM currently turned on.") + +(defun gpm-mode (&optional arg device) + "Toggle GPM mouse mode. +With prefix arg, turn GPM mouse mode on if and only if arg is positive." + (interactive (list current-prefix-arg (selected-device))) + (cond + ((null arg) ; Toggle + (if (gethash device gpm-enabled-devices) + (progn + (gpm-enable device nil) + (remhash device gpm-enabled-devices)) + (gpm-enable device t) + (puthash device t gpm-enabled-devices))) + ((> arg 0) ; Turn on + (gpm-enable device t) + (puthash device t gpm-enabled-devices)) + ((gethash device gpm-enabled-devices) ; Turn off + (gpm-enable device nil) + (remhash device gpm-enabled-devices)))) + +(defun turn-on-gpm-mouse-tracking (&optional device) + ;; Enable mouse tracking on linux console + (gpm-mode 5 device)) + +(defun turn-off-gpm-mouse-tracking (&optional device) + ;; Disable mouse tracking on linux console + (gpm-mode -5 device)) + +(defun gpm-create-device-hook (device) + (if (and (not noninteractive) ; Don't want to do this in batch mode + (fboundp 'gpm-enable) ; Must have C-level GPM support + (eq system-type 'linux) ; Must be running linux + (eq (device-type device) 'tty) ; on a tty + (equal "linux" (console-tty-terminal-type ; an a linux terminal type + (device-console device)))) + (turn-on-gpm-mouse-tracking device))) + +(defun gpm-delete-device-hook (device) + (if (and (not noninteractive) ; Don't want to do this in batch mode + (fboundp 'gpm-enable) ; Must have C-level GPM support + (eq system-type 'linux) ; Must be running linux + (eq (device-type device) 'tty) ; on a tty + (equal "linux" (console-tty-terminal-type ; an a linux terminal type + (device-console device)))) + (turn-off-gpm-mouse-tracking device))) + +;; Restore normal mouse behaviour outside Emacs + +(add-hook 'suspend-hook 'turn-off-gpm-mouse-tracking) +(add-hook 'suspend-resume-hook 'turn-on-gpm-mouse-tracking) +(add-hook 'create-device-hook 'gpm-create-device-hook) +(add-hook 'delete-device-hook 'gpm-delete-device-hook) + +(provide 'gpm) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/gui.el --- a/lisp/gui.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/gui.el Mon Aug 13 11:13:30 2007 +0200 @@ -64,6 +64,7 @@ menubar-visible-p nil has-modeline-p nil default-toolbar-visible-p nil + default-gutter-visible-p nil modeline-shadow-thickness 0 left ,(+ fleft (- (/ fwidth 2) (/ (* dfwidth fontw) @@ -82,7 +83,7 @@ "True if OBJECT is a GUI button." (and (vectorp object) (> (length object) 0) - (eq 'gui-button (aref object 0)))) + (eq 'button (aref object 0)))) (make-face 'gui-button-face "Face used for gui buttons") (if (not (face-differs-from-default-p 'gui-button-face)) @@ -97,26 +98,15 @@ "Make a GUI button whose label is STRING and whose action is ACTION. If the button is inserted in a buffer and then clicked on, and ACTION is non-nil, ACTION will be called with one argument, USER-DATA." - (vector 'gui-button - (if (featurep 'xpm) - (xpm-button-create - string gui-button-shadow-thickness - (color-instance-name (face-foreground-instance 'gui-button-face)) - (color-instance-name (face-background-instance 'gui-button-face))) - (xbm-button-create string gui-button-shadow-thickness)) - action user-data)) + (vector 'button + :descriptor string + :face 'gui-button-face + :callback `(funcall (quote ,action) (quote ,user-data)))) (defun insert-gui-button (button &optional pos buffer) "Insert GUI button BUTTON at POS in BUFFER." (check-argument-type 'gui-button-p button) - (let ((annotation - (make-annotation (make-glyph (car (aref button 1))) - pos 'text buffer nil - (make-glyph (cadr (aref button 1))))) - (action (aref button 2))) - (and action - (progn - (set-annotation-action annotation action) - (set-annotation-data annotation (aref button 3)))))) + (make-annotation (make-glyph button) + pos 'text buffer nil)) ;;; gui.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/gutter-items.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gutter-items.el Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,575 @@ +;;; gutter-items.el --- Gutter content for XEmacs. + +;; Copyright (C) 1999 Free Software Foundation, Inc. +;; Copyright (C) 1999 Andy Piper. + +;; Maintainer: XEmacs Development Team +;; Keywords: frames, extensions, internal, dumped + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Xmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;; Some of this is taken from the buffer-menu stuff in menubar-items.el +;; and the custom specs in toolbar.el. + +(defgroup gutter nil + "Input from the gutters." + :group 'environment) + +(defvar gutter-buffers-tab nil + "A tab widget in the gutter for displaying buffers. +Do not set this. Use `glyph-image-instance' and +`set-image-instance-property' to change the properties of the tab.") + +(defcustom gutter-visible-p + (specifier-instance default-gutter-visible-p) + "Whether the default gutter is globally visible. This option can be +customized through the options menu." + :group 'gutter + :type 'boolean + :set #'(lambda (var val) + (set-specifier default-gutter-visible-p val) + (setq gutter-visible-p val) + (when gutter-buffers-tab (update-tab-in-gutter)))) + +(defcustom default-gutter-position + (default-gutter-position) + "The location of the default gutter. It can be 'top, 'bottom, 'left or +'right. This option can be customized through the options menu." + :group 'gutter + :type '(choice (const :tag "top" top) + (const :tag "bottom" bottom) + (const :tag "left" left) + (const :tag "right" right)) + :set #'(lambda (var val) + (set-default-gutter-position val) + (setq default-gutter-position val) + (when gutter-buffers-tab (update-tab-in-gutter)))) + +;;; The Buffers tab + +(defgroup buffers-tab nil + "Customization of `Buffers' tab." + :group 'gutter) + +(defvar gutter-buffers-tab-orientation 'top + "Where the buffers tab currently is. Do not set this.") + +(defvar gutter-buffers-tab-extent nil) + +(defcustom buffers-tab-max-size 6 + "*Maximum number of entries which may appear on the \"Buffers\" tab. +If this is 10, then only the ten most-recently-selected buffers will be +shown. If this is nil, then all buffers will be shown. Setting this to +a large number or nil will slow down tab responsiveness." + :type '(choice (const :tag "Show all" nil) + (integer 6)) + :group 'buffers-tab) + +(defcustom buffers-tab-switch-to-buffer-function 'buffers-tab-switch-to-buffer + "*The function to call to select a buffer from the buffers tab. +`switch-to-buffer' is a good choice, as is `pop-to-buffer'." + :type '(radio (function-item switch-to-buffer) + (function-item pop-to-buffer) + (function :tag "Other")) + :group 'buffers-tab) + +(defcustom buffers-tab-omit-function 'buffers-menu-omit-invisible-buffers + "*If non-nil, a function specifying the buffers to omit from the buffers tab. +This is passed a buffer and should return non-nil if the buffer should be +omitted. The default value `buffers-tab-omit-invisible-buffers' omits +buffers that are normally considered \"invisible\" (those whose name +begins with a space)." + :type '(choice (const :tag "None" nil) + function) + :group 'buffers-tab) + +(defcustom buffers-tab-selection-function 'select-buffers-tab-buffers-by-mode + "*If non-nil, a function specifying the buffers to select from the +buffers tab. This is passed two buffers and should return non-nil if +the second buffer should be selected. The default value +`select-buffers-tab-buffers-by-mode' groups buffers by major mode and +by `buffers-tab-grouping-regexp'." + + :type '(choice (const :tag "None" nil) + function) + :group 'buffers-tab) + +(make-face 'buffers-tab "Face for displaying the buffers tab.") +(set-face-parent 'buffers-tab 'default) + +(defcustom buffers-tab-face 'buffers-tab + "*Face to use for displaying the buffers tab." + :type 'face + :group 'buffers-tab) + +(defcustom buffers-tab-grouping-regexp + '("^\\(gnus-\\|message-mode\\|mime/viewer-mode\\)" + "^\\(emacs-lisp-\\|lisp-\\)") + "*If non-nil, a list of regular expressions for buffer grouping. +Each regular expression is applied to the current major-mode symbol +name and mode-name, if it matches then any other buffers that match +the same regular expression be added to the current group." + :type '(choice (const :tag "None" nil) + sexp) + :group 'buffers-tab) + +(defcustom buffers-tab-format-buffer-line-function 'format-buffers-tab-line + "*The function to call to return a string to represent a buffer in the +buffers tab. The function is passed a buffer and should return a +string. The default value `format-buffers-tab-line' just returns the +name of the buffer, optionally truncated to +`buffers-tab-max-buffer-line-length'. Also check out +`slow-format-buffers-menu-line' which returns a whole bunch of info +about a buffer." + :type 'function + :group 'buffers-tab) + +(defvar buffers-tab-default-buffer-line-length + (make-specifier-and-init 'generic '((global ((default) . 25))) t) + "*Maximum length of text which may appear in a \"Buffers\" tab. +This is a specifier, use set-specifier to modify it.") + +(defcustom buffers-tab-max-buffer-line-length + (specifier-instance buffers-tab-default-buffer-line-length) + "*Maximum length of text which may appear in a \"Buffers\" tab. +Buffer names over this length will be truncated with elipses. +If this is 0, then the full buffer name will be shown." + :type '(choice (const :tag "Show all" 0) + (integer 25)) + :group 'buffers-tab + :set #'(lambda (var val) + (set-specifier buffers-tab-default-buffer-line-length val) + (setq buffers-tab-max-buffer-line-length val))) + +(defun buffers-tab-switch-to-buffer (buffer) + "For use as a value for `buffers-tab-switch-to-buffer-function'." + (unless (eq (window-buffer) buffer) + (if (> (length (windows-of-buffer buffer)) 0) + (select-window (car (windows-of-buffer buffer))) + (switch-to-buffer buffer t)))) + +(defun select-buffers-tab-buffers-by-mode (buf1 buf2) + "For use as a value of `buffers-tab-selection-function'. +This selects buffers by major mode `buffers-tab-grouping-regexp'." + (let ((mode1 (symbol-name (symbol-value-in-buffer 'major-mode buf1))) + (mode2 (symbol-name (symbol-value-in-buffer 'major-mode buf2))) + (modenm1 (symbol-value-in-buffer 'mode-name buf1)) + (modenm2 (symbol-value-in-buffer 'mode-name buf2))) + (cond ((or (eq mode1 mode2) + (eq modenm1 modenm2) + (and (string-match "^[^-]+-" mode1) + (string-match + (concat "^" (regexp-quote + (substring mode1 0 (match-end 0)))) + mode2)) + (and buffers-tab-grouping-regexp + (find-if #'(lambda (x) + (or + (and (string-match x mode1) + (string-match x mode2)) + (and (string-match x modenm1) + (string-match x modenm2)))) + buffers-tab-grouping-regexp))) + t) + (t nil)))) + +(defun format-buffers-tab-line (buffer) + "For use as a value of `buffers-tab-format-buffer-line-function'. +This just returns the buffer's name, optionally truncated." + (let ((len (specifier-instance buffers-tab-default-buffer-line-length))) + (if (and (> len 0) + (> (length (buffer-name buffer)) len)) + (if (string-match ".*<.>$" (buffer-name buffer)) + (concat (substring (buffer-name buffer) + 0 (- len 6)) "..." + (substring (buffer-name buffer) -3)) + (concat (substring (buffer-name buffer) + 0 (- len 3)) "...")) + (buffer-name buffer)))) + +(defsubst build-buffers-tab-internal (buffers) + (let (line) + (mapcar + #'(lambda (buffer) + (setq line (funcall buffers-tab-format-buffer-line-function + buffer)) + (vector line (list buffers-tab-switch-to-buffer-function + (buffer-name buffer)))) + buffers))) + +(defun buffers-tab-items (&optional in-deletion frame) + "This is the tab filter for the top-level buffers \"Buffers\" tab. +It dynamically creates a list of buffers to use as the contents of the tab. +Only the most-recently-used few buffers will be listed on the tab, for +efficiency reasons. You can control how many buffers will be shown by +setting `buffers-tab-max-size'. You can control the text of the tab +items by redefining the function `format-buffers-menu-line'." + (save-match-data + (let* ((buffers (delete-if buffers-tab-omit-function (buffer-list frame))) + (first-buf (car buffers))) + ;; if we're in deletion ignore the current buffer + (when in-deletion + (setq buffers (delq (current-buffer) buffers)) + (setq first-buf (car buffers))) + ;; group buffers by mode + (when buffers-tab-selection-function + (delete-if-not #'(lambda (buf) + (funcall buffers-tab-selection-function + first-buf buf)) buffers)) + (and (integerp buffers-tab-max-size) + (> buffers-tab-max-size 1) + (> (length buffers) buffers-tab-max-size) + ;; shorten list of buffers + (setcdr (nthcdr buffers-tab-max-size buffers) nil)) + (setq buffers (build-buffers-tab-internal buffers)) + buffers))) + +(defun add-tab-to-gutter () + "Put a tab control in the gutter area to hold the most recent buffers." + (setq gutter-buffers-tab-orientation (default-gutter-position)) + (let ((gutter-string "")) + (unless gutter-buffers-tab-extent + (setq gutter-buffers-tab-extent (make-extent 0 0 gutter-string))) + (set-extent-begin-glyph + gutter-buffers-tab-extent + (setq gutter-buffers-tab + (make-glyph + (vector 'tab-control :descriptor "Buffers" :face buffers-tab-face + :orientation gutter-buffers-tab-orientation + :properties (list :items (buffers-tab-items)))))) + ;; This looks better than a 3d border + (mapcar '(lambda (x) + (when (valid-image-instantiator-format-p 'tab-control x) + (set-specifier default-gutter-border-width 0 'global x) + (set-specifier top-gutter nil 'global x) + (set-specifier bottom-gutter nil 'global x) + (set-specifier left-gutter nil 'global x) + (set-specifier right-gutter nil 'global x) + (set-specifier left-gutter-width 0 'global x) + (set-specifier right-gutter-width 0 'global x) + (cond ((eq gutter-buffers-tab-orientation 'top) + (set-specifier top-gutter gutter-string 'global x)) + ((eq gutter-buffers-tab-orientation 'bottom) + (set-specifier bottom-gutter gutter-string 'global x)) + ((eq gutter-buffers-tab-orientation 'left) + (set-specifier left-gutter gutter-string 'global x) + (set-specifier left-gutter-width + (glyph-width gutter-buffers-tab) + 'global x)) + ((eq gutter-buffers-tab-orientation 'right) + (set-specifier right-gutter gutter-string 'global x) + (set-specifier right-gutter-width + (glyph-width gutter-buffers-tab) + 'global x)) + ))) + (console-type-list)))) + +(defun update-tab-in-gutter (&optional frame-or-buffer) + "Update the tab control in the gutter area." + (let ((locale (if (framep frame-or-buffer) frame-or-buffer))) + (when (specifier-instance default-gutter-visible-p locale) + (unless (and gutter-buffers-tab + (eq (default-gutter-position) + gutter-buffers-tab-orientation)) + (add-tab-to-gutter)) + (when (valid-image-instantiator-format-p 'tab-control locale) + (let ((inst (glyph-image-instance + gutter-buffers-tab + (when (framep frame-or-buffer) + (last-nonminibuf-window frame-or-buffer))))) + (set-image-instance-property inst :items + (buffers-tab-items + nil locale))))))) + +(defun remove-buffer-from-gutter-tab () + "Remove the current buffer from the tab control in the gutter area." + (when (and (valid-image-instantiator-format-p 'tab-control) + (specifier-instance default-gutter-visible-p)) + (let ((inst (glyph-image-instance gutter-buffers-tab)) + (buffers (buffers-tab-items t))) + (unless buffers + (setq buffers (build-buffers-tab-internal + (list + (get-buffer-create "*scratch*"))))) + (set-image-instance-property inst :items buffers)))) + +(add-hook 'kill-buffer-hook 'remove-buffer-from-gutter-tab) +(add-hook 'create-frame-hook 'update-tab-in-gutter) +(add-hook 'record-buffer-hook 'update-tab-in-gutter) + +;; +;; progress display +;; ripped off from message display +;; +(defvar progress-stack nil + "An alist of label/string pairs representing active progress gauges. +The first element in the list is currently displayed in the gutter area. +Do not modify this directly--use the `progress' or +`display-progress'/`clear-progress' functions.") + +(defvar progress-glyph-height 32 + "Height of the gutter area for progress messages.") + +(defvar progress-stop-callback 'progress-quit-function + "Function to call to stop the progress operation.") + +(defun progress-quit-function () + "Default function to call for the stop button in a progress gauge. +This just removes the progress gauge and calls quit." + (interactive) + (clear-progress) + (keyboard-quit)) + +;; private variables +(defvar progress-gauge-glyph + (make-glyph + (vector 'progress-gauge + :pixel-height (- progress-glyph-height 8) + :pixel-width 250 + :descriptor "Progress"))) + +(defvar progress-text-glyph + (make-glyph [string :data ""])) + +(defvar progress-layout-glyph + (make-glyph + (vector + 'layout :orientation 'vertical :justify 'left + :items (list + progress-text-glyph + (make-glyph + (vector + 'layout :pixel-height progress-glyph-height + :orientation 'horizontal + :items (list + progress-gauge-glyph + (vector + 'button :pixel-height (- progress-glyph-height 8) + :descriptor " Stop " + :callback '(funcall progress-stop-callback))))))))) + +(defvar progress-abort-glyph + (make-glyph + (vector 'layout :orientation 'vertical :justify 'left + :items (list progress-text-glyph + (make-glyph + (vector 'layout + :pixel-height progress-glyph-height + :orientation 'horizontal)))))) + +(defvar progress-extent-text "") +(defvar progress-extent nil) + +(defun progress-displayed-p (&optional return-string frame) + "Return a non-nil value if a progress gauge is presently displayed in the +gutter area. If optional argument RETURN-STRING is non-nil, +return a string containing the message, otherwise just return t." + (let ((buffer (get-buffer-create " *Gutter Area*"))) + (and (< (point-min buffer) (point-max buffer)) + (if return-string + (buffer-substring nil nil buffer) + t)))) + +;;; Returns the string which remains in the echo area, or nil if none. +;;; If label is nil, the whole message stack is cleared. +(defun clear-progress (&optional label frame no-restore) + "Remove any progress gauge with the given LABEL from the progress gauge-stack, +erasing it from the gutter area if it's currently displayed there. +If a message remains at the head of the progress-stack and NO-RESTORE +is nil, it will be displayed. The string which remains in the gutter +area will be returned, or nil if the progress-stack is now empty. +If LABEL is nil, the entire progress-stack is cleared. + +Unless you need the return value or you need to specify a label, +you should just use (progress nil)." + (or frame (setq frame (selected-frame))) + (remove-progress label frame) + (let ((inhibit-read-only t) + (zmacs-region-stays zmacs-region-stays)) ; preserve from change + (erase-buffer " *Echo Area*") + (erase-buffer (get-buffer-create " *Gutter Area*"))) + (if no-restore + nil ; just preparing to put another msg up + (if progress-stack + (let ((oldmsg (cdr (car progress-stack)))) + (raw-append-progress oldmsg frame) + oldmsg) + ;; nothing to display so get rid of the gauge + (set-specifier bottom-gutter-border-width 0 frame) + (set-specifier bottom-gutter-visible-p nil frame)))) + +(defun remove-progress (&optional label frame) + ;; If label is nil, we want to remove all matching progress gauges. + (while (and progress-stack + (or (null label) ; null label means clear whole stack + (eq label (car (car progress-stack))))) + (setq progress-stack (cdr progress-stack))) + (let ((s progress-stack)) + (while (cdr s) + (let ((msg (car (cdr s)))) + (if (eq label (car msg)) + (progn + (setcdr s (cdr (cdr s)))) + (setq s (cdr s))))))) + +(defun append-progress (label message &optional value frame) + (or frame (setq frame (selected-frame))) + ;; Add a new entry to the message-stack, or modify an existing one + (let* ((top (car progress-stack)) + (tmsg (cdr top))) + (if (eq label (car top)) + (progn + (setcdr top message) + (if (eq tmsg message) + (set-image-instance-property + (glyph-image-instance progress-gauge-glyph) + :percent value) + (raw-append-progress message value frame)) + (redisplay-gutter-area) + (when (input-pending-p) + (dispatch-event (next-command-event)))) + (push (cons label message) progress-stack) + (raw-append-progress message value frame)) + (when (eq value 100) + (sit-for 0.5 nil) + (clear-progress label)))) + +(defun abort-progress (label message &optional frame) + (or frame (setq frame (selected-frame))) + ;; Add a new entry to the message-stack, or modify an existing one + (let* ((top (car progress-stack)) + (inhibit-read-only t) + (zmacs-region-stays zmacs-region-stays)) + (if (eq label (car top)) + (setcdr top message) + (push (cons label message) progress-stack)) + (unless (equal message "") + (insert-string message (get-buffer-create " *Gutter Area*")) + ;; Do what the device is able to cope with. + (if (not (valid-image-instantiator-format-p 'progress-gauge frame)) + (progn + (insert-string message " *Echo Area*") + (if (not executing-kbd-macro) + (redisplay-echo-area))) + ;; do some funky display here. + (unless progress-extent + (setq progress-extent (make-extent 0 0 progress-extent-text))) + (let ((bglyph (extent-begin-glyph progress-extent))) + (set-extent-begin-glyph progress-extent progress-abort-glyph) + ;; fixup the gutter specifiers + (set-specifier bottom-gutter progress-extent-text frame) + (set-specifier bottom-gutter-border-width 2 frame) + (set-image-instance-property + (glyph-image-instance progress-text-glyph) :data message) + (set-specifier bottom-gutter-height 'autodetect frame) + (set-specifier bottom-gutter-visible-p t frame) + ;; we have to do this so redisplay is up-to-date and so + ;; redisplay-gutter-area performs optimally. + (redisplay-gutter-area) + (sit-for 0.5 nil) + (clear-progress label) + (set-extent-begin-glyph progress-extent bglyph) + ))))) + +(defun raw-append-progress (message &optional value frame) + (unless (equal message "") + (let ((inhibit-read-only t) + (zmacs-region-stays zmacs-region-stays) + (val (or value 0))) ; preserve from change + (insert-string message (get-buffer-create " *Gutter Area*")) + ;; Do what the device is able to cope with. + (if (not (valid-image-instantiator-format-p 'progress-gauge frame)) + (progn + (insert-string + (concat message (if (eq val 100) "done.") + (make-string (/ val 5) ?.)) + " *Echo Area*") + (if (not executing-kbd-macro) + (redisplay-echo-area))) + ;; do some funky display here. + (unless progress-extent + (setq progress-extent (make-extent 0 0 progress-extent-text)) + (set-extent-begin-glyph progress-extent progress-layout-glyph)) + ;; fixup the gutter specifiers + (set-specifier bottom-gutter progress-extent-text frame) + (set-specifier bottom-gutter-border-width 2 frame) + (set-image-instance-property + (glyph-image-instance progress-gauge-glyph) :percent val) + (set-image-instance-property + (glyph-image-instance progress-text-glyph) :data message) + (if (and (eq (specifier-instance bottom-gutter-height frame) + 'autodetect) + (specifier-instance bottom-gutter-visible-p frame)) + (progn + ;; if the gauge is already visible then just draw the gutter + ;; checking for user events + (redisplay-gutter-area) + (when (input-pending-p) + (dispatch-event (next-command-event)))) + ;; otherwise make the gutter visible and redraw the frame + (set-specifier bottom-gutter-height 'autodetect frame) + (set-specifier bottom-gutter-visible-p t frame) + ;; we have to do this so redisplay is up-to-date and so + ;; redisplay-gutter-area performs optimally. + (redisplay-frame) + ))))) + +(defun display-progress (label message &optional value frame) + "Display a progress gauge and message in the bottom gutter area. + First argument LABEL is an identifier for this message. MESSAGE is +the string to display. Use `clear-progress' to remove a labelled +message." + (clear-progress label frame t) + (if (eq value 'abort) + (abort-progress label message frame) + (append-progress label message value frame))) + +(defun current-progress (&optional frame) + "Return the current progress gauge in the gutter area, or nil. +The FRAME argument is currently unused." + (cdr (car progress-stack))) + +;;; may eventually be frame-dependent +(defun current-progress-label (&optional frame) + (car (car progress-stack))) + +(defun progress (fmt &optional value &rest args) + "Print a progress gauge and message in the bottom gutter area of the frame. +The arguments are the same as to `format'. + +If the only argument is nil, clear any existing progress gauge." + (if (and (null fmt) (null args)) + (prog1 nil + (clear-progress nil)) + (let ((str (apply 'format fmt args))) + (display-progress 'progress str value) + str))) + +(defun lprogress (label fmt &optional value &rest args) + "Print a progress gauge and message in the bottom gutter area of the frame. +First argument LABEL is an identifier for this progress gauge. The rest of the +arguments are the same as to `format'." + (if (and (null fmt) (null args)) + (prog1 nil + (clear-progress label nil)) + (let ((str (apply 'format fmt args))) + (display-progress label str value) + str))) + +(provide 'gutter-items) +;;; gutter-items.el ends here. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/help-nomule.el --- a/lisp/help-nomule.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/help-nomule.el Mon Aug 13 11:13:30 2007 +0200 @@ -100,6 +100,19 @@ ;; Now, signal the error (signal (car error-data) (cdr error-data))))))) +;; General Mule-compatibility stuffs +(define-function 'string-width 'length) + +;; The following was originally in subr.el +(defun make-char (charset &optional arg1 arg2) + "Make a character from CHARSET and octets ARG1 and ARG2. +This function is available for compatibility with Mule-enabled XEmacsen. +When CHARSET is `ascii', return (int-char ARG1). Otherwise, return +that value with the high bit set. ARG2 is always ignored." + (int-char (if (eq charset 'ascii) + arg1 + (logior arg1 #x80)))) + (provide 'help-nomule) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/help.el --- a/lisp/help.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/help.el Mon Aug 13 11:13:30 2007 +0200 @@ -305,8 +305,8 @@ "Return the command invoked by KEY. Like `key-binding', but handles menu events and toolbar presses correctly. KEY is any value returned by `next-command-event'. -MENU-FLAG is a symbol that should be set to T if KEY is a menu event, - or NIL otherwise" +MENU-FLAG is a symbol that should be set to t if KEY is a menu event, + or nil otherwise" (let (defn) (and menu-flag (set menu-flag nil)) ;; If the key typed was really a menu selection, grab the form out @@ -461,7 +461,9 @@ (if (and (integerp help-max-help-buffers) (> help-max-help-buffers 0) (stringp name)) - (format "*%s: %s*" help-buffer-prefix-string name) + (if help-buffer-prefix-string + (format "*%s: %s*" help-buffer-prefix-string name) + (format "*%s*" name)) (format "*%s*" help-buffer-prefix-string))) ;; Use this function for displaying help when C-h something is pressed @@ -655,9 +657,20 @@ (gettext "key binding\n--- -------\n"))) (buffer (current-buffer)) (minor minor-mode-map-alist) + (extent-maps (mapcar-extents + 'extent-keymap + nil (current-buffer) (point) (point) nil 'keymap)) (local (current-local-map)) (shadow '())) (set-buffer standard-output) + (while extent-maps + (insert "Bindings for Text Region:\n" + heading) + (describe-bindings-internal + (car extent-maps) nil shadow prefix mouse-only-p) + (insert "\n") + (setq shadow (cons (car extent-maps) shadow) + extent-maps (cdr extent-maps))) (while minor (let ((sym (car (car minor))) (map (cdr (car minor)))) @@ -935,8 +948,9 @@ (format (gettext "Describe function (default %s): ") fn) (gettext "Describe function: ")) - obarray 'fboundp t nil 'function-history)))) - (list (if (equal val "") fn (intern val))))) + obarray 'fboundp t nil 'function-history + (symbol-name fn))))) + (list (intern val)))) (with-displaying-help-buffer (lambda () (describe-function-1 function) @@ -1004,24 +1018,27 @@ This function is used by `describe-function-1' to list function arguments in the standard Lisp style." - (let* ((fndef (indirect-function function)) + (let* ((fnc (indirect-function function)) + (fndef (if (eq (car-safe fnc) 'macro) + (cdr fnc) + fnc)) (arglist - (cond ((compiled-function-p fndef) - (compiled-function-arglist fndef)) - ((eq (car-safe fndef) 'lambda) - (nth 1 fndef)) - ((subrp fndef) - (let* ((doc (documentation function)) - (args (and (string-match - "[\n\t ]*\narguments: ?(\\(.*\\))\n?\\'" - doc) - (match-string 1 doc)))) - ;; If there are no arguments documented for the - ;; subr, rather don't print anything. - (cond ((null args) t) - ((equal args "") nil) - (args)))) - (t t)))) + (cond ((compiled-function-p fndef) + (compiled-function-arglist fndef)) + ((eq (car-safe fndef) 'lambda) + (nth 1 fndef)) + ((subrp fndef) + (let* ((doc (documentation function)) + (args (and (string-match + "[\n\t ]*\narguments: ?(\\(.*\\))\n?\\'" + doc) + (match-string 1 doc)))) + ;; If there are no arguments documented for the + ;; subr, rather don't print anything. + (cond ((null args) t) + ((equal args "") nil) + (args)))) + (t t)))) (cond ((listp arglist) (prin1-to-string (cons function (mapcar (lambda (arg) @@ -1224,8 +1241,9 @@ (if v (format "Describe variable (default %s): " v) (gettext "Describe variable: ")) - obarray 'boundp t nil 'variable-history)))) - (list (if (equal val "") v (intern val))))) + obarray 'boundp t nil 'variable-history + (symbol-name v))))) + (list (intern val)))) (with-displaying-help-buffer (lambda () (let ((origvar variable) @@ -1408,7 +1426,7 @@ (if cmd (princ " "))))) (terpri)))))) -;; Stop gap for 21.0 untill we do help-char etc properly. +;; Stop gap for 21.0 until we do help-char etc properly. (defun help-keymap-with-help-key (keymap form) "Return a copy of KEYMAP with an help-key binding according to help-char invoking FORM like help-form. An existing binding is not overridden. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/hyper-apropos.el --- a/lisp/hyper-apropos.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/hyper-apropos.el Mon Aug 13 11:13:30 2007 +0200 @@ -58,9 +58,9 @@ ;; Massive changes by Christoph Wedler ;; Some changes for XEmacs 20.3 by hniksic -;; ### The maintainer is supposed to be stig, but I haven't seen him +;; #### The maintainer is supposed to be stig, but I haven't seen him ;; around for ages. The real maintainer for the moment is Hrvoje -;; Niksic . +;; Niksic . ;;; Code: @@ -243,16 +243,22 @@ (setq hyper-apropos-prev-wconfig (current-window-configuration))) (if (string= "" regexp) (if (get-buffer hyper-apropos-apropos-buf) - (if toggle-apropos - (hyper-apropos-toggle-programming-flag) - (message "Using last search results")) + (progn + (setq regexp hyper-apropos-last-regexp) + (if toggle-apropos + (hyper-apropos-toggle-programming-flag) + (message "Using last search results"))) (error "Be more specific...")) (set-buffer (get-buffer-create hyper-apropos-apropos-buf)) (setq buffer-read-only nil) (erase-buffer) (if toggle-apropos - (set (make-local-variable 'hyper-apropos-programming-apropos) - (not (default-value 'hyper-apropos-programming-apropos)))) + (if (local-variable-p 'hyper-apropos-programming-apropos + (current-buffer)) + (setq hyper-apropos-programming-apropos + (not hyper-apropos-programming-apropos)) + (set (make-local-variable 'hyper-apropos-programming-apropos) + (not (default-value 'hyper-apropos-programming-apropos))))) (let ((flist (apropos-internal regexp (if hyper-apropos-programming-apropos #'fboundp @@ -432,7 +438,9 @@ (if (and (or (symbolp defn) (symbolp (setq defn (car-safe defn)))) defn show) - (hyper-apropos-get-doc defn t)))))) + (hyper-apropos-get-doc defn t)) + (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode)) + (setq hyper-apropos-prev-wconfig (current-window-configuration))))))) ;;;###autoload (defun hyper-describe-face (symbol &optional this-ref-buffer) @@ -454,10 +462,9 @@ ": ")) (mapcar #'(lambda (x) (list (symbol-name x))) (face-list)) - nil t nil 'hyper-apropos-face-history))) - (list (if (string= val "") - (progn (push (symbol-name v) hyper-apropos-face-history) v) - (intern-soft val)) + nil t nil 'hyper-apropos-face-history + (and v (symbol-name v))))) + (list (intern-soft val) current-prefix-arg))) (if (null symbol) (message "Sorry, nothing to describe.") @@ -524,10 +531,10 @@ (if v (format " (default %s): " v) ": ")) - obarray predicate t nil 'variable-history))) - (if (string= val "") - (progn (push (symbol-name v) variable-history) v) - (intern-soft val)))) + obarray predicate t nil 'variable-history + (and v (symbol-name v))))) + (intern-soft val))) + ;;;###autoload (define-obsolete-function-alias 'hypropos-read-variable-symbol 'hyper-apropos-read-variable-symbol) @@ -543,10 +550,9 @@ (format "%s (default %s): " prompt fn) (format "%s: " prompt)) obarray 'fboundp t nil - 'function-history))) - (if (equal val "") - (progn (push (symbol-name fn) function-history) fn) - (intern-soft val)))) + 'function-history + (and fn (symbol-name fn))))) + (intern-soft val))) (defun hyper-apropos-last-help (arg) "Go back to the last symbol documented in the *Hyper Help* buffer." @@ -1079,6 +1085,12 @@ nil (forward-char 3) (read (point-marker)))) + ((and + (eq major-mode 'hyper-apropos-help-mode) + (> (point) (point-min))) + (save-excursion + (goto-char (point-min)) + (hyper-apropos-this-symbol))) (t (let* ((st (progn (skip-syntax-backward "w_") @@ -1121,11 +1133,6 @@ (interactive (let ((var (hyper-apropos-this-symbol))) (or (and var (boundp var)) - (and (setq var (and (eq major-mode 'hyper-apropos-help-mode) - (save-excursion - (goto-char (point-min)) - (hyper-apropos-this-symbol)))) - (boundp var)) (setq var nil)) (list var (hyper-apropos-read-variable-value var)))) (and var @@ -1175,7 +1182,10 @@ (defun hyper-apropos-customize-variable () (interactive) (let ((var (hyper-apropos-this-symbol))) - (customize-variable var))) + (and + (or (and var (boundp var)) + (setq var nil)) + (customize-variable var)))) ;; ---------------------------------------------------------------------- ;; @@ -1197,11 +1207,6 @@ (interactive (let ((fn (hyper-apropos-this-symbol))) (or (fboundp fn) - (and (setq fn (and (eq major-mode 'hyper-apropos-help-mode) - (save-excursion - (goto-char (point-min)) - (hyper-apropos-this-symbol)))) - (fboundp fn)) (setq fn nil)) (list fn))) (if fn @@ -1257,11 +1262,7 @@ (defun hyper-apropos-popup-menu (event) (interactive "e") (mouse-set-point event) - (let* ((sym (or (hyper-apropos-this-symbol) - (and (eq major-mode 'hyper-apropos-help-mode) - (save-excursion - (goto-char (point-min)) - (hyper-apropos-this-symbol))))) + (let* ((sym (hyper-apropos-this-symbol)) (notjunk (not (null sym))) (command-p (if (commandp sym) t)) (variable-p (and sym (boundp sym))) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/indent.el --- a/lisp/indent.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/indent.el Mon Aug 13 11:13:30 2007 +0200 @@ -93,7 +93,7 @@ (back-to-indentation) (let ((cur-col (current-column))) (cond ((< cur-col column) - (if (> (- column (* (/ cur-col tab-width) tab-width)) tab-width) + (if (>= (- column (* (/ cur-col tab-width) tab-width)) tab-width) (delete-region (point) (progn (skip-chars-backward " ") (point)))) (indent-to column)) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/info.el --- a/lisp/info.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/info.el Mon Aug 13 11:13:30 2007 +0200 @@ -437,9 +437,15 @@ "List of directories to search for Info documentation files. The first directory in this list, the \"dir\" file there will become -the (dir)Top node of the Info documentation tree. If you wish to -modify the info search path, use `M-x customize-variable, -Info-directory-list' to do so.") +the (dir)Top node of the Info documentation tree. + +Note: DO NOT use the `customize' interface to change the value of this +variable. Its value is created dynamically on each startup, depending +on XEmacs packages installed on the system. If you want to change the +search path, make the needed modifications on the variable's value +from .emacs. For instance: + + (setq Info-directory-list (cons \"~/info\" Info-directory-list))") (defcustom Info-localdir-heading-regexp "^Locally installed XEmacs Packages:?" @@ -459,6 +465,7 @@ ;; Is this right for NT? .zip, with -c for to stdout, right? (defvar Info-suffix-list '( ("" . nil) (".info" . nil) + (".info.bz2" . "bzip2 -dc %s") (".info.gz" . "gzip -dc %s") (".info-z" . "gzip -dc %s") (".info.Z" . "uncompress -c %s") @@ -501,9 +508,12 @@ "List of possible matches for last Info-index command.") (defvar Info-index-first-alternative nil) -(defcustom Info-annotations-path '("~/.xemacs/info.notes" - "~/.infonotes" - "/usr/lib/info.notes") +(defcustom Info-annotations-path + (list + (paths-construct-path (list user-init-directory "info.notes")) + (paths-construct-path '("~" ".infonotes")) + (paths-construct-path '("usr" "lib" "info.notes") + (char-to-string directory-sep-char))) "*Names of files that contain annotations for different Info nodes. By convention, the first one should reside in your personal directory. The last should be a world-writable \"public\" annotations file." @@ -1485,12 +1495,10 @@ (or (equal tag "") (Info-find-node nil (format "<<%s>>" tag))))) ;;;###autoload -(defun Info-visit-file () +(defun Info-visit-file (file) "Directly visit an info file." - (interactive) - (let* ((insert-default-directory nil) - (file (read-file-name "Goto Info file: " "" ""))) - (or (equal file "") (Info-find-node (expand-file-name file) "Top")))) + (interactive "fVisit Info file: ") + (Info-find-node (expand-file-name file) "Top")) (defun Info-restore-point (&optional always) "Restore point to same location it had last time we were in this node." @@ -1509,13 +1517,33 @@ (set-window-start (get-buffer-window (current-buffer)) (+ (nth 2 entry) (point-min))))) +(defvar Info-read-node-completion-table) + +;; This function is used as the "completion table" while reading a node name. +;; It does completion using the alist in Info-read-node-completion-table +;; unless STRING starts with an open-paren. +(defun Info-read-node-name-1 (string predicate code) + (let ((no-completion (and (> (length string) 0) (eq (aref string 0) ?\()))) + (cond ((eq code nil) + (if no-completion + string + (try-completion string Info-read-node-completion-table predicate))) + ((eq code t) + (if no-completion + nil + (all-completions string Info-read-node-completion-table predicate))) + ((eq code 'lambda) + (if no-completion + t + (assoc string Info-read-node-completion-table)))))) + (defun Info-read-node-name (prompt &optional default) (Info-setup-initial) (let* ((completion-ignore-case t) - (nodename (completing-read prompt - (Info-build-node-completions) - nil nil nil - 'Info-minibuffer-history))) + (Info-read-node-completion-table (Info-build-node-completions)) + (nodename (completing-read prompt 'Info-read-node-name-1 + nil t nil 'Info-minibuffer-history + default))) (if (equal nodename "") (or default (Info-read-node-name prompt)) @@ -1572,10 +1600,14 @@ ;;;###autoload (defun Info-search (regexp) "Search for REGEXP, starting from point, and select node it's found in." - (interactive "sSearch (regexp): ") - (if (equal regexp "") - (setq regexp Info-last-search) - (setq Info-last-search regexp)) + (interactive (list + (read-from-minibuffer + (if Info-last-search + (format "Search (regexp, default %s): " + Info-last-search) + "Search (regexp): ") + nil nil nil nil nil Info-last-search))) + (setq Info-last-search regexp) (with-search-caps-disable-folding regexp t (let ((found ()) (onode Info-current-node) @@ -1652,7 +1684,7 @@ ;; Return the node name in the buffer following point. ;; ALLOWEDCHARS, if non-nil, goes within [...] to make a regexp -;; saying which chas may appear in the node name. +;; saying which chars may appear in the node name. (defun Info-following-node-name (&optional allowedchars) (skip-chars-forward " \t") (buffer-substring @@ -1662,7 +1694,7 @@ (skip-chars-forward (concat (or allowedchars "^,\t\n") "(")) (if (looking-at "(") (skip-chars-forward "^)"))) - (skip-chars-backward " ") + (skip-chars-backward " .") (point)))) (defun Info-next (&optional n) @@ -1757,7 +1789,8 @@ default ") ") "Follow reference named: ") completions nil t nil - 'Info-minibuffer-history))) + 'Info-minibuffer-history + default))) (if (and (string= item "") default) (list default) (list item))) @@ -1841,7 +1874,19 @@ (if (looking-at ":") (buffer-substring beg (1- (point))) (skip-chars-forward " \t\n") - (Info-following-node-name (if multi-line "^.,\t" "^.,\t\n")))) + ;; Kludge. + ;; Allow dots in node name not followed by whitespace. + (re-search-forward + (concat "\\(([^)]+)[^." + (if multi-line "" "\n") + "]*\\|\\([^.,\t" + (if multi-line "" "\n") + ;; We consider dots followed by newline as + ;; end of nodename even if multil-line. + ;; Also stops at .). It is generated by @pxref. + ;; Skips sequential dots. + "]\\|\\.+[^ \t\n)]\\)+\\)")) + (match-string 1))) (while (setq i (string-match "\n" str i)) (aset str i ?\ )) str)) @@ -1884,7 +1929,8 @@ default) "Menu item: ") completions nil t nil - 'Info-minibuffer-history))) + 'Info-minibuffer-history + default))) ;; we rely on the fact that completing-read accepts an input ;; of "" even when the require-match argument is true and "" ;; is not a valid possibility @@ -2060,11 +2106,9 @@ (progn (Info-global-prev) (message "Node: %s" Info-current-node) - (sit-for 0) - ;;(scroll-up 1) ; work around bug in pos-visible-in-window-p - ;;(scroll-down 1) - (while (not (pos-visible-in-window-p (point-max))) - (scroll-up))) + (goto-char (point-max)) + (recenter -1) + (move-to-window-line 0)) (scroll-down))))) (defun Info-scroll-prev (arg) @@ -2074,9 +2118,9 @@ (not (eq Info-auto-advance t)) (not (eq last-command this-command))) (message "Hit %s again to go to previous node" - (if (= last-command-char 0) + (if (mouse-event-p last-command-event) "mouse button" - (key-description (char-to-string last-command-char)))) + (key-description (event-key last-command-event)))) (Info-page-prev) (setq this-command 'Info)) (scroll-down arg))) @@ -2093,7 +2137,7 @@ (interactive "sIndex topic: ") (let ((pattern (format "\n\\* \\([^\n:]*%s[^\n:]*\\):[ \t]*%s" (regexp-quote topic) - "\\([^.\n]*\\)\\.[ t]*\\([0-9]*\\)")) + "\\(.*\\)\\.[ t]*\\([0-9]*\\)$")) node) (message "Searching index for `%s'..." topic) (Info-goto-node "Top") diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/isearch-mode.el --- a/lisp/isearch-mode.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/isearch-mode.el Mon Aug 13 11:13:30 2007 +0200 @@ -1,6 +1,6 @@ ;;; isearch-mode.el --- Incremental search minor mode. -;; Copyright (C) 1992, 1993, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1992,93,94,95,96,97,98,1999 Free Software Foundation, Inc. ;; Author: Daniel LaLiberte ;; Maintainer: XEmacs Development Team @@ -19,35 +19,29 @@ ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the +;; along with XEmacs; see the file COPYING. If not, write to the ;; Free Software Foundation, 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;;; Synched up with: Not synched with FSF. +;;; Synched up with: FSF 20.4. ;;; Commentary: -;; LCD Archive Entry: -;; isearch-mode|Daniel LaLiberte|liberte@cs.uiuc.edu -;; |A minor mode replacement for isearch.el. - -;;==================================================================== ;; Instructions -;; Searching with isearch-mode.el should work just like isearch.el, -;; except it is done in a temporary minor mode that terminates when -;; you finish searching. +;; Searching with isearch-mode.el should work just like isearch.el +;; [the one from Emacs 18], except it is done in a temporary minor +;; mode that terminates when you finish searching. -;; Semi-modal searching is supported, using a recursive edit. If -;; isearching is started non-interactively by calling one of the -;; isearch commands (e.g. (isearch-forward), but not like gnus does -;; it: (call-interactively 'isearch-forward)), isearch-mode does not -;; return until the search is completed. You should still be able -;; switch buffers, so be careful not to get things confused. +;; For programmed use of isearch-mode, e.g. calling (isearch-forward), +;; isearch-mode behaves modally and does not return until the search +;; is completed. It uses a recursive-edit to behave this way. In +;; that case, you should still be able switch buffers, so be careful +;; not to get things confused. ;; The key bindings active within isearch-mode are defined below in ;; `isearch-mode-map' which is given bindings close to the default -;; characters of isearch.el for version 19. With `isearch-mode', +;; characters of the original isearch.el. With `isearch-mode', ;; however, you can bind multi-character keys and it should be easier ;; to add new commands. One bug though: keys with meta-prefix cannot ;; be longer than two chars. Also see minibuffer-local-isearch-map @@ -63,16 +57,18 @@ ;; Exiting immediately from isearch uses isearch-edit-string instead ;; of nonincremental-search, if search-nonincremental-instead is non-nil. ;; The name of this option should probably be changed if we decide to -;; keep the behavior. One difference is that isearch-edit-string does -;; not support word search yet; perhaps isearch-mode should support it -;; even for incremental searches, but how? +;; keep the behavior. No point in forcing nonincremental search until +;; the last possible moment. -;;==================================================================== -;;; Change History: +;; TODO +;; - Integrate generalized command history to isearch-edit-string. +;; - Think about incorporating query-replace. +;; - Hooks and options for failed search. -;; Header: /import/kaplan/kaplan/liberte/Isearch/RCS/isearch-mode.el,v 1.3 92/06/29 13:10:08 liberte Exp Locker: liberte -;; Log: isearch-mode.el,v -;; +;;; Change Log: + +;; Changes before those recorded in ChangeLog: + ;; 20-aug-92 Hacked by jwz for Lucid Emacs 19.3. ;; ;; Revision 1.3 92/06/29 13:10:08 liberte @@ -83,7 +79,7 @@ ;; Renamed all regex to regexp. ;; Got rid of found-start and found-point globals. ;; Generalized handling of upper-case chars. - + ;; Revision 1.2 92/05/27 11:33:57 liberte ;; Emacs version 19 has a search ring, which is supported here. ;; Other fixes found in the version 19 isearch are included here. @@ -100,38 +96,20 @@ ;;; Code: + +;;;========================================================================= +;;; User-accessible variables + (defgroup isearch nil - "Incremental search" + "Incremental search minor mode." :prefix "search-" :group 'matching) -(defun isearch-char-to-string (c) - (if (eventp c) - (make-string 1 (event-to-character c nil nil t)) - (make-string 1 c))) - -;(defun isearch-text-char-description (c) -; (isearch-char-to-string c)) - -(define-function 'isearch-text-char-description 'text-char-description) - - -;;;========================================================================= -;;; User-accessible variables - -(defvar search-last-string "" - "Last string search for by a search command. -This does not include direct calls to the primitive search functions, -and does not include searches that are aborted.") - -(defvar search-last-regexp "" - "Last string searched for by a regexp search command. -This does not include direct calls to the primitive search functions, -and does not include searches that are aborted.") - -(defconst search-exit-option t - "Non-nil means random control characters terminate incremental search.") +(defcustom search-exit-option t + "*Non-nil means random control characters terminate incremental search." + :type 'boolean + :group 'isearch) (defcustom search-slow-window-lines 1 "*Number of lines in slow search display windows. @@ -148,16 +126,70 @@ :type 'integer :group 'isearch) +;; We have `search-caps-disable-folding'. +;(defcustom search-upper-case 'not-yanks +; "*If non-nil, upper case chars disable case fold searching. +;That is, upper and lower case chars must match exactly. +;This applies no matter where the chars come from, but does not +;apply to chars in regexps that are prefixed with `\\'. +;If this value is `not-yanks', yanked text is always downcased." +; :type '(choice (const :tag "off" nil) +; (const not-yanks) +; (other :tag "on" t)) +; :group 'isearch) + (defcustom search-nonincremental-instead t - "*If non-nil, do a nonincremental search instead if exiting immediately." + "*If non-nil, do a nonincremental search instead if exiting immediately. +Actually, `isearch-edit-string' is called to let you enter the search +string, and RET terminates editing and does a nonincremental search." :type 'boolean :group 'isearch) - -(defcustom search-whitespace-regexp "\\(\\s \\|[\n\r]\\)+" + +;; FSF default is "\\s-+", but I think our default is better so I'm +;; leaving it. +(defcustom search-whitespace-regexp "\\(\\s-\\|[\n\r]\\)+" "*If non-nil, regular expression to match a sequence of whitespace chars." :type 'regexp :group 'isearch) +(defcustom search-highlight t + "*Whether incremental search and query-replace should highlight +the text that currently matches the search string." + :type 'boolean + :group 'isearch) + +;; I think the name `search-highlight' makes more sense, both because +;; of consistency with other search-* variables above, and because it +;; also applies to query-replace. +(define-obsolete-variable-alias 'isearch-highlight 'search-highlight) + +(defcustom search-invisible 'open + "If t incremental search can match hidden text. +nil means don't match invisible text. +If the value is `open', if the text matched is made invisible by +an overlay having an `invisible' property and that overlay has a property +`isearch-open-invisible', then incremental search will show the contents. +\(This applies when using `outline.el' and `hideshow.el'.)" + :type '(choice (const :tag "Match hidden text" t) + (const :tag "Open overlays" open) + (const :tag "Don't match hidden text" nil)) + :group 'isearch) + +(defcustom isearch-hide-immediately t + "If non-nil, re-hide an invisible match right away. +This variable makes a difference when `search-invisible' is set to `open'. +It means that after search makes some invisible text visible +to show the match, it makes the text invisible again when the match moves. +Ordinarily the text becomes invisible again at the end of the search." + :type 'boolean + :group 'isearch) + +(defvar isearch-mode-hook nil + "Function(s) to call after starting up an incremental search.") + +(defvar isearch-mode-end-hook nil + "Function(s) to call after terminating an incremental search.") + ;;;================================================================== ;;; Search ring. @@ -175,22 +207,34 @@ :type 'integer :group 'isearch) +;; The important difference between pre-20.4-merge yank-pointers and +;; current code is that the yank pointers positions used to be +;; preserved across the isearch sessions. I changed this because I +;; think the FSF code is closer to how the feature is supposed to +;; behave (read: to minibuffer histories.) (defvar search-ring-yank-pointer nil - "The tail of the search ring whose car is the last thing searched for.") + "Index in `search-ring' of last string reused. +nil if none yet.") (defvar regexp-search-ring-yank-pointer nil - "The tail of the regular expression search ring whose car is the last -thing searched for.") + "Index in `regexp-search-ring' of last string reused. +nil if none yet.") + +(defcustom search-ring-update nil + "*Non-nil if advancing or retreating in the search ring should cause search. +Default nil means edit the string from the search ring first." + :type 'boolean + :group 'isearch) ;;;==================================================== ;;; Define isearch-mode keymap. -(defvar isearch-mode-map +(defvar isearch-mode-map (let ((map (make-keymap))) (set-keymap-name map 'isearch-mode-map) ;; Bind all printing characters to `isearch-printing-char'. - ;; This isn't normally necessary, but if a printing character were - ;; bound to something other than self-insert-command in global-map, + ;; This isn't normally necessary, but if a printing character were + ;; bound to something other than self-insert-command in global-map, ;; then it would terminate the search and be executed without this. (let ((i 32) (str (make-string 1 0))) @@ -198,7 +242,10 @@ (aset str 0 i) (define-key map str 'isearch-printing-char) (setq i (1+ i)))) - (define-key map "\t" 'isearch-printing-char) + + ;; Here FSF sets up various kludges to handle local bindings with + ;; meta char prefix keys. We don't need isearch-other-meta-char + ;; because we handle things differently (via pre-command-hook). ;; Several non-printing chars change the searching behavior. ;; @@ -207,26 +254,29 @@ (define-key map "\C-r" 'isearch-repeat-backward) (define-key map "\C-g" 'isearch-abort) + ;; I wish this worked... + ;(define-key map [escape escape escape] 'isearch-cancel) + (define-key map [(meta escape) escape] 'isearch-cancel) + (define-key map "\C-q" 'isearch-quote-char) (define-key map "\C-m" 'isearch-exit) (define-key map "\C-j" 'isearch-printing-char) (define-key map "\t" 'isearch-printing-char) + ;; I prefer our default. + ;(define-key map " " 'isearch-whitespace-chars) + (define-key map "\M- " 'isearch-whitespace-chars) (define-key map "\C-w" 'isearch-yank-word) (define-key map "\C-y" 'isearch-yank-line) (define-key map "\M-y" 'isearch-yank-kill) - ;; Define keys for regexp chars * ? | + ;; Define keys for regexp chars * ? |. + ;; Nothing special for + because it matches at least once. (define-key map "*" 'isearch-*-char) (define-key map "?" 'isearch-*-char) (define-key map "|" 'isearch-|-char) - ;; Some bindings you may want to put in your isearch-mode-hook. - ;; Suggest some alternates... - ;; (define-key map "\C-t" 'isearch-toggle-regexp) - ;; (define-key map "\C-^" 'isearch-edit-string) - ;; delete and backspace delete backward, f1 is help, and C-h can be either (define-key map 'delete 'isearch-delete-char) (define-key map 'backspace 'isearch-delete-char) @@ -236,15 +286,23 @@ (define-key map "\M-n" 'isearch-ring-advance) (define-key map "\M-p" 'isearch-ring-retreat) - (define-key map "\M- " 'isearch-whitespace-chars) (define-key map "\M-\t" 'isearch-complete) - (define-key map 'button2 'isearch-yank-x-selection) + ;; I find this binding somewhat unintuitive, because it doesn't + ;; work if the mouse pointer is over the echo area -- it has to be + ;; over the search window. + (define-key map 'button2 'isearch-yank-selection) map) "Keymap for isearch-mode.") -(defvar minibuffer-local-isearch-map +;; Some bindings you may want to put in your isearch-mode-hook. +;; Suggest some alternates... +;; (define-key isearch-mode-map "\C-t" 'isearch-toggle-case-fold) +;; (define-key isearch-mode-map "\C-t" 'isearch-toggle-regexp) +;; (define-key isearch-mode-map "\C-^" 'isearch-edit-string) + +(defvar minibuffer-local-isearch-map (let ((map (make-sparse-keymap))) ;; #### - this should also be minor-mode-ified (set-keymap-parents map (list minibuffer-local-map)) @@ -254,6 +312,8 @@ (define-key map "\r" 'isearch-nonincremental-exit-minibuffer) (define-key map "\M-n" 'isearch-ring-advance-edit) (define-key map "\M-p" 'isearch-ring-retreat-edit) + (define-key map 'down 'isearch-ring-advance-edit) + (define-key map 'up 'isearch-ring-retreat-edit) (define-key map "\M-\t" 'isearch-complete-edit) (define-key map "\C-s" 'isearch-forward-exit-minibuffer) (define-key map "\C-r" 'isearch-reverse-exit-minibuffer) @@ -262,7 +322,8 @@ ;;;======================================================== ;; Internal variables declared globally for byte-compiler. -;; These are all bound locally while editing the search string. +;; These are all set with setq while isearching +;; and bound locally while editing the search string. (defvar isearch-forward nil) ; Searching in the forward direction. (defvar isearch-regexp nil) ; Searching for a regexp. @@ -274,6 +335,7 @@ (defvar isearch-success t) ; Searching is currently successful. (defvar isearch-invalid-regexp nil) ; Regexp not well formed. +(defvar isearch-within-brackets nil) ; Regexp has unclosed [. (defvar isearch-other-end nil) ; Start (end) of match if forward (backward). (defvar isearch-wrapped nil) ; Searching restarted from the top (bottom). (defvar isearch-barrier 0) @@ -282,6 +344,12 @@ (defvar isearch-case-fold-search nil) +;; Need this for toggling case in isearch-toggle-case-fold. When this +;; is non-nil, the case-sensitiveness of the search is set by the +;; user, and is may no longer be dynamically changed as per +;; search-caps-disable-folding. +(defvar isearch-fixed-case nil) + (defvar isearch-adjusted nil) (defvar isearch-slow-terminal-mode nil) ;;; If t, using a small window. @@ -308,12 +376,9 @@ ;; New value of isearch-forward after isearch-edit-string. (defvar isearch-new-forward nil) +;; Accumulate here the extents unhidden during searching. +(defvar isearch-unhidden-extents nil) ; in FSF: isearch-opened-overlays -(defvar isearch-mode-hook nil - "Function(s) to call after starting up an incremental search.") - -(defvar isearch-mode-end-hook nil - "Function(s) to call after terminating an incremental search.") ;;;============================================================== ;; Minor-mode-alist changes - kind of redundant with the @@ -321,21 +386,28 @@ (add-minor-mode 'isearch-mode 'isearch-mode) -(defvar isearch-mode nil) +(defvar isearch-mode nil) ;; Name of the minor mode, if non-nil. (make-variable-buffer-local 'isearch-mode) +;; We bind these in keydefs.el. +;(define-key global-map "\C-s" 'isearch-forward) +;(define-key global-map "\C-r" 'isearch-backward) +;(define-key global-map "\M-\C-s" 'isearch-forward-regexp) +;(define-key global-map "\M-\C-r" 'isearch-backward-regexp) + ;;;=============================================================== ;;; Entry points to isearch-mode. ;;; These four functions should replace those in loaddefs.el -;;; An alternative is to fset isearch-forward etc to isearch-mode, -;;; and look at the last command to set the options accordingly. +;;; An alternative is to defalias isearch-forward etc to isearch-mode, +;;; and look at this-command to set the options accordingly. -(defun isearch-forward (&optional regexp-p) - "Do incremental search forward. +(defun isearch-forward (&optional regexp-p no-recursive-edit) + "\ +Do incremental search forward. With a prefix argument, do an incremental regular expression search instead. \\ As you type characters, they add to the search string and are found. -The following non-printing keys are bound in `isearch-mode-map'. +The following non-printing keys are bound in `isearch-mode-map'. Type \\[isearch-delete-char] to cancel characters from end of search string. Type \\[isearch-exit] to exit, leaving point at location found. @@ -346,6 +418,8 @@ string and search for it. Type \\[isearch-yank-line] to yank rest of line onto end of search string\ and search for it. +Type \\[isearch-yank-kill] to yank last killed text onto end of search string\ + and search for it. Type \\[isearch-quote-char] to quote control character to search for it. Type \\[isearch-whitespace-chars] to match all whitespace chars in regexp. \\[isearch-abort] while searching or when search has failed cancels input\ @@ -377,36 +451,38 @@ ;; Type \\[isearch-edit-string] to edit the search string in the minibuffer. ;; Terminate editing and return to incremental searching with CR. - (interactive "_P") - (isearch-mode t (not (null regexp-p)) nil (not (interactive-p)))) + (interactive "_P\np") + (isearch-mode t (not (null regexp-p)) nil (not no-recursive-edit))) -(defun isearch-forward-regexp () +(defun isearch-forward-regexp (&optional not-regexp no-recursive-edit) "\ Do incremental search forward for regular expression. +With a prefix argument, do a regular string search instead. Like ordinary incremental search except that your input is treated as a regexp. See \\[isearch-forward] for more info." - (interactive "_") - (isearch-mode t t nil (not (interactive-p)))) + (interactive "_P\np") + (isearch-mode t (null not-regexp) nil (not no-recursive-edit))) -(defun isearch-backward (&optional regexp-p) +(defun isearch-backward (&optional regexp-p no-recursive-edit) "\ Do incremental search backward. -With a prefix argument, do an incremental regular expression search instead. +With a prefix argument, do a regular expression search instead. See \\[isearch-forward] for more information." - (interactive "_P") - (isearch-mode nil (not (null regexp-p)) nil (not (interactive-p)))) + (interactive "_P\np") + (isearch-mode nil (not (null regexp-p)) nil (not no-recursive-edit))) -(defun isearch-backward-regexp () +(defun isearch-backward-regexp (&optional not-regexp no-recursive-edit) "\ Do incremental search backward for regular expression. +With a prefix argument, do a regular string search instead. Like ordinary incremental search except that your input is treated as a regexp. See \\[isearch-forward] for more info." - (interactive "_") - (isearch-mode nil t nil (not (interactive-p)))) + (interactive "_P\np") + (isearch-mode nil (null not-regexp) nil (not no-recursive-edit))) -;; This function is way wrong, because you can't scroll the help -;; screen; as soon as you press a key, it's gone. I don't know of a -;; good way to fix it, though. -hniksic +;; The problem here is that you can't scroll the help screen; as soon +;; as you press a key, it's gone. I don't know of a good way to fix +;; it, though. -hniksic (defun isearch-mode-help () (interactive "_") (let ((w (selected-window))) @@ -420,7 +496,9 @@ ;; All the work is done by the isearch-mode commands. (defun isearch-mode (forward &optional regexp op-fun recursive-edit word-p) - "Start isearch minor mode. Called by isearch-forward, etc." + "Start isearch minor mode. Called by `isearch-forward', etc. + +\\{isearch-mode-map}" (if executing-kbd-macro (setq recursive-edit nil)) @@ -433,6 +511,7 @@ isearch-word word-p isearch-op-fun op-fun isearch-case-fold-search case-fold-search + isearch-fixed-case nil isearch-string "" isearch-message "" isearch-cmds nil @@ -442,6 +521,7 @@ isearch-adjusted nil isearch-yank-flag nil isearch-invalid-regexp nil + isearch-within-brackets nil isearch-slow-terminal-mode (and (<= (device-baud-rate) search-slow-speed) (> (window-height) @@ -451,10 +531,14 @@ isearch-just-started t isearch-opoint (point) + search-ring-yank-pointer nil + regexp-search-ring-yank-pointer nil + isearch-unhidden-extents nil isearch-window-configuration (current-window-configuration) - ;; #### Should we remember the old value of - ;; overriding-local-map? + ;; #### What we really need is a buffer-local + ;; overriding-local-map. See isearch-pre-command-hook for + ;; more details. overriding-local-map (progn (set-keymap-parents isearch-mode-map (nconc (current-minor-mode-maps) @@ -463,7 +547,6 @@ isearch-mode-map) isearch-selected-frame (selected-frame) - isearch-mode (gettext " Isearch") ) ;; XEmacs change: without clearing the match data, sometimes old values @@ -471,7 +554,10 @@ (store-match-data nil) (add-hook 'pre-command-hook 'isearch-pre-command-hook) - (set-buffer-modified-p (buffer-modified-p)) ; update modeline + + (setq isearch-mode (gettext " Isearch")) + (redraw-modeline) + (isearch-push-state) ) ; inhibit-quit is t before here @@ -479,26 +565,26 @@ (isearch-update) (run-hooks 'isearch-mode-hook) - ;; isearch-mode can be made modal (in the sense of not returning to - ;; the calling function until searching is completed) by entering + ;; isearch-mode can be made modal (in the sense of not returning to + ;; the calling function until searching is completed) by entering ;; a recursive-edit and exiting it when done isearching. (if recursive-edit (let ((isearch-recursive-edit t)) (recursive-edit))) - ) + isearch-success) ;;;==================================================== ;; Some high level utilities. Others below. (defun isearch-update () - ;; Called after each command to update the display. - (if (null unread-command-event) + ;; Called after each command to update the display. + (if (null unread-command-events) (progn (if (not (input-pending-p)) (isearch-message)) (if (and isearch-slow-terminal-mode - (not (or isearch-small-window + (not (or isearch-small-window (pos-visible-in-window-p)))) (let ((found-point (point))) (setq isearch-small-window t) @@ -520,27 +606,24 @@ (if (< isearch-other-end (point)) (isearch-highlight isearch-other-end (point)) (isearch-highlight (point) isearch-other-end)) - (if (extentp isearch-extent) - (isearch-dehighlight nil))) + (isearch-dehighlight)) )) (setq ;; quit-flag nil not for isearch-mode isearch-adjusted nil isearch-yank-flag nil) + (isearch-highlight-all-update) ) -(defun isearch-done () +(defun isearch-done (&optional nopush edit) ;; Called by all commands that terminate isearch-mode. (let ((inhibit-quit t)) ; danger danger! (if (and isearch-buffer (buffer-live-p isearch-buffer)) - (save-excursion - ;; Some loser process filter might have switched the - ;; window's buffer, so be sure to set these variables back - ;; in the buffer we frobbed them in. But only if the buffer - ;; is still alive. - (set-buffer isearch-buffer) - ;; #### Should we restore the old value of - ;; overriding-local-map? + ;; Some loser process filter might have switched the window's + ;; buffer, so be sure to set these variables back in the + ;; buffer we frobbed them in. But only if the buffer is still + ;; alive. + (with-current-buffer isearch-buffer (setq overriding-local-map nil) ;; Use remove-hook instead of just setting it to our saved value ;; in case some process filter has created a buffer and modified @@ -549,8 +632,11 @@ (remove-hook 'pre-command-hook 'isearch-pre-command-hook) (set-keymap-parents isearch-mode-map nil) (setq isearch-mode nil) - (set-buffer-modified-p (buffer-modified-p));; update modeline - (isearch-dehighlight t))) + (redraw-modeline) + (isearch-dehighlight) + (isearch-highlight-all-cleanup) + (isearch-restore-invisible-extents nil nil) + )) ;; it's not critical that this be inside inhibit-quit, but leaving ;; things in small-window-mode would be bad. @@ -568,37 +654,41 @@ ;; Maybe should test difference between and set mark iff > threshold. (if (and (buffer-live-p isearch-buffer) (/= (point isearch-buffer) isearch-opoint)) + ;; #### FSF doesn't do this if the region is active. Should + ;; we do the same? (progn (push-mark isearch-opoint t nil isearch-buffer) (or executing-kbd-macro (> (minibuffer-depth) 0) - (display-message 'command "Mark saved where search started")))) - ) + (display-message 'command "Mark saved where search started"))))) (setq isearch-buffer nil) ) ; inhibit-quit is t before here - (if (> (length isearch-string) 0) + (if (and (> (length isearch-string) 0) (not nopush)) ;; Update the ring data. - (if isearch-regexp - (if (not (setq regexp-search-ring-yank-pointer - (member isearch-string regexp-search-ring))) - (progn - (setq regexp-search-ring - (cons isearch-string regexp-search-ring) - regexp-search-ring-yank-pointer regexp-search-ring) - (if (> (length regexp-search-ring) regexp-search-ring-max) - (setcdr (nthcdr (1- regexp-search-ring-max) regexp-search-ring) - nil)))) - (if (not (setq search-ring-yank-pointer - ;; really need equal test instead of eq. - (member isearch-string search-ring))) - (progn - (setq search-ring (cons isearch-string search-ring) - search-ring-yank-pointer search-ring) - (if (> (length search-ring) search-ring-max) - (setcdr (nthcdr (1- search-ring-max) search-ring) nil)))))) + (isearch-update-ring isearch-string isearch-regexp)) (run-hooks 'isearch-mode-end-hook) - (if isearch-recursive-edit (exit-recursive-edit))) + + (and (not edit) isearch-recursive-edit (exit-recursive-edit))) + +(defun isearch-update-ring (string &optional regexp) + "Add STRING to the beginning of the search ring. +REGEXP says which ring to use." + (if regexp + (if (or (null regexp-search-ring) + (not (string= string (car regexp-search-ring)))) + (progn + (setq regexp-search-ring + (cons string regexp-search-ring)) + (if (> (length regexp-search-ring) regexp-search-ring-max) + (setcdr (nthcdr (1- search-ring-max) regexp-search-ring) + nil)))) + (if (or (null search-ring) + (not (string= string (car search-ring)))) + (progn + (setq search-ring (cons string search-ring)) + (if (> (length search-ring) search-ring-max) + (setcdr (nthcdr (1- search-ring-max) search-ring) nil)))))) ;;;==================================================== @@ -607,12 +697,16 @@ (defun isearch-exit () "Exit search normally. However, if this is the first command after starting incremental -search and `search-nonincremental-instead' is non-nil, do an -incremental search via `isearch-edit-string'." +search and `search-nonincremental-instead' is non-nil, do a +nonincremental search instead via `isearch-edit-string'." (interactive) - (if (and search-nonincremental-instead + (if (and search-nonincremental-instead (= 0 (length isearch-string))) - (let ((isearch-nonincremental t)) + (let ((isearch-nonincremental t) + ;; Highlighting only gets in the way of nonincremental + ;; search. + (search-highlight nil) + (isearch-highlight-all-matches nil)) (isearch-edit-string)) (isearch-done))) @@ -621,115 +715,112 @@ "Edit the search string in the minibuffer. The following additional command keys are active while editing. \\ -\\[exit-minibuffer] to exit editing and resume incremental searching. +\\[exit-minibuffer] to resume incremental searching with the edited string. +\\[isearch-nonincremental-exit-minibuffer] to do one nonincremental search. \\[isearch-forward-exit-minibuffer] to resume isearching forward. -\\[isearch-backward-exit-minibuffer] to resume isearching backward. -\\[isearch-ring-advance-edit] to replace the search string with the next\ - item in the search ring. -\\[isearch-ring-retreat-edit] to replace the search string with the next\ - item in the search ring. -\\[isearch-complete-edit] to complete the search string from the search ring." +\\[isearch-reverse-exit-minibuffer] to resume isearching backward. +\\[isearch-ring-advance-edit] to replace the search string with the next item in the search ring. +\\[isearch-ring-retreat-edit] to replace the search string with the previous item in the search ring. +\\[isearch-complete-edit] to complete the search string using the search ring. +\\ +If first char entered is \\[isearch-yank-word], then do word search instead." + ;; This code is very hairy for several reasons, explained in the code. + ;; Mainly, isearch-mode must be terminated while editing and then restarted. + ;; If there were a way to catch any change of buffer from the minibuffer, + ;; this could be simplified greatly. ;; Editing doesn't back up the search point. Should it? (interactive) (condition-case nil - (let ((minibuffer-local-map minibuffer-local-isearch-map) - isearch-nonincremental ; should search nonincrementally? - isearch-new-string - isearch-new-message - (isearch-new-forward isearch-forward) + (progn + (let ((isearch-nonincremental isearch-nonincremental) - ;; Locally bind all isearch global variables to protect them - ;; from recursive isearching. - (isearch-string isearch-string) - (isearch-message isearch-message) - (isearch-forward isearch-forward) ; set by commands below. + ;; Locally bind all isearch global variables to protect them + ;; from recursive isearching. + ;; isearch-string -message and -forward are not bound + ;; so they may be changed. Instead, save the values. + (isearch-new-string isearch-string) + (isearch-new-message isearch-message) + (isearch-new-forward isearch-forward) + (isearch-new-word isearch-word) - (isearch-forward isearch-forward) - (isearch-regexp isearch-regexp) - (isearch-word isearch-word) - (isearch-op-fun isearch-op-fun) - (isearch-cmds isearch-cmds) - (isearch-success isearch-success) - (isearch-wrapped isearch-wrapped) - (isearch-barrier isearch-barrier) - (isearch-adjusted isearch-adjusted) - (isearch-yank-flag isearch-yank-flag) - (isearch-invalid-regexp isearch-invalid-regexp) - (isearch-other-end isearch-other-end) - (isearch-opoint isearch-opoint) - (isearch-slow-terminal-mode isearch-slow-terminal-mode) - (isearch-small-window isearch-small-window) - (isearch-recursive-edit isearch-recursive-edit) - (isearch-window-configuration (current-window-configuration)) - (isearch-selected-frame (selected-frame)) - ) - ;; Actually terminate isearching until editing is done. - ;; This is so that the user can do anything without failure, - ;; like switch buffers and start another isearch, and return. + (isearch-regexp isearch-regexp) + (isearch-op-fun isearch-op-fun) + (isearch-cmds isearch-cmds) + (isearch-success isearch-success) + (isearch-wrapped isearch-wrapped) + (isearch-barrier isearch-barrier) + (isearch-adjusted isearch-adjusted) + (isearch-fixed-case isearch-fixed-case) + (isearch-yank-flag isearch-yank-flag) + (isearch-invalid-regexp isearch-invalid-regexp) + (isearch-within-brackets isearch-within-brackets) + ;;; Don't bind this. We want isearch-search, below, to set it. + ;;; And the old value won't matter after that. + ;;; (isearch-other-end isearch-other-end) + (isearch-opoint isearch-opoint) + (isearch-slow-terminal-mode isearch-slow-terminal-mode) + (isearch-small-window isearch-small-window) + (isearch-recursive-edit isearch-recursive-edit) + (isearch-window-configuration (current-window-configuration)) + (isearch-selected-frame (selected-frame)) + ) + ;; Actually terminate isearching until editing is done. + ;; This is so that the user can do anything without failure, + ;; like switch buffers and start another isearch, and return. ;; (condition-case nil - (isearch-done) + (isearch-done t t) ;;#### What does this mean? There is no such condition! -;; (exit nil)) ; was recursive editing +;; (exit nil)) ; was recursive editing - (unwind-protect - (let ((prompt (isearch-message-prefix nil t)) - event) - ;; If the first character the user types when we prompt them - ;; for a string is the yank-word character, then go into - ;; word-search mode. Otherwise unread that character and - ;; read a string the normal way. - (let ((cursor-in-echo-area t)) - (display-message 'prompt prompt) - (setq event (next-command-event)) - (if (eq 'isearch-yank-word - (lookup-key isearch-mode-map (vector event))) - (setq isearch-word t) - (setq unread-command-event event))) - (setq isearch-new-string -;; (if (fboundp 'gmhist-old-read-from-minibuffer) -;; ;; Eschew gmhist crockery -;; (gmhist-old-read-from-minibuffer prompt isearch-string) - (read-string - prompt isearch-string - 't ;does its own history (but shouldn't) -;; (if isearch-regexp -;; ;; The search-rings aren't exactly minibuffer -;; ;; histories, but they are close enough -;; (cons 'regexp-search-ring -;; (- (length regexp-search-ring-yank-pointer) -;; (length regexp-search-ring))) -;; (cons 'search-ring -;; (- (length search-ring-yank-pointer) -;; (length search-ring)))) + (unwind-protect + (progn + ;; Fake the prompt message for the sake of + ;; next-command-event below. + (isearch-message) + ;; If the first character the user types when we + ;; prompt them for a string is the yank-word + ;; character, then go into word-search mode. + ;; Otherwise unread that character and read a string + ;; the normal way. + (let* ((cursor-in-echo-area t) + (event (next-command-event))) + (if (eq 'isearch-yank-word + (lookup-key isearch-mode-map (vector event))) + (setq isearch-word t;; so message-prefix is right + isearch-new-word t) + (setq unread-command-event event))) + (setq isearch-new-string + (read-from-minibuffer + (isearch-message-prefix nil isearch-nonincremental) + isearch-string + minibuffer-local-isearch-map + nil + 't ;does its own history (but shouldn't) ) -;; ) - isearch-new-message (mapconcat - 'isearch-text-char-description - isearch-new-string "")) - ) - ;; Always resume isearching by restarting it. - (isearch-mode isearch-forward - isearch-regexp - isearch-op-fun - isearch-recursive-edit - isearch-word) - ) + isearch-new-message (mapconcat + 'isearch-text-char-description + isearch-new-string ""))) + ;; Always resume isearching by restarting it. + (isearch-mode isearch-forward + isearch-regexp + isearch-op-fun + isearch-recursive-edit + isearch-word) - ;; Copy new values in outer locals to isearch globals - (setq isearch-string isearch-new-string - isearch-message isearch-new-message - isearch-forward isearch-new-forward) + ;; Copy new values in outer locals to isearch globals + (setq isearch-string isearch-new-string + isearch-message isearch-new-message + isearch-forward isearch-new-forward + isearch-word isearch-new-word)) - ;; Empty isearch-string means use default. - (if (= 0 (length isearch-string)) - (setq isearch-string (if isearch-regexp search-last-regexp - search-last-string)) - ;; Set last search string now so it is set even if we fail. - (if search-last-regexp - (setq search-last-regexp isearch-string) - (setq search-last-string isearch-string))) + ;; Empty isearch-string means use default. + (if (= 0 (length isearch-string)) + (setq isearch-string (or (car (if isearch-regexp + regexp-search-ring + search-ring)) + "")))) ;; Reinvoke the pending search. (isearch-push-state) @@ -756,25 +847,33 @@ (setq isearch-new-forward nil) (exit-minibuffer)) +(defun isearch-cancel () + "Terminate the search and go back to the starting point." + (interactive) + (goto-char isearch-opoint) + (isearch-done t) + (signal 'quit '(isearch))) ; and pass on quit signal (defun isearch-abort () - "Quit incremental search mode if searching is successful, signalling quit. + "Abort incremental search mode if searching is successful, signaling quit. Otherwise, revert to previous successful search and continue searching. -Use `isearch-exit' to quit without signalling." +Use `isearch-exit' to quit without signaling." (interactive) -;; (ding) signal instead below, if quiting +;; (ding) signal instead below, if quitting (discard-input) (if isearch-success ;; If search is successful, move back to starting point ;; and really do quit. (progn (goto-char isearch-opoint) - (isearch-done) ; exit isearch + (setq isearch-success nil) + (isearch-done t) ; exit isearch (signal 'quit '(isearch))) ; and pass on quit signal - ;; If search is failing, rub out until it is once more successful. - (while (not isearch-success) (isearch-pop-state)) + ;; If search is failing, or has an incomplete regexp, + ;; rub out until it is once more successful. + (while (or (not isearch-success) isearch-invalid-regexp) + (isearch-pop-state)) (isearch-update))) - (defun isearch-repeat (direction) ;; Utility for isearch-repeat-forward and -backward. (if (eq isearch-forward (eq direction 'forward)) @@ -783,35 +882,30 @@ ;; If search string is empty, use last one. (setq isearch-string (or (if isearch-regexp - (if regexp-search-ring-yank-pointer - (car regexp-search-ring-yank-pointer) - (car regexp-search-ring)) - (if search-ring-yank-pointer - (car search-ring-yank-pointer) - (car search-ring))) + (car regexp-search-ring) + (car search-ring)) "") isearch-message (mapconcat 'isearch-text-char-description isearch-string "")) ;; If already have what to search for, repeat it. (or isearch-success - (progn - + (progn (goto-char (if isearch-forward (point-min) (point-max))) (setq isearch-wrapped t)))) ;; C-s in reverse or C-r in forward, change direction. (setq isearch-forward (not isearch-forward))) (setq isearch-barrier (point)) ; For subsequent \| if regexp. + (if (equal isearch-string "") (setq isearch-success t) - (if (and (equal (match-end 0) (match-beginning 0)) - isearch-success + (if (and isearch-success (equal (match-end 0) (match-beginning 0)) (not isearch-just-started)) ;; If repeating a search that found ;; an empty string, ensure we advance. (if (if isearch-forward (eobp) (bobp)) - ;; nowhere to advance to, so fail (and wrap next time) + ;; If there's nowhere to advance to, fail (and wrap next time). (progn (setq isearch-success nil) (and executing-kbd-macro @@ -821,6 +915,7 @@ (forward-char (if isearch-forward 1 -1)) (isearch-search)) (isearch-search))) + (isearch-push-state) (isearch-update)) @@ -845,18 +940,21 @@ (defun isearch-toggle-case-fold () "Toggle case folding in searching on or off." (interactive) - (setq isearch-case-fold-search - (if isearch-case-fold-search nil 'yes)) - (message "%s%s [case %ssensitive]" - (isearch-message-prefix) - isearch-message - (if isearch-case-fold-search "in" "")) + (setq isearch-case-fold-search (if isearch-case-fold-search nil 'yes) + isearch-fixed-case t) + (lmessage 'progress "%s%s [case %ssensitive]" + (isearch-message-prefix) + isearch-message + (if isearch-case-fold-search "in" "")) (setq isearch-adjusted t) + ;; Update the highlighting here so that it gets done before the + ;; one-second pause. + (isearch-highlight-all-update) (sit-for 1) (isearch-update)) (defun isearch-delete-char () - "Discard last input item and move point back. + "Discard last input item and move point back. If no previous match was done, just beep." (interactive) (if (null (cdr isearch-cmds)) @@ -876,6 +974,7 @@ (isearch-delete-char) (isearch-mode-help))) +;; This is similar to FSF isearch-yank-string, but more general. (defun isearch-yank (chunk) ;; Helper for isearch-yank-* functions. CHUNK can be a string or a ;; function. @@ -886,7 +985,7 @@ (goto-char isearch-other-end)) (buffer-substring (point) - (save-excursion + (progn (funcall chunk) (point))))))) ;; if configured so that typing upper-case characters turns off case @@ -904,7 +1003,6 @@ isearch-yank-flag t)) (isearch-search-and-update)) - (defun isearch-yank-word () "Pull next word from buffer into search string." (interactive) @@ -925,30 +1023,34 @@ (interactive) (isearch-yank 'forward-sexp)) -(defun isearch-yank-x-selection () - "Pull the current X selection into the search string." +(defun isearch-yank-selection () + "Pull the current selection into the search string." (interactive) - (isearch-yank (x-get-selection))) + (isearch-yank (get-selection))) -(defun isearch-yank-x-clipboard () - "Pull the current X clipboard selection into the search string." +(defun isearch-yank-clipboard () + "Pull the current clipboard selection into the search string." (interactive) - (isearch-yank (x-get-clipboard))) + (isearch-yank (get-clipboard))) (defun isearch-fix-case () - (if (and isearch-case-fold-search search-caps-disable-folding) - (setq isearch-case-fold-search + ;; The commented-out (and ...) form implies that, once + ;; isearch-case-fold-search becomes nil due to a capital letter + ;; typed in, it can never be restored to the original value. In + ;; that case, it's impossible to revert a case-sensitive search back + ;; to case-insensitive. + (if ;(and isearch-case-fold-search search-caps-disable-folding) + (and case-fold-search + ;; Make sure isearch-toggle-case-fold works. + (not isearch-fixed-case) + search-caps-disable-folding) + (setq isearch-case-fold-search (no-upper-case-p isearch-string isearch-regexp))) (setq isearch-mode (if case-fold-search (if isearch-case-fold-search " Isearch" ;As God Intended Mode " ISeARch") ;Warn about evil case via StuDLYcAps. - "Isearch" -; (if isearch-case-fold-search -; " isearch" ;Presumably case-sensitive losers -; ;will notice this 1-char difference. -; " Isearch") ;Weenie mode. - ))) + " Isearch"))) (defun isearch-search-and-update () ;; Do the search and update the display. @@ -972,16 +1074,17 @@ (regexp-quote isearch-string))))) (error nil)) (or isearch-yank-flag - (<= (match-end 0) + (<= (match-end 0) (min isearch-opoint isearch-barrier)))) - (setq isearch-success t + (setq isearch-success t isearch-invalid-regexp nil + isearch-within-brackets nil isearch-other-end (match-end 0)) ;; Not regexp, not reverse, or no match at point. (if (and isearch-other-end (not isearch-adjusted)) (goto-char (if isearch-forward isearch-other-end - (min isearch-opoint - isearch-barrier + (min isearch-opoint + isearch-barrier (1+ isearch-other-end))))) (isearch-search) )) @@ -991,31 +1094,34 @@ ;; *, ?, and | chars can make a regexp more liberal. -;; They can make a regexp match sooner -;; or make it succeed instead of failing. +;; They can make a regexp match sooner or make it succeed instead of failing. ;; So go back to place last successful search started ;; or to the last ^S/^R (barrier), whichever is nearer. +;; + needs no special handling because the string must match at least once. (defun isearch-*-char () "Handle * and ? specially in regexps." (interactive) - (if isearch-regexp - - (progn - (setq isearch-adjusted t) - (let ((cs (nth (if isearch-forward - 5 ; isearch-other-end - 2) ; saved (point) - (car (cdr isearch-cmds))))) + (if isearch-regexp + (let ((idx (length isearch-string))) + (while (and (> idx 0) + (eq (aref isearch-string (1- idx)) ?\\)) + (setq idx (1- idx))) + (when (= (mod (- (length isearch-string) idx) 2) 0) + (setq isearch-adjusted t) + ;; Get the isearch-other-end from before the last search. + ;; We want to start from there, + ;; so that we don't retreat farther than that. ;; (car isearch-cmds) is after last search; ;; (car (cdr isearch-cmds)) is from before it. - (setq cs (or cs isearch-barrier)) - (goto-char - (if isearch-forward - (max cs isearch-barrier) - (min cs isearch-barrier)))))) + (let ((cs (nth 5 (car (cdr isearch-cmds))))) + (setq cs (or cs isearch-barrier)) + (goto-char + (if isearch-forward + (max cs isearch-barrier) + (min cs isearch-barrier))))))) (isearch-process-search-char last-command-event)) - + (defun isearch-|-char () @@ -1027,42 +1133,59 @@ (goto-char isearch-barrier))) (isearch-process-search-char last-command-event)) +;; FSF: +;(defalias 'isearch-other-control-char 'isearch-other-meta-char) +; +;(defun isearch-other-meta-char () +;... +; + (defun isearch-quote-char () "Quote special characters for incremental search." (interactive) + ;; #### Here FSF does some special conversion of chars in 0200-0377 + ;; range. Maybe we should do the same. (isearch-process-search-char (read-quoted-char (isearch-message t)))) - (defun isearch-return-char () "Convert return into newline for incremental search. Obsolete." (interactive) (isearch-process-search-char ?\n)) - (defun isearch-printing-char () - "Any other printing character => add it to the search string and search." + "Add this ordinary printing character to the search string and search." (interactive) - (isearch-process-search-char last-command-event)) - + (let ((event last-command-event)) + ;; If we are called by isearch-whitespace-chars because the + ;; context disallows whitespace search (e.g. within brackets), + ;; replace M-SPC with a space. FSF has similar code. + (and (eq this-command 'isearch-whitespace-chars) + (null (event-to-character event)) + (setq event (character-to-event ?\ ))) + (isearch-process-search-char event))) (defun isearch-whitespace-chars () "Match all whitespace chars, if in regexp mode." + ;; FSF docstring adds: "If you want to search for just a space, type + ;; C-q SPC." But we don't need the addition because we have a + ;; different (better) default for the variable. (interactive) - (if (and isearch-regexp search-whitespace-regexp) - (isearch-process-search-string search-whitespace-regexp " ") - (beep) - (isearch-process-search-char ?\ ) -; (if isearch-word -; nil -; (setq isearch-word t) -; (goto-char isearch-other-end) -; (isearch-process-search-char ?\ )) - )) + (if isearch-regexp + (if (and search-whitespace-regexp (not isearch-within-brackets) + (not isearch-invalid-regexp)) + (isearch-process-search-string search-whitespace-regexp " ") + (isearch-printing-char)) + (progn + ;; This way of doing word search doesn't correctly extend current search. + ;; (setq isearch-word t) + ;; (setq isearch-adjusted t) + ;; (goto-char isearch-barrier) + (isearch-printing-char)))) (defun isearch-process-search-char (char) ;; Append the char to the search string, update the message and re-search. - (isearch-process-search-string (isearch-char-to-string char) + (isearch-process-search-string (isearch-char-to-string char) (isearch-text-char-description char))) (defun isearch-process-search-string (string message) @@ -1074,12 +1197,6 @@ ;;=========================================================== ;; Search Ring -(defcustom search-ring-update nil - "*Non-nil if advancing or retreating in the search ring should cause search. -Default nil means edit the string from the search ring first." - :type 'boolean - :group 'isearch) - (defun isearch-ring-adjust1 (advance) ;; Helper for isearch-ring-adjust (let* ((ring (if isearch-regexp regexp-search-ring search-ring)) @@ -1092,25 +1209,25 @@ () (set yank-pointer-name (setq yank-pointer - (nthcdr (% (+ (- length (length yank-pointer)) - (if advance (1- length) 1)) - length) ring))) - (setq isearch-string (car yank-pointer) + (mod (+ (or yank-pointer 0) + (if advance -1 1)) + length))) + (setq isearch-string (nth yank-pointer ring) isearch-message (mapconcat 'isearch-text-char-description isearch-string ""))))) (defun isearch-ring-adjust (advance) ;; Helper for isearch-ring-advance and isearch-ring-retreat - (if (cdr isearch-cmds) ;; is there more than one thing on stack? - (isearch-pop-state)) +; (if (cdr isearch-cmds) ;; is there more than one thing on stack? +; (isearch-pop-state)) (isearch-ring-adjust1 advance) - (isearch-push-state) (if search-ring-update (progn (isearch-search) (isearch-update)) (isearch-edit-string) - )) + ) + (isearch-push-state)) (defun isearch-ring-advance () "Advance to the next search string in the ring." @@ -1123,30 +1240,59 @@ (interactive) (isearch-ring-adjust nil)) -(defun isearch-ring-adjust-edit (advance) - "Use the next or previous search string in the ring while in minibuffer." - (isearch-ring-adjust1 advance) - (erase-buffer) - (insert isearch-string)) +(defun isearch-ring-advance-edit (n) + "Insert the next element of the search history into the minibuffer." + (interactive "p") + (let* ((yank-pointer-name (if isearch-regexp + 'regexp-search-ring-yank-pointer + 'search-ring-yank-pointer)) + (yank-pointer (eval yank-pointer-name)) + (ring (if isearch-regexp regexp-search-ring search-ring)) + (length (length ring))) + (if (zerop length) + () + (set yank-pointer-name + (setq yank-pointer + (mod (- (or yank-pointer 0) n) + length))) + + (erase-buffer) + (insert (nth yank-pointer ring)) + (goto-char (point-max))))) -(defun isearch-ring-advance-edit () - (interactive) - (isearch-ring-adjust-edit 'advance)) +(defun isearch-ring-retreat-edit (n) + "Inserts the previous element of the search history into the minibuffer." + (interactive "p") + (isearch-ring-advance-edit (- n))) + +;; Merging note: FSF comments out these functions and implements them +;; differently (see above), presumably because the versions below mess +;; with isearch-string, while what we really want them to do is simply +;; to insert the correct string to the minibuffer. -(defun isearch-ring-retreat-edit () - "Retreat to the previous search string in the ring while in the minibuffer." - (interactive) - (isearch-ring-adjust-edit nil)) +;;(defun isearch-ring-adjust-edit (advance) +;; "Use the next or previous search string in the ring while in minibuffer." +;; (isearch-ring-adjust1 advance) +;; (erase-buffer) +;; (insert isearch-string)) + +;;(defun isearch-ring-advance-edit () +;; (interactive) +;; (isearch-ring-adjust-edit 'advance)) + +;;(defun isearch-ring-retreat-edit () +;; "Retreat to the previous search string in the ring while in the minibuffer." +;; (interactive) +;; (isearch-ring-adjust-edit nil)) (defun isearch-complete1 () ;; Helper for isearch-complete and isearch-complete-edit - ;; Return t if completion OK, + ;; Return t if completion OK, nil if no completion exists. (let* ((ring (if isearch-regexp regexp-search-ring search-ring)) (alist (mapcar (function (lambda (string) (list string))) ring)) (completion-ignore-case case-fold-search) - (completion (try-completion isearch-string alist)) - ) + (completion (try-completion isearch-string alist))) (cond ((eq completion t) ;; isearch-string stays the same @@ -1154,12 +1300,14 @@ ((or completion ; not nil, must be a string (= 0 (length isearch-string))) ; shouldn't have to say this (if (equal completion isearch-string) ;; no extension? - (if completion-auto-help - (with-output-to-temp-buffer "*Isearch completions*" - (display-completion-list - (all-completions isearch-string alist)))) - (setq isearch-string completion)) - t) + (progn + (if completion-auto-help + (with-output-to-temp-buffer "*Isearch completions*" + (display-completion-list + (all-completions isearch-string alist)))) + t) + (and completion + (setq isearch-string completion)))) (t (temp-minibuffer-message "No completion") nil)))) @@ -1186,32 +1334,61 @@ ;;;============================================================== -;; The search status stack (and isearch window-local variables, not used). +;; The search status stack. (defun isearch-top-state () -;; (fetch-window-local-variables) (let ((cmd (car isearch-cmds))) + ;; #### Grr, this is so error-prone. If you add something to + ;; isearch-push-state, don't forget to update this. I thought I'd + ;; make a list of variables, and just do (mapcar* #'set vars + ;; values), but the (point) thing would spoil it, leaving to more + ;; complication. (setq isearch-string (car cmd) isearch-message (car (cdr cmd)) isearch-success (nth 3 cmd) isearch-forward (nth 4 cmd) isearch-other-end (nth 5 cmd) - isearch-invalid-regexp (nth 6 cmd) - isearch-wrapped (nth 7 cmd) - isearch-barrier (nth 8 cmd)) + isearch-word (nth 6 cmd) + isearch-invalid-regexp (nth 7 cmd) + isearch-wrapped (nth 8 cmd) + isearch-barrier (nth 9 cmd) + isearch-within-brackets (nth 10 cmd)) (goto-char (car (cdr (cdr cmd)))))) (defun isearch-pop-state () -;; (fetch-window-local-variables) - (setq isearch-cmds (cdr isearch-cmds)) + (pop isearch-cmds) (isearch-top-state) - ) + + ;; Make sure isearch-case-fold-search gets the correct value. FSF + ;; simply stores isearch-case-fold-search to isearch-cmds. We + ;; should probably do the same. + (isearch-fix-case) + + ;; Here, as well as in isearch-search we must deal with the point + ;; landing at an invisible area which may need unhiding. + (if (or (not (eq search-invisible 'open)) + (not isearch-hide-immediately)) + ;; If search-invisible is t, invisible text is just like any + ;; other text. If it is nil, it is always skipped and we can't + ;; land inside. In both cases, we don't need to do anything. + ;; + ;; Similarly, if isearch-hide-immediately is nil, needn't + ;; re-hide the area here, and neither can we land back into a + ;; hidden one. + nil + (when isearch-other-end + ;; This will unhide the extents. + (isearch-range-invisible (point) isearch-other-end)) + (isearch-restore-invisible-extents (point) + (or isearch-other-end (point))))) (defun isearch-push-state () - (setq isearch-cmds + (setq isearch-cmds (cons (list isearch-string isearch-message (point) - isearch-success isearch-forward isearch-other-end - isearch-invalid-regexp isearch-wrapped isearch-barrier) + isearch-success isearch-forward isearch-other-end + isearch-word + isearch-invalid-regexp isearch-wrapped isearch-barrier + isearch-within-brackets) isearch-cmds))) @@ -1222,27 +1399,41 @@ ;; Generate and print the message string. (let ((cursor-in-echo-area ellipsis) (m (concat - (isearch-message-prefix c-q-hack) + (isearch-message-prefix c-q-hack ellipsis isearch-nonincremental) isearch-message - (isearch-message-suffix c-q-hack) + (isearch-message-suffix c-q-hack ellipsis) ))) - (if c-q-hack m (display-message 'progress (format "%s" m))))) + (if c-q-hack + m + (display-message 'progress (format "%s" m))))) -(defun isearch-message-prefix (&optional c-q-hack nonincremental) +(defun isearch-message-prefix (&optional c-q-hack ellipsis nonincremental) ;; If about to search, and previous search regexp was invalid, ;; check that it still is. If it is valid now, ;; let the message we display while searching say that it is valid. - (and isearch-invalid-regexp + (and isearch-invalid-regexp ellipsis (condition-case () (progn (re-search-forward isearch-string (point) t) - (setq isearch-invalid-regexp nil)) + (setq isearch-invalid-regexp nil + isearch-within-brackets nil)) (error nil))) - ;; #### - Yo! Emacs assembles strings all over the place, they can't all - ;; be internationalized in the manner proposed below... Add an explicit - ;; call to `gettext' and have the string snarfer pluck the english - ;; strings out of the comment below. XEmacs is on a purespace diet! -Stig + ;; If currently failing, display no ellipsis. + (or isearch-success (setq ellipsis nil)) + ;; #### - ! Emacs assembles strings all over the place, they can't + ;; all be internationalized in the manner proposed below... Add an + ;; explicit call to `gettext' and have the string snarfer pluck the + ;; english strings out of the comment below. XEmacs is on a + ;; purespace diet! -Stig + + ;; The comment below is dead and buried, but it can be rebuilt if + ;; necessary. -hniksic (let ((m (concat (if isearch-success nil "failing ") - (if isearch-wrapped "wrapped ") + (if (and isearch-wrapped + (if isearch-forward + (> (point) isearch-opoint) + (< (point) isearch-opoint))) + "overwrapped " + (if isearch-wrapped "wrapped ")) (if isearch-word "word ") (if isearch-regexp "regexp ") (if nonincremental "search" "I-search") @@ -1252,14 +1443,12 @@ (aset m 0 (upcase (aref m 0))) (gettext m))) -(defun isearch-message-suffix (&optional c-q-hack) +(defun isearch-message-suffix (&optional c-q-hack ellipsis) (concat (if c-q-hack "^Q" "") (if isearch-invalid-regexp (concat " [" isearch-invalid-regexp "]") ""))) -;;;;; #### - yuck...this is soooo lame. Is this really worth 4k of purespace??? -;;; ;;;(let ((i (logior (if isearch-success 32 0) ;;; (if isearch-wrapped 16 0) ;;; (if isearch-word 8 0) @@ -1268,68 +1457,7 @@ ;;; (if isearch-forward 1 0)))) ;;; (cond ;;; ((= i 63) (gettext "Wrapped word regexp search: ")) ; 111111 -;;; ((= i 62) (gettext "Wrapped word regexp search backward: ")) ; 111110 -;;; ((= i 61) (gettext "Wrapped word regexp I-search: ")) ; 111101 -;;; ((= i 60) (gettext "Wrapped word regexp I-search backward: ")) ; 111100 -;;; ((= i 59) (gettext "Wrapped word search: ")) ; 111011 -;;; ((= i 58) (gettext "Wrapped word search backward: ")) ; 111010 -;;; ((= i 57) (gettext "Wrapped word I-search: ")) ; 111001 -;;; ((= i 56) (gettext "Wrapped word I-search backward: ")) ; 111000 -;;; ((= i 55) (gettext "Wrapped regexp search: ")) ; 110111 -;;; ((= i 54) (gettext "Wrapped regexp search backward: ")) ; 110110 -;;; ((= i 53) (gettext "Wrapped regexp I-search: ")) ; 110101 -;;; ((= i 52) (gettext "Wrapped regexp I-search backward: ")) ; 110100 -;;; ((= i 51) (gettext "Wrapped search: ")) ; 110011 -;;; ((= i 50) (gettext "Wrapped search backward: ")) ; 110010 -;;; ((= i 49) (gettext "Wrapped I-search: ")) ; 110001 -;;; ((= i 48) (gettext "Wrapped I-search backward: ")) ; 110000 -;;; ((= i 47) (gettext "Word regexp search: ")) ; 101111 -;;; ((= i 46) (gettext "Word regexp search backward: ")) ; 101110 -;;; ((= i 45) (gettext "Word regexp I-search: ")) ; 101101 -;;; ((= i 44) (gettext "Word regexp I-search backward: ")) ; 101100 -;;; ((= i 43) (gettext "Word search: ")) ; 101011 -;;; ((= i 42) (gettext "Word search backward: ")) ; 101010 -;;; ((= i 41) (gettext "Word I-search: ")) ; 101001 -;;; ((= i 40) (gettext "Word I-search backward: ")) ; 101000 -;;; ((= i 39) (gettext "Regexp search: ")) ; 100111 -;;; ((= i 38) (gettext "Regexp search backward: ")) ; 100110 -;;; ((= i 37) (gettext "Regexp I-search: ")) ; 100101 -;;; ((= i 36) (gettext "Regexp I-search backward: ")) ; 100100 -;;; ((= i 35) (gettext "Search: ")) ; 100011 -;;; ((= i 34) (gettext "Search backward: ")) ; 100010 -;;; ((= i 33) (gettext "I-search: ")) ; 100001 -;;; ((= i 32) (gettext "I-search backward: ")) ; 100000 -;;; ((= i 31) (gettext "Failing wrapped word regexp search: ")) ; 011111 -;;; ((= i 30) (gettext "Failing wrapped word regexp search backward: ")) ; 011110 -;;; ((= i 29) (gettext "Failing wrapped word regexp I-search: ")) ; 011101 -;;; ((= i 28) (gettext "Failing wrapped word regexp I-search backward: ")) ; 011100 -;;; ((= i 27) (gettext "Failing wrapped word search: ")) ; 011011 -;;; ((= i 26) (gettext "Failing wrapped word search backward: ")) ; 011010 -;;; ((= i 25) (gettext "Failing wrapped word I-search: ")) ; 011001 -;;; ((= i 24) (gettext "Failing wrapped word I-search backward: ")) ; 011000 -;;; ((= i 23) (gettext "Failing wrapped regexp search: ")) ; 010111 -;;; ((= i 22) (gettext "Failing wrapped regexp search backward: ")) ; 010110 -;;; ((= i 21) (gettext "Failing wrapped regexp I-search: ")) ; 010101 -;;; ((= i 20) (gettext "Failing wrapped regexp I-search backward: ")) ; 010100 -;;; ((= i 19) (gettext "Failing wrapped search: ")) ; 010011 -;;; ((= i 18) (gettext "Failing wrapped search backward: ")) ; 010010 -;;; ((= i 17) (gettext "Failing wrapped I-search: ")) ; 010001 -;;; ((= i 16) (gettext "Failing wrapped I-search backward: ")) ; 010000 -;;; ((= i 15) (gettext "Failing word regexp search: ")) ; 001111 -;;; ((= i 14) (gettext "Failing word regexp search backward: ")) ; 001110 -;;; ((= i 13) (gettext "Failing word regexp I-search: ")) ; 001101 -;;; ((= i 12) (gettext "Failing word regexp I-search backward: ")) ; 001100 -;;; ((= i 11) (gettext "Failing word search: ")) ; 001011 -;;; ((= i 10) (gettext "Failing word search backward: ")) ; 001010 -;;; ((= i 9) (gettext "Failing word I-search: ")) ; 001001 -;;; ((= i 8) (gettext "Failing word I-search backward: ")) ; 001000 -;;; ((= i 7) (gettext "Failing regexp search: ")) ; 000111 -;;; ((= i 6) (gettext "Failing regexp search backward: ")) ; 000110 -;;; ((= i 5) (gettext "Failing regexp I-search: ")) ; 000101 -;;; ((= i 4) (gettext "Failing regexp I-search backward: ")) ; 000100 -;;; ((= i 3) (gettext "Failing search: ")) ; 000011 -;;; ((= i 2) (gettext "Failing search backward: ")) ; 000010 -;;; ((= i 1) (gettext "Failing I-search: ")) ; 000001 +;;; ...and so on, ad nauseam... ;;; ((= i 0) (gettext "Failing I-search backward: ")) ; 000000 ;;; (t (error "Something's rotten"))))) @@ -1343,6 +1471,7 @@ (put 'isearch-repeat-backward 'isearch-command t) (put 'isearch-delete-char 'isearch-command t) (put 'isearch-help-or-delete-char 'isearch-command t) +(put 'isearch-cancel 'isearch-command t) (put 'isearch-abort 'isearch-command t) (put 'isearch-quote-char 'isearch-command t) (put 'isearch-exit 'isearch-command t) @@ -1371,6 +1500,8 @@ (put 'isearch-forward-exit-minibuffer 'isearch-command t) (put 'isearch-reverse-exit-minibuffer 'isearch-command t) (put 'isearch-nonincremental-exit-minibuffer 'isearch-command t) +(put 'isearch-yank-selection 'isearch-command t) +(put 'isearch-yank-clipboard 'isearch-command t) (put 'isearch-yank-x-selection 'isearch-command t) (put 'isearch-yank-x-clipboard 'isearch-command t) @@ -1408,11 +1539,24 @@ ;; (cond ((not (eq (current-buffer) isearch-buffer)) ;; If the buffer (likely meaning "frame") has changed, bail. - ;; This can also happen if a proc filter has popped up another - ;; buffer, which is arguably a bad thing for it to have done, - ;; but the way in which isearch would have hosed you in that - ;; case is unarguably even worse. -jwz - (isearch-done)) + ;; This can happen if the user types something into another + ;; frame. It can also happen if a proc filter has popped up + ;; another buffer, which is arguably a bad thing for it to + ;; have done, but the way in which isearch would have hosed + ;; you in that case is unarguably even worse. -jwz + (isearch-done) + + ;; `this-command' is set according to the value of + ;; `overriding-local-map', set by isearch-mode. This is + ;; wrong because that keymap makes sense only in isearch + ;; buffer. To make sure the right command is called, adjust + ;; `this-command' to the appropriate value, now that + ;; `isearch-done' has set `overriding-local-map' to nil. + + ;; FSF does similar magic in `isearch-other-meta-char', which + ;; is horribly complex. I *hope* what we do works in all + ;; cases. + (setq this-command (key-binding (this-command-keys)))) (t (isearch-maybe-frob-keyboard-macros) (if (and this-command @@ -1453,44 +1597,39 @@ ;;;======================================================== ;;; Highlighting -(defcustom isearch-highlight t - "*Whether isearch and query-replace should highlight the text which -currently matches the search-string.") - (defvar isearch-extent nil) -;; this face is initialized by x-faces.el since isearch is preloaded. -;; this face is now created in initialize-faces -;;(make-face 'isearch) +;; this face is initialized by faces.el since isearch is preloaded. +;(make-face 'isearch) (defun isearch-make-extent (begin end) (let ((x (make-extent begin end (current-buffer)))) - ;; make the isearch extent always take prescedence over any mouse- + ;; make the isearch extent always take precedence over any mouse- ;; highlighted extents we may be passing through, since isearch, being ;; modal, is more interesting (there's nothing they could do with a ;; mouse-highlighted extent while in the midst of a search anyway). - (set-extent-priority x (1+ mouse-highlight-priority)) + (set-extent-priority x (+ mouse-highlight-priority 2)) (set-extent-face x 'isearch) (setq isearch-extent x))) (defun isearch-highlight (begin end) - (if (null isearch-highlight) + (if (null search-highlight) nil ;; make sure isearch-extent is in the current buffer - (or (extentp isearch-extent) + (or (and (extentp isearch-extent) + (extent-live-p isearch-extent)) (isearch-make-extent begin end)) (set-extent-endpoints isearch-extent begin end (current-buffer)))) -(defun isearch-dehighlight (totally) - (if (and isearch-highlight isearch-extent) - (if totally - (let ((inhibit-quit t)) - (if (extentp isearch-extent) - (delete-extent isearch-extent)) - (setq isearch-extent nil)) - (if (extentp isearch-extent) - (detach-extent isearch-extent) - (setq isearch-extent nil))))) +;; This used to have a TOTALLY flag that also deleted the extent. I +;; don't think this is necessary any longer, as isearch-highlight can +;; simply move the extent to another buffer. The IGNORED argument is +;; for the code that calls this function with an argument. --hniksic +(defun isearch-dehighlight (&optional ignored) + (and search-highlight + (extentp isearch-extent) + (extent-live-p isearch-extent) + (detach-extent isearch-extent))) ;;;======================================================== @@ -1502,33 +1641,54 @@ (isearch-fix-case) (condition-case lossage (let ((inhibit-quit nil) - (case-fold-search isearch-case-fold-search)) + (case-fold-search isearch-case-fold-search) + (retry t)) (if isearch-regexp (setq isearch-invalid-regexp nil)) - (setq isearch-success - (funcall - (cond (isearch-word - (if isearch-forward - 'word-search-forward 'word-search-backward)) - (isearch-regexp - (if isearch-forward - 're-search-forward 're-search-backward)) - (t - (if isearch-forward 'search-forward 'search-backward))) - isearch-string nil t)) + (setq isearch-within-brackets nil) + (while retry + (setq isearch-success + (funcall + (cond (isearch-word + (if isearch-forward + 'word-search-forward 'word-search-backward)) + (isearch-regexp + (if isearch-forward + 're-search-forward 're-search-backward)) + (t + (if isearch-forward 'search-forward 'search-backward))) + isearch-string nil t)) + ;; Clear RETRY unless we matched some invisible text + ;; and we aren't supposed to do that. + (if (or (eq search-invisible t) + (not isearch-success) + (bobp) (eobp) + (= (match-beginning 0) (match-end 0)) + (not (isearch-range-invisible + (match-beginning 0) (match-end 0)))) + (setq retry nil))) (setq isearch-just-started nil) - (if isearch-success - (setq isearch-other-end - (if isearch-forward (match-beginning 0) (match-end 0))))) + (when isearch-success + (setq isearch-other-end + (if isearch-forward (match-beginning 0) (match-end 0))) + (and isearch-hide-immediately + (isearch-restore-invisible-extents (match-beginning 0) + (match-end 0))))) - (quit (setq unread-command-event (character-to-event (quit-char))) + (quit (setq unread-command-events (nconc unread-command-events + (character-to-event (quit-char)))) (setq isearch-success nil)) - (invalid-regexp + (invalid-regexp (setq isearch-invalid-regexp (car (cdr lossage))) + (setq isearch-within-brackets (string-match "\\`Unmatched \\[" + isearch-invalid-regexp)) (if (string-match "\\`Premature \\|\\`Unmatched \\|\\`Invalid " isearch-invalid-regexp) - (setq isearch-invalid-regexp (gettext "incomplete input"))))) + (setq isearch-invalid-regexp (gettext "incomplete input")))) + (error + ;; stack overflow in regexp search. + (setq isearch-invalid-regexp (car (cdr lossage))))) (if isearch-success nil @@ -1548,59 +1708,79 @@ (ding nil 'isearch-failed)) (goto-char (nth 2 (car isearch-cmds))))) -;;;================================================= -;; This is called from incremental-search -;; if the first input character is the exit character. - -;; We store the search string in `isearch-string' -;; which has been bound already by `isearch-search' -;; so that, when we exit, it is copied into `search-last-string'. - +;; Replaced with isearch-edit-string. ;(defun nonincremental-search (forward regexp) -; ;; This may be broken. Anyway, it is replaced by the isearch-edit-string. -; ;; Missing features: word search option, command history. -; (setq isearch-forward forward -; isearch-regexp regexp) -; (let (char function -; inhibit-quit -; (cursor-in-echo-area t)) -; ;; Prompt assuming not word search, -; (setq isearch-message -; (if isearch-regexp -; (if isearch-forward "Regexp search: " -; "Regexp search backward: ") -; (if isearch-forward "Search: " "Search backward: "))) -; (message "%s" isearch-message) -; ;; Read 1 char and switch to word search if it is ^W. -; (setq char (read-char)) -; (if (eq char search-yank-word-char) -; (setq isearch-message (if isearch-forward "Word search: " -; "Word search backward: ")) -; ;; Otherwise let that 1 char be part of the search string. -; (setq unread-command-event (character-to-event char)) -; ) -; (setq function -; (if (eq char search-yank-word-char) -; (if isearch-forward 'word-search-forward 'word-search-backward) -; (if isearch-regexp -; (if isearch-forward 're-search-forward 're-search-backward) -; (if isearch-forward 'search-forward 'search-backward)))) -; ;; Read the search string with corrected prompt. -; (setq isearch-string (read-string isearch-message isearch-string)) -; ;; Empty means use default. -; (if (= 0 (length isearch-string)) -; (setq isearch-string search-last-string) -; ;; Set last search string now so it is set even if we fail. -; (setq search-last-string isearch-string)) -; ;; Since we used the minibuffer, we should be available for redo. -; (setq command-history -; (cons (list function isearch-string) command-history)) -; ;; Go ahead and search. -; (if search-caps-disable-folding -; (setq isearch-case-fold-search -; (no-upper-case-p isearch-string isearch-regexp))) -; (let ((case-fold-search isearch-case-fold-search)) -; (funcall function isearch-string)))) +;... + +(defun isearch-unhide-extent (extent) + ;; Store the values for the `invisible' and `intangible' + ;; properties, and then set them to nil. This way the text hidden + ;; by this extent becomes visible. + (put extent 'isearch-invisible (get extent 'invisible)) + (put extent 'isearch-intangible (get extent 'intangible)) + (put extent 'invisible nil) + (put extent 'intangible nil)) + +(defun isearch-range-invisible (beg end) + "Return t if all the text from BEG to END is invisible. +Before that, if search-invisible is `open', unhide the extents with an +`isearch-open-invisible' property." + ;; isearch-search uses this to skip the extents that are invisible, + ;; but don't have `isearch-open-invisible' set. It is unclear + ;; what's supposed to happen if only a part of [BEG, END) overlaps + ;; the extent. + (let (to-be-unhidden) + (if (map-extents + (lambda (extent ignored) + (if (and (<= (extent-start-position extent) beg) + (>= (extent-end-position extent) end)) + ;; All of the region is covered by the extent. + (if (and (eq search-invisible 'open) + (get extent 'isearch-open-invisible)) + (progn + (push extent to-be-unhidden) + nil) ; keep mapping + ;; We can't or won't unhide this extent, so we must + ;; skip the whole match. We return from map-extents + ;; immediately. + t) + ;; Else, keep looking. + nil)) + nil beg end nil 'all-extents-closed 'invisible) + ;; The whole match must be skipped. Signal it by returning t + ;; to the caller. + t + ;; If any extents need to be unhidden, unhide them. + (mapc #'isearch-unhide-extent to-be-unhidden) + ;; Will leave this assert for some time, to catch bugs. + (assert (null (intersection to-be-unhidden isearch-unhidden-extents))) + (setq isearch-unhidden-extents (nconc to-be-unhidden + isearch-unhidden-extents)) + nil))) + +(defun isearch-restore-extent (extent) + (put extent 'invisible (get extent 'isearch-invisible)) + (put extent 'intangible (get extent 'isearch-intangible)) + (remprop extent 'isearch-invisible) + (remprop extent 'isearch-intangible)) + +;; FSF calls this function `isearch-clean-overlays'. +(defun isearch-restore-invisible-extents (beg end) + (cond + ((null beg) + ;; Delete all -- this is called at the end of isearch. + (mapc #'isearch-restore-extent isearch-unhidden-extents) + (setq isearch-unhidden-extents nil)) + (t + ;; Extents that do not overlap the match area can be safely + ;; restored to their hidden state. + (setq isearch-unhidden-extents + (delete-if (lambda (extent) + (unless (extent-in-region-p extent beg end + 'all-extents-closed) + (isearch-restore-extent extent) + t)) + isearch-unhidden-extents))))) (defun isearch-no-upper-case-p (string) "Return t if there are no upper case chars in string. @@ -1611,6 +1791,18 @@ (not (string-match "\\(^\\|[^\\]\\)[A-Z]" string)))) (make-obsolete 'isearch-no-upper-case-p 'no-upper-case-p) +;; Portability functions to support various Emacs versions. + +(defun isearch-char-to-string (c) + (if (eventp c) + (make-string 1 (event-to-character c nil nil t)) + (make-string 1 c))) + +;(defun isearch-text-char-description (c) +; (isearch-char-to-string c)) + +(define-function 'isearch-text-char-description 'text-char-description) + ;; Used by etags.el and info.el (defmacro with-caps-disable-folding (string &rest body) "\ Eval BODY with `case-fold-search' let to nil if STRING contains @@ -1624,4 +1816,204 @@ (put 'with-caps-disable-folding 'lisp-indent-function 1) (put 'with-caps-disable-folding 'edebug-form-spec '(form body)) + +;;;======================================================== +;;; Advanced highlighting + +;; When active, *every* visible match for the current search string is +;; highlighted: the current one using the normal isearch match color +;; and all the others using the `isearch-secondary' face. The extra +;; highlighting makes it easier to anticipate where the cursor will +;; land each time you press C-s or C-r to repeat a pending search. +;; Only the matches visible at any point are highlighted -- when you +;; move through the buffer, the highlighting is readjusted. + +;; This is based on ideas from Bob Glickstein's `ishl' package. It +;; has been merged with XEmacs by Darryl Okahata, and then completely +;; rewritten by Hrvoje Niksic. + +;; The code makes the following assumptions about the rest of this +;; file, so be careful when modifying it. + +;; * `isearch-highlight-all-update' should get called when the search +;; string changes, or when the search advances. This is done from +;; `isearch-update'. +;; * `isearch-highlight-all-cleanup' should get called when the search +;; is done. This is performed in `isearch-done'. +;; * `isearch-string' is expected to contain the current search string +;; as entered by the user. +;; * `isearch-opoint' is expected to contain the location where the +;; current search began. +;; * the type of the current search is expected to be given by +;; `isearch-word' and `isearch-regexp'. +;; * the variable `isearch-invalid-regexp' is expected to be true iff +;; `isearch-string' is an invalid regexp. + +(defcustom isearch-highlight-all-matches search-highlight + "*Non-nil means highlight all visible matches." + :type 'boolean + :group 'isearch) + +;; We can't create this face here, as isearch.el is preloaded. +;; #### Think up a better name for this! +;(defface isearch-secondary '((t (:foreground "red3"))) +; "Face to use for highlighting all matches." +; :group 'isearch) + +(defvar isearch-highlight-extents nil) +(defvar isearch-window-start nil) +(defvar isearch-window-end nil) +;; We compare isearch-string and isearch-case-fold-search to saved +;; values for better efficiency. +(defvar isearch-highlight-last-string nil) +(defvar isearch-highlight-last-case-fold-search nil) +(defvar isearch-highlight-last-regexp nil) + +(defun isearch-delete-extents-in-range (start end) + ;; Delete all highlighting extents that overlap [START, END). + (setq isearch-highlight-extents + (delete-if (lambda (extent) + (when (extent-in-region-p extent start end) + (delete-extent extent) + t)) + isearch-highlight-extents))) + +(defun isearch-highlight-all-cleanup () + ;; Stop lazily highlighting and remove extra highlighting from + ;; buffer. + (mapc #'delete-extent isearch-highlight-extents) + (setq isearch-highlight-extents nil) + (setq isearch-highlight-all-start nil + isearch-window-end nil + isearch-highlight-last-string nil)) + +(defun isearch-highlight-all-update () + ;; Update the highlighting if necessary. This needs to check if the + ;; search string has changed, or if the window has changed position + ;; in the buffer. + (let ((need-start-over nil)) + ;; NB: we don't check for isearch-success because if the point is + ;; after the last match, the search can be unsuccessful, and yet + ;; there are things to highlight. + (cond ((not isearch-highlight-all-matches)) + ((or (equal isearch-string "") + isearch-invalid-regexp) + (isearch-highlight-all-cleanup)) + ((not (eq isearch-case-fold-search + isearch-highlight-last-case-fold-search)) + ;; This case is usually caused by search string being + ;; changed, which would be caught below, but it can also be + ;; tripped using isearch-toggle-case-fold. + (setq need-start-over t)) + ((not (eq isearch-regexp isearch-highlight-last-regexp)) + ;; Ditto for isearch-toggle-regexp. + (setq need-start-over t)) + ((equal isearch-string isearch-highlight-last-string) + ;; The search string is the same. We need to do something + ;; if our position has changed. + + ;; It would be nice if we didn't have to do this; however, + ;; window-start doesn't support a GUARANTEE flag, so we must + ;; force redisplay to get the correct value for start and end + ;; of window. + (sit-for 0) + + ;; Check whether our location has changed. + (let ((start (window-start)) + (end (min (window-end) (point-max)))) + (cond ((and (= start isearch-window-start) + (= end isearch-window-end)) + ;; Our position is unchanged -- do nothing. + ) + ((and (> start isearch-window-start) + (> end isearch-window-end) + (<= start isearch-window-end)) + ;; We've migrated downward, but we overlap the old + ;; region. Delete the old non-overlapping extents + ;; and fill in the rest. + (isearch-delete-extents-in-range isearch-window-start start) + (isearch-highlightify-region isearch-window-end end) + (setq isearch-window-start start + isearch-window-end end)) + ((and (<= start isearch-window-start) + (<= end isearch-window-end) + (> end isearch-window-start)) + ;; We've migrated upward, but we overlap the old + ;; region. Delete the old non-overlapping extents + ;; and fill in the rest. + (isearch-delete-extents-in-range + end isearch-window-end) + (isearch-highlightify-region start isearch-window-start) + (setq isearch-window-start start + isearch-window-end end)) + (t + ;; The regions don't overlap, or they overlap in a + ;; weird way. + (setq need-start-over t))))) + (t + ;; The search string has changed. + + ;; If more input is pending, don't start over because + ;; starting over forces redisplay, and that slows down + ;; typing. + (unless (input-pending-p) + (setq need-start-over t)))) + (when need-start-over + ;; Force redisplay before removing the old extents, in order to + ;; avoid flicker. + (sit-for 0) + (isearch-highlight-all-cleanup) + (setq isearch-window-start (window-start) + isearch-window-end (min (window-end) (point-max))) + (isearch-highlightify-region isearch-window-start isearch-window-end)) + + (setq isearch-highlight-last-string isearch-string + isearch-highlight-last-case-fold-search isearch-case-fold-search + isearch-highlight-last-regexp isearch-regexp))) + +(defun isearch-highlight-advance (string forwardp) + ;; Search ahead for the next or previous match. This is the same as + ;; isearch-search, but without the extra baggage. Maybe it should + ;; be in a separate function. + (let ((case-fold-search isearch-case-fold-search)) + (funcall (cond (isearch-word (if forwardp + 'word-search-forward + 'word-search-backward)) + (isearch-regexp (if forwardp + 're-search-forward + 're-search-backward)) + (t (if forwardp + 'search-forward + 'search-backward))) + string nil t))) + +(defun isearch-highlightify-region (start end) + ;; Highlight all occurrences of isearch-string between START and + ;; END. To do this right, we have to search forward as long as + ;; there are matches that overlap [START, END), and then search + ;; backward the same way. + (save-excursion + (goto-char isearch-opoint) + (let ((lastpoint (point))) + (while (and (isearch-highlight-advance isearch-string t) + (/= lastpoint (point)) + (< (match-beginning 0) end)) + (let ((extent (make-extent (match-beginning 0) + (match-end 0)))) + (set-extent-priority extent (1+ mouse-highlight-priority)) + (put extent 'face 'isearch-secondary) + (push extent isearch-highlight-extents)) + (setq lastpoint (point)))) + (goto-char isearch-opoint) + (let ((lastpoint (point))) + (while (and (isearch-highlight-advance isearch-string nil) + (/= lastpoint (point)) + (>= (match-end 0) start)) + (let ((extent (make-extent (match-beginning 0) + (match-end 0)))) + (set-extent-priority extent (1+ mouse-highlight-priority)) + (put extent 'face 'isearch-secondary) + (push extent isearch-highlight-extents)) + (setq lastpoint (point)))))) + ;;; isearch-mode.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/iso8859-1.el --- a/lisp/iso8859-1.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/iso8859-1.el Mon Aug 13 11:13:30 2007 +0200 @@ -2,7 +2,7 @@ ;; Copyright (C) 1992, 1997 Free Software Foundation, Inc. -;; Author: Jamie Zawinski +;; Author: Jamie Zawinski ;; Created: 19-aug-92 ;; Maintainer: XEmacs Development Team ;; Keywords: internal, dumped diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/itimer.el --- a/lisp/itimer.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/itimer.el Mon Aug 13 11:13:30 2007 +0200 @@ -20,6 +20,8 @@ (provide 'itimer) +(require 'lisp-float-type) + ;; `itimer' feature means Emacs-Lisp programmers get: ;; itimerp ;; itimer-live-p @@ -46,7 +48,7 @@ ;; ;; See the doc strings of these functions for more information. -(defvar itimer-version "1.07" +(defvar itimer-version "1.09" "Version number of the itimer package.") (defvar itimer-list nil @@ -62,7 +64,7 @@ (defvar itimer-timer-last-wakeup nil "The time the timer driver function last ran.") -(defvar itimer-short-interval (if (featurep 'lisp-float-type) 1e-3 1) +(defvar itimer-short-interval 1e-3 "Interval used for scheduling an event a very short time in the future. Used internally to make the scheduler wake up early. Unit is seconds.") @@ -159,7 +161,7 @@ ;; Functions to access and modify itimer attributes. (defun itimerp (obj) - "Return t if OBJ is an itimer." + "Return non-nil if OBJ is an itimer." (and (consp obj) (eq (length obj) 8))) (defun itimer-live-p (obj) @@ -181,7 +183,7 @@ (defun itimer-restart (itimer) "Return the value to which ITIMER will be set at restart. -Return nil if this itimer doesn't restart." +The value nil is returned if this itimer isn't set to restart." (check-itimer itimer) (nth 2 itimer)) @@ -194,8 +196,8 @@ (defun itimer-is-idle (itimer) "Return non-nil if ITIMER is an idle timer. Normal timers expire after a set interval. Idle timers expire -only after Emacs has been idle for a specific interval. -``Idle'' means no command events occur within the interval." +only after Emacs has been idle for a specific interval. ``Idle'' +means no command events have occurred within the interval." (check-itimer itimer) (nth 4 itimer)) @@ -208,7 +210,7 @@ (defun itimer-function-arguments (itimer) "Return the function arguments of ITIMER as a list. -ITIMER's function is called with these argument each time ITIMER expires." +ITIMER's function is called with these arguments each time ITIMER expires." (check-itimer itimer) (nth 6 itimer)) @@ -302,7 +304,7 @@ (get-itimer (completing-read prompt itimer-list nil 'confirm initial-input))) (defun delete-itimer (itimer) - "Delete ITIMER. ITIMER may be an itimer or the name of one." + "Deletes ITIMER. ITIMER may be an itimer or the name of one." (check-itimer-coerce-string itimer) (setq itimer-list (delq itimer itimer-list))) @@ -327,13 +329,13 @@ must be an integer. Optional fourth arg RESTART non-nil means that this itimer should be restarted automatically after its function is called. Normally an itimer - is deleted at expiration after its function has returned. - If non-nil, RESTART should be a number indicating the value at which - the itimer should be set at restart time. + is deleted at expiration after its function has returned. + If non-nil RESTART should be a number indicating the value at which the + itimer should be set at restart time. Optional fifth arg IS-IDLE specifies if this is an idle timer. Normal timers expire after a set interval. Idle timers expire - only after Emacs has been idle for specific interval. - ``Idle'' means no command events occur within the interval. + only after Emacs has been idle for specific interval. ``Idle'' + means no command events have occurred within the interval. Returns the newly created itimer." (interactive (list (completing-read "Start itimer: " itimer-list) @@ -671,7 +673,7 @@ (inhibit-quit t)) (setq next-wakeup 600) (cond ((and (boundp 'last-command-event-time) - (consp 'last-command-event-time)) + (consp last-command-event-time)) (setq last-event-time last-command-event-time idle-time (itimer-time-difference (current-time) last-event-time))) @@ -717,7 +719,12 @@ (inhibit-quit nil) ;; for FSF Emacs timer.el emulation under XEmacs. ;; eldoc expect this to be done, apparently. - (this-command nil)) + (this-command nil) + ;; bind these variables so that the + ;; itimer function can't screw with + ;; them. + last-event-time next-wakeup + itimer itimers time-elapsed) (if (itimer-uses-arguments current-itimer) (apply (itimer-function current-itimer) (itimer-function-arguments current-itimer)) @@ -837,11 +844,9 @@ secs (+ secs 65536)) (setq carry 0)) (setq 65536-secs (- (nth 0 t1) (nth 0 t2) carry)) - ;; loses for interval larger than the maximum signed Lisp integer. - ;; can't really be helped. - (+ (* 65536-secs 65536) + (+ (* 65536-secs 65536.0) secs - (/ usecs (if (featurep 'lisp-float-type) 1e6 1000000))))) + (/ usecs 1000000.0)))) (defun itimer-timer-driver (&rest ignored) ;; inhibit quit because if the user quits at an inopportune diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/ldap.el --- a/lisp/ldap.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/ldap.el Mon Aug 13 11:13:30 2007 +0200 @@ -5,7 +5,7 @@ ;; Author: Oscar Figueiredo ;; Maintainer: Oscar Figueiredo ;; Created: Jan 1998 -;; Version: $Revision: 1.7.2.3 $ +;; Version: $Revision: 1.7.2.6 $ ;; Keywords: help comm ;; This file is part of XEmacs @@ -40,7 +40,9 @@ :group 'comm) (defcustom ldap-default-host nil - "*Default LDAP server." + "*Default LDAP server hostname. +A TCP port number can be appended to that name using a colon as +a separator." :type '(choice (string :tag "Host name") (const :tag "Use library default" nil)) :group 'ldap) @@ -66,8 +68,10 @@ "*Alist of host-specific options for LDAP transactions. The format of each list element is: \(HOST PROP1 VAL1 PROP2 VAL2 ...) -HOST is the name of an LDAP server. PROPn and VALn are property/value -pairs describing parameters for the server. Valid properties include: +HOST is the hostname of an LDAP server (with an optional TCP port number +appended to it using a colon as a separator). +PROPn and VALn are property/value pairs describing parameters for the server. +Valid properties include: `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax). `passwd' is the password to use for simple authentication. @@ -87,6 +91,11 @@ (checklist :inline t :greedy t (list + :tag "Search Base" + :inline t + (const :tag "Search Base" base) + string) + (list :tag "Binding DN" :inline t (const :tag "Binding DN" binddn) @@ -106,11 +115,6 @@ (const :menu-tag "Kerberos 4.1" :tag "Kerberos 4.1" krbv41) (const :menu-tag "Kerberos 4.2" :tag "Kerberos 4.2" krbv42))) (list - :tag "Search Base" - :inline t - (const :tag "Search Base" base) - string) - (list :tag "Search Scope" :inline t (const :tag "Search Scope" scope) @@ -141,32 +145,334 @@ (integer :tag "(number of records)"))))) :group 'ldap) +(defcustom ldap-ignore-attribute-codings nil + "*If non-nil, do not perform any encoding/decoding on LDAP attribute values." + :type 'boolean + :group 'ldap) -(defun ldap-search (filter &optional host attributes attrsonly) +(defcustom ldap-default-attribute-decoder nil + "*Decoder function to use for attributes whose syntax is unknown." + :type 'symbol + :group 'ldap) + +(defcustom ldap-coding-system nil + "*Coding system of LDAP string values. +LDAP v3 specifies the coding system of strings to be UTF-8. +Mule support is needed for this." + :type 'symbol + :group 'ldap) + +(defvar ldap-attribute-syntax-encoders + [nil ; 1 ACI Item N + nil ; 2 Access Point Y + nil ; 3 Attribute Type Description Y + nil ; 4 Audio N + nil ; 5 Binary N + nil ; 6 Bit String Y + ldap-encode-boolean ; 7 Boolean Y + nil ; 8 Certificate N + nil ; 9 Certificate List N + nil ; 10 Certificate Pair N + ldap-encode-country-string ; 11 Country String Y + ldap-encode-string ; 12 DN Y + nil ; 13 Data Quality Syntax Y + nil ; 14 Delivery Method Y + ldap-encode-string ; 15 Directory String Y + nil ; 16 DIT Content Rule Description Y + nil ; 17 DIT Structure Rule Description Y + nil ; 18 DL Submit Permission Y + nil ; 19 DSA Quality Syntax Y + nil ; 20 DSE Type Y + nil ; 21 Enhanced Guide Y + nil ; 22 Facsimile Telephone Number Y + nil ; 23 Fax N + nil ; 24 Generalized Time Y + nil ; 25 Guide Y + nil ; 26 IA5 String Y + number-to-string ; 27 INTEGER Y + nil ; 28 JPEG N + nil ; 29 Master And Shadow Access Points Y + nil ; 30 Matching Rule Description Y + nil ; 31 Matching Rule Use Description Y + nil ; 32 Mail Preference Y + nil ; 33 MHS OR Address Y + nil ; 34 Name And Optional UID Y + nil ; 35 Name Form Description Y + nil ; 36 Numeric String Y + nil ; 37 Object Class Description Y + nil ; 38 OID Y + nil ; 39 Other Mailbox Y + nil ; 40 Octet String Y + ldap-encode-address ; 41 Postal Address Y + nil ; 42 Protocol Information Y + nil ; 43 Presentation Address Y + ldap-encode-string ; 44 Printable String Y + nil ; 45 Subtree Specification Y + nil ; 46 Supplier Information Y + nil ; 47 Supplier Or Consumer Y + nil ; 48 Supplier And Consumer Y + nil ; 49 Supported Algorithm N + nil ; 50 Telephone Number Y + nil ; 51 Teletex Terminal Identifier Y + nil ; 52 Telex Number Y + nil ; 53 UTC Time Y + nil ; 54 LDAP Syntax Description Y + nil ; 55 Modify Rights Y + nil ; 56 LDAP Schema Definition Y + nil ; 57 LDAP Schema Description Y + nil ; 58 Substring Assertion Y + ] + "A vector of functions used to encode LDAP attribute values. +The sequence of functions corresponds to the sequence of LDAP attribute syntax +object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in +RFC2252 section 4.3.2") + +(defvar ldap-attribute-syntax-decoders + [nil ; 1 ACI Item N + nil ; 2 Access Point Y + nil ; 3 Attribute Type Description Y + nil ; 4 Audio N + nil ; 5 Binary N + nil ; 6 Bit String Y + ldap-decode-boolean ; 7 Boolean Y + nil ; 8 Certificate N + nil ; 9 Certificate List N + nil ; 10 Certificate Pair N + ldap-decode-string ; 11 Country String Y + ldap-decode-string ; 12 DN Y + nil ; 13 Data Quality Syntax Y + nil ; 14 Delivery Method Y + ldap-decode-string ; 15 Directory String Y + nil ; 16 DIT Content Rule Description Y + nil ; 17 DIT Structure Rule Description Y + nil ; 18 DL Submit Permission Y + nil ; 19 DSA Quality Syntax Y + nil ; 20 DSE Type Y + nil ; 21 Enhanced Guide Y + nil ; 22 Facsimile Telephone Number Y + nil ; 23 Fax N + nil ; 24 Generalized Time Y + nil ; 25 Guide Y + nil ; 26 IA5 String Y + string-to-number ; 27 INTEGER Y + nil ; 28 JPEG N + nil ; 29 Master And Shadow Access Points Y + nil ; 30 Matching Rule Description Y + nil ; 31 Matching Rule Use Description Y + nil ; 32 Mail Preference Y + nil ; 33 MHS OR Address Y + nil ; 34 Name And Optional UID Y + nil ; 35 Name Form Description Y + nil ; 36 Numeric String Y + nil ; 37 Object Class Description Y + nil ; 38 OID Y + nil ; 39 Other Mailbox Y + nil ; 40 Octet String Y + ldap-decode-address ; 41 Postal Address Y + nil ; 42 Protocol Information Y + nil ; 43 Presentation Address Y + ldap-decode-string ; 44 Printable String Y + nil ; 45 Subtree Specification Y + nil ; 46 Supplier Information Y + nil ; 47 Supplier Or Consumer Y + nil ; 48 Supplier And Consumer Y + nil ; 49 Supported Algorithm N + nil ; 50 Telephone Number Y + nil ; 51 Teletex Terminal Identifier Y + nil ; 52 Telex Number Y + nil ; 53 UTC Time Y + nil ; 54 LDAP Syntax Description Y + nil ; 55 Modify Rights Y + nil ; 56 LDAP Schema Definition Y + nil ; 57 LDAP Schema Description Y + nil ; 58 Substring Assertion Y + ] + "A vector of functions used to decode LDAP attribute values. +The sequence of functions corresponds to the sequence of LDAP attribute syntax +object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in +RFC2252 section 4.3.2") + + +(defvar ldap-attribute-syntaxes-alist + '((createtimestamp . 24) + (modifytimestamp . 24) + (creatorsname . 12) + (modifiersname . 12) + (subschemasubentry . 12) + (attributetypes . 3) + (objectclasses . 37) + (matchingrules . 30) + (matchingruleuse . 31) + (namingcontexts . 12) + (altserver . 26) + (supportedextension . 38) + (supportedcontrol . 38) + (supportedsaslmechanisms . 15) + (supportedldapversion . 27) + (ldapsyntaxes . 16) + (ditstructurerules . 17) + (nameforms . 35) + (ditcontentrules . 16) + (objectclass . 38) + (aliasedobjectname . 12) + (cn . 15) + (sn . 15) + (serialnumber . 44) + (c . 15) + (l . 15) + (st . 15) + (street . 15) + (o . 15) + (ou . 15) + (title . 15) + (description . 15) + (searchguide . 25) + (businesscategory . 15) + (postaladdress . 41) + (postalcode . 15) + (postofficebox . 15) + (physicaldeliveryofficename . 15) + (telephonenumber . 50) + (telexnumber . 52) + (telexterminalidentifier . 51) + (facsimiletelephonenumber . 22) + (x121address . 36) + (internationalisdnnumber . 36) + (registeredaddress . 41) + (destinationindicator . 44) + (preferreddeliverymethod . 14) + (presentationaddress . 43) + (supportedapplicationcontext . 38) + (member . 12) + (owner . 12) + (roleoccupant . 12) + (seealso . 12) + (userpassword . 40) + (usercertificate . 8) + (cacertificate . 8) + (authorityrevocationlist . 9) + (certificaterevocationlist . 9) + (crosscertificatepair . 10) + (name . 15) + (givenname . 15) + (initials . 15) + (generationqualifier . 15) + (x500uniqueidentifier . 6) + (dnqualifier . 44) + (enhancedsearchguide . 21) + (protocolinformation . 42) + (distinguishedname . 12) + (uniquemember . 34) + (houseidentifier . 15) + (supportedalgorithms . 49) + (deltarevocationlist . 9) + (dmdname . 15)) + "A map of LDAP attribute names to their type object id minor number. +This table is built from RFC2252 Section 5 and RFC2256 Section 5") + + +;; Coding/decoding functions + +(defun ldap-encode-boolean (bool) + (if bool + "TRUE" + "FALSE")) + +(defun ldap-decode-boolean (str) + (cond + ((string-equal str "TRUE") + t) + ((string-equal str "FALSE") + nil) + (t + (error "Wrong LDAP boolean string: %s" str)))) + +(defun ldap-encode-country-string (str) + ;; We should do something useful here... + (if (not (= 2 (length str))) + (error "Invalid country string: %s" str))) + +(defun ldap-decode-string (str) + (if (fboundp 'decode-coding-string) + (decode-coding-string str ldap-coding-system))) + +(defun ldap-encode-string (str) + (if (fboundp 'encode-coding-string) + (encode-coding-string str ldap-coding-system))) + +(defun ldap-decode-address (str) + (mapconcat 'ldap-decode-string + (split-string str "\\$") + "\n")) + +(defun ldap-encode-address (str) + (mapconcat 'ldap-encode-string + (split-string str "\n") + "$")) + + +;; LDAP protocol functions + +(defun ldap-get-host-parameter (host parameter) + "Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'." + (plist-get (cdr (assoc host ldap-host-parameters-alist)) + parameter)) + +(defun ldap-decode-attribute (attr) + "Decode the attribute/value pair ATTR according to LDAP rules. +The attribute name is looked up in `ldap-attribute-syntaxes-alist' +and the corresponding decoder is then retrieved from +`ldap-attribute-syntax-decoders' and applied on the value(s)." + (let* ((name (car attr)) + (values (cdr attr)) + (syntax-id (cdr (assq (intern (downcase name)) + ldap-attribute-syntaxes-alist))) + decoder) + (if syntax-id + (setq decoder (aref ldap-attribute-syntax-decoders + (1- syntax-id))) + (setq decoder ldap-default-attribute-decoder)) + (if decoder + (cons name (mapcar decoder values)) + attr))) + + +(defun ldap-search (filter &optional host attributes attrsonly withdn) "Perform an LDAP search. -FILTER is the search filter in RFC1558 syntax, i.e. something that +FILTER is the search filter in RFC1558 syntax, i.e., something that looks like \"(cn=John Smith)\". HOST is the LDAP host on which to perform the search. ATTRIBUTES is a list of attributes to retrieve; nil means retrieve all. If ATTRSONLY is non nil, the attributes will be retrieved without the associated values. +If WITHDN is non-nil each entry in the result will be prepennded with +its distinguished name DN. Additional search parameters can be specified through -`ldap-host-parameters-alist' which see." +`ldap-host-parameters-alist' which see. +The function returns a list of matching entries. Each entry is itself +an alist of attribute/value pairs optionally preceded by the DN of the +entry according to the value of WITHDN." (interactive "sFilter:") (or host - (setq host ldap-default-host)) - (or host + (setq host ldap-default-host) (error "No LDAP host specified")) (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) - ldap) + ldap + result) (message "Opening LDAP connection to %s..." host) (setq ldap (ldap-open host host-plist)) (message "Searching with LDAP on %s..." host) - (prog1 (ldap-search-internal ldap filter - (plist-get host-plist 'base) - (plist-get host-plist 'scope) - attributes attrsonly) - (ldap-close ldap)))) + (setq result (ldap-search-internal ldap filter + (plist-get host-plist 'base) + (plist-get host-plist 'scope) + attributes attrsonly withdn)) + (ldap-close ldap) + (if ldap-ignore-attribute-codings + result + (mapcar (function + (lambda (record) + (mapcar 'ldap-decode-attribute record))) + result)))) (provide 'ldap) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/lib-complete.el --- a/lisp/lib-complete.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/lib-complete.el Mon Aug 13 11:13:30 2007 +0200 @@ -38,7 +38,6 @@ ;; Last Modified By: Heiko M|nkel ;; Additional XEmacs integration By: Chuck Thompson ;; Last Modified On: Thu Jul 1 14:23:00 1994 -;; RCS Info : $Revision: 1.3.2.1 $ $Locker: $ ;; ======================================================================== ;; NOTE: XEmacs must be redumped if this file is changed. ;; @@ -57,6 +56,7 @@ ;;; ChangeLog: ;; 4/26/97: sb Mule-ize. +;; 6/24/1999 much rewriting from Bob Weiner ;;; Code: @@ -217,7 +217,6 @@ (if tail (setcdr tail nil))))) ;;=== Read a filename, with completion in a search path =================== -(defvar read-library-internal-search-path) (defun read-library-internal (FILE FILTER FLAG) "Don't call this." @@ -255,82 +254,93 @@ (cond ((equal library "") DEFAULT) (FULL (locate-file library read-library-internal-search-path - ;; decompression doesn't work with Mule -slb - (if (featurep 'mule) - ".el:.elc" - ".el:.el.gz:.elc"))) + '(".el" ".el.gz" ".elc"))) (t library)))) +(defun read-library-name (prompt) + "PROMPTs for and returns an existing Elisp library name (without any suffix) or the empty string." + (interactive) + (let ((read-library-internal-search-path load-path)) + (completing-read prompt + 'read-library-internal + (lambda (fn) + (cond + ((string-match "\\.el\\(\\.gz\\|\\.Z\\)?$" fn) + (substring fn 0 (match-beginning 0))))) + t nil))) + ;; NOTE: as a special case, read-library may be used to read a filename ;; relative to the current directory, returning a *relative* pathname ;; (read-file-name returns a full pathname). ;; ;; eg. (read-library "Local header: " '(nil) nil) -(defun get-library-path () - "Front end to read-library" - (read-library "Find Library file: " load-path nil t t - (function (lambda (fn) - (cond - ;; decompression doesn't work with mule -slb - ((string-match (if (featurep 'mule) - "\\.el$" - "\\.el\\(\\.gz\\)?$") fn) - (substring fn 0 (match-beginning 0)))))) - )) - ;;=== Replacement for load-library with completion ======================== (defun load-library (library) "Load the library named LIBRARY. This is an interface to the function `load'." (interactive - (list (read-library "Load Library: " load-path nil nil nil - (function (lambda (fn) - (cond - ((string-match "\\.elc?$" fn) - (substring fn 0 (match-beginning 0)))))) - ))) + (list (read-library "Load library: " load-path nil nil nil + (function (lambda (fn) + (cond + ((string-match "\\.elc?$" fn) + (substring fn 0 (match-beginning 0)))))) + ))) (load library)) -;;=== find-library with completion (Author: Heiko Muenkel) =================== +;;=== find-library with completion (Author: Bob Weiner) =================== -(defun find-library (library &optional codesys) - "Find and edit the source for the library named LIBRARY. -The extension of the LIBRARY must be omitted. -Under XEmacs/Mule, the optional second argument specifies the -coding system to use when decoding the file. Interactively, -with a prefix argument, you will be prompted for the coding system." +(defun find-library (library &optional codesys display-function) + "Find and display in the current window the source for the Elisp LIBRARY. +LIBRARY should be a name without any path information and may include or omit +the \".el\" suffix. Under XEmacs/Mule, the optional second argument CODESYS +specifies the coding system to use when decoding the file. Interactively, +with a prefix argument, this prompts for the coding system. Optional third +argument DISPLAY-FUNCTION must take two arguments, the filename to display +and CODESYS. The default for DISPLAY-FUNCTION is `find-file'." (interactive - (list (get-library-path) + (list (read-library-name "Find library: ") (if current-prefix-arg (read-coding-system "Coding System: ")))) - (find-file library codesys)) + (let ((path (if (or (null library) (equal library "")) + nil + (locate-file library load-path + ;; decompression doesn't work with Mule -slb + (if (featurep 'mule) + ":.el:.elc" + ":.el:.el.gz:.el.Z:.elc"))))) + (if path (funcall (if (fboundp display-function) + display-function 'find-file) + path codesys) + (error "(find-library): Cannot locate library `%s'" library)))) (defun find-library-other-window (library &optional codesys) - "Load the library named LIBRARY in another window. -Under XEmacs/Mule, the optional second argument specifies the -coding system to use when decoding the file. Interactively, -with a prefix argument, you will be prompted for the coding system." + "Find and display in another window the source for the Elisp LIBRARY. +LIBRARY should be a name without any path information and may include or omit +the \".el\" suffix. Under XEmacs/Mule, the optional second argument CODESYS +specifies the coding system to use when decoding the file. Interactively, +with a prefix argument, this prompts for the coding system." (interactive - (list (get-library-path) + (list (read-library-name "Find library in other window: ") (if current-prefix-arg - (read-coding-system "Coding System: ")))) - (find-file-other-window library codesys)) + (read-coding-system "Coding System: ")))) + (find-library library codesys 'find-file-other-window)) (defun find-library-other-frame (library &optional codesys) - "Load the library named LIBRARY in a newly-created frame. -Under XEmacs/Mule, the optional second argument specifies the -coding system to use when decoding the file. Interactively, -with a prefix argument, you will be prompted for the coding system." + "Find and display in another frame the source for the Elisp LIBRARY. +LIBRARY should be a name without any path information and may include or omit +the \".el\" suffix. Under XEmacs/Mule, the optional second argument CODESYS +specifies the coding system to use when decoding the file. Interactively, +with a prefix argument, this prompts for the coding system." (interactive - (list (get-library-path) + (list (read-library-name "Find library in other frame: ") (if current-prefix-arg (read-coding-system "Coding System: ")))) - (find-file-other-frame library codesys)) + (find-library library codesys 'find-file-other-frame)) -; This conflicts with an existing binding -;(define-key global-map "\C-xl" 'find-library) +;; This conflicts with an existing binding. +;;(define-key global-map "\C-xl" 'find-library) (define-key global-map "\C-x4l" 'find-library-other-window) (define-key global-map "\C-x5l" 'find-library-other-frame) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/lisp-mnt.el --- a/lisp/lisp-mnt.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/lisp-mnt.el Mon Aug 13 11:13:30 2007 +0200 @@ -6,7 +6,7 @@ ;; Maintainer: Eric S. Raymond ;; Created: 14 Jul 1992 ;; Keywords: docs, maint -;; X-Modified-by: Bob Weiner , 4/14/95, to support +;; X-Modified-by: Bob Weiner , 4/14/95, to support ;; InfoDock headers. ;; X-Bogus-Bureaucratic-Cruft: Gruad will get you if you don't watch out! diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/lisp-mode.el --- a/lisp/lisp-mode.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/lisp-mode.el Mon Aug 13 11:13:30 2007 +0200 @@ -290,6 +290,8 @@ (lisp-mode-variables nil) (run-hooks 'emacs-lisp-mode-hook)) +(put 'emacs-lisp-mode 'font-lock-lisp-like t) + (defvar lisp-mode-map () "Keymap for ordinary Lisp mode. All commands in `shared-lisp-mode-map' are inherited by this map.") diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/list-mode.el --- a/lisp/list-mode.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/list-mode.el Mon Aug 13 11:13:30 2007 +0200 @@ -77,7 +77,10 @@ (make-local-variable 'next-line-add-newlines) (setq next-line-add-newlines nil) (setq list-mode-extent nil) - (set-specifier text-cursor-visible-p nil (current-buffer)) +;; It is visually disconcerting to have the text cursor disappear within list +;; buffers, especially when moving from window to window, so leave it +;; visible. -- Bob Weiner, 06/20/1999 +; (set-specifier text-cursor-visible-p nil (current-buffer)) (setq buffer-read-only t) (goto-char (point-min)) (run-hooks 'list-mode-hook)) @@ -458,21 +461,23 @@ (define-derived-mode completion-list-mode list-mode "Completion List" "Major mode for buffers showing lists of possible completions. -Type \\\\[choose-completion] in the completion list\ - to select the completion near point. -Use \\\\[mouse-choose-completion] to select one\ - with the mouse." +\\{completion-list-mode-map}" (make-local-variable 'completion-base-size) (setq completion-base-size nil)) (let ((map completion-list-mode-map)) + (define-key map 'button2up 'mouse-choose-completion) + (define-key map 'button2 'undefined) + (define-key map "\C-m" 'choose-completion) (define-key map "\e\e\e" 'delete-completion-window) (define-key map "\C-g" 'minibuffer-keyboard-quit) - (define-key map "q" 'abort-recursive-edit) - (define-key map " " (lambda () (interactive) - (select-window (minibuffer-window)))) - (define-key map "\t" (lambda () (interactive) - (select-window (minibuffer-window))))) + (define-key map "q" 'completion-list-mode-quit) + (define-key map " " 'completion-switch-to-minibuffer) + ;; [Tab] used to switch to the minibuffer but since [space] does that and + ;; since most applications in the world use [Tab] to select the next item + ;; in a list, do that in the *Completions* buffer too. -- Bob Weiner, + ;; BeOpen.com, 06/23/1999. + (define-key map "\t" 'next-list-mode-item)) (defvar completion-reference-buffer nil "Record the buffer that was current when the completion list was requested. @@ -486,6 +491,10 @@ If this is nil, it means to compare text to determine which part of the tail end of the buffer's text is involved in completion.") +;; These names are referenced in the doc string for `completion-list-mode'. +(defalias 'choose-completion 'list-mode-item-keyboard-selected) +(defalias 'mouse-choose-completion 'list-mode-item-mouse-selected) + (defun delete-completion-window () "Delete the completion list window. Go to the window from which completion was requested." @@ -495,6 +504,21 @@ (if (get-buffer-window buf) (select-window (get-buffer-window buf))))) +(defun completion-switch-to-minibuffer () + "Move from a completions buffer to the active minibuffer window." + (interactive) + (select-window (minibuffer-window))) + +(defun completion-list-mode-quit () + "Abort any recursive edit and bury the completions buffer." + (interactive) + (condition-case () + (abort-recursive-edit) + (error nil)) + ;; If there was no recursive edit to abort, simply bury the completions + ;; list buffer. + (if (eq major-mode 'completion-list-mode) (bury-buffer))) + (defun completion-do-in-minibuffer () (interactive "_") (save-excursion diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/loadup.el --- a/lisp/loadup.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/loadup.el Mon Aug 13 11:13:30 2007 +0200 @@ -42,18 +42,36 @@ (defvar preloaded-file-list nil "List of files preloaded into the XEmacs binary image.") +(defvar Installation-string nil + "Description of XEmacs installation.") (let ((gc-cons-threshold 30000)) ;; This is awfully damn early to be getting an error, right? (call-with-condition-handler 'really-early-error-handler #'(lambda () - ;; message not defined yet ... + + ;; Initialize Installation-string. We do it before loading + ;; anything so that dumped code can make use of its value. + (setq Installation-string + (save-current-buffer + (set-buffer (get-buffer-create (generate-new-buffer-name + " *temp*"))) + ;; insert-file-contents-internal bogusly calls + ;; format-decode without checking if it's defined. + (fset 'format-decode #'(lambda (f l &optional v) l)) + (insert-file-contents-internal "../Installation") + (fmakunbound 'format-decode) + (prog1 (buffer-substring) + (kill-buffer (current-buffer))))) + (setq load-path (split-path (getenv "EMACSBOOTSTRAPLOADPATH"))) (setq module-load-path (split-path (getenv "EMACSBOOTSTRAPMODULEPATH"))) + ;; message not defined yet ... (external-debugging-output (format "\nUsing load-path %s" load-path)) - (external-debugging-output (format "\nUsing module-load-path %s" module-load-path)) + (external-debugging-output (format "\nUsing module-load-path %s" + module-load-path)) ;; We don't want to have any undo records in the dumped XEmacs. (buffer-disable-undo (get-buffer "*scratch*")) @@ -86,7 +104,8 @@ (defun pureload (file) (let ((full-path (locate-file file load-path - (if load-ignore-elc-files ".el:" ".elc:.el:")))) + (if load-ignore-elc-files + '(".el" "") '(".elc" ".el" ""))))) (if full-path (prog1 (load full-path) @@ -98,7 +117,7 @@ ;;(print (format "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name))) nil))) - (load (concat default-directory "../lisp/dumped-lisp.el")) + (load (expand-file-name "../lisp/dumped-lisp.el")) (let ((files preloaded-file-list) file) @@ -145,7 +164,6 @@ ;;; for the sake of the next call to precompute-menubar-bindings. ;(setq define-key-rebound-commands nil) - ;; Note: all compiled Lisp files loaded above this point ;; must be among the ones parsed by make-docfile ;; to construct DOC. Any that are not processed diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/make-docfile.el --- a/lisp/make-docfile.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/make-docfile.el Mon Aug 13 11:13:30 2007 +0200 @@ -3,7 +3,7 @@ ;; Copyright (C) 1985, 1986, 1992-1995, 1997 Free Software Foundation, Inc. ;; Author: Unknown -;; Maintainer: Steven L Baur +;; Maintainer: Steven L Baur ;; Keywords: internal ;; This file is part of XEmacs. @@ -51,9 +51,9 @@ (string-equal arg "-a") ; Append to DOC file (string-equal arg "-d")) ; Set working directory (if (string-equal arg "-o") - (setq docfile (car (cdr command-line-args)))) + (setq docfile (expand-file-name (car (cdr command-line-args))))) (setq options (cons arg options)) - (setq options (cons (car (cdr command-line-args)) options))) + (setq options (cons (expand-file-name (car (cdr command-line-args))) options))) ((string-equal arg "-i") ; Set site files to scan (setq site-file-list (car (cdr command-line-args)))) (t (setq done t))) @@ -91,7 +91,7 @@ (nconc load-path (split-path (getenv "EMACSBOOTSTRAPLOADPATH")))) (let (preloaded-file-list) - (load (concat default-directory "../lisp/dumped-lisp.el")) + (load (expand-file-name "../lisp/dumped-lisp.el")) (let ((package-preloaded-file-list (packages-collect-package-dumped-lisps late-package-load-path))) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/menubar-items.el --- a/lisp/menubar-items.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/menubar-items.el Mon Aug 13 11:13:30 2007 +0200 @@ -93,17 +93,17 @@ (or buffer-undo-list pending-undo-list)) :suffix (if (or (eq last-command 'undo) (eq last-command 'advertised-undo)) - "More" "")] + "More" "")] ["Redo" redo :included (fboundp 'redo) :active (not (or (eq buffer-undo-list t) - (eq last-buffer-undo-list nil) - (not (or (eq last-buffer-undo-list buffer-undo-list) - (and (null (car-safe buffer-undo-list)) - (eq last-buffer-undo-list - (cdr-safe buffer-undo-list))))) - (or (eq buffer-undo-list pending-undo-list) - (eq (cdr buffer-undo-list) pending-undo-list)))) + (eq last-buffer-undo-list nil) + (not (or (eq last-buffer-undo-list buffer-undo-list) + (and (null (car-safe buffer-undo-list)) + (eq last-buffer-undo-list + (cdr-safe buffer-undo-list))))) + (or (eq buffer-undo-list pending-undo-list) + (eq (cdr buffer-undo-list) pending-undo-list)))) :suffix (if (eq last-command 'redo) "More" "")] ["Cut" kill-primary-selection :active (selection-owner-p)] @@ -143,7 +143,7 @@ ("Set language environment") "--" ["Toggle input method" toggle-input-method] - ["Select input method" select-input-method] + ["Select input method" set-input-method] ["Describe input method" describe-input-method] "--" ["Describe current coding systems" @@ -238,9 +238,9 @@ ["Update Package Index" package-get-update-base] ["List & Install" pui-list-packages] ["Update Installed Packages" package-get-update-all] - ;; hack-o-matic, we can't force a laod of package-base here + ;; hack-o-matic, we can't force a load of package-base here ;; since it triggers dialog box interactions which we can't - ;; deal while using a menu + ;; deal with while using a menu ("Using Custom" :filter (lambda (&rest junk) (if package-get-base @@ -375,7 +375,7 @@ ["Color Printing" (cond (ps-print-color-p (customize-set-variable 'ps-print-color-p nil) - ;; I'm wondering whether all this muck is usefull. + ;; I'm wondering whether all this muck is useful. (and (boundp 'original-face-background) original-face-background (set-face-background 'default original-face-background))) @@ -634,24 +634,24 @@ (force-cursor-redisplay)) :style radio :selected (eq bar-cursor t)] - ["Bar cursor (2 pixels)" - (progn - (customize-set-variable 'bar-cursor 2) - (force-cursor-redisplay)) - :style radio - :selected (and bar-cursor (not (eq bar-cursor t)))] - "------" - ["Line Numbers" - (progn - (customize-set-variable 'line-number-mode (not line-number-mode)) - (redraw-modeline)) - :style toggle :selected line-number-mode] - ["Column Numbers" - (progn - (customize-set-variable 'column-number-mode - (not column-number-mode)) - (redraw-modeline)) - :style toggle :selected column-number-mode] + ["Bar cursor (2 pixels)" + (progn + (customize-set-variable 'bar-cursor 2) + (force-cursor-redisplay)) + :style radio + :selected (and bar-cursor (not (eq bar-cursor t)))] + "------" + ["Line Numbers" + (progn + (customize-set-variable 'line-number-mode (not line-number-mode)) + (redraw-modeline)) + :style toggle :selected line-number-mode] + ["Column Numbers" + (progn + (customize-set-variable 'column-number-mode + (not column-number-mode)) + (redraw-modeline)) + :style toggle :selected column-number-mode] ) ("Menubar Appearance" ["Buffers Menu Length..." @@ -737,6 +737,32 @@ :selected (eq default-toolbar-position 'right)] ) ))) + ,@(if (featurep 'gutter) + '(("Gutter Appearance" + ["Visible" + (customize-set-variable 'gutter-visible-p + (not gutter-visible-p)) + :style toggle + :selected gutter-visible-p] + ("Default Location" + ["Top" + (customize-set-variable 'default-gutter-position 'top) + :style radio + :selected (eq default-gutter-position 'top)] + ["Bottom" + (customize-set-variable 'default-gutter-position 'bottom) + :style radio + :selected (eq default-gutter-position 'bottom)] + ["Left" + (customize-set-variable 'default-gutter-position 'left) + :style radio + :selected (eq default-gutter-position 'left)] + ["Right" + (customize-set-variable 'default-gutter-position 'right) + :style radio + :selected (eq default-gutter-position 'right)] + ) + ))) ("Mouse" ["Avoid Text..." (customize-set-variable 'mouse-avoidance-mode @@ -955,7 +981,8 @@ ["No Warranty" describe-no-warranty] ["XEmacs License" describe-copying] ["The Latest Version" describe-distribution]) - ["Send Bug Report..." report-emacs-bug])))) + ["Send Bug Report..." report-emacs-bug + :active (fboundp 'report-emacs-bug)])))) (defun maybe-add-init-button () @@ -963,12 +990,12 @@ Adds `Load .emacs' button to menubar when starting up with -q." ;; by Stig@hackvan.com (cond - (init-file-user nil) + (load-user-init-file-p nil) ((file-exists-p (expand-file-name ".emacs" "~")) (add-menu-button nil ["Load .emacs" (progn (delete-menu-item '("Load .emacs")) - (load-user-init-file (user-login-name))) + (load-user-init-file)) ] "Help")) (t nil))) @@ -1081,7 +1108,7 @@ 'sort-buffers-menu-by-mode-then-alphabetically "*If non-nil, a function to sort the list of buffers in the buffers menu. It will be passed two arguments (two buffers to compare) and should return -T if the first is \"less\" than the second. One possible value is +t if the first is \"less\" than the second. One possible value is `sort-buffers-menu-alphabetically'; another is `sort-buffers-menu-by-mode-then-alphabetically'." :type '(choice (const :tag "None" nil) @@ -1115,11 +1142,16 @@ with a star at the end of the list." (let* ((nam1 (buffer-name buf1)) (nam2 (buffer-name buf2)) + (inv1p (not (null (string-match "\\` " nam1)))) + (inv2p (not (null (string-match "\\` " nam2)))) (star1p (not (null (string-match "\\`*" nam1)))) (star2p (not (null (string-match "\\`*" nam2))))) - (if (not (eq star1p star2p)) - (not star1p) - (string-lessp nam1 nam2)))) + (cond ((not (eq inv1p inv2p)) + (not inv1p)) + ((not (eq star1p star2p)) + (not star1p)) + (t + (string-lessp nam1 nam2))))) (defun sort-buffers-menu-by-mode-then-alphabetically (buf1 buf2) "For use as a value of `buffers-menu-sort-function'. @@ -1127,15 +1159,23 @@ beginning with a star at the end of the list." (let* ((nam1 (buffer-name buf1)) (nam2 (buffer-name buf2)) + (inv1p (not (null (string-match "\\` " nam1)))) + (inv2p (not (null (string-match "\\` " nam2)))) (star1p (not (null (string-match "\\`*" nam1)))) (star2p (not (null (string-match "\\`*" nam2)))) (mode1 (symbol-value-in-buffer 'major-mode buf1)) (mode2 (symbol-value-in-buffer 'major-mode buf2))) - (cond ((not (eq star1p star2p)) (not star1p)) + (cond ((not (eq inv1p inv2p)) + (not inv1p)) + ((not (eq star1p star2p)) + (not star1p)) ((and star1p star2p (string-lessp nam1 nam2))) - ((string-lessp mode1 mode2) t) - ((string-lessp mode2 mode1) nil) - (t (string-lessp nam1 nam2))))) + ((string-lessp mode1 mode2) + t) + ((string-lessp mode2 mode1) + nil) + (t + (string-lessp nam1 nam2))))) ;; this version is too slow on some machines. (defun slow-format-buffers-menu-line (buffer) @@ -1212,10 +1252,10 @@ (list 'buffer-menu-write-file name) t) (vector "Delete Buffer" (list 'kill-buffer name) t))) - ;; ### We don't want buffer names to be translated, - ;; ### so we put the buffer name in the suffix. - ;; ### Also, avoid losing with non-ASCII buffer names. - ;; ### We still lose, however, if complex-buffers-menu-p. --mrb + ;; #### We don't want buffer names to be translated, + ;; #### so we put the buffer name in the suffix. + ;; #### Also, avoid losing with non-ASCII buffer names. + ;; #### We still lose, however, if complex-buffers-menu-p. --mrb (vector "" (list buffers-menu-switch-to-buffer-function (buffer-name buffer)) @@ -1376,7 +1416,7 @@ (make-variable-buffer-local 'mode-popup-menu) ;; In an effort to avoid massive menu clutter, this mostly worthless menu is -;; superceded by any local popup menu... +;; superseded by any local popup menu... (setq-default mode-popup-menu default-popup-menu) (defvar activate-popup-menu-hook nil @@ -1517,4 +1557,4 @@ (provide 'x-menubar) (provide 'menubar-items) -;;; x-menubar.el ends here. +;;; menubar-items.el ends here. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/minibuf.el --- a/lisp/minibuf.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/minibuf.el Mon Aug 13 11:13:30 2007 +0200 @@ -77,10 +77,12 @@ (defvar minibuffer-completion-confirm nil "Non-nil => demand confirmation of completion before exiting minibuffer.") -(defvar minibuffer-confirm-incomplete nil +(defcustom minibuffer-confirm-incomplete nil "If true, then in contexts where completing-read allows answers which are not valid completions, an extra RET must be typed to confirm the -response. This is helpful for catching typos, etc.") +response. This is helpful for catching typos, etc." + :type 'boolean + :group 'minibuffer) (defcustom completion-auto-help t "*Non-nil means automatically provide help for invalid completion input." @@ -344,7 +346,8 @@ keymap readp history - abbrev-table) + abbrev-table + default) "Read a string from the minibuffer, prompting with string PROMPT. If optional second arg INITIAL-CONTENTS is non-nil, it is a string to be inserted into the minibuffer before reading input. @@ -366,6 +369,8 @@ Positions are counted starting from 1 at the beginning of the list. Sixth arg ABBREV-TABLE, if non-nil, becomes the value of `local-abbrev-table' in the minibuffer. +Seventh arg DEFAULT, if non-nil, will be returned when user enters + an empty string. See also the variable completion-highlight-first-word-only for control over completion display." @@ -412,7 +417,8 @@ ;; `M-x doctor' makes history a local variable, and thus ;; our binding above is buffer-local and doesn't apply ;; once we switch buffers!!!! We demand better scope! - (_history_ history)) + (_history_ history) + (minibuffer-default default)) (unwind-protect (progn (set-buffer (reset-buffer buffer)) @@ -490,8 +496,13 @@ (let* ((val (progn (set-buffer buffer) (if minibuffer-exit-hook (run-hooks 'minibuffer-exit-hook)) - (buffer-string))) - (histval val) + (if (and (eq (char-after (point-min)) nil) + default) + default + (buffer-string)))) + (histval (if (and default (string= val "")) + default + val)) (err nil)) (if readp (condition-case e @@ -748,7 +759,7 @@ (defun completing-read (prompt table &optional predicate require-match - initial-contents history) + initial-contents history default) "Read a string in the minibuffer, with completion. Args: PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-CONTENTS, HISTORY. PROMPT is a string to prompt with; normally it ends in a colon and a space. @@ -770,19 +781,27 @@ which INITIAL-CONTENTS corresponds to). If HISTORY is `t', no history will be recorded. Positions are counted starting from 1 at the beginning of the list. +DEFAULT, if non-nil, is the default value. Completion ignores case if the ambient value of `completion-ignore-case' is non-nil." (let ((minibuffer-completion-table table) (minibuffer-completion-predicate predicate) (minibuffer-completion-confirm (if (eq require-match 't) nil t)) - (last-exact-completion nil)) - (read-from-minibuffer prompt - initial-contents - (if (not require-match) - minibuffer-local-completion-map - minibuffer-local-must-match-map) - nil - history))) + (last-exact-completion nil) + ret) + (setq ret (read-from-minibuffer prompt + initial-contents + (if (not require-match) + minibuffer-local-completion-map + minibuffer-local-must-match-map) + nil + history + nil + default)) + (if (and (string= ret "") + default) + default + ret))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1231,7 +1250,9 @@ If N is negative, find the next or Nth next match." (interactive (let ((enable-recursive-minibuffers t) - (minibuffer-history-sexp-flag nil)) + (minibuffer-history-sexp-flag nil) + (minibuffer-max-depth (and minibuffer-max-depth + (1+ minibuffer-max-depth)))) (if (eq 't (symbol-value minibuffer-history-variable)) (error "History is not being recorded in this context")) (list (read-from-minibuffer "Previous element matching (regexp): " @@ -1279,7 +1300,9 @@ If N is negative, find the previous or Nth previous match." (interactive (let ((enable-recursive-minibuffers t) - (minibuffer-history-sexp-flag nil)) + (minibuffer-history-sexp-flag nil) + (minibuffer-max-depth (and minibuffer-max-depth + (1+ minibuffer-max-depth)))) (if (eq t (symbol-value minibuffer-history-variable)) (error "History is not being recorded in this context")) (list (read-from-minibuffer "Next element matching (regexp): " @@ -1303,7 +1326,10 @@ (let ((narg (- minibuffer-history-position n)) (minimum (if minibuffer-default -1 0))) (cond ((< narg minimum) - (error "No following item in %s" minibuffer-history-variable)) + (error (if minibuffer-default + "No following item in %s" + "No following item in %s; no default available") + minibuffer-history-variable)) ((> narg (length (symbol-value minibuffer-history-variable))) (error "No preceding item in %s" minibuffer-history-variable))) (erase-buffer) @@ -1354,11 +1380,14 @@ ;;;; reading various things from a minibuffer ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun read-expression (prompt &optional initial-contents history) - "Return a Lisp object read using the minibuffer. -Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS -is a string to insert in the minibuffer before reading. -Third arg HISTORY, if non-nil, specifies a history list." +(defun read-expression (prompt &optional initial-contents history default-value) + "Return a Lisp object read using the minibuffer, prompting with PROMPT. +If non-nil, optional second arg INITIAL-CONTENTS is a string to insert + in the minibuffer before reading. +Third arg HISTORY, if non-nil, specifies a history list. +Fourth arg DEFAULT-VALUE is the default value. If non-nil, it is used + for history command, and as the value to return if the user enters the + empty string." (let ((minibuffer-history-sexp-flag t) ;; Semi-kludge to get around M-x C-x o M-ESC trying to do completion. (minibuffer-completion-table nil)) @@ -1367,50 +1396,57 @@ read-expression-map t (or history 'read-expression-history) - lisp-mode-abbrev-table))) + lisp-mode-abbrev-table + default-value))) -(defun read-string (prompt &optional initial-contents history) +(defun read-string (prompt &optional initial-contents history default-value) "Return a string from the minibuffer, prompting with string PROMPT. If non-nil, optional second arg INITIAL-CONTENTS is a string to insert -in the minibuffer before reading. -Third arg HISTORY, if non-nil, specifies a history list." + in the minibuffer before reading. +Third arg HISTORY, if non-nil, specifies a history list. +Fourth arg DEFAULT-VALUE is the default value. If non-nil, it is used + for history command, and as the value to return if the user enters the + empty string." (let ((minibuffer-completion-table nil)) (read-from-minibuffer prompt initial-contents minibuffer-local-map - nil history))) + nil history nil default-value))) -(defun eval-minibuffer (prompt &optional initial-contents history) +(defun eval-minibuffer (prompt &optional initial-contents history default-value) "Return value of Lisp expression read using the minibuffer. Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS is a string to insert in the minibuffer before reading. -Third arg HISTORY, if non-nil, specifies a history list." - (eval (read-expression prompt initial-contents history))) +Third arg HISTORY, if non-nil, specifies a history list. +Fourth arg DEFAULT-VALUE is the default value. If non-nil, it is used + for history command, and as the value to return if the user enters the + empty string." + (eval (read-expression prompt initial-contents history default-value))) ;; The name `command-history' is already taken (defvar read-command-history '()) -(defun read-command (prompt) +(defun read-command (prompt &optional default-value) "Read the name of a command and return as a symbol. -Prompts with PROMPT." +Prompts with PROMPT. By default, return DEFAULT-VALUE." (intern (completing-read prompt obarray 'commandp t nil ;; 'command-history is not right here: that's a ;; list of evalable forms, not a history list. 'read-command-history - ))) + default-value))) -(defun read-function (prompt) +(defun read-function (prompt &optional default-value) "Read the name of a function and return as a symbol. -Prompts with PROMPT." +Prompts with PROMPT. By default, return DEFAULT-VALUE." (intern (completing-read prompt obarray 'fboundp t nil - 'function-history))) + 'function-history default-value))) -(defun read-variable (prompt) +(defun read-variable (prompt &optional default-value) "Read the name of a user variable and return it as a symbol. -Prompts with PROMPT. +Prompts with PROMPT. By default, return DEFAULT-VALUE. A user variable is one whose documentation starts with a `*' character." (intern (completing-read prompt obarray 'user-variable-p t nil - 'variable-history))) + 'variable-history default-value))) (defun read-buffer (prompt &optional default require-match) "Read the name of a buffer and return as a string. @@ -1428,7 +1464,10 @@ result) (while (progn (setq result (completing-read prompt alist nil require-match - nil 'buffer-history)) + nil 'buffer-history + (if (bufferp default) + (buffer-name default) + default))) (cond ((not (equal result "")) nil) ((not require-match) @@ -1445,8 +1484,12 @@ (buffer-name result) result))) -(defun read-number (prompt &optional integers-only) - "Read a number from the minibuffer." +(defun read-number (prompt &optional integers-only default-value) + "Read a number from the minibuffer, prompting with PROMPT. +If optional second argument INTEGERS-ONLY is non-nil, accept + only integer input. +If DEFAULT-VALUE is non-nil, return that if user enters an empty + line." (let ((pred (if integers-only 'integerp 'numberp)) num) (while (not (funcall pred num)) @@ -1454,19 +1497,20 @@ (let ((minibuffer-completion-table nil)) (read-from-minibuffer prompt (if num (prin1-to-string num)) nil t - t)) ;no history + nil nil default-value)) (input-error nil) (invalid-read-syntax nil) (end-of-file nil))) (or (funcall pred num) (beep))) num)) -(defun read-shell-command (prompt &optional initial-input history) +(defun read-shell-command (prompt &optional initial-input history default-value) "Just like read-string, but uses read-shell-command-map: \\{read-shell-command-map}" (let ((minibuffer-completion-table nil)) (read-from-minibuffer prompt initial-input read-shell-command-map - nil (or history 'shell-command-history)))) + nil (or history 'shell-command-history) + nil default-value))) ;;; This read-file-name stuff probably belongs in files.el @@ -1531,8 +1575,9 @@ read-file-name-map read-file-name-must-match-map) nil - history)) - )) + history + nil + default)))) ;;; ;; Kludge! Put "/foo/bar" on history rather than "/default//foo/bar" ;;; (let ((hist (cond ((not history) 'minibuffer-history) ;;; ((consp history) (car history)) @@ -1625,22 +1670,27 @@ This will prompt with a dialog box if appropriate, according to `should-use-dialog-box-p'. Value is not expanded---you must call `expand-file-name' yourself. -Value is subject to interpreted by substitute-in-file-name however. +Value is subject to interpretation by `substitute-in-file-name' however. Default name to DEFAULT if user enters a null string. (If DEFAULT is omitted, the visited file name is used, except that if INITIAL-CONTENTS is specified, that combined with DIR is used.) Fourth arg MUST-MATCH non-nil means require existing file's name. Non-nil and non-t means also require confirmation after completion. -Fifth arg INITIAL-CONTENTS specifies text to start with. +Fifth arg INITIAL-CONTENTS specifies text to start with. If this is not + specified, and `insert-default-directory' is non-nil, DIR or the current + directory will be used. Sixth arg HISTORY specifies the history list to use. Default is `file-name-history'. DIR defaults to current buffer's directory default." (read-file-name-1 (or history 'file-name-history) prompt dir (or default - (if initial-contents (expand-file-name initial-contents dir) - buffer-file-name)) + (and initial-contents + (abbreviate-file-name (expand-file-name + initial-contents dir) t)) + (and buffer-file-truename + (abbreviate-file-name buffer-file-name t))) must-match initial-contents ;; A separate function (not an anonymous lambda-expression) ;; and passed as a symbol because of disgusting kludges in various @@ -2107,10 +2157,18 @@ ;;(if (featurep 'mule) -(defun read-coding-system (prompt) +(defun read-coding-system (prompt &optional default-coding-system) "Read a coding-system (or nil) from the minibuffer. -Prompting with string PROMPT." - (intern (completing-read prompt obarray 'find-coding-system t))) +Prompting with string PROMPT. +If the user enters null input, return second argument DEFAULT-CODING-SYSTEM. +DEFAULT-CODING-SYSTEM can be a string, symbol, or coding-system object." + (intern (completing-read prompt obarray 'find-coding-system t nil nil + (cond ((symbolp default-coding-system) + (symbol-name default-coding-system)) + ((coding-system-p default-coding-system) + (symbol-name (coding-system-name default-coding-system))) + (t + default-coding-system))))) (defun read-non-nil-coding-system (prompt) "Read a non-nil coding-system from the minibuffer. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/modeline.el --- a/lisp/modeline.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/modeline.el Mon Aug 13 11:13:30 2007 +0200 @@ -19,7 +19,7 @@ ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the +;; along with XEmacs; see the file COPYING. If not, write to the ;; Free Software Foundation, 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. @@ -59,11 +59,36 @@ :type 'boolean :group 'modeline) +(defcustom modeline-scrolling-method nil + "*If non-nil, dragging the modeline with the mouse may also scroll its +text horizontally (vertical motion controls window resizing and horizontal +motion controls modeline scrolling). + +With a value of t, the modeline text is scrolled in the same direction as +the mouse motion. With a value of 'scrollbar, the modeline is considered as +a scrollbar for its own text, which then moves in the opposite direction." + :type '(choice (const :tag "none" nil) + (const :tag "text" t) + (const :tag "scrollbar" scrollbar)) + :set (lambda (sym val) + (set-default sym val) + (when (featurep 'x) + (cond ((eq val t) + (set-glyph-image modeline-pointer-glyph "hand2" 'global 'x)) + ((eq val 'scrollbar) + (set-glyph-image modeline-pointer-glyph "fleur" 'global 'x)) + (t + (set-glyph-image modeline-pointer-glyph "sb_v_double_arrow" + 'global 'x))))) + :group 'modeline) + (defun mouse-drag-modeline (event) "Resize a window by dragging its modeline. This command should be bound to a button-press event in modeline-map. Holding down a mouse button and moving the mouse up and down will -make the clicked-on window taller or shorter." +make the clicked-on window taller or shorter. + +See also the variable `modeline-scrolling-method'." (interactive "e") (or (button-press-event-p event) (error "%s must be invoked by a mouse-press" this-command)) @@ -79,9 +104,9 @@ (start-event-frame (event-frame event)) (start-event-window (event-window event)) (start-nwindows (count-windows t)) -;; (hscroll-delta (face-width 'modeline)) -;; (start-hscroll (modeline-hscroll (event-window event))) -; (start-x-pixel (event-x-pixel event)) + (hscroll-delta (face-width 'modeline)) + (start-hscroll (modeline-hscroll (event-window event))) + (start-x-pixel (event-x-pixel event)) (last-timestamp 0) default-line-height modeline-height @@ -141,7 +166,9 @@ ;; scroll) nore Y pos (modeline drag) have changed. (and modeline-click-swaps-buffers (= depress-line (event-y event)) -;; (= start-hscroll (modeline-hscroll start-event-window)) + (or (not modeline-scrolling-method) + (= start-hscroll + (modeline-hscroll start-event-window))) (modeline-swap-buffers event))) ((button-event-p event) (setq done t)) @@ -153,11 +180,14 @@ drag-divider-event-lag) nil) (t -;; (set-modeline-hscroll start-event-window -;; (+ (/ (- (event-x-pixel event) -;; start-x-pixel) -;; hscroll-delta) -;; start-hscroll)) + (when modeline-scrolling-method + (let ((delta (/ (- (event-x-pixel event) start-x-pixel) + hscroll-delta))) + (set-modeline-hscroll start-event-window + (if (eq modeline-scrolling-method t) + (- start-hscroll delta) + (+ start-hscroll delta))) + )) (setq last-timestamp (event-timestamp event) y (event-y-pixel event) edges (window-pixel-edges start-event-window) @@ -263,13 +293,9 @@ (make-face 'modeline-mousable "Face for mousable portions of the modeline.") (set-face-parent 'modeline-mousable 'modeline nil '(default)) (when (featurep 'window-system) - (set-face-foreground 'modeline-mousable - '(((default color x) . "firebrick") - ((default color mswindows) . "firebrick")) - 'global)) -(when (featurep 'x) - (set-face-font 'modeline-mousable [bold] nil '(default mono x)) - (set-face-font 'modeline-mousable [bold] nil '(default grayscale x))) + (set-face-foreground 'modeline-mousable "firebrick" nil '(default color win)) + (set-face-font 'modeline-mousable [bold] nil '(default mono win)) + (set-face-font 'modeline-mousable [bold] nil '(default grayscale win))) (defmacro make-modeline-command-wrapper (command) `#'(lambda (event) @@ -303,12 +329,8 @@ (set-face-parent 'modeline-mousable-minor-mode 'modeline-mousable nil '(default)) (when (featurep 'window-system) - (set-face-foreground 'modeline-mousable-minor-mode - '(((default color x) . "green4") - ((default color x) . "forestgreen") - ((default color mswindows) . "green4") - ((default color mswindows) . "forestgreen")) - 'global)) + (set-face-foreground 'modeline-mousable-minor-mode '("green4" "forestgreen") + nil '(default color win))) (defvar modeline-mousable-minor-mode-extent (make-extent nil nil) ;; alliteration at its finest. @@ -391,7 +413,7 @@ name))) (if (setq el (assq toggle minor-mode-alist)) (setcdr el (list hacked-name)) - (funcall add-elt + (funcall add-elt (list toggle hacked-name) 'minor-mode-alist)))) (when keymap @@ -508,20 +530,16 @@ "Face for the buffer ID string in the modeline.") (set-face-parent 'modeline-buffer-id 'modeline nil '(default)) (when (featurep 'window-system) - (set-face-foreground 'modeline-buffer-id - '(((default color x) . "blue4") - ((default color mswindows) . "blue4")) - 'global)) -(when (featurep 'x) - (set-face-font 'modeline-buffer-id [bold-italic] nil '(default mono x)) - (set-face-font 'modeline-buffer-id [bold-italic] nil '(default grayscale x))) + (set-face-foreground 'modeline-buffer-id "blue4" nil '(default color win)) + (set-face-font 'modeline-buffer-id [bold-italic] nil '(default mono win)) + (set-face-font 'modeline-buffer-id [bold-italic] nil '(default grayscale win))) (when (featurep 'tty) (set-face-font 'modeline-buffer-id [bold-italic] nil '(default tty))) (defvar modeline-buffer-id-extent (make-extent nil nil) "Extent covering the whole of the buffer-id string.") (set-extent-face modeline-buffer-id-extent 'modeline-buffer-id) - + (defvar modeline-buffer-id-left-extent (make-extent nil nil) "Extent covering the left half of the buffer-id string.") (set-extent-keymap modeline-buffer-id-left-extent @@ -595,13 +613,14 @@ (purecopy " ") 'global-mode-string (purecopy " %[(") - (cons modeline-minor-mode-extent (list "" 'mode-name 'minor-mode-alist)) - (cons modeline-narrowed-extent "%n") + (cons modeline-minor-mode-extent + (list (purecopy "") 'mode-name 'minor-mode-alist)) + (cons modeline-narrowed-extent (purecopy "%n")) 'modeline-process (purecopy ")%]----") - (purecopy '(line-number-mode "L%l--")) - (purecopy '(column-number-mode "C%c--")) - (purecopy '(-3 . "%p")) + (list 'line-number-mode (purecopy "L%l--")) + (list 'column-number-mode (purecopy "C%c--")) + (cons -3 (purecopy "%p")) (purecopy "-%-"))) ;;; Added for XEmacs 20.3. Provide wrapper for vc since it may not always be diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mouse.el --- a/lisp/mouse.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/mouse.el Mon Aug 13 11:13:30 2007 +0200 @@ -84,11 +84,54 @@ "Function that is called upon by `mouse-yank' to actually insert text.") (defun mouse-consolidated-yank () + "Insert the current selection or, if there is none under X insert +the X cutbuffer. A mark is pushed, so that the inserted text lies +between point and mark." (interactive) - (case (device-type) - (x (x-yank-function)) - (tty (yank)) - (otherwise (yank)))) + (if (and (not (console-on-window-system-p)) + (and (featurep 'gpm) + (not gpm-minor-mode))) + (yank) + (push-mark) + (if (region-active-p) + (if (consp zmacs-region-extent) + ;; pirated code from insert-rectangle in rect.el + ;; perhaps that code should be modified to handle a list of extents + ;; as the rectangle to be inserted? + (let ((lines zmacs-region-extent) + (insertcolumn (current-column)) + (first t)) + (push-mark) + (while lines + (or first + (progn + (forward-line 1) + (or (bolp) (insert ?\n)) + (move-to-column insertcolumn t))) + (setq first nil) + (insert (extent-string (car lines))) + (setq lines (cdr lines)))) + (insert (extent-string zmacs-region-extent))) + (insert-selection t)))) + +(defun insert-selection (&optional check-cutbuffer-p move-point-event) + "Insert the current selection into buffer at point." + (interactive "P") + ;; we fallback to the clipboard if the current selection is not existent + (let ((text (if check-cutbuffer-p + (or (get-selection-no-error) + (get-cutbuffer) + (get-selection-no-error 'CLIPBOARD) + (error "No selection, clipboard or cut buffer available")) + (or (get-selection-no-error) + (get-selection 'CLIPBOARD))))) + (cond (move-point-event + (mouse-set-point move-point-event) + (push-mark (point))) + ((interactive-p) + (push-mark (point)))) + (insert text) + )) (defun mouse-select () @@ -185,9 +228,10 @@ (if (click-inside-extent-p event zmacs-region-extent) ;; okay, this is a drag (cond ((featurep 'offix) - (offix-start-drag-region event - (extent-start-position zmacs-region-extent) - (extent-end-position zmacs-region-extent))) + (offix-start-drag-region + event + (extent-start-position zmacs-region-extent) + (extent-end-position zmacs-region-extent))) ((featurep 'cde) ;; should also work with CDE (cde-start-drag-region event @@ -1339,7 +1383,7 @@ ;; vars is a list of glyph variables to check for a pointer ;; value. (vars (cond - ;; Checking if button is non-nil is not sufficent + ;; Checking if button is non-nil is not sufficient ;; since the pointer could be over a blank portion ;; of the toolbar. ((event-over-toolbar-p event) @@ -1481,10 +1525,10 @@ (setq last-timestamp (event-timestamp event)) ;; Enlarge the window, calculating change in characters ;; of default font. Do not let the window to become - ;; less than alolwed minimum (not because that's critical + ;; less than allowed minimum (not because that's critical ;; for the code performance, just the visual effect is ;; better: when cursor goes to the left of the next left - ;; divider, the vindow being resized shrinks to minimal + ;; divider, the window being resized shrinks to minimal ;; size. (enlarge-window (max (- window-min-width (window-width window)) (/ (- (event-x-pixel event) old-right) @@ -1494,7 +1538,7 @@ ;; if the change caused more than two windows to resize ;; (shifting the whole stack right is ugly), or if the ;; left window side has slipped (right side cannot be - ;; moved any funrther to the right, so enlarge-window + ;; moved any further to the right, so enlarge-window ;; plays bad games with the left edge. (if (or (/= (count-windows) (length old-edges-all-windows)) (/= old-left (car (window-pixel-edges window))) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/movemail.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/movemail.el Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,60 @@ +;;; movemail.el --- move mail spool to a place where XEmacs can munge it + +;; Copyright (C) 1985-1986, 1990, 1992-1997 Free Software Foundation, Inc. +;; Copyright (c) 1993, 1994 Sun Microsystems, Inc. +;; Copyright (C) 1995 Board of Trustees, University of Illinois + +;; Author: Mike Sperber +;; Maintainer: XEmacs Development Team +;; Keywords: internal, dumped + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Synched up with: Not in FSF. + +;;; Commentary: + +;; This file is dumped with XEmacs. + +;; This file handles calling movemail with the right locking command +;; line options. + +;;; Code: + +(defvar mail-lock-method + (let ((stuff (getenv "EMACSLOCKMETHOD"))) + (if stuff + (intern stuff) + configure-mail-lock-method)) + "mail spool locking method used by thios instance of XEmacs. +This must be one of the symbols in MAIL-LOCK-METHODS.") + +(defun move-mail-spool (from to &optional buffer pop-password) + "Move mail spool in file FROM to file TO. +BUFFER is a buffer for error messages. +POP-PASSWORD is a password for POP mailbox access." + (apply 'call-process + (expand-file-name "movemail" exec-directory) + nil buffer nil + "-m" + (symbol-name mail-lock-method) + from to + (and pop-password + (list pop-password)))) + +;;; movemail.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/msw-faces.el --- a/lisp/msw-faces.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/msw-faces.el Mon Aug 13 11:13:30 2007 +0200 @@ -39,6 +39,19 @@ (defun mswindows-init-frame-faces (frame) ) +;; Other functions expect these regexps +(defconst mswindows-font-regexp + (let + ((- ":") + (fontname "\\([a-zA-Z ]+\\)") + (weight "\\([a-zA-Z]*\\)?") + (style "\\( [a-zA-Z]*\\)?") + (pointsize "\\([0-9]+\\)?") + (effects "\\([a-zA-Z ]*\\)?") + (charset "\\([a-zA-Z 0-9]*\\)") + ) + (concat "^" + fontname - weight style - pointsize - effects - charset "$"))) ;;; Fill in missing parts of a font spec. This is primarily intended as a ;;; helper function for the functions below. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/msw-font-menu.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/msw-font-menu.el Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,213 @@ +;; msw-font-menu.el --- Managing menus of mswindows fonts. + +;; Copyright (C) 1999 Free Software Foundation, Inc. + +;; Adapted from x-font-menu.el by Andy Piper + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; mswindows fonts look like: +;;; fontname[:[weight][ style][:pointsize[:effects]]][:charset] +;;; ie: +;;; Lucida Console:Regular:10 +;;; minimal: +;;; Courier New +;;; maximal: +;;; Courier New:Bold Italic:10:underline strikeout:western + +;;; Code: + +;; #### - implement these... +;; +;;; (defvar font-menu-ignore-proportional-fonts nil +;;; "*If non-nil, then the font menu will only show fixed-width fonts.") + +(require 'font-menu) + +(defvar mswindows-font-menu-registry-encoding nil + "Registry and encoding to use with font menu fonts.") + +(defvar mswindows-font-menu-junk-families + (purecopy + (mapconcat + #'identity + '("Symbol" + ) + "\\|")) + "A regexp matching font families which are uninteresting (e.g. cursor fonts).") + +(defvar mswindows-font-regexp-ascii nil + "This is used to filter out font families that can't display ASCII text. +It must be set at run-time.") + +;;;###autoload +(defun mswindows-reset-device-font-menus (device &optional debug) + "Generates the `Font', `Size', and `Weight' submenus for the Options menu. +This is run the first time that a font-menu is needed for each device. +If you don't like the lazy invocation of this function, you can add it to +`create-device-hook' and that will make the font menus respond more quickly +when they are selected for the first time. If you add fonts to your system, +or if you change your font path, you can call this to re-initialize the menus." + (unless mswindows-font-regexp-ascii + (setq mswindows-font-regexp-ascii (if (featurep 'mule) + (charset-registry 'ascii) + "Western"))) + (setq mswindows-font-menu-registry-encoding (if (featurep 'mule) "" "Western")) + (let ((case-fold-search t) + family size weight entry + dev-cache cache families sizes weights) + (dolist (name (cond ((null debug) ; debugging kludge + (list-fonts "::::" device)) + ((stringp debug) (split-string debug "\n")) + (t debug))) + (when (and (string-match mswindows-font-regexp-ascii name) + (string-match mswindows-font-regexp name)) + (setq weight (capitalize (match-string 2 name)) + size (string-to-int (or (match-string 4 name) "0")) + family (match-string 1 name)) + (unless (string-match mswindows-font-menu-junk-families family) + (setq entry (or (vassoc name cache) + (car (setq cache + (cons (vector family nil nil t) + cache))))) + (or (member family families) (push family families)) + (or (member weight weights) (push weight weights)) + (or (member size sizes) (push size sizes)) + (or (member weight (aref entry 1)) (push weight (aref entry 1))) + (or (member size (aref entry 2)) (push size (aref entry 2)))))) + ;; + ;; Hack scalable fonts. + ;; Some fonts come only in scalable versions (the only size is 0) + ;; and some fonts come in both scalable and non-scalable versions + ;; (one size is 0). If there are any scalable fonts at all, make + ;; sure that the union of all point sizes contains at least some + ;; common sizes - it's possible that some sensible sizes might end + ;; up not getting mentioned explicitly. + ;; + (if (member 0 sizes) + (let ((common '(6 8 10 12 14 16 18 24))) + (while common + (or;;(member (car common) sizes) ; not enough slack + (let ((rest sizes) + (done nil)) + (while (and (not done) rest) + (if (and (> (car common) (- (car rest) 1)) + (< (car common) (+ (car rest) 1))) + (setq done t)) + (setq rest (cdr rest))) + done) + (setq sizes (cons (car common) sizes))) + (setq common (cdr common))) + (setq sizes (delq 0 sizes)))) + + (setq families (sort families 'string-lessp) + weights (sort weights 'string-lessp) + sizes (sort sizes '<)) + + (dolist (entry cache) + (aset entry 1 (sort (aref entry 1) 'string-lessp)) + (aset entry 2 (sort (aref entry 2) '<))) + + (setq dev-cache (assq device device-fonts-cache)) + (or dev-cache + (setq dev-cache (car (push (list device) device-fonts-cache)))) + (setcdr + dev-cache + (vector + cache + (mapcar (lambda (x) + (vector x + (list 'font-menu-set-font x nil nil) + ':style 'radio ':active nil ':selected nil)) + families) + (mapcar (lambda (x) + (vector (int-to-string x) + (list 'font-menu-set-font nil nil x) + ':style 'radio ':active nil ':selected nil)) + sizes) + (mapcar (lambda (x) + (vector x + (list 'font-menu-set-font nil x nil) + ':style 'radio ':active nil ':selected nil)) + weights))) + (cdr dev-cache))) + +;; Extract font information from a face. We examine both the +;; user-specified font name and the canonical (`true') font name. +;; These can appear to have totally different properties. + +;; We use the user-specified one if possible, else use the truename. +;; If the user didn't specify one get the truename and use the +;; possibly suboptimal data from that. +;;;###autoload +(defun* mswindows-font-menu-font-data (face dcache) + (let* ((case-fold-search t) + (domain (if font-menu-this-frame-only-p + (selected-frame) + (selected-device))) + (name (font-instance-name (face-font-instance face domain))) + (truename (font-instance-truename + (face-font-instance face domain + (if (featurep 'mule) 'ascii)))) + family size weight entry slant) + (when (string-match mswindows-font-regexp name) + (setq family (match-string 1 name)) + (setq entry (vassoc family (aref dcache 0)))) + (when (and (null entry) + (string-match mswindows-font-regexp truename)) + (setq family (match-string 1 truename)) + (setq entry (vassoc family (aref dcache 0)))) + (when (null entry) + (return-from mswindows-font-menu-font-data (make-vector 5 nil))) + + (when (string-match mswindows-font-regexp name) + (setq weight (match-string 2 name)) + (setq size (string-to-int (match-string 4 name)))) + + (when (string-match mswindows-font-regexp truename) + (when (not (member weight (aref entry 1))) + (setq weight (match-string 2 truename))) + (when (not (member size (aref entry 2))) + (setq size (string-to-int (match-string 4 truename)))) + (setq slant (match-string 5 truename))) + + (vector entry family size weight slant))) + +(defun mswindows-font-menu-load-font (family weight size slant resolution) + "Try to load a font with the requested properties. +The weight, slant and resolution are only hints." + (when (integerp size) (setq size (int-to-string size))) + (let (font) + (catch 'got-font + (dolist (weight (list weight "")) + (dolist (slant + ;; oblique is not currently implemented + (cond ((string-equal slant "Oblique") '(" Italic" "")) + ((string-equal slant "Italic") '(" Italic" "")) + (t (list slant "")))) + (when (setq font + (make-font-instance + (concat family ":" weight slant ":" + size "::" + mswindows-font-menu-registry-encoding) + nil t)) + (throw 'got-font font))))))) + +(provide 'mswindows-font-menu) + +;;; msw-font-menu.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/msw-glyphs.el --- a/lisp/msw-glyphs.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/msw-glyphs.el Mon Aug 13 11:13:30 2007 +0200 @@ -27,12 +27,10 @@ ;;; Commentary: -;; This file contains temporary definitions for 'mswindows glyphs. -;; Since there currently is no image support, the glyps are defined -;; TTY-style. This file has to be removed or reworked completely -;; when we have images. +;; Initialization code for MS Windows glyphs. -;; This file is dumped with XEmacs. +;; This file is dumped with XEmacs (when MS Windows support is +;; compiled in). ;;; Code: diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/msw-select.el --- a/lisp/msw-select.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/msw-select.el Mon Aug 13 11:13:30 2007 +0200 @@ -49,59 +49,6 @@ (insert-rectangle clip) (insert clip)))) -(defun mswindows-own-clipboard (string) - "Paste the given string to the mswindows clipboard." - (mswindows-set-clipboard string)) -(defvar mswindows-selection-owned-p nil - "Whether we have a selection or not. -MS-Windows has no concept of ownership; don't use this.") - -(defun mswindows-own-selection (data &optional type) - "Make an MS-Windows selection of type TYPE and value DATA. -The argument TYPE is ignored, and DATA specifies the contents. -DATA may be a string, -a symbol, an integer (or a cons of two integers or list of two integers). - -The selection may also be a cons of two markers pointing to the same buffer, -or an overlay. In these cases, the selection is considered to be the text -between the markers *at whatever time the selection is examined*. -Thus, editing done in the buffer after you specify the selection -can alter the effective value of the selection. - -The data may also be a vector of valid non-vector selection values. -Interactively, the text of the region is used as the selection value." - (interactive (if (not current-prefix-arg) - (list (read-string "Store text for pasting: ")) - (list (substring (region-beginning) (region-end))))) - (or (valid-simple-selection-p data) - (and (vectorp data) - (let ((valid t) - (i (1- (length data)))) - (while (>= i 0) - (or (valid-simple-selection-p (aref data i)) - (setq valid nil)) - (setq i (1- i))) - valid)) - (signal 'error (list "invalid selection" data))) - (if data - (setq mswindows-selection-owned-p data) - (setq mswindows-selection-owned-p nil)) - (setq primary-selection-extent - (select-make-extent-for-selection - data primary-selection-extent)) - (setq zmacs-region-stays t) - data) -(defun mswindows-disown-selection (&optional secondary-p) - "Assuming we own the selection, disown it. With an argument, discard the -secondary selection instead of the primary selection." - (setq mswindows-selection-owned-p nil) - (mswindows-delete-selection)) - -(defun mswindows-selection-owner-p (&optional selection) - "Return t if current emacs process owns the given Selection. -The arg is ignored." - (not (eq mswindows-selection-owned-p nil))) - diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/auto-autoloads.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mule/auto-autoloads.el Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,40 @@ +;;; DO NOT MODIFY THIS FILE +(if (featurep 'mule-autoloads) (error "Already loaded")) + +;;;### (autoloads (ccl-execute-with-args check-ccl-program define-ccl-program declare-ccl-program ccl-dump ccl-compile ccl-program-p) "mule-ccl" "mule/mule-ccl.el") + +(autoload 'ccl-program-p "mule-ccl" "\ +T if OBJECT is a valid CCL compiled code." nil nil) + +(autoload 'ccl-compile "mule-ccl" "\ +Return a compiled code of CCL-PROGRAM as a vector of integer." nil nil) + +(autoload 'ccl-dump "mule-ccl" "\ +Disassemble compiled CCL-CODE." nil nil) + +(autoload 'declare-ccl-program "mule-ccl" "\ +Declare NAME as a name of CCL program. + +To compile a CCL program which calls another CCL program not yet +defined, it must be declared as a CCL program in advance. +Optional arg VECTOR is a compiled CCL code of the CCL program." nil 'macro) + +(autoload 'define-ccl-program "mule-ccl" "\ +Set NAME the compiled code of CCL-PROGRAM. +CCL-PROGRAM is `eval'ed before being handed to the CCL compiler `ccl-compile'. +The compiled code is a vector of integers." nil 'macro) + +(autoload 'check-ccl-program "mule-ccl" "\ +Check validity of CCL-PROGRAM. +If CCL-PROGRAM is a symbol denoting a valid CCL program, return +CCL-PROGRAM, else return nil. +If CCL-PROGRAM is a vector and optional arg NAME (symbol) is supplied, +register CCL-PROGRAM by name NAME, and return NAME." nil 'macro) + +(autoload 'ccl-execute-with-args "mule-ccl" "\ +Execute CCL-PROGRAM with registers initialized by the remaining args. +The return value is a vector of resulting CCL registers." nil nil) + +;;;*** + +(provide 'mule-autoloads) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/chinese.el --- a/lisp/mule/chinese.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/mule/chinese.el Mon Aug 13 11:13:30 2007 +0200 @@ -1,4 +1,4 @@ -;;; chinese.el --- Support for Chinese +;;; chinese.el --- Support for Chinese -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. @@ -104,28 +104,34 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; (make-coding-system -;; 'chinese-iso-7bit 2 ?C +;; 'iso-2022-cn 2 ?C ;; "ISO 2022 based 7bit encoding for Chinese GB and CNS (MIME:ISO-2022-CN)" ;; '(ascii ;; (nil chinese-gb2312 chinese-cns11643-1) ;; (nil chinese-cns11643-2) +;; nil +;; nil ascii-eol ascii-cntl seven locking-shift single-shift nil nil nil +;; init-bol) +;; '((safe-charsets ascii chinese-gb2312 chinese-cns11643-1 chinese-cns11643-2) +;; (mime-charset . iso-2022-cn))) + +;; (define-coding-system-alias 'chinese-iso-7bit 'iso-2022-cn) + +;; (make-coding-system +;; 'iso-2022-cn-ext 2 ?C +;; "ISO 2022 based 7bit encoding for Chinese GB and CNS (MIME:ISO-2022-CN-EXT)" +;; '(ascii +;; (nil chinese-gb2312 chinese-cns11643-1) +;; (nil chinese-cns11643-2) ;; (nil chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5 ;; chinese-cns11643-6 chinese-cns11643-7) ;; nil ascii-eol ascii-cntl seven locking-shift single-shift nil nil nil -;; init-bol)) - -;; (define-coding-system-alias 'iso-2022-cn 'chinese-iso-7bit) -;; (define-coding-system-alias 'iso-2022-cn-ext 'chinese-iso-7bit) +;; init-bol) +;; '((safe-charsets ascii chinese-gb2312 chinese-cns11643-1 chinese-cns11643-2 +;; chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5 +;; chinese-cns11643-6 chinese-cns11643-7) +;; (mime-charset . iso-2022-cn-ext))) -;; (define-prefix-command 'describe-chinese-environment-map) -;; (define-key-after describe-language-environment-map [Chinese] -;; '("Chinese" . describe-chinese-environment-map) -;; t) - -;; (define-prefix-command 'setup-chinese-environment-map) -;; (define-key-after setup-language-environment-map [Chinese] -;; '("Chinese" . setup-chinese-environment-map) -;; t) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Chinese GB2312 (simplified) @@ -134,8 +140,10 @@ ;; (make-coding-system ;; 'chinese-iso-8bit 2 ?c ;; "ISO 2022 based EUC encoding for Chinese GB2312 (MIME:CN-GB-2312)" -;; '((ascii t) chinese-gb2312 chinese-sisheng nil -;; nil ascii-eol ascii-cntl nil nil single-shift nil)) +;; '(ascii chinese-gb2312 nil nil +;; nil ascii-eol ascii-cntl nil nil nil nil) +;; '((safe-charsets ascii chinese-gb2312) +;; (mime-charset . cn-gb-2312))) (make-coding-system 'cn-gb-2312 'iso2022 @@ -149,14 +157,19 @@ ;; (define-coding-system-alias 'cn-gb-2312 'chinese-iso-8bit) ;; (define-coding-system-alias 'euc-china 'chinese-iso-8bit) +;; (define-coding-system-alias 'euc-cn 'chinese-iso-8bit) -(copy-coding-system 'cn-gb-2312 'gb2312) -(copy-coding-system 'cn-gb-2312 'chinese-euc) +(define-coding-system-alias 'gb2312 'cn-gb-2312) +(define-coding-system-alias 'chinese-euc 'cn-gb-2312) ;; (make-coding-system ;; 'chinese-hz 0 ?z ;; "Hz/ZW 7-bit encoding for Chinese GB2312 (MIME:HZ-GB-2312)" -;; nil) +;; nil +;; '((safe-charsets ascii chinese-gb2312) +;; (mime-charset . hz-gb-2312) +;; (post-read-conversion . post-read-decode-hz) +;; (pre-write-conversion . pre-write-encode-hz))) ;; (put 'chinese-hz 'post-read-conversion 'post-read-decode-hz) ;; (put 'chinese-hz 'pre-write-conversion 'pre-write-encode-hz) @@ -171,41 +184,48 @@ ;; (define-coding-system-alias 'hz-gb-2312 'chinese-hz) ;; (define-coding-system-alias 'hz 'chinese-hz) -(copy-coding-system 'hz-gb-2312 'hz) -(copy-coding-system 'hz-gb-2312 'chinese-hz) +(define-coding-system-alias 'hz 'hz-gb-2312) (defun post-read-decode-hz (len) - (let ((pos (point))) - (decode-hz-region pos (+ pos len)))) + (let ((pos (point)) + (buffer-modified-p (buffer-modified-p)) + last-coding-system-used) + (prog1 + (decode-hz-region pos (+ pos len)) + (set-buffer-modified-p buffer-modified-p)))) (defun pre-write-encode-hz (from to) - (let ((buf (current-buffer)) - (work (get-buffer-create " *pre-write-encoding-work*"))) - (set-buffer work) - (erase-buffer) + (let ((buf (current-buffer))) + (set-buffer (generate-new-buffer " *temp*")) (if (stringp from) (insert from) (insert-buffer-substring buf from to)) - (encode-hz-region 1 (point-max)) + (let (last-coding-system-used) + (encode-hz-region 1 (point-max))) nil)) (set-language-info-alist - "Chinese-GB" '((setup-function . (setup-chinese-gb-environment - . setup-chinese-environment-map)) - (charset . (chinese-gb2312 sisheng)) - (coding-system - . (cn-gb-2312 iso-2022-7bit hz-gb-2312)) + "Chinese-GB" '((setup-function . setup-chinese-gb-environment-internal) + (charset chinese-gb2312 sisheng) + (coding-system cn-gb-2312 iso-2022-7bit hz-gb-2312) + (coding-priority cn-gb-2312 big5 iso-2022-7bit) + (input-method . "chinese-py-punct") + (features china-util) (sample-text . "Chinese ($AVPND(B,$AFUM(;0(B,$A::So(B) $ADc:C(B") - (documentation . ("Support for Chinese GB2312 character set." - . describe-chinese-environment-map)) - )) + (documentation . "Support for Chinese GB2312 character set.")) + '("Chinese")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Chinese BIG5 (traditional) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; (make-coding-system -;; 'chinese-big5 3 ?B "BIG5 8-bit encoding for Chinese (MIME:CN-BIG5)") +;; 'chinese-big5 3 ?B "BIG5 8-bit encoding for Chinese (MIME:CN-BIG5)" +;; nil +;; '((safe-charsets ascii chinese-big5-1 chinese-big5-2) +;; (mime-charset . cn-big5) +;; (charset-origin-alist (chinese-big5-1 "BIG5" encode-big5-char) +;; (chinese-big5-2 "BIG5" encode-big5-char)))) (make-coding-system 'big5 'big5 @@ -215,8 +235,7 @@ ;; (define-coding-system-alias 'big5 'chinese-big5) ;; (define-coding-system-alias 'cn-big5 'chinese-big5) -(copy-coding-system 'big5 'cn-big5) -(copy-coding-system 'big5 'chinese-big5) +(define-coding-system-alias 'cn-big5 'big5) ;; Big5 font requires special encoding. (define-ccl-program ccl-encode-big5-font @@ -240,29 +259,29 @@ (set-charset-ccl-program 'chinese-big5-2 ccl-encode-big5-font) (set-language-info-alist - "Chinese-BIG5" '((setup-function . (setup-chinese-big5-environment - . setup-chinese-environment-map)) - (charset . (chinese-big5-1 chinese-big5-2)) - (coding-system . (big5 iso-2022-7bit)) + "Chinese-BIG5" '((charset chinese-big5-1 chinese-big5-2) + (coding-system big5 iso-2022-7bit) + (coding-priority big5 cn-gb-2312 iso-2022-7bit) + (input-method . "chinese-py-punct-b5") + (features china-util) (sample-text . "Cantonese ($(0GnM$(B,$(0N]0*Hd(B) $(0*/=((B, $(0+$)p(B") - (documentation . ("Support for Chinese Big5 character set." - . describe-chinese-environment-map)) - )) + (documentation . "Support for Chinese Big5 character set.")) + '("Chinese")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Chinese CNS11643 (traditional) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; (set-language-info-alist -;; "Chinese-CNS" '((setup-function . (setup-chinese-cns-environment -;; . setup-chinese-environment-map)) -;; (charset . (chinese-cns11643-1 chinese-cns11643-2 -;; chinese-cns11643-3 chinese-cns11643-4 -;; chinese-cns11643-5 chinese-cns11643-6 -;; chinese-cns11643-7)) -;; (coding-system . (chinese-iso-7bit)) -;; (documentation . ("Support for Chinese CNS character sets." -;; . describe-chinese-environment-map)) -;; )) +;; "Chinese-CNS" '((charset chinese-cns11643-1 chinese-cns11643-2 +;; chinese-cns11643-3 chinese-cns11643-4 +;; chinese-cns11643-5 chinese-cns11643-6 +;; chinese-cns11643-7) +;; (coding-system iso-2022-cn) +;; (coding-priority iso-2022-cn chinese-big5 chinese-iso-8bit) +;; (features china-util) +;; (input-method . "chinese-cns-quick") +;; (documentation . "Support for Chinese CNS character sets.")) +;; '("Chinese")) ;;; chinese.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/custom-load.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mule/custom-load.el Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,7 @@ +;;; custom-load.el --- automatically extracted custom dependencies + +;;; Code: + +(custom-add-loads 'mule '("mule-cmds")) + +;;; custom-load.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/cyrillic.el --- a/lisp/mule/cyrillic.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/mule/cyrillic.el Mon Aug 13 11:13:30 2007 +0200 @@ -1,6 +1,6 @@ -;;; cyrillic.el --- Support for languages which use Cyrillic characters +;;; cyrillic.el --- Support for Cyrillic -*- coding: iso-2022-7bit; -*- -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. +;; Copyright (C) 1995,1999 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. ;; Copyright (C) 1997 MORIOKA Tomohiko @@ -40,24 +40,15 @@ ;;; CYRILLIC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; (define-prefix-command 'describe-cyrillic-environment-map) -;; (define-key-after describe-language-environment-map [Cyrillic] -;; '("Cyrillic" . describe-cyrillic-environment-map) -;; t) - -;; (define-prefix-command 'setup-cyrillic-environment-map) -;; (define-key-after setup-language-environment-map [Cyrillic] -;; '("Cyrillic" . setup-cyrillic-environment-map) -;; t) - - ;; ISO-8859-5 staff ;; (make-coding-system ;; 'cyrillic-iso-8bit 2 ?5 ;; "ISO 2022 based 8-bit encoding for Cyrillic script (MIME:ISO-8859-5)" -;; '((ascii t) (cyrillic-iso8859-5 t) nil nil -;; nil ascii-eol ascii-cntl nil nil nil nil)) +;; '(ascii cyrillic-iso8859-5 nil nil +;; nil nil nil nil nil nil nil) +;; '((safe-charsets ascii cyrillic-iso8859-5) +;; (mime-charset . iso-8859-5))) ;; (define-coding-system-alias 'iso-8859-5 'cyrillic-iso-8bit) @@ -72,71 +63,92 @@ )) (set-language-info-alist - "Cyrillic-ISO" '((setup-function . (setup-cyrillic-iso-environment - . setup-cyrillic-environment-map)) - (charset . (cyrillic-iso8859-5)) + "Cyrillic-ISO" '((charset cyrillic-iso8859-5) (tutorial . "TUTORIAL.ru") - (coding-system . (iso-8859-5)) + (coding-system iso-8859-5) + (coding-priority iso-8859-5) + (input-method . "cyrillic-yawerty") + (features cyril-util) (sample-text . "Russian (,L@caaZXY(B) ,L7T`PRabRcYbU(B!") - (documentation . ("Support for Cyrillic ISO-8859-5." - . describe-cyrillic-environment-map)))) + (documentation . "Support for Cyrillic ISO-8859-5.")) + '("Cyrillic")) ;; KOI-8 staff +(eval-and-compile + +(defvar cyrillic-koi8-r-decode-table + [ + 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 + 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 + 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 + 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 + 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 + 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 + 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 + 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 + ?$B(!(B ?$B("(B ?$B(#(B ?$B($(B ?$B(&(B ?$B(%(B ?$B('(B ?$B()(B ?$B(((B ?$B(*(B ?$B(+(B 32 ?$(G#'(B ?$(G#+(B ?$(G#/(B 32 + 32 ?$(C"F(B 32 32 ?$B"#(B 32 ?$B"e(B ?$A!V(B ?$A!\(B ?$A!](B ?,L (B 32 ?,A0(B ?,A2(B ?,A7(B ?,Aw(B + ?$(G#D(B 32 32 ?,Lq(B 32 32 32 32 32 32 32 32 32 32 32 ?$(G#E(B + 32 32 ?$(G#G(B ?,L!(B 32 32 32 32 32 32 32 32 ?$(G#F(B 32 32 ?,A)(B + ?,Ln(B ?,LP(B ?,LQ(B ?,Lf(B ?,LT(B ?,LU(B ?,Ld(B ?,LS(B ?,Le(B ?,LX(B ?,LY(B ?,LZ(B ?,L[(B ?,L\(B ?,L](B ?,L^(B + ?,L_(B ?,Lo(B ?,L`(B ?,La(B ?,Lb(B ?,Lc(B ?,LV(B ?,LR(B ?,Ll(B ?,Lk(B ?,LW(B ?,Lh(B ?,Lm(B ?,Li(B ?,Lg(B ?,Lj(B + ?,LN(B ?,L0(B ?,L1(B ?,LF(B ?,L4(B ?,L5(B ?,LD(B ?,L3(B ?,LE(B ?,L8(B ?,L9(B ?,L:(B ?,L;(B ?,L<(B ?,L=(B ?,L>(B + ?,L?(B ?,LO(B ?,L@(B ?,LA(B ?,LB(B ?,LC(B ?,L6(B ?,L2(B ?,LL(B ?,LK(B ?,L7(B ?,LH(B ?,LM(B ?,LI(B ?,LG(B ?,LJ(B ] + "Cyrillic KOI8-R decoding table.") + +(defvar cyrillic-koi8-r-encode-table + (let ((table (make-vector 256 32)) + (i 0)) + (while (< i 256) + (let* ((ch (aref cyrillic-koi8-r-decode-table i)) + (split (split-char ch))) + (cond ((eq (car split) 'cyrillic-iso8859-5) + (aset table (logior (nth 1 split) 128) i) + ) + ((eq ch 32)) + ((eq (car split) 'ascii) + (aset table ch i) + ))) + (setq i (1+ i))) + table) + "Cyrillic KOI8-R encoding table.") + +) + (define-ccl-program ccl-decode-koi8 - '(3 + `(3 ((read r0) (loop - (write-read-repeat - r0 - [0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 - 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 - 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 - 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 - 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 - 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 - 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 - 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 - 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 - 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 - 32 32 32 ?,Lq(B 32 32 32 32 32 32 32 32 32 32 32 32 - 32 32 32 ?,L!(B 32 32 32 32 32 32 32 32 32 32 32 32 - ?,Ln(B ?,LP(B ?,LQ(B ?,Lf(B ?,LT(B ?,LU(B ?,Ld(B ?,LS(B ?,Le(B ?,LX(B ?,LY(B ?,LZ(B ?,L[(B ?,L\(B ?,L](B ?,L^(B - ?,L_(B ?,Lo(B ?,L`(B ?,La(B ?,Lb(B ?,Lc(B ?,LV(B ?,LR(B ?,Ll(B ?,Lk(B ?,LW(B ?,Lh(B ?,Lm(B ?,Li(B ?,Lg(B ?,Lj(B - ?,LN(B ?,L0(B ?,L1(B ?,LF(B ?,L4(B ?,L5(B ?,LD(B ?,L3(B ?,LE(B ?,L8(B ?,L9(B ?,L:(B ?,L;(B ?,L<(B ?,L=(B ?,L>(B - ?,L?(B ?,LO(B ?,L@(B ?,LA(B ?,LB(B ?,LC(B ?,L6(B ?,L2(B ?,LL(B ?,LK(B ?,L7(B ?,LH(B ?,LM(B ?,LI(B ?,LG(B ?,LJ(B ])))) + (write-read-repeat r0 ,cyrillic-koi8-r-decode-table)))) "CCL program to decode KOI8.") (define-ccl-program ccl-encode-koi8 `(1 ((read r0) (loop - (if (r0 != ,(charset-id 'cyrillic-iso8859-5)) - (write-read-repeat r0) - ((read r0) - (r0 -= 160) - (write-read-repeat - r0 - [ 32 179 32 32 32 32 32 32 32 32 32 32 32 32 32 32 - 225 226 247 231 228 229 246 250 233 234 235 236 237 238 239 240 - 242 243 244 245 230 232 227 254 251 253 255 249 248 252 224 241 - 193 194 215 199 196 197 214 218 201 202 203 204 205 206 207 208 - 210 211 212 213 198 200 195 222 219 221 223 217 216 220 192 209 - 32 163 32 32 32 32 32 32 32 32 32 32 32 32 32 32]) - ))))) + (if (r0 != ,(charset-id 'cyrillic-iso8859-5)) + (write-read-repeat r0) + ((read r0) + (write-read-repeat r0 , cyrillic-koi8-r-encode-table)))))) "CCL program to encode KOI8.") -;(make-coding-system -; 'cyrillic-koi8 4 -; ;; We used to use ?K. It is true that ?K is more strictly correct, -; ;; but it is also used for Korean. -; ;; So people who use koi8 for languages other than Russian -; ;; will have to forgive us. -; ?R "KOI8 8-bit encoding for Cyrillic (MIME: KOI8-R)" -; (cons ccl-decode-koi8 ccl-encode-koi8)) +;; (make-coding-system +;; 'cyrillic-koi8 4 +;; ;; We used to use ?K. It is true that ?K is more strictly correct, +;; ;; but it is also used for Korean. +;; ;; So people who use koi8 for languages other than Russian +;; ;; will have to forgive us. +;; ?R "KOI8 8-bit encoding for Cyrillic (MIME: KOI8-R)" +;; '(ccl-decode-koi8 . ccl-encode-koi8) +;; '((safe-charsets ascii cyrillic-iso8859-5) +;; (mime-charset . koi8-r) +;; (valid-codes (0 . 127) 163 179 (192 . 255)) +;; (charset-origin-alist (cyrillic-iso8859-5 "KOI8-R" +;; cyrillic-encode-koi8-r-char)))) -;(define-coding-system-alias 'koi8-r 'cyrillic-koi8) -;(define-coding-system-alias 'koi8 'cyrillic-koi8) +;; (define-coding-system-alias 'koi8-r 'cyrillic-koi8) +;; (define-coding-system-alias 'koi8 'cyrillic-koi8) (make-coding-system 'koi8-r 'ccl @@ -145,83 +157,102 @@ encode ,ccl-encode-koi8 mnemonic "KOI8")) -;(define-coding-system-alias 'koi8-r 'koi8) +;; it is not correct, but XEmacs doesn't have `ccl' category... +(coding-system-put 'koi8-r 'category 'iso-8-1) ;; (define-ccl-program ccl-encode-koi8-font -;; '(0 -;; ((r1 -= 160) -;; (r1 = r1 -;; [ 32 179 32 32 32 32 32 32 32 32 32 32 32 32 32 32 -;; 225 226 247 231 228 229 246 250 233 234 235 236 237 238 239 240 -;; 242 243 244 245 230 232 227 254 251 253 255 249 248 252 224 241 -;; 193 194 215 199 196 197 214 218 201 202 203 204 205 206 207 208 -;; 210 211 212 213 198 200 195 222 219 221 223 217 216 220 192 209 -;; 32 163 32 32 32 32 32 32 32 32 32 32 32 32 32 32]) -;; )) +;; `(0 +;; ((r1 |= 128) +;; (r1 = r1 ,cyrillic-koi8-r-encode-table))) ;; "CCL program to encode Cyrillic chars to KOI font.") ;; (setq font-ccl-encoder-alist ;; (cons (cons "koi8" ccl-encode-koi8-font) font-ccl-encoder-alist)) +;; (defvar cyrillic-koi8-r-nonascii-translation-table +;; (make-translation-table-from-vector cyrillic-koi8-r-decode-table) +;; "Value of `nonascii-translation-table' in Cyrillic-KOI8 language environment..") + (set-language-info-alist - "Cyrillic-KOI8" '((setup-function . (setup-cyrillic-koi8-environment - . setup-cyrillic-environment-map)) - (charset . (cyrillic-iso8859-5)) - (coding-system . (koi8-r)) + "Cyrillic-KOI8" '((charset cyrillic-iso8859-5) + (coding-system koi8-r) + (coding-priority koi8-r) + (input-method . "cyrillic-yawerty") + (features cyril-util) (tutorial . "TUTORIAL.ru") (sample-text . "Russian (,L@caaZXY(B) ,L7T`PRabRcYbU(B!") - (documentation . ("Support for Cyrillic KOI-8." - . describe-cyrillic-environment-map)))) + (documentation . "Support for Cyrillic KOI8-R.")) + '("Cyrillic")) ;;; ALTERNATIVNYJ staff +(eval-and-compile + +(defvar cyrillic-alternativnyj-decode-table + [ + 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 + 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 + 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 + 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 + 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 + 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 + 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 + 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 + ?,L0(B ?,L1(B ?,L2(B ?,L3(B ?,L4(B ?,L5(B ?,L6(B ?,L7(B ?,L8(B ?,L9(B ?,L:(B ?,L;(B ?,L<(B ?,L=(B ?,L>(B ?,L?(B + ?,L@(B ?,LA(B ?,LB(B ?,LC(B ?,LD(B ?,LE(B ?,LF(B ?,LG(B ?,LH(B ?,LI(B ?,LJ(B ?,LK(B ?,LL(B ?,LM(B ?,LN(B ?,LO(B + ?,LP(B ?,LQ(B ?,LR(B ?,LS(B ?,LT(B ?,LU(B ?,LV(B ?,LW(B ?,LX(B ?,LY(B ?,LZ(B ?,L[(B ?,L\(B ?,L](B ?,L^(B ?,L_(B + 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 + 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 + 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 + ?,L`(B ?,La(B ?,Lb(B ?,Lc(B ?,Ld(B ?,Le(B ?,Lf(B ?,Lg(B ?,Lh(B ?,Li(B ?,Lj(B ?,Lk(B ?,Ll(B ?,Lm(B ?,Ln(B ?,Lo(B + ?,L!(B ?,Lq(B 32 32 32 32 32 32 32 32 32 32 32 32 32 ?,Lp(B] + "Cyrillic ALTERNATIVNYJ decoding table.") + +(defvar cyrillic-alternativnyj-encode-table + (let ((table (make-vector 256 32)) + (i 0)) + (while (< i 256) + (let* ((ch (aref cyrillic-alternativnyj-decode-table i)) + (split (split-char ch))) + (if (eq (car split) 'cyrillic-iso8859-5) + (aset table (logior (nth 1 split) 128) i) + (if (/= ch 32) + (aset table ch i)))) + (setq i (1+ i))) + table) + "Cyrillic ALTERNATIVNYJ encoding table.") + +) + + (define-ccl-program ccl-decode-alternativnyj - '(3 + `(3 ((read r0) (loop - (write-read-repeat - r0 - [ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 - 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 - 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 - 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 - 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 - 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 - 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 - 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 - ?,L0(B ?,L1(B ?,L2(B ?,L3(B ?,L4(B ?,L5(B ?,L6(B ?,L7(B ?,L8(B ?,L9(B ?,L:(B ?,L;(B ?,L<(B ?,L=(B ?,L>(B ?,L?(B - ?,L@(B ?,LA(B ?,LB(B ?,LC(B ?,LD(B ?,LE(B ?,LF(B ?,LG(B ?,LH(B ?,LI(B ?,LJ(B ?,LK(B ?,LL(B ?,LM(B ?,LN(B ?,LO(B - ?,LP(B ?,LQ(B ?,LR(B ?,LS(B ?,LT(B ?,LU(B ?,LV(B ?,LW(B ?,LX(B ?,LY(B ?,LZ(B ?,L[(B ?,L\(B ?,L](B ?,L^(B ?,L_(B - 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 - 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 - 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 - ?,L`(B ?,La(B ?,Lb(B ?,Lc(B ?,Ld(B ?,Le(B ?,Lf(B ?,Lg(B ?,Lh(B ?,Li(B ?,Lj(B ?,Lk(B ?,Ll(B ?,Lm(B ?,Ln(B ?,Lo(B - ?,L!(B ?,Lq(B 32 32 32 32 32 32 32 32 32 32 32 32 32 ?,Lp(B])))) + (write-read-repeat r0 ,cyrillic-alternativnyj-decode-table)))) "CCL program to decode Alternativnyj.") (define-ccl-program ccl-encode-alternativnyj `(1 ((read r0) (loop - (if (r0 != ,(charset-id 'cyrillic-iso8859-5)) - (write-read-repeat r0) - ((read r0) - (r0 -= 160) - (write-read-repeat - r0 - [ 32 240 32 32 32 32 32 32 32 32 32 32 32 32 32 32 - 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 - 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 - 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 - 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 - 255 241 32 32 32 32 32 32 32 32 32 32 32 32 32 32]) - ))))) + (if (r0 != ,(charset-id 'cyrillic-iso8859-5)) + (write-read-repeat r0) + ((read r0) + (write-read-repeat r0 ,cyrillic-alternativnyj-encode-table)))))) "CCL program to encode Alternativnyj.") ;; (make-coding-system -;; 'alternativnyj 4 -;; ?A "Coding-system used for Alternativnyj" -;; (cons ccl-decode-alternativnyj ccl-encode-alternativnyj)) +;; 'cyrillic-alternativnyj 4 ?A +;; "ALTERNATIVNYJ 8-bit encoding for Cyrillic" +;; '(ccl-decode-alternativnyj . ccl-encode-alternativnyj) +;; '((safe-charsets ascii cyrillic-iso8859-5) +;; (valid-codes (0 . 175) (224 . 241) 255) +;; (charset-origin-alist (cyrillic-iso8859-5 "ALTERNATIVNYJ" +;; cyrillic-encode-koi8-r-char)))) + + +;; (define-coding-system-alias 'alternativnyj 'cyrillic-alternativnyj) (make-coding-system 'alternativnyj 'ccl @@ -230,65 +261,32 @@ encode ,ccl-encode-alternativnyj mnemonic "Cy.Alt")) +;; it is not correct, but XEmacs doesn't have `ccl' category... +(coding-system-put 'alternativnyj 'category 'iso-8-1) + ;; (define-ccl-program ccl-encode-alternativnyj-font ;; '(0 -;; ((r1 -= 160) -;; (r1 = r1 -;; [ 32 240 32 32 32 32 32 32 32 32 32 32 32 32 32 32 -;; 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 -;; 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 -;; 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 -;; 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 -;; 255 241 32 32 32 32 32 32 32 32 32 32 32 32 32 32]) -;; )) +;; ((r1 |= 128) +;; (r1 = r1 ,cyrillic-alternativnyj-encode-table))) ;; "CCL program to encode Cyrillic chars to Alternativnyj font.") ;; (setq font-ccl-encoder-alist ;; (cons (cons "alternativnyj" ccl-encode-alternativnyj-font) ;; font-ccl-encoder-alist)) +;; (defvar cyrillic-alternativnyj-nonascii-translation-table +;; (make-translation-table-from-vector cyrillic-alternativnyj-decode-table) +;; "Value of `nonascii-translation-table' in Cyrillic-ALT language environment.") + (set-language-info-alist - "Cyrillic-ALT" '((setup-function . (setup-cyrillic-alternativnyj-environment - . setup-cyrillic-environment-map)) - (charset . (cyrillic-iso8859-5)) - (coding-system . (alternativnyj)) + "Cyrillic-ALT" '((charset cyrillic-iso8859-5) + (coding-system alternativnyj) + (coding-priority alternativnyj) + (input-method . "cyrillic-yawerty") + (features cyril-util) (tutorial . "TUTORIAL.ru") (sample-text . "Russian (,L@caaZXY(B) ,L7T`PRabRcYbU(B!") - (documentation . ("Support for Cyrillic ALTERNATIVNYJ." - . describe-cyrillic-environment-map)))) - -;;; GENERAL - -(defun setup-cyrillic-environment () - "Setup multilingual environment for Cyrillic users." - (interactive) - (setq primary-language "Cyrillic") - - (setq coding-category-iso-8-1 'iso-8859-5) - - (set-coding-priority - '(coding-category-iso-7 - coding-category-iso-8-1)) - - (setq-default buffer-file-coding-system 'iso-8859-5) - (set-terminal-coding-system 'iso-8859-5) - (set-keyboard-coding-system 'iso-8859-5) - - (setq default-input-method '("Cyrillic" . "quail-yawerty")) - ) - -(defun describe-cyrillic-support () - "Describe how Emacs support Cyrillic." - (interactive) - (describe-language-support-internal "Cyrillic")) - -(set-language-info-alist - "Cyrillic" '((setup-function . setup-cyrillic-environment) - (describe-function . describe-cyrillic-support) - (charset . (cyrillic-iso8859-5)) - (tutorial . "TUTORIAL.ru") - (coding-system . (iso-8859-5 koi8-r alternativnyj)) - (sample-text . "Russian (,L@caaZXY(B) ,L7T`PRabRcYbU(B!") - (documentation . nil))) + (documentation . "Support for Cyrillic ALTERNATIVNYJ.")) + '("Cyrillic")) ;;; cyrillic.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/english.el --- a/lisp/mule/english.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/mule/english.el Mon Aug 13 11:13:30 2007 +0200 @@ -1,8 +1,7 @@ ;;; english.el --- English support -;; Copyright (C) 1997 Electrotechnical Laboratory, JAPAN. +;; Copyright (C) 1997,1999 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. -;; Copyright (C) 1997 MORIOKA Tomohiko ;; Keywords: multibyte character, character set, syntax, category @@ -27,92 +26,19 @@ ;; We need nothing special to support English on Emacs. Selecting ;; English as a language environment is one of the ways to reset -;; various multilingual environment to the original settting. - -;; modified for XEmacs by MORIOKA Tomohiko +;; various multilingual environment to the original setting. ;;; Code (defun setup-english-environment () "Reset multilingual environment of Emacs to the default status. -The default status is as follows. - - The default value of enable-multibyte-characters is t. - - The default value of buffer-file-coding-system is nil. - The coding system for terminal output is nil. - The coding system for keyboard input is nil. - - The order of priorities of coding categories and the coding system - bound to each category are as follows - coding category coding system - -------------------------------------------------- - coding-category-iso-7 iso-2022-7bit - coding-category-iso-8-1 iso-8859-1 - coding-category-iso-8-2 iso-8859-1 - coding-category-iso-7-else iso-2022-7bit-lock - coding-category-iso-8-else iso-2022-8bit-ss2 - coding-category-emacs-mule no-conversion - coding-category-sjis japanese-shift-jis - coding-category-big5 chinese-big5 - coding-category-binarry no-conversion -" +See the function `reset-language-environment' for more detail." (interactive) - ;; (setq-default enable-multibyte-characters t) - - ;; (setq coding-category-iso-7 'iso-2022-7bit - ;; coding-category-iso-8-1 'iso-8859-1 - ;; coding-category-iso-8-2 'iso-8859-1 - ;; coding-category-iso-7-else 'iso-2022-7bit-lock - ;; coding-category-iso-8-else 'iso-2022-8bit-ss2 - ;; coding-category-emacs-mule 'no-conversion - ;; coding-category-sjis 'japanese-shift-jis - ;; coding-category-big5 'chinese-big5 - ;; coding-category-binary 'binary) - (set-coding-category-system 'iso-7 'iso-2022-7bit) - (set-coding-category-system 'iso-8-1 'iso-8859-1) - (set-coding-category-system 'iso-8-2 'iso-8859-1) - (set-coding-category-system 'iso-lock-shift 'iso-2022-lock) - (set-coding-category-system 'iso-8-designate 'ctext) - (set-coding-category-system 'no-conversion 'no-conversion) - (set-coding-category-system 'shift-jis 'shift_jis) - (set-coding-category-system 'big5 'big5) - - ;; (set-coding-priority - ;; '(coding-category-iso-7 - ;; coding-category-iso-8-2 - ;; coding-category-iso-8-1 - ;; coding-category-iso-7-else - ;; coding-category-iso-8-else - ;; coding-category-emacs-mule - ;; coding-category-raw-text - ;; coding-category-sjis - ;; coding-category-big5 - ;; coding-category-binary)) - (set-coding-priority-list - '(iso-7 - iso-8-2 - iso-8-1 - iso-8-designate - iso-lock-shift - no-conversion - shift-jis - big5)) - - (set-default-coding-systems nil) - ;; Don't alter the terminal and keyboard coding systems here. - ;; The terminal still supports the same coding system - ;; that it supported a minute ago. -;;; (set-terminal-coding-system-internal nil) -;;; (set-keyboard-coding-system-internal nil) - - ;;(setq nonascii-insert-offset 0) - ) + (reset-language-environment)) (set-language-info-alist - "English" '((setup-function . setup-english-environment) - (tutorial . "TUTORIAL") - (charset . (ascii)) + "English" '((tutorial . "TUTORIAL") + (charset ascii) (sample-text . "Hello!, Hi!, How are you?") (documentation . "\ Nothing special is needed to handle English.") diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/ethiopic.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mule/ethiopic.el Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,81 @@ +;;; ethiopic.el --- Support for Ethiopic -*- coding: iso-2022-7bit; -*- + +;; Copyright (C) 1995,1999 Electrotechnical Laboratory, JAPAN. +;; Licensed to the Free Software Foundation. +;; Copyright (C) 1997 MORIOKA Tomohiko + +;; Keywords: multilingual, Ethiopic + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;; Author: TAKAHASHI Naoto +;; modified by MORIOKA Tomohiko for XEmacs. + +;;; Code: + +;; Ethiopic +(make-charset 'ethiopic "Ethiopic" + '(registry "Ethio" + dimension 2 + chars 94 + final ?3 + graphic 0 + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ETHIOPIC +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-category ?E "Ethiopic (Ge'ez) character.") +(modify-category-entry 'ethiopic ?E) + +(define-ccl-program ccl-encode-ethio-font + '(0 + ;; In: R0:ethiopic (not checked) + ;; R1:position code 1 + ;; R2:position code 2 + ;; Out: R1:font code point 1 + ;; R2:font code point 2 + ((r1 -= 33) + (r2 -= 33) + (r1 *= 94) + (r2 += r1) + (if (r2 < 256) + (r1 = ?\x12) + (if (r2 < 448) + ((r1 = ?\x13) (r2 -= 256)) + ((r1 = ?\xfd) (r2 -= 208)) + )))) + "CCL program to encode an Ethiopic code to code point of Ethiopic font.") + +;; (setq font-ccl-encoder-alist +;; (cons (cons "ethiopic" ccl-encode-ethio-font) font-ccl-encoder-alist)) +(set-charset-ccl-program 'ethiopic ccl-encode-ethio-font) + +(set-language-info-alist + "Ethiopic" '((setup-function . setup-ethiopic-environment-internal) + (exit-function . exit-ethiopic-environment) + (charset ethiopic) + (coding-system iso-2022-7bit) + (coding-priority iso-2022-7bit) + (input-method . "ethiopic") + (features ethio-util) + (sample-text . "$(3$Q#U!.(B") + (documentation . t))) + +;;; ethiopic.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/european.el --- a/lisp/mule/european.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/mule/european.el Mon Aug 13 11:13:30 2007 +0200 @@ -1,4 +1,4 @@ -;;; european.el --- Support for European languages +;;; european.el --- European languages -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. @@ -27,6 +27,8 @@ ;; For Europeans, five character sets ISO8859-1,2,3,4,9 are supported. +;; #### latin.el would be a better name for this file. + ;;; Code: ;; For syntax of Latin-1 characters. @@ -48,130 +50,114 @@ (modify-syntax-entry ?,BW(B ".") (modify-syntax-entry ?,Bw(B ".") +;; For syntax of Latin-3 +(loop for c in '(?,C!(B ?,C&(B ?,C)(B ?,C*(B ?,C+(B ?,C,(B ?,C/(B ?,C1(B ?,C5(B ?,C6(B ?,C:(B ?,C;(B ?,C<(B ?,C?(B) + do (modify-syntax-entry c "w")) + +(loop for c from 64 to 126 + do (modify-syntax-entry (make-char 'latin-iso8859-3 c) "w")) + +(modify-syntax-entry (make-char 'latin-iso8859-3 32) "w") ; no-break space +(modify-syntax-entry ?,CW(B ".") +(modify-syntax-entry ?,Cw(B ".") + +;; For syntax of Latin-4 +(loop for c in '(?,D!(B ?,D"(B ?,D#(B ?,D%(B ?,D&(B ?,D)(B ?,D*(B ?,D+(B ?,D,(B ?,D.(B ?,D1(B ?,D3(B ?,D5(B ?,D6(B ?,D9(B ?,D:(B ?,D;(B ?,D<(B ?,D=(B ?,D>(B ?,D?(B) + do (modify-syntax-entry c "w")) + +(loop for c from 64 to 126 + do (modify-syntax-entry (make-char 'latin-iso8859-4 c) "w")) + +(modify-syntax-entry (make-char 'latin-iso8859-4 32) "w") ; no-break space +(modify-syntax-entry ?,DW(B ".") +(modify-syntax-entry ?,Dw(B ".") + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; EUROPEANS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; (define-prefix-command 'describe-european-environment-map) -;; (define-key-after describe-language-environment-map [European] -;; '("European" . describe-european-environment-map) -;; t) - -;; (define-prefix-command 'setup-european-environment-map) -;; (define-key-after setup-language-environment-map [European] -;; '("European" . setup-european-environment-map) -;; t) - -;; Setup for LANGAUGE which uses one-byte 8-bit CHARSET, one-byte -;; 8-bit CODING-SYSTEM, and INPUT-METHOD. -(defun setup-8-bit-environment (language charset coding-system input-method) - (setup-english-environment) - (set-default-coding-systems coding-system) - ;; (setq coding-category-iso-8-1 coding-system - ;; coding-category-iso-8-2 coding-system) - (set-coding-category-system 'iso-8-1 coding-system) - (set-coding-category-system 'iso-8-2 coding-system) - - ;; (if charset - ;; (let ((nonascii-offset (- (make-char charset) 128))) - ;; ;; Set up for insertion of characters in this character set - ;; ;; when codes 0200 - 0377 are typed in. - ;; (setq nonascii-insert-offset nonascii-offset))) - - (if input-method - (setq default-input-method input-method)) - - ;; If this is a Latin-N character set, set up syntax for it in - ;; single-byte mode. We can't use require because the file - ;; must be eval'd each time in case we change from one Latin-N to another. - ;; (if (string-match "^Latin-\\([1-9]\\)$" language) - ;; (load (downcase language) nil t)) - ) ;; Latin-1 (ISO-8859-1) ;; (make-coding-system ;; 'iso-latin-1 2 ?1 -;; "ISO 2022 based 8-bit encoding (MIME:ISO-8859-1, Compound Text Encoding)" -;; '((ascii t) (latin-iso8859-1 t) nil nil -;; nil ascii-eol ascii-cntl nil nil nil nil nil nil nil nil nil t)) +;; "ISO 2022 based 8-bit encoding for Latin-1 (MIME:ISO-8859-1)" +;; '(ascii latin-iso8859-1 nil nil +;; nil nil nil nil nil nil nil nil nil nil nil nil t) +;; '((safe-charsets ascii latin-iso8859-1) +;; (mime-charset . iso-8859-1))) ;; (define-coding-system-alias 'iso-8859-1 'iso-latin-1) ;; (define-coding-system-alias 'latin-1 'iso-latin-1) -;; (define-coding-system-alias 'ctext 'iso-latin-1) + +;; (make-coding-system +;; 'compound-text 2 ?1 +;; "ISO 2022 based encoding used in inter client communication of X" +;; '((ascii t) (latin-iso8859-1 t) nil nil +;; nil ascii-eol ascii-cntl nil nil nil nil nil nil nil nil nil t) +;; '((safe-charsets . t))) + +;; (define-coding-system-alias 'ctext 'compound-text) (defun setup-latin1-environment () "Set up multilingual environment (MULE) for European Latin-1 users." (interactive) - (setup-8-bit-environment "Latin-1" 'latin-iso8859-1 'iso-8859-1 - "latin-1-prefix")) + (set-language-environment "Latin-1")) (set-language-info-alist - "Latin-1" '((setup-function . (setup-latin1-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-1)) - (coding-system . (iso-8859-1)) + "Latin-1" '((charset ascii latin-iso8859-1) + (coding-system iso-8859-1) + (coding-priority iso-8859-1) + (input-method . "latin-1-prefix") (sample-text . "Hello, Hej, Tere, Hei, Bonjour, Gr,A|_(B Gott, Ciao, ,A!(BHola!") - (documentation . ("\ -These languages are supported with the Latin-1 (ISO-8859-1) character set: + (documentation . "\ +This language environment is a generic one for Latin-1 (ISO-8859-1) +character set which supports the following languages: Danish, Dutch, English, Faeroese, Finnish, French, German, Icelandic, Irish, Italian, Norwegian, Portuguese, Spanish, and Swedish. -" . describe-european-environment-map)) - )) +We also have a German specific language environment \"German\".")) + '("European")) (set-language-info-alist - "German" '((setup-function . (setup-latin1-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-1)) - (coding-system . (iso-8859-1)) - (tutorial . "TUTORIAL.de") - (sample-text - . "Hello, Hej, Tere, Hei, Bonjour, Gr,A|_(B Gott, Ciao, ,A!(BHola!") - (documentation . ("\ + "French" '((charset ascii latin-iso8859-1) + (coding-system iso-8859-1) + (coding-priority iso-8859-1) + (tutorial . "TUTORIAL.fr") + (sample-text + . "Hello, Hej, Tere, Hei, Bonjour, Gr,A|_(B Gott, Ciao, ,A!(BHola!") + (documentation . ("\ These languages are supported with the Latin-1 (ISO-8859-1) character set: Danish, Dutch, English, Faeroese, Finnish, French, German, Icelandic, Irish, Italian, Norwegian, Portuguese, Spanish, and Swedish. -" . describe-european-environment-map)) - )) +"))) + '("European")) (set-language-info-alist - "French" '((setup-function . (setup-latin1-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-1)) - (coding-system . (iso-8859-1)) - (tutorial . "TUTORIAL.fr") - (sample-text - . "Hello, Hej, Tere, Hei, Bonjour, Gr,A|_(B Gott, Ciao, ,A!(BHola!") - (documentation . ("\ + "Norwegian" '((charset ascii latin-iso8859-1) + (coding-system iso-8859-1) + (coding-priority iso-8859-1) + (tutorial . "TUTORIAL.no") + (sample-text + . "Hello, Hej, Tere, Hei, Bonjour, Gr,A|_(B Gott, Ciao, ,A!(BHola!") + (documentation . ("\ These languages are supported with the Latin-1 (ISO-8859-1) character set: Danish, Dutch, English, Faeroese, Finnish, French, German, Icelandic, Irish, Italian, Norwegian, Portuguese, Spanish, and Swedish. -" . describe-european-environment-map)) - )) +"))) + '("European")) -(set-language-info-alist - "Norwegian" '((setup-function . (setup-latin1-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-1)) - (coding-system . (iso-8859-1)) - (tutorial . "TUTORIAL.no") - (sample-text - . "Hello, Hej, Tere, Hei, Bonjour, Gr,A|_(B Gott, Ciao, ,A!(BHola!") - (documentation . ("\ -These languages are supported with the Latin-1 (ISO-8859-1) character set: - Danish, Dutch, English, Faeroese, Finnish, French, German, Icelandic, - Irish, Italian, Norwegian, Portuguese, Spanish, and Swedish. -" . describe-european-environment-map)) - )) ;; Latin-2 (ISO-8859-2) ;; (make-coding-system ;; 'iso-latin-2 2 ?2 ;; "ISO 2022 based 8-bit encoding (MIME:ISO-8859-2)" -;; '((ascii t) (latin-iso8859-2 t) nil nil -;; nil ascii-eol ascii-cntl nil nil nil nil)) +;; '(ascii latin-iso8859-2 nil nil +;; nil nil nil nil nil nil nil) +;; '((safe-charsets ascii latin-iso8859-2) +;; (mime-charset . iso-8859-2))) ;; (define-coding-system-alias 'iso-8859-2 'iso-latin-2) ;; (define-coding-system-alias 'latin-2 'iso-latin-2) @@ -188,67 +174,96 @@ (defun setup-latin2-environment () "Set up multilingual environment (MULE) for European Latin-2 users." (interactive) - (setup-8-bit-environment "Latin-2" 'latin-iso8859-2 'iso-8859-2 - "latin-2-prefix")) + (set-language-environment "Latin-2")) (set-language-info-alist - "Latin-2" '((setup-function . (setup-latin2-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-2)) - (coding-system . (iso-8859-2)) - (documentation . ("\ -These languages are supported with the Latin-2 (ISO-8859-2) character set: + "Latin-2" '((charset ascii latin-iso8859-2) + (coding-system iso-8859-2) + (coding-priority iso-8859-2) + (input-method . "latin-2-prefix") + (documentation . "\ +This language environment is a generic one for Latin-2 (ISO-8859-2) +character set which supports the following languages: Albanian, Czech, English, German, Hungarian, Polish, Romanian, - Serbian, Croatian, Slovak, Slovene, and Swedish. -" . describe-european-environment-map)) - )) + Serbian, Croatian, Slovak, Slovene, Sorbian (upper and lower), + and Swedish.")) + '("European")) + +(set-language-info-alist + "Croatian" '((charset ascii latin-iso8859-2) + (coding-system iso-8859-2) + (coding-priority iso-8859-2) + (tutorial . "TUTORIAL.hr") + (documentation . "\ +This language environment is a generic one for Latin-2 (ISO-8859-2) +character set which supports the following languages: + Albanian, Czech, English, German, Hungarian, Polish, Romanian, + Serbian, Croatian, Slovak, Slovene, Sorbian (upper and lower), + and Swedish.")) + '("European")) (set-language-info-alist - "Croatian" '((setup-function . (setup-latin2-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-2)) - (tutorial . "TUTORIAL.hr") - (coding-system . (iso-8859-2)) - (documentation . ("\ -These languages are supported with the Latin-2 (ISO-8859-2) character set: + "Polish" '((charset ascii latin-iso8859-2) + (coding-system iso-8859-2) + (coding-priority iso-8859-2) + (tutorial . "TUTORIAL.pl") + (documentation . "\ +This language environment is a generic one for Latin-2 (ISO-8859-2) +character set which supports the following languages: Albanian, Czech, English, German, Hungarian, Polish, Romanian, - Serbian, Croatian, Slovak, Slovene, and Swedish. -" . describe-european-environment-map)) - )) + Serbian, Croatian, Slovak, Slovene, Sorbian (upper and lower), + and Swedish.")) + '("European")) + +;; Romanian support originally from romanian.el + +(defun setup-romanian-environment () + "Setup multilingual environment (MULE) for Romanian." + (interactive) + (set-language-environment "Romanian")) (set-language-info-alist - "Polish" '((setup-function . (setup-latin2-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-2)) - (tutorial . "TUTORIAL.pl") - (coding-system . (iso-8859-2)) - (documentation . ("\ -These languages are supported with the Latin-2 (ISO-8859-2) character set: - Albanian, Czech, English, German, Hungarian, Polish, Romanian, - Serbian, Croatian, Slovak, Slovene, and Swedish. -" . describe-european-environment-map)) - )) + "Romanian" '((charset ascii latin-iso8859-2) + (coding-system iso-8859-2) + (coding-priority iso-8859-2) + (input-method . "latin-2-postfix") + (tutorial . "TUTORIAL.ro") + (sample-text . "Bun,Bc(B ziua, bine a,B~(Bi venit!") + (documentation . t)) + '("European")) + +(provide 'romanian) + +;; Czech support originally from czech.el +;; Author: Milan Zamazal +;; Maintainer(for XEmacs): David Sauer + +(defun setup-czech-environment () + "Set up multilingual environment (MULE) for czech users." + (interactive) + (set-language-environment "Czech")) (set-language-info-alist - "Romanian" '((setup-function . (setup-latin2-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-2)) - (tutorial . "TUTORIAL.ro") - (coding-system . (iso-8859-2)) - (documentation . ("\ -These languages are supported with the Latin-2 (ISO-8859-2) character set: - Albanian, Czech, English, German, Hungarian, Polish, Romanian, - Serbian, Croatian, Slovak, Slovene, and Swedish. -" . describe-european-environment-map)) - )) + "Czech" '((charset ascii latin-iso8859-2) + (coding-system iso-8859-2) + (coding-priority iso-8859-2) + (tutorial . "TUTORIAL.cs") + (sample-text . "P,Bx(Bejeme v,Ba(Bm hezk,B}(B den!") + (documentation . t)) + '("European")) + +(provide 'czech) + ;; Latin-3 (ISO-8859-3) ;; (make-coding-system ;; 'iso-latin-3 2 ?3 ;; "ISO 2022 based 8-bit encoding (MIME:ISO-8859-3)" -;; '((ascii t) (latin-iso8859-3 t) nil nil -;; nil ascii-eol ascii-cntl nil nil nil nil)) +;; '(ascii latin-iso8859-3 nil nil +;; nil nil nil nil nil nil nil) +;; '((safe-charsets ascii latin-iso8859-3) +;; (mime-charset . iso-8859-3))) ;; (define-coding-system-alias 'iso-8859-3 'iso-latin-3) ;; (define-coding-system-alias 'latin-3 'iso-latin-3) @@ -265,28 +280,29 @@ (defun setup-latin3-environment () "Set up multilingual environment (MULE) for European Latin-3 users." (interactive) - (setup-8-bit-environment "Latin-3" 'latin-iso8859-3 'iso-8859-3 - "latin-3-prefix")) + (set-language-environment "Latin-3")) (set-language-info-alist - "Latin-3" '((setup-function . (setup-latin3-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-3)) - (coding-system . (iso-8859-3)) - (documentation . ("\ + "Latin-3" '((charset ascii latin-iso8859-3) + (coding-system iso-8859-3) + (coding-priority iso-8859-3) + (input-method . "latin-3-prefix") + (documentation . "\ These languages are supported with the Latin-3 (ISO-8859-3) character set: Afrikaans, Catalan, Dutch, English, Esperanto, French, Galician, - German, Italian, Maltese, Spanish, and Turkish. -" . describe-european-environment-map)) - )) + German, Italian, Maltese, Spanish, and Turkish.")) + '("European")) + ;; Latin-4 (ISO-8859-4) ;; (make-coding-system ;; 'iso-latin-4 2 ?4 ;; "ISO 2022 based 8-bit encoding (MIME:ISO-8859-4)" -;; '((ascii t) (latin-iso8859-4 t) nil nil -;; nil ascii-eol ascii-cntl nil nil nil nil)) +;; '(ascii latin-iso8859-4 nil nil +;; nil nil nil nil nil nil nil) +;; '((safe-charsets ascii latin-iso8859-4) +;; (mime-charset . iso-8895-4))) ;; (define-coding-system-alias 'iso-8859-4 'iso-latin-4) ;; (define-coding-system-alias 'latin-4 'iso-latin-4) @@ -303,28 +319,29 @@ (defun setup-latin4-environment () "Set up multilingual environment (MULE) for European Latin-4 users." (interactive) - (setup-8-bit-environment "Latin-4" 'latin-iso8859-4 'iso-8859-4 - "latin-4-prefix")) + (set-language-environment "Latin-4")) (set-language-info-alist - "Latin-4" '((setup-function . (setup-latin4-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-4)) - (coding-system . (iso-8859-4)) - (documentation . ("\ + "Latin-4" '((charset ascii latin-iso8859-4) + (coding-system iso-8859-4) + (coding-priority iso-8859-4) + (input-method . "latin-4-prefix") + (documentation . "\ These languages are supported with the Latin-4 (ISO-8859-4) character set: Danish, English, Estonian, Finnish, German, Greenlandic, Lappish, - Latvian, Lithuanian, and Norwegian. -" . describe-european-environment-map)) - )) + Latvian, Lithuanian, and Norwegian.")) + '("European")) + ;; Latin-5 (ISO-8859-9) ;; (make-coding-system ;; 'iso-latin-5 2 ?9 ;; "ISO 2022 based 8-bit encoding (MIME:ISO-8859-9)" -;; '((ascii t) (latin-iso8859-9 t) nil nil -;; nil ascii-eol ascii-cntl nil nil nil nil)) +;; '(ascii latin-iso8859-9 nil nil +;; nil nil nil nil nil nil nil) +;; '((safe-charsets ascii latin-iso8859-9) +;; (mime-charset . iso-8859-9))) ;; (define-coding-system-alias 'iso-8859-9 'iso-latin-5) ;; (define-coding-system-alias 'latin-5 'iso-latin-5) @@ -341,46 +358,52 @@ (defun setup-latin5-environment () "Set up multilingual environment (MULE) for European Latin-5 users." (interactive) - (setup-8-bit-environment "Latin-5" 'latin-iso8859-9 'iso-8859-5 - "latin-5-prefix")) + (set-language-environment "Latin-5")) + +(set-language-info-alist + "Latin-5" '((charset ascii latin-iso8859-9) + (coding-system iso-8859-9) + (coding-priority iso-8859-9) + (input-method . "latin-5-prefix") + (documentation . "\ +These languages are supported with the Latin-5 (ISO-8859-9) character set.")) + '("European")) + + +(defun setup-german-environment () + "Set up multilingual environment (MULE) for German users." + (interactive) + (set-language-environment "German")) (set-language-info-alist - "Latin-5" '((setup-function . (setup-latin5-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-9)) - (coding-system . (iso-8859-5)) - (documentation . ("\ -These languages are supported with the Latin-5 (ISO-8859-9) character set. -" . describe-european-environment-map)) - )) - -;; (defun setup-european-environment () -;; "Setup multilingual environment (MULE) for European languages users. -;; It actually reset MULE to the default status, and -;; set quail-latin-1 as the default input method to be selected. -;; See also the documentation of setup-english-environment." -;; (setup-english-environment) -;; (setq default-input-method '("European" . "quail-latin-1"))) + "German" '((tutorial . "TUTORIAL.de") + (charset ascii latin-iso8859-1) + (coding-system iso-8859-1) + (coding-priority iso-8859-1) + (input-method . "german-postfix") + (sample-text . "\ +German (Deutsch Nord) Guten Tag +German (Deutsch S,A|(Bd) Gr,A|_(B Gott") + (documentation . "\ +This language environment is almost the same as Latin-1, +but default input method is set to \"german-postfix\".")) + '("European")) -;; (defun describe-european-support () -;; "Describe how Emacs support European languages." -;; (interactive) -;; (describe-language-support-internal "European")) +(defun setup-slovenian-environment () + "Setup multilingual environment (MULE) for Slovenian." + (interactive) + (set-language-environment "Slovenian")) -;; (set-language-info-alist -;; "European" '((setup-function . setup-european-environment) -;; (describe-function . describe-european-support) -;; (charset . (ascii latin-iso8859-1 latin-iso8859-2 -;; latin-iso8859-3 latin-iso8859-4 latin-iso8859-9)) -;; (coding-system . (iso-8859-1 iso-8859-2 iso-8859-3 -;; iso-8859-4 iso-8859-9)) -;; (sample-text -;; . "Hello, Hej, Tere, Hei, Bonjour, Gr,A|_(B Gott, Ciao, ,A!(BHola!") -;; (documentation . "\ -;; Almost all of European languages are supported by the character sets and -;; coding systems listed below. -;; To input them, LEIM (Libraries for Emacs Input Methods) should have been -;; installed.") -;; )) +(set-language-info-alist + "Slovenian" '((charset . (ascii latin-iso8859-2)) + (coding-system . (iso-8859-2)) + (coding-priority . (iso-8859-2)) + (input-method . "latin-2-postfix") + (tutorial . "TUTORIAL.sl") + (sample-text . ",B.(Belimo vam uspe,B9(Ben dan!") + (documentation . t)) + '("European")) + +(provide 'slovenian) ;;; european.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/greek.el --- a/lisp/mule/greek.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/mule/greek.el Mon Aug 13 11:13:30 2007 +0200 @@ -33,31 +33,25 @@ (loop for c from 54 to 126 do (modify-syntax-entry (make-char 'greek-iso8859-7 c) "w")) (modify-syntax-entry (make-char 'greek-iso8859-7 32) "w") ; no-break space -(modify-syntax-entry ?,F7(B ".") -(modify-syntax-entry ?,F;(B ".") -(modify-syntax-entry ?,F=(B ".") +(modify-syntax-entry ?.FN7 ".") +(modify-syntax-entry ?N; ".") +(modify-syntax-entry ?N= ".") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; GREEK ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; (define-language-environment 'greek -;; "Greek" -;; (lambda () -;; (set-coding-category-system 'iso-8-designate 'iso-8859-7) -;; (set-coding-priority-list '(iso-8-designate iso-8-1)) -;; (set-default-buffer-file-coding-system 'iso-8859-7) -;; (setq terminal-coding-system 'iso-8859-7) -;; (setq keyboard-coding-system 'iso-8859-7) -;; ;; (setq-default quail-current-package -;; ;; (assoc "greek" quail-package-alist)) -;; )) ;; (make-coding-system -;; 'iso-8859-7 2 ?7 "MIME ISO-8859-7" -;; '((ascii t) (greek-iso8859-7 t) nil nil -;; nil ascii-eol ascii-cntl nil nil nil nil)) +;; 'greek-iso-8bit 2 ?7 +;; "ISO 2022 based 8-bit encoding for Greek (MIME:ISO-8859-7)" +;; '(ascii greek-iso8859-7 nil nil +;; nil nil nil nil nil nil nil) +;; '((safe-charsets ascii greek-iso8859-7) +;; (mime-charset . iso-8859-7))) + +;; (define-coding-system-alias 'iso-8859-7 'greek-iso-8bit) (make-coding-system 'iso-8859-7 'iso2022 "MIME ISO-8859-7" @@ -71,14 +65,14 @@ (defun setup-greek-environment () "Setup multilingual environment (MULE) for Greek." (interactive) - (setup-8-bit-environment "Greek" 'greek-iso8859-7 'iso-8859-7 "greek") - ) + (set-language-environment "Greek")) (set-language-info-alist - "Greek" '((setup-function . setup-greek-environment) - (charset . (greek-iso8859-7)) - (coding-system . (iso-8859-7)) - (sample-text . "Greek (,FGkk]mija(B) ,FCei\(B ,Fsar(B") + "Greek" '((charset greek-iso8859-7) + (coding-system iso-8859-7) + (coding-priority iso-8859-7) + (input-method . "greek") + (sample-text . "Greek (NGNkNkN]NmNiNjNa) NCNeNiN\ NsNaNr") (documentation . t))) ;;; greek.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/hebrew.el --- a/lisp/mule/hebrew.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/mule/hebrew.el Mon Aug 13 11:13:30 2007 +0200 @@ -1,4 +1,4 @@ -;;; hebrew.el --- Support for Hebrew +;;; hebrew.el --- Support for Hebrew -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. @@ -37,8 +37,10 @@ ;; (make-coding-system ;; 'hebrew-iso-8bit 2 ?8 ;; "ISO 2022 based 8-bit encoding for Hebrew (MIME:ISO-8859-8)" -;; '((ascii t) (hebrew-iso8859-8 t) nil nil -;; nil ascii-eol ascii-cntl nil nil nil nil nil t)) +;; '(ascii hebrew-iso8859-8 nil nil +;; nil ascii-eol ascii-cntl nil nil nil nil nil t) +;; '((safe-charsets ascii hebrew-iso8859-8) +;; (mime-charset . iso-8859-8))) ;; (define-coding-system-alias 'iso-8859-8 'hebrew-iso-8bit) @@ -51,7 +53,7 @@ charset-g3 t no-iso6429 t mnemonic "MIME/Hbrw" -)) + )) (make-coding-system 'ctext-hebrew 'iso2022 @@ -67,26 +69,14 @@ "Setup multilingual environment (MULE) for Hebrew. But, please note that right-to-left writing is not yet supported." (interactive) - (setup-8-bit-environment "Hebrew" 'hebrew-iso8859-8 'iso-8859-8 - "hebrew") - (set-coding-category-system 'iso-8-designate 'iso-8859-8) - (set-coding-priority-list - '(iso-8-designate - iso-8-1 - iso-7 - iso-8-2 - iso-lock-shift - no-conversion - shift-jis - big5)) - ) + (set-language-environment "Hebrew")) (set-language-info-alist - "Hebrew" '((setup-function . setup-hebrew-environment) - (describe-function . describe-hebrew-support) - (charset . (hebrew-iso8859-8)) - (coding-system . (iso-8859-8)) - (sample-text . "Hebrew ,Hylem(B") + "Hebrew" '((charset hebrew-iso8859-8) + (coding-system iso-8859-8) + (coding-priority iso-8859-8) + (input-method . "hebrew") + (sample-text . "Hebrew [2],Hylem[0](B") (documentation . "Right-to-left writing is not yet supported.") )) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/japanese.el --- a/lisp/mule/japanese.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/mule/japanese.el Mon Aug 13 11:13:30 2007 +0200 @@ -1,4 +1,4 @@ -;;; japanese.el --- Japanese support +;;; japanese.el --- Japanese support -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. @@ -144,10 +144,11 @@ ;; 'iso-2022-jp 2 ?J ;; "ISO 2022 based 7bit encoding for Japanese (MIME:ISO-2022-JP)" ;; '((ascii japanese-jisx0208-1978 japanese-jisx0208 -;; latin-jisx0201 japanese-jisx0212 katakana-jisx0201 t) nil nil nil -;; short ascii-eol ascii-cntl seven)) - -;; (define-coding-system-alias 'junet 'iso-2022-jp) +;; latin-jisx0201 japanese-jisx0212 katakana-jisx0201) nil nil nil +;; short ascii-eol ascii-cntl seven) +;; '((safe-charsets ascii japanese-jisx0208-1978 japanese-jisx0208 +;; latin-jisx0201 japanese-jisx0212 katakana-jisx0201) +;; (mime-charset . iso-2022-jp))) (make-coding-system 'iso-2022-jp 'iso2022 @@ -160,26 +161,47 @@ mnemonic "MULE/7bit" )) -(copy-coding-system 'iso-2022-jp 'junet) +(define-coding-system-alias 'junet 'iso-2022-jp) ;; (make-coding-system -;; 'shift_jis 1 ?S -;; "Coding-system of Shift-JIS used in Japan." t) +;; 'iso-2022-jp-2 2 ?J +;; "ISO 2022 based 7bit encoding for CJK, Latin-1, and Greek (MIME:ISO-2022-JP-2)" +;; '((ascii japanese-jisx0208-1978 japanese-jisx0208 +;; latin-jisx0201 japanese-jisx0212 katakana-jisx0201 +;; chinese-gb2312 korean-ksc5601) nil +;; (nil latin-iso8859-1 greek-iso8859-7) nil +;; short ascii-eol ascii-cntl seven nil single-shift) +;; '((safe-charsets ascii japanese-jisx0208-1978 japanese-jisx0208 +;; latin-jisx0201 japanese-jisx0212 katakana-jisx0201 +;; chinese-gb2312 korean-ksc5601 +;; latin-iso8859-1 greek-iso8859-7) +;; (mime-charset . iso-2022-jp-2))) + +;; (make-coding-system +;; 'japanese-shift-jis 1 ?S +;; "Shift-JIS 8-bit encoding for Japanese (MIME:SHIFT_JIS)" +;; nil +;; '((safe-charsets ascii japanese-jisx0208 japanese-jisx0208-1978 +;; latin-jisx0201 katakana-jisx0201) +;; (mime-charset . shift_jis) +;; (charset-origin-alist (japanese-jisx0208 "SJIS" encode-sjis-char) +;; (katakana-jisx0201 "SJIS" encode-sjis-char)))) (make-coding-system 'shift_jis 'shift-jis "Coding-system of Shift-JIS used in Japan." '(mnemonic "Ja/SJIS")) -;;(define-coding-system-alias 'shift_jis 'sjis) - -(copy-coding-system 'shift_jis 'sjis) +;; (define-coding-system-alias 'shift_jis 'japanese-shift-jis) +;; (define-coding-system-alias 'sjis 'japanese-shift-jis) ;; (make-coding-system -;; 'iso-2022-jp-1978-irv 2 ?J -;; "Coding-system used for old jis terminal." -;; '((ascii t) nil nil nil -;; short ascii-eol ascii-cntl seven nil nil use-roman use-oldjis)) +;; 'japanese-iso-7bit-1978-irv 2 ?j +;; "ISO 2022 based 7-bit encoding for Japanese JISX0208-1978 and JISX0201-Roman" +;; '((ascii japanese-jisx0208-1978 japanese-jisx0208 +;; latin-jisx0201 japanese-jisx0212 katakana-jisx0201 t) nil nil nil +;; short ascii-eol ascii-cntl seven nil nil use-roman use-oldjis) +;; '(ascii japanese-jisx0208-1978 japanese-jisx0208 latin-jisx0201)) (make-coding-system 'iso-2022-jp-1978-irv 'iso2022 @@ -192,15 +214,19 @@ mnemonic "Ja-78/7bit" )) -;;(define-coding-system-alias 'iso-2022-jp-1978-irv 'old-jis) +;; (define-coding-system-alias 'iso-2022-jp-1978-irv 'japanese-iso-7bit-1978-irv) +;; (define-coding-system-alias 'old-jis 'japanese-iso-7bit-1978-irv) -(copy-coding-system 'iso-2022-jp-1978-irv 'old-jis) +(define-coding-system-alias 'old-jis 'iso-2022-jp-1978-irv) ;; (make-coding-system -;; 'euc-japan-1990 2 ?E -;; "Coding-system of Japanese EUC (Extended Unix Code)." +;; 'japanese-iso-8bit 2 ?E +;; "ISO 2022 based EUC encoding for Japanese (MIME:EUC-JP)" ;; '(ascii japanese-jisx0208 katakana-jisx0201 japanese-jisx0212 -;; short ascii-eol ascii-cntl nil nil single-shift)) +;; short ascii-eol ascii-cntl nil nil single-shift) +;; '((safe-charsets ascii latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978 +;; katakana-jisx0201 japanese-jisx0212) +;; (mime-charset . euc-jp))) (make-coding-system 'euc-jp 'iso2022 @@ -213,20 +239,26 @@ mnemonic "Ja/EUC" )) -;;(define-coding-system-alias 'euc-japan-1990 'euc-japan) +;; (define-coding-system-alias 'euc-japan-1990 'japanese-iso-8bit) +;; (define-coding-system-alias 'euc-japan 'japanese-iso-8bit) +;; (define-coding-system-alias 'euc-jp 'japanese-iso-8bit) -(copy-coding-system 'euc-jp 'euc-japan) ; only for w3 -(copy-coding-system 'euc-jp 'japanese-euc) +(define-coding-system-alias 'euc-japan 'euc-jp) ; only for w3 +(define-coding-system-alias 'japanese-euc 'euc-jp) (set-language-info-alist - "Japanese" '((setup-function . setup-japanese-environment) + "Japanese" '((setup-function . setup-japanese-environment-internal) + (exit-function . exit-japanese-environment) (tutorial . "TUTORIAL.ja") - (charset . (japanese-jisx0208 japanese-jisx0208-1978 - japanese-jisx0212 latin-jisx0201 - katakana-jisx0201)) - (coding-system . (iso-2022-jp euc-jp - shift_jis iso-2022-jp-1978-irv)) - (sample-text . "Japanese ($BF|K\8l(B) $B$3$s$K$A$O(B, (I:]FAJ(B") + (charset japanese-jisx0208 japanese-jisx0208-1978 + japanese-jisx0212 latin-jisx0201 katakana-jisx0201) + (coding-system iso-2022-jp euc-jp + shift_jis iso-2022-jp-2) + (coding-priority iso-2022-jp euc-jp + shift_jis iso-2022-jp-2) +;; (input-method . "japanese") + (features japan-util) + (sample-text . "Japanese ($BF|K\8l(B) $B$3$s$K$A$O(B, )IºÝÆÁÊ")-A (documentation . t))) ;;; japanese.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/korean.el --- a/lisp/mule/korean.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/mule/korean.el Mon Aug 13 11:13:30 2007 +0200 @@ -1,4 +1,4 @@ -;;; korean.el --- Support for Korean +;;; korean.el --- Support for Korean -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. @@ -66,10 +66,12 @@ (setq-default its:*current-map* (its:get-mode-map "hangul")))) ;; (make-coding-system -;; 'euc-kr 2 ?K -;; "Coding-system of Korean EUC (Extended Unix Code)." -;; '((ascii t) korean-ksc5601 nil nil -;; nil ascii-eol ascii-cntl)) +;; 'korean-iso-8bit 2 ?K +;; "ISO 2022 based EUC encoding for Korean KSC5601 (MIME:EUC-KR)" +;; '(ascii korean-ksc5601 nil nil +;; nil ascii-eol ascii-cntl) +;; '((safe-charsets ascii korean-ksc5601) +;; (mime-charset . euc-kr))) (make-coding-system 'euc-kr 'iso2022 @@ -81,14 +83,16 @@ ;;(define-coding-system-alias 'euc-kr 'euc-korea) -(copy-coding-system 'euc-kr 'korean-euc) +(define-coding-system-alias 'korean-euc 'euc-kr) ;; (make-coding-system ;; 'iso-2022-kr 2 ?k -;; "MIME ISO-2022-KR" +;; "ISO 2022 based 7-bit encoding for Korean KSC5601 (MIME:ISO-2022-KR)." ;; '(ascii (nil korean-ksc5601) nil nil ;; nil ascii-eol ascii-cntl seven locking-shift nil nil nil nil nil -;; designation-bol)) +;; designation-bol) +;; '((safe-charsets ascii korean-ksc5601) +;; (mime-charset . iso-2022-kr))) (make-coding-system 'iso-2022-kr 'iso2022 @@ -101,49 +105,23 @@ mnemonic "Ko/7bit" eol-type lf)) -(defun setup-korean-environment () - "Setup multilingual environment (MULE) for Korean." - (interactive) - (setup-english-environment) - ;; (setq coding-category-iso-8-2 'euc-kr) - (set-coding-category-system 'iso-8-2 'euc-kr) - - ;; (set-coding-priority - ;; '(coding-category-iso-7 - ;; coding-category-iso-8-2 - ;; coding-category-iso-8-1)) - (set-coding-priority-list - '(iso-8-2 - iso-7 - iso-8-1 - iso-8-designate - iso-lock-shift - no-conversion - shift-jis - big5)) - - (set-default-coding-systems 'euc-kr) - - ;; (when (eq 'x (device-type (selected-device))) - ;; (x-use-halfwidth-roman-font 'korean-ksc5601 "ksc5636")) - - ;; EGG specific setup 97.02.05 jhod - (when (featurep 'egg) - (when (not (featurep 'egg-kor)) - (provide 'egg-kor) - (load "its-hangul") - (setq its:*standard-modes* - (cons (its:get-mode-map "hangul") its:*standard-modes*))) - (setq-default its:*current-map* (its:get-mode-map "hangul"))) - - (setq default-input-method "korean-hangul")) +;; (define-coding-system-alias 'korean-iso-7bit-lock 'iso-2022-kr) (set-language-info-alist - "Korean" '((setup-function . setup-korean-environment) + "Korean" '((setup-function . setup-korean-environment-internal) + (exit-function . exit-korean-environment) (tutorial . "TUTORIAL.ko") - (charset . (korean-ksc5601)) - (coding-system . (iso-2022-kr euc-kr)) + (charset korean-ksc5601) + (coding-system euc-kr iso-2022-kr) + (coding-priority euc-kr iso-2022-kr) + (input-method . "korean-hangul") + (features korea-util) (sample-text . "Hangul ($(CGQ1[(B) $(C>H3gGO<H3gGO=J4O1n(B") - (documentation . t))) + (documentation . "\ +The following key bindings are available while using Korean input methods: + Shift-SPC: toggle-korean-input-mthod + Control-F9: quail-hangul-switch-symbol-ksc + F9: quail-hangul-switch-hanja") + )) ;;; korean.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/misc-lang.el --- a/lisp/mule/misc-lang.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/mule/misc-lang.el Mon Aug 13 11:13:30 2007 +0200 @@ -1,6 +1,6 @@ ;;; misc-lang.el --- support for miscellaneous languages (characters) -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. +;; Copyright (C) 1995,1999 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. ;; Copyright (C) 1997 MORIOKA Tomohiko @@ -40,11 +40,13 @@ (defun setup-ipa-environment () "Setup multilingual environment (MULE) for IPA." (interactive) - (setup-english-environment)) + (set-language-environment "IPA")) (set-language-info-alist - "IPA" '((setup-function . setup-ipa-environment) - (charset . (ipa)) + "IPA" '((charset . (ipa)) + (coding-priority iso-2022-7bit) + (coding-system iso-2022-7bit) + (input-method . "ipa") (documentation . "\ IPA is International Phonetic Alphabet for English, French, German and Italian."))) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/mule-category.el --- a/lisp/mule/mule-category.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/mule/mule-category.el Mon Aug 13 11:13:30 2007 +0200 @@ -1,6 +1,8 @@ ;;; mule-category.el --- category functions for XEmacs/Mule. ;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN. +;; Licensed to the Free Software Foundation. ;; Copyright (C) 1995 Amdahl Corporation. ;; Copyright (C) 1995 Sun Microsystems. @@ -27,7 +29,7 @@ ;; type of char table. Some function names / arguments should be ;; parallel with syntax tables. -;; Written by Ben Wing . The initialization code +;; Written by Ben Wing . The initialization code ;; at the end of this file comes from Mule. ;; Some bugfixes by Jareth Hein @@ -67,8 +69,8 @@ "Return an undefined category designator, or nil if there are none." (let ((a 32) found) (while (and (< a 127) (not found)) - (if (gethash a defined-category-hashtable) - (setq found a)) + (unless (gethash a defined-category-hashtable) + (setq found (make-char 'ascii a))) (setq a (1+ a))) found)) @@ -115,11 +117,11 @@ (let ((a 32) list) (while (< a 127) (if (= 1 (aref vec (- a 32))) - (setq list (cons a list))) + (setq list (cons (make-char 'ascii a) list))) (setq a (1+ a))) (nreverse list))))) -;; implimented in c, file chartab.c (97/3/14 jhod@po.iijnet.or.jp) +;; implemented in c, file chartab.c (97/3/14 jhod@po.iijnet.or.jp) ;(defun char-in-category-p (char category &optional table) ; "Return non-nil if CHAR is in CATEGORY. ;TABLE defaults to the current buffer's category table. @@ -135,8 +137,9 @@ "Describe the category specifications in the category table. The descriptions are inserted in a buffer, which is then displayed." (interactive) - (with-output-to-temp-buffer "*Help*" - (describe-category-table (category-table) standard-output))) + (with-displaying-help-buffer + (lambda () + (describe-category-table (category-table) standard-output)))) (defun describe-category-table (table stream) (let (first-char @@ -243,9 +246,11 @@ (let (i l) (define-category ?a "ASCII character set.") + (define-category ?l "Latin-1 through Latin-5 character set") (setq i 32) (while (< i 127) (modify-category-entry i ?a) + (modify-category-entry i ?l) (setq i (1+ i))) (setq l predefined-category-list) (while l @@ -255,6 +260,23 @@ (modify-category-entry (car (car l)) (nth 1 (car l))) (setq l (cdr l)))) +;;; Setting word boundary. + +(setq word-combining-categories + '((?l . ?l))) + +(setq word-separating-categories ; (2-byte character sets) + '((?A . ?K) ; Alpha numeric - Katakana + (?A . ?C) ; Alpha numeric - Chinese + (?H . ?A) ; Hiragana - Alpha numeric + (?H . ?K) ; Hiragana - Katakana + (?H . ?C) ; Hiragana - Chinese + (?K . ?A) ; Katakana - Alpha numeric + (?K . ?C) ; Katakana - Chinese + (?C . ?A) ; Chinese - Alpha numeric + (?C . ?K) ; Chinese - Katakana + )) + ;;; At the present, I know Japanese and Chinese text can ;;; break line at any point under a restriction of 'kinsoku'. (defvar word-across-newline "\\(\\cj\\|\\cc\\|\\ct\\)" diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/mule-ccl.el --- a/lisp/mule/mule-ccl.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/mule/mule-ccl.el Mon Aug 13 11:13:30 2007 +0200 @@ -74,11 +74,13 @@ ;; (read REG ...) ;; | (read-if (REG OPERATOR ARG) CCL_BLOCK CCL_BLOCK) ;; | (read-branch REG CCL_BLOCK [CCL_BLOCK ...]) +;; | (read-multibyte-character REG {charset} REG {code-point}) ;; WRITE := ;; (write REG ...) ;; | (write EXPRESSION) ;; | (write integer) | (write string) | (write REG ARRAY) ;; | string +;; | (write-multibyte-character REG(charset) REG(codepoint)) ;; CALL := (call ccl-program-name) ;; END := (end) ;; @@ -89,14 +91,15 @@ ;; | < | > | == | <= | >= | != | de-sjis | en-sjis ;; ASSIGNMENT_OPERATOR := ;; += | -= | *= | /= | %= | &= | '|=' | ^= | <<= | >>= -;; ARRAY := '[' interger ... ']' +;; ARRAY := '[' integer ... ']' ;;; Code: (defconst ccl-command-table [if branch loop break repeat write-repeat write-read-repeat - read read-if read-branch write call end] - "*Vector of CCL commands (symbols).") + read read-if read-branch write call end + read-multibyte-character write-multibyte-character] + "Vector of CCL commands (symbols).") ;; Put a property to each symbol of CCL commands for the compiler. (let (op (i 0) (len (length ccl-command-table))) @@ -137,8 +140,21 @@ jump-cond-expr-register read-jump-cond-expr-const read-jump-cond-expr-register + ex-cmd ] - "*Vector of CCL compiled codes (symbols).") + "Vector of CCL compiled codes (symbols).") + +(defconst ccl-extended-code-table + [read-multibyte-character + write-multibyte-character + translate-character + translate-character-const-tbl + nil nil nil nil nil nil nil nil nil nil nil nil ; 0x04-0x0f + iterate-multiple-map + map-multiple + map-single + ] + "Vector of CCL extended compiled codes (symbols).") ;; Put a property to each symbol of CCL codes for the disassembler. (let (code (i 0) (len (length ccl-code-table))) @@ -148,6 +164,15 @@ (put code 'ccl-dump-function (intern (format "ccl-dump-%s" code))) (setq i (1+ i)))) +(let (code (i 0) (len (length ccl-extended-code-table))) + (while (< i len) + (setq code (aref ccl-extended-code-table i)) + (if code + (progn + (put code 'ccl-ex-code i) + (put code 'ccl-dump-function (intern (format "ccl-dump-%s" code))))) + (setq i (1+ i)))) + (defconst ccl-jump-code-list '(jump jump-cond write-register-jump write-register-read-jump write-const-jump write-const-read-jump write-string-jump @@ -162,7 +187,7 @@ (defconst ccl-register-table [r0 r1 r2 r3 r4 r5 r6 r7] - "*Vector of CCL registers (symbols).") + "Vector of CCL registers (symbols).") ;; Put a property to indicate register number to each symbol of CCL. ;; registers. @@ -175,7 +200,7 @@ (defconst ccl-arith-table [+ - * / % & | ^ << >> <8 >8 // nil nil nil < > == <= >= != de-sjis en-sjis] - "*Vector of CCL arithmetic/logical operators (symbols).") + "Vector of CCL arithmetic/logical operators (symbols).") ;; Put a property to each symbol of CCL operators for the compiler. (let (arith (i 0) (len (length ccl-arith-table))) @@ -186,7 +211,7 @@ (defconst ccl-assign-arith-table [+= -= *= /= %= &= |= ^= <<= >>= <8= >8= //=] - "*Vector of CCL assignment operators (symbols).") + "Vector of CCL assignment operators (symbols).") ;; Put a property to each symbol of CCL assignment operators for the compiler. (let (arith (i 0) (len (length ccl-assign-arith-table))) @@ -258,13 +283,23 @@ (aset ccl-program-vector ccl-current-ic code) (setq ccl-current-ic (1+ ccl-current-ic)))) +;; extended ccl command format +;; |- 14-bit -|- 3-bit --|- 3-bit --|- 3-bit --|- 5-bit -| +;; |- EX-OP --|-- REG3 --|-- REG2 --|-- REG ---|-- OP ---| +(defun ccl-embed-extended-command (ex-op reg reg2 reg3) + (let ((data (logior (ash (get ex-op 'ccl-ex-code) 3) + (if (symbolp reg3) + (get reg3 'ccl-register-number) + 0)))) + (ccl-embed-code 'ex-cmd reg data reg2))) + ;; Just advance `ccl-current-ic' by INC. (defun ccl-increment-ic (inc) (setq ccl-current-ic (+ ccl-current-ic inc))) ;;;###autoload (defun ccl-program-p (obj) - "T if OBJECT is a valid CCL compiled code." + "Return t if OBJECT is a valid CCL compiled code." (and (vectorp obj) (let ((i 0) (len (length obj)) (flag t)) (if (> len 1) @@ -524,7 +559,9 @@ (let ((unconditional-jump (ccl-compile-1 true-cmds))) (if (null false-cmds) ;; This is the place to jump to if condition is false. - (ccl-embed-current-address jump-cond-address) + (progn + (ccl-embed-current-address jump-cond-address) + (setq unconditional-jump nil)) (let (end-true-part-address) (if (not unconditional-jump) (progn @@ -802,6 +839,119 @@ (ccl-embed-code 'end 0 0) t) +;; Compile read-multibyte-character +(defun ccl-compile-read-multibyte-character (cmd) + (if (/= (length cmd) 3) + (error "CCL: Invalid number of arguments: %s" cmd)) + (let ((RRR (nth 1 cmd)) + (rrr (nth 2 cmd))) + (ccl-check-register rrr cmd) + (ccl-check-register RRR cmd) + (ccl-embed-extended-command 'read-multibyte-character rrr RRR 0)) + nil) + +;; Compile write-multibyte-character +(defun ccl-compile-write-multibyte-character (cmd) + (if (/= (length cmd) 3) + (error "CCL: Invalid number of arguments: %s" cmd)) + (let ((RRR (nth 1 cmd)) + (rrr (nth 2 cmd))) + (ccl-check-register rrr cmd) + (ccl-check-register RRR cmd) + (ccl-embed-extended-command 'write-multibyte-character rrr RRR 0)) + nil) + +;; Compile translate-character +;; (defun ccl-compile-translate-character (cmd) +;; (if (/= (length cmd) 4) +;; (error "CCL: Invalid number of arguments: %s" cmd)) +;; (let ((Rrr (nth 1 cmd)) +;; (RRR (nth 2 cmd)) +;; (rrr (nth 3 cmd))) +;; (ccl-check-register rrr cmd) +;; (ccl-check-register RRR cmd) +;; (cond ((and (symbolp Rrr) (not (get Rrr 'ccl-register-number))) +;; (if (not (get Rrr 'translation-table)) +;; (error "CCL: Invalid translation table %s in %s" Rrr cmd)) +;; (ccl-embed-extended-command 'translate-character-const-tbl +;; rrr RRR 0) +;; (ccl-embed-data Rrr)) +;; (t +;; (ccl-check-register Rrr cmd) +;; (ccl-embed-extended-command 'translate-character rrr RRR Rrr)))) +;; nil) + +;; (defun ccl-compile-iterate-multiple-map (cmd) +;; (ccl-compile-multiple-map-function 'iterate-multiple-map cmd) +;; nil) + +;; (defun ccl-compile-map-multiple (cmd) +;; (if (/= (length cmd) 4) +;; (error "CCL: Invalid number of arguments: %s" cmd)) +;; (let ((func '(lambda (arg mp) +;; (let ((len 0) result add) +;; (while arg +;; (if (consp (car arg)) +;; (setq add (funcall func (car arg) t) +;; result (append result add) +;; add (+ (-(car add)) 1)) +;; (setq result +;; (append result +;; (list (car arg))) +;; add 1)) +;; (setq arg (cdr arg) +;; len (+ len add))) +;; (if mp +;; (cons (- len) result) +;; result)))) +;; arg) +;; (setq arg (append (list (nth 0 cmd) (nth 1 cmd) (nth 2 cmd)) +;; (funcall func (nth 3 cmd) nil))) +;; (ccl-compile-multiple-map-function 'map-multiple arg)) +;; nil) + +;; (defun ccl-compile-map-single (cmd) +;; (if (/= (length cmd) 4) +;; (error "CCL: Invalid number of arguments: %s" cmd)) +;; (let ((RRR (nth 1 cmd)) +;; (rrr (nth 2 cmd)) +;; (map (nth 3 cmd)) +;; id) +;; (ccl-check-register rrr cmd) +;; (ccl-check-register RRR cmd) +;; (ccl-embed-extended-command 'map-single rrr RRR 0) +;; (cond ((symbolp map) +;; (if (get map 'code-conversion-map) +;; (ccl-embed-data map) +;; (error "CCL: Invalid map: %s" map))) +;; (t +;; (error "CCL: Invalid type of arguments: %s" cmd)))) +;; nil) + +;; (defun ccl-compile-multiple-map-function (command cmd) +;; (if (< (length cmd) 4) +;; (error "CCL: Invalid number of arguments: %s" cmd)) +;; (let ((RRR (nth 1 cmd)) +;; (rrr (nth 2 cmd)) +;; (args (nthcdr 3 cmd)) +;; map) +;; (ccl-check-register rrr cmd) +;; (ccl-check-register RRR cmd) +;; (ccl-embed-extended-command command rrr RRR 0) +;; (ccl-embed-data (length args)) +;; (while args +;; (setq map (car args)) +;; (cond ((symbolp map) +;; (if (get map 'code-conversion-map) +;; (ccl-embed-data map) +;; (error "CCL: Invalid map: %s" map))) +;; ((numberp map) +;; (ccl-embed-data map)) +;; (t +;; (error "CCL: Invalid type of arguments: %s" cmd))) +;; (setq args (cdr args))))) + + ;;; CCL dump staffs ;; To avoid byte-compiler warning. @@ -1069,17 +1219,69 @@ (insert "\n")) (setq i (1+ i))))) +(defun ccl-dump-ex-cmd (rrr cc) + (let* ((RRR (logand cc ?\x7)) + (Rrr (logand (ash cc -3) ?\x7)) + (ex-op (aref ccl-extended-code-table (logand (ash cc -6) ?\x3fff)))) + (insert (format "<%s> " ex-op)) + (funcall (get ex-op 'ccl-dump-function) rrr RRR Rrr))) + +(defun ccl-dump-read-multibyte-character (rrr RRR Rrr) + (insert (format "read-multibyte-character r%d r%d\n" RRR rrr))) + +(defun ccl-dump-write-multibyte-character (rrr RRR Rrr) + (insert (format "write-multibyte-character r%d r%d\n" RRR rrr))) + +;; (defun ccl-dump-translate-character (rrr RRR Rrr) +;; (insert (format "translation table(r%d) r%d r%d\n" Rrr RRR rrr))) + +;; (defun ccl-dump-translate-character-const-tbl (rrr RRR Rrr) +;; (let ((tbl (ccl-get-next-code))) +;; (insert (format "translation table(%S) r%d r%d\n" tbl RRR rrr)))) + +;; (defun ccl-dump-iterate-multiple-map (rrr RRR Rrr) +;; (let ((notbl (ccl-get-next-code)) +;; (i 0) id) +;; (insert (format "iterate-multiple-map r%d r%d\n" RRR rrr)) +;; (insert (format "\tnumber of maps is %d .\n\t [" notbl)) +;; (while (< i notbl) +;; (setq id (ccl-get-next-code)) +;; (insert (format "%S" id)) +;; (setq i (1+ i))) +;; (insert "]\n"))) + +;; (defun ccl-dump-map-multiple (rrr RRR Rrr) +;; (let ((notbl (ccl-get-next-code)) +;; (i 0) id) +;; (insert (format "map-multiple r%d r%d\n" RRR rrr)) +;; (insert (format "\tnumber of maps and separators is %d\n\t [" notbl)) +;; (while (< i notbl) +;; (setq id (ccl-get-next-code)) +;; (if (= id -1) +;; (insert "]\n\t [") +;; (insert (format "%S " id))) +;; (setq i (1+ i))) +;; (insert "]\n"))) + +;; (defun ccl-dump-map-single (rrr RRR Rrr) +;; (let ((id (ccl-get-next-code))) +;; (insert (format "map-single r%d r%d map(%S)\n" RRR rrr id)))) + + ;; CCL emulation staffs ;; Not yet implemented. +;; Auto-loaded functions. + ;;;###autoload -(defmacro declare-ccl-program (name) +(defmacro declare-ccl-program (name &optional vector) "Declare NAME as a name of CCL program. To compile a CCL program which calls another CCL program not yet -defined, it must be declared as a CCL program in advance." - `(put ',name 'ccl-program-idx (register-ccl-program ',name nil))) +defined, it must be declared as a CCL program in advance. +Optional arg VECTOR is a compiled CCL code of the CCL program." + `(put ',name 'ccl-program-idx (register-ccl-program ',name ,vector))) ;;;###autoload (defmacro define-ccl-program (name ccl-program &optional doc) @@ -1092,9 +1294,27 @@ nil)) ;;;###autoload +(defmacro check-ccl-program (ccl-program &optional name) + "Check validity of CCL-PROGRAM. +If CCL-PROGRAM is a symbol denoting a valid CCL program, return +CCL-PROGRAM, else return nil. +If CCL-PROGRAM is a vector and optional arg NAME (symbol) is supplied, +register CCL-PROGRAM by name NAME, and return NAME." + `(let ((result ,ccl-program)) + (cond ((symbolp ,ccl-program) + (or (numberp (get ,ccl-program 'ccl-program-idx)) + (setq result nil))) + ((vectorp ,ccl-program) + (setq result ,name) + (register-ccl-program result ,ccl-program)) + (t + (setq result nil))) + result)) + +;;;###autoload (defun ccl-execute-with-args (ccl-prog &rest args) "Execute CCL-PROGRAM with registers initialized by the remaining args. -The return value is a vector of resulting CCL registeres." +The return value is a vector of resulting CCL registers." (let ((reg (make-vector 8 0)) (i 0)) (while (and args (< i 8)) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/mule-charset.el --- a/lisp/mule/mule-charset.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/mule/mule-charset.el Mon Aug 13 11:13:30 2007 +0200 @@ -1,8 +1,12 @@ ;;; mule-charset.el --- Charset functions for Mule. + ;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Copyright (C) 1995 Amdahl Corporation. ;; Copyright (C) 1996 Sun Microsystems. +;; Author: Unknown +;; Keywords: i18n, mule, internal + ;; This file is part of XEmacs. ;; XEmacs is free software; you can redistribute it and/or modify it @@ -20,40 +24,14 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. - -;;;; Composite character support +;;; Synched up with: Not synched. API at source level synched with FSF 20.3.9. -(defun compose-region (start end &optional buffer) - "Compose characters in the current region into one composite character. -From a Lisp program, pass two arguments, START to END. -The composite character replaces the composed characters. -BUFFER defaults to the current buffer if omitted." - (interactive "r") - (let ((ch (make-composite-char (buffer-substring start end buffer)))) - (delete-region start end buffer) - (insert-char ch nil nil buffer))) +;;; Commentary: -(defun decompose-region (start end &optional buffer) - "Decompose any composite characters in the current region. -From a Lisp program, pass two arguments, START to END. -This converts each composite character into one or more characters, -the individual characters out of which the composite character was formed. -Non-composite characters are left as-is. BUFFER defaults to the current -buffer if omitted." - (interactive "r") - (save-excursion - (set-buffer buffer) - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (let ((compcharset (get-charset 'composite))) - (while (< (point) (point-max)) - (let ((ch (char-after (point)))) - (if (eq compcharset (char-charset ch)) - (progn - (delete-char 1) - (insert (composite-char-string ch)))))))))) +;; These functions are not compatible at the bytecode level with Emacs/Mule, +;; and they never will be. -sb [1999-05-26] +;;; Code: ;;;; Classifying text according to charsets @@ -97,12 +75,12 @@ ;;;; Charset accessors -(defun charset-graphic (charset) +(defun charset-iso-graphic-plane (charset) "Return the `graphic' property of CHARSET. See `make-charset'." (charset-property charset 'graphic)) -(defun charset-final (charset) +(defun charset-iso-final-char (charset) "Return the final byte of the ISO 2022 escape sequence designating CHARSET." (charset-property charset 'final)) @@ -110,16 +88,21 @@ "Return the number of characters per dimension of CHARSET." (charset-property charset 'chars)) -(defun charset-columns (charset) +(defun charset-width (charset) "Return the number of display columns per character of CHARSET. This only applies to TTY mode (under X, the actual display width can be automatically determined)." (charset-property charset 'columns)) +;; #### FSFmacs returns 0 (defun charset-direction (charset) - "Return the display direction (`l2r' or `r2l') of CHARSET." - (charset-property charset 'direction)) + "Return the display direction (0 for `l2r' or 1 for `r2l') of CHARSET. +Only left-to-right is currently implemented." + (if (eq (charset-property charset 'direction) 'l2r) + 0 + 1)) +;; Not in Emacs/Mule (defun charset-registry (charset) "Return the registry of CHARSET. This is a regular expression matching the registry field of fonts @@ -131,12 +114,139 @@ See `make-charset'." (charset-property charset 'ccl-program)) -(defun charset-leading-byte (charset) - "Return the leading byte of CHARSET. -See `make-charset'." - (charset-property charset 'leading-byte)) +(defun charset-bytes (charset) + "Useless in XEmacs, returns 1." + 1) + +(define-obsolete-function-alias 'charset-columns 'charset-width) ;; 19990409 +(define-obsolete-function-alias 'charset-final 'charset-iso-final-char) ;; 19990409 +(define-obsolete-function-alias 'charset-graphic 'charset-iso-graphic-plane) ;; 19990409 +(define-obsolete-function-alias 'charset-doc-string 'charset-description) ;; 19990409 ;;;; Define setf methods for all settable Charset properties (defsetf charset-registry set-charset-registry) (defsetf charset-ccl-program set-charset-ccl-program) + +;;; FSF compatibility functions +(defun charset-after (&optional pos) + "Return charset of a character in current buffer at position POS. +If POS is nil, it defauls to the current point. +If POS is out of range, the value is nil." + (when (null pos) + (setq pos (point))) + (check-argument-type 'integerp pos) + (unless (or (< pos (point-min)) + (> pos (point-max))) + (char-charset (char-after pos)))) + +;; Yuck! +;; We're not going to support this. +;(defun charset-info (charset) +; "Return a vector of information of CHARSET. +;The elements of the vector are: +; CHARSET-ID, BYTES, DIMENSION, CHARS, WIDTH, DIRECTION, +; LEADING-CODE-BASE, LEADING-CODE-EXT, +; ISO-FINAL-CHAR, ISO-GRAPHIC-PLANE, +; REVERSE-CHARSET, SHORT-NAME, LONG-NAME, DESCRIPTION, +; PLIST, +;where +;CHARSET-ID (integer) is the identification number of the charset. +;BYTES (integer) is the length of multi-byte form of a character in +; the charset: one of 1, 2, 3, and 4. +;DIMENSION (integer) is the number of bytes to represent a character of +;the charset: 1 or 2. +;CHARS (integer) is the number of characters in a dimension: 94 or 96. +;WIDTH (integer) is the number of columns a character in the charset +; occupies on the screen: one of 0, 1, and 2. +;DIRECTION (integer) is the rendering direction of characters in the +; charset when rendering. If 0, render from left to right, else +; render from right to left. +;LEADING-CODE-BASE (integer) is the base leading-code for the +; charset. +;LEADING-CODE-EXT (integer) is the extended leading-code for the +; charset. All charsets of less than 0xA0 has the value 0. +;ISO-FINAL-CHAR (character) is the final character of the +; corresponding ISO 2022 charset. +;ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked +; while encoding to variants of ISO 2022 coding system, one of the +; following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR). +;REVERSE-CHARSET (integer) is the charset which differs only in +; LEFT-TO-RIGHT value from the charset. If there's no such a +; charset, the value is -1. +;SHORT-NAME (string) is the short name to refer to the charset. +;LONG-NAME (string) is the long name to refer to the charset +;DESCRIPTION (string) is the description string of the charset. +;PLIST (property list) may contain any type of information a user +; want to put and get by functions `put-charset-property' and +; `get-charset-property' respectively." +; (vector +; (charset-id charset) +; 1 +; (charset-dimension charset) +; (charset-chars charset) +; (charset-width charset) +; (charset-direction charset) +; nil ;; (charset-leading-code-base (charset)) +; nil ;; (charset-leading-code-ext (charset)) +; (charset-iso-final-char charset) +; (charset-iso-graphic-plane charset) +; -1 +; (charset-short-name charset) +; (charset-long-name charset) +; (charset-description charset) +; (charset-plist charset))) + +;(make-compatible 'charset-info "Don't use this if you can help it.") + +(defun define-charset (charset-id charset property-vector) + "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR. +If CHARSET-ID is nil, it is decided automatically, which means CHARSET is + treated as a private charset. +INFO-VECTOR is a vector of the format: + [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE + SHORT-NAME LONG-NAME DESCRIPTION] +The meanings of each elements is as follows: +DIMENSION (integer) is the number of bytes to represent a character: 1 or 2. +CHARS (integer) is the number of characters in a dimension: 94 or 96. +WIDTH (integer) is the number of columns a character in the charset +occupies on the screen: one of 0, 1, and 2. + +DIRECTION (integer) is the rendering direction of characters in the +charset when rendering. If 0, render from left to right, else +render from right to left. + +ISO-FINAL-CHAR (character) is the final character of the +corresponding ISO 2022 charset. + +ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked +while encoding to variants of ISO 2022 coding system, one of the +following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR). + + +SHORT-NAME (string) is the short name to refer to the charset. + +LONG-NAME (string) is the long name to refer to the charset. + +DESCRIPTION (string) is the description string of the charset." + (make-charset charset (aref property-vector 8) + (list + 'short-name (aref property-vector 6) + 'long-name (aref property-vector 7) + 'dimension (aref property-vector 0) + 'columns (aref property-vector 2) + 'chars (aref property-vector 1) + 'final (aref property-vector 4) + 'graphic (aref property-vector 5) + 'direction (aref property-vector 3)))) + +(make-compatible 'define-charset "") + +;;; Charset property + +(defalias 'get-charset-property 'get) +(defalias 'put-charset-property 'put) +(defalias 'charset-plist 'object-plist) +(defalias 'set-charset-plist 'setplist) + +;;; mule-charset.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/mule-cmds.el --- a/lisp/mule/mule-cmds.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/mule/mule-cmds.el Mon Aug 13 11:13:30 2007 +0200 @@ -1,6 +1,6 @@ ;;; mule-cmds.el --- Commands for multilingual environment -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. +;; Copyright (C) 1995,1999 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. ;; Copyright (C) 1997 MORIOKA Tomohiko @@ -27,8 +27,8 @@ ;;; MULE related key bindings and menus. -(defvar mule-keymap (make-sparse-keymap "MULE") - "Keymap for MULE (Multilingual environment) specific commands.") +(defvar mule-keymap (make-sparse-keymap "Mule") + "Keymap for Mule (Multilingual environment) specific commands.") ;; Keep "C-x C-m ..." for mule specific commands. (define-key ctl-x-map "\C-m" mule-keymap) @@ -38,10 +38,12 @@ (define-key mule-keymap "t" 'set-terminal-coding-system) (define-key mule-keymap "k" 'set-keyboard-coding-system) (define-key mule-keymap "p" 'set-buffer-process-coding-system) -(define-key mule-keymap "\C-\\" 'select-input-method) +(define-key mule-keymap "x" 'set-selection-coding-system) +(define-key mule-keymap "X" 'set-next-selection-coding-system) +(define-key mule-keymap "\C-\\" 'set-input-method) (define-key mule-keymap "c" 'universal-coding-system-argument) ;;(define-key mule-keymap "c" 'list-coding-system-briefly) ; XEmacs -(define-key mule-keymap "C" 'list-coding-system) ; XEmacs +(define-key mule-keymap "C" 'describe-coding-system) ; XEmacs (define-key mule-keymap "r" 'toggle-display-direction) ; XEmacs (define-key mule-keymap "l" 'set-language-environment) @@ -63,18 +65,80 @@ ;; but it won't be used that frequently. (define-key global-map "\C-\\" 'toggle-input-method) +;;; This is no good because people often type Shift-SPC +;;; meaning to type SPC. -- rms. +;;; ;; Here's an alternative key binding for X users (Shift-SPACE). +;;; (define-key global-map [?\S- ] 'toggle-input-method) + +(defun coding-system-change-eol-conversion (coding-system eol-type) + "Return a coding system which differs from CODING-SYSTEM in eol conversion. +The returned coding system converts end-of-line by EOL-TYPE +but text as the same way as CODING-SYSTEM. +EOL-TYPE should be `lf', `crlf', `cr' or nil. +If EOL-TYPE is nil, the returned coding system detects +how end-of-line is formatted automatically while decoding. + +EOL-TYPE can be specified by an symbol `unix', `dos' or `mac'. +They means `lf', `crlf', and `cr' respectively." + (if (symbolp eol-type) + (setq eol-type (cond ((or (eq eol-type 'unix) + (eq eol-type 'lf)) + 'eol-lf) + ((or (eq eol-type 'dos) + (eq eol-type 'crlf)) + 'eol-crlf) + ((or (eq eol-type 'mac) + (eq eol-type 'cr)) + 'eol-cr) + (t eol-type)))) + (let ((orig-eol-type (coding-system-eol-type coding-system))) + (if (null orig-eol-type) + (if (not eol-type) + coding-system + (coding-system-property coding-system eol-type)) + (let ((base (coding-system-base coding-system))) + (if (not eol-type) + base + (if (= eol-type orig-eol-type) + coding-system + (setq orig-eol-type (coding-system-eol-type base)) + (if (null orig-eol-type) + (coding-system-property base eol-type)))))))) + +;; (defun coding-system-change-text-conversion (coding-system coding) +;; "Return a coding system which differs from CODING-SYSTEM in text conversion. +;; The returned coding system converts text by CODING +;; but end-of-line as the same way as CODING-SYSTEM. +;; If CODING is nil, the returned coding system detects +;; how text is formatted automatically while decoding." +;; (if (not coding) +;; (coding-system-base coding-system) +;; (let ((eol-type (coding-system-eol-type coding-system))) +;; (coding-system-change-eol-conversion +;; coding +;; (if (numberp eol-type) (aref [unix dos mac] eol-type)))))) + (defun view-hello-file () "Display the HELLO file which list up many languages and characters." (interactive) ;; We have to decode the file in any environment. - (let ((coding-system-for-read 'iso-2022-7)) + (let ((coding-system-for-read 'iso-2022-7bit)) (find-file-read-only (expand-file-name "HELLO" data-directory)))) (defun universal-coding-system-argument () "Execute an I/O command using the specified coding system." (interactive) - (let* ((coding-system - (read-coding-system "Coding system for following command: ")) + (let* ((default (and buffer-file-coding-system + (not (eq (coding-system-type buffer-file-coding-system) + t)) + (coding-system-name buffer-file-coding-system))) + (coding-system + (read-coding-system + (if default + (format "Coding system for following command (default, %s): " + default) + "Coding system for following command: ") + default)) (keyseq (read-key-sequence (format "Command to execute with %s:" coding-system))) (cmd (key-binding keyseq))) @@ -85,183 +149,504 @@ (defun set-default-coding-systems (coding-system) "Set default value of various coding systems to CODING-SYSTEM. -The follwing coding systems are set: +This sets the following coding systems: o coding system of a newly created buffer o default coding system for terminal output o default coding system for keyboard input - o default coding system for subprocess I/O" + o default coding system for subprocess I/O + o default coding system for converting file names." (check-coding-system coding-system) ;;(setq-default buffer-file-coding-system coding-system) (set-default-buffer-file-coding-system coding-system) - ;;(setq default-terminal-coding-system coding-system) + ;; (if default-enable-multibyte-characters + ;; (setq default-file-name-coding-system coding-system)) + ;; If coding-system is nil, honor that on MS-DOS as well, so + ;; that they could reset the terminal coding system. + ;; (unless (and (eq window-system 'pc) coding-system) + ;; (setq default-terminal-coding-system coding-system)) (setq terminal-coding-system coding-system) ;;(setq default-keyboard-coding-system coding-system) (setq keyboard-coding-system coding-system) ;;(setq default-process-coding-system (cons coding-system coding-system)) + ;; Refer to coding-system-for-read and coding-system-for-write + ;; so that C-x RET c works. (add-hook 'comint-exec-hook `(lambda () (let ((proc (get-buffer-process (current-buffer)))) - (set-process-input-coding-system proc ',coding-system) - (set-process-output-coding-system proc ',coding-system))) + (set-process-input-coding-system + proc (or coding-system-for-read ',coding-system)) + (set-process-output-coding-system + proc (or coding-system-for-write ',coding-system)))) 'append) (setq file-name-coding-system coding-system)) (defun prefer-coding-system (coding-system) "Add CODING-SYSTEM at the front of the priority list for automatic detection. -This also sets the following coding systems to CODING-SYSTEM: +This also sets the following coding systems: o coding system of a newly created buffer o default coding system for terminal output o default coding system for keyboard input - o default coding system for subprocess I/O" + o default coding system for converting file names. + +If CODING-SYSTEM specifies a certain type of EOL conversion, the coding +systems set by this function will use that type of EOL conversion. + +This command does not change the default value of terminal coding system +for MS-DOS terminal, because DOS terminals only support a single coding +system, and Emacs automatically sets the default to that coding system at +startup." (interactive "zPrefer coding system: ") - (if (not (and coding-system (coding-system-p coding-system))) + (if (not (and coding-system (find-coding-system coding-system))) (error "Invalid coding system `%s'" coding-system)) (let ((coding-category (coding-system-category coding-system)) - (parent (coding-system-parent coding-system))) + (base (coding-system-base coding-system)) + (eol-type (coding-system-eol-type coding-system))) (if (not coding-category) ;; CODING-SYSTEM is no-conversion or undecided. (error "Can't prefer the coding system `%s'" coding-system)) - (set coding-category (or parent coding-system)) - (if (not (eq coding-category (car coding-category-list))) + (set-coding-category-system coding-category (or base coding-system)) + ;; (update-coding-systems-internal) + (or (eq coding-category (car (coding-category-list))) ;; We must change the order. - (setq coding-category-list - (cons coding-category - (delq coding-category coding-category-list)))) - (if (and parent (interactive-p)) - (message "Highest priority is set to %s (parent of %s)" - parent coding-system)) - (set-default-coding-systems (or parent coding-system)))) + (set-coding-priority-list (list coding-category))) + (if (and base (interactive-p)) + (message "Highest priority is set to %s (base of %s)" + base coding-system)) + ;; If they asked for specific EOL conversion, honor that. + (if (memq eol-type '(lf crlf mac)) + (setq coding-system + (coding-system-change-eol-conversion base eol-type)) + (setq coding-system base)) + (set-default-coding-systems coding-system))) + +;; (defun find-coding-systems-region-subset-p (list1 list2) +;; "Return non-nil if all elements in LIST1 are included in LIST2. +;; Comparison done with EQ." +;; (catch 'tag +;; (while list1 +;; (or (memq (car list1) list2) +;; (throw 'tag nil)) +;; (setq list1 (cdr list1))) +;; t)) + +;; (defun find-coding-systems-region (from to) +;; "Return a list of proper coding systems to encode a text between FROM and TO. +;; All coding systems in the list can safely encode any multibyte characters +;; in the text. +;; +;; If the text contains no multibyte characters, return a list of a single +;; element `undecided'." +;; (find-coding-systems-for-charsets (find-charset-region from to))) + +;; (defun find-coding-systems-string (string) +;; "Return a list of proper coding systems to encode STRING. +;; All coding systems in the list can safely encode any multibyte characters +;; in STRING. +;; +;; If STRING contains no multibyte characters, return a list of a single +;; element `undecided'." +;; (find-coding-systems-for-charsets (find-charset-string string))) + +;; (defun find-coding-systems-for-charsets (charsets) +;; "Return a list of proper coding systems to encode characters of CHARSETS. +;; CHARSETS is a list of character sets." +;; (if (or (null charsets) +;; (and (= (length charsets) 1) +;; (eq 'ascii (car charsets)))) +;; '(undecided) +;; (setq charsets (delq 'composition charsets)) +;; (let ((l (coding-system-list 'base-only)) +;; (charset-preferred-codings +;; (mapcar (function +;; (lambda (x) +;; (if (eq x 'unknown) +;; 'raw-text +;; (get-charset-property x 'preferred-coding-system)))) +;; charsets)) +;; (priorities (mapcar (function (lambda (x) (symbol-value x))) +;; coding-category-list)) +;; codings coding safe) +;; (if (memq 'unknown charsets) +;; ;; The region contains invalid multibyte characters. +;; (setq l '(raw-text))) +;; (while l +;; (setq coding (car l) l (cdr l)) +;; (if (and (setq safe (coding-system-get coding 'safe-charsets)) +;; (or (eq safe t) +;; (find-coding-systems-region-subset-p charsets safe))) +;; ;; We put the higher priority to coding systems included +;; ;; in CHARSET-PREFERRED-CODINGS, and within them, put the +;; ;; higher priority to coding systems which support smaller +;; ;; number of charsets. +;; (let ((priority +;; (+ (if (coding-system-get coding 'mime-charset) 4096 0) +;; (lsh (length (memq coding priorities)) 7) +;; (if (memq coding charset-preferred-codings) 64 0) +;; (if (> (coding-system-type coding) 0) 32 0) +;; (if (consp safe) (- 32 (length safe)) 0)))) +;; (setq codings (cons (cons priority coding) codings))))) +;; (mapcar 'cdr +;; (sort codings (function (lambda (x y) (> (car x) (car y)))))) +;; ))) + +;; (defun find-multibyte-characters (from to &optional maxcount excludes) +;; "Find multibyte characters in the region specified by FROM and TO. +;; If FROM is a string, find multibyte characters in the string. +;; The return value is an alist of the following format: +;; ((CHARSET COUNT CHAR ...) ...) +;; where +;; CHARSET is a character set, +;; COUNT is a number of characters, +;; CHARs are found characters of the character set. +;; Optional 3rd arg MAXCOUNT limits how many CHARs are put in the above list. +;; Optional 4th arg EXCLUDE is a list of character sets to be ignored. +;; +;; For invalid characters, CHARs are actually strings." +;; (let ((chars nil) +;; charset char) +;; (if (stringp from) +;; (let ((idx 0)) +;; (while (setq idx (string-match "[^\000-\177]" from idx)) +;; (setq char (aref from idx) +;; charset (char-charset char)) +;; (if (eq charset 'unknown) +;; (setq char (match-string 0))) +;; (if (or (eq charset 'unknown) +;; (not (or (eq excludes t) (memq charset excludes)))) +;; (let ((slot (assq charset chars))) +;; (if slot +;; (if (not (memq char (nthcdr 2 slot))) +;; (let ((count (nth 1 slot))) +;; (setcar (cdr slot) (1+ count)) +;; (if (or (not maxcount) (< count maxcount)) +;; (nconc slot (list char))))) +;; (setq chars (cons (list charset 1 char) chars))))) +;; (setq idx (1+ idx)))) +;; (save-excursion +;; (goto-char from) +;; (while (re-search-forward "[^\000-\177]" to t) +;; (setq char (preceding-char) +;; charset (char-charset char)) +;; (if (eq charset 'unknown) +;; (setq char (match-string 0))) +;; (if (or (eq charset 'unknown) +;; (not (or (eq excludes t) (memq charset excludes)))) +;; (let ((slot (assq charset chars))) +;; (if slot +;; (if (not (member char (nthcdr 2 slot))) +;; (let ((count (nth 1 slot))) +;; (setcar (cdr slot) (1+ count)) +;; (if (or (not maxcount) (< count maxcount)) +;; (nconc slot (list char))))) +;; (setq chars (cons (list charset 1 char) chars)))))))) +;; (nreverse chars))) + +;; (defvar last-coding-system-specified nil +;; "Most recent coding system explicitly specified by the user when asked. +;; This variable is set whenever Emacs asks the user which coding system +;; to use in order to write a file. If you set it to nil explicitly, +;; then call `write-region', then afterward this variable will be non-nil +;; only if the user was explicitly asked and specified a coding system.") +;; (defun select-safe-coding-system (from to &optional default-coding-system) +;; "Ask a user to select a safe coding system from candidates. +;; The candidates of coding systems which can safely encode a text +;; between FROM and TO are shown in a popup window. +;; +;; Optional arg DEFAULT-CODING-SYSTEM specifies a coding system to be +;; checked at first. If omitted, buffer-file-coding-system of the +;; current buffer is used. +;; +;; If the text can be encoded safely by DEFAULT-CODING-SYSTEM, it is +;; returned without any user interaction. +;; +;; Kludgy feature: if FROM is a string, the string is the target text, +;; and TO is ignored." +;; (or default-coding-system +;; (setq default-coding-system buffer-file-coding-system)) +;; (let* ((charsets (if (stringp from) (find-charset-string from) +;; (find-charset-region from to))) +;; (safe-coding-systems (find-coding-systems-for-charsets charsets))) +;; (if (or (not enable-multibyte-characters) +;; (eq (car safe-coding-systems) 'undecided) +;; (eq default-coding-system 'no-conversion) +;; (and default-coding-system +;; (memq (coding-system-base default-coding-system) +;; safe-coding-systems))) +;; default-coding-system +;; +;; ;; At first, change each coding system to the corresponding +;; ;; mime-charset name if it is also a coding system. +;; (let ((l safe-coding-systems) +;; mime-charset) +;; (while l +;; (setq mime-charset (coding-system-get (car l) 'mime-charset)) +;; (if (and mime-charset (coding-system-p mime-charset)) +;; (setcar l mime-charset)) +;; (setq l (cdr l)))) +;; +;; (let ((non-safe-chars (find-multibyte-characters +;; from to 3 +;; (and default-coding-system +;; (coding-system-get default-coding-system +;; 'safe-charsets)))) +;; show-position overlays) +;; (save-excursion +;; ;; Highlight characters that default-coding-system can't encode. +;; (when (integerp from) +;; (goto-char from) +;; (let ((found nil)) +;; (while (and (not found) +;; (re-search-forward "[^\000-\177]" to t)) +;; (setq found (assq (char-charset (preceding-char)) +;; non-safe-chars)))) +;; (forward-line -1) +;; (setq show-position (point)) +;; (save-excursion +;; (while (and (< (length overlays) 256) +;; (re-search-forward "[^\000-\177]" to t)) +;; (let* ((char (preceding-char)) +;; (charset (char-charset char))) +;; (when (assq charset non-safe-chars) +;; (setq overlays (cons (make-overlay (1- (point)) (point)) +;; overlays)) +;; (overlay-put (car overlays) 'face 'highlight)))))) +;; +;; ;; At last, ask a user to select a proper coding system. +;; (unwind-protect +;; (save-window-excursion +;; (when show-position +;; ;; At first, be sure to show the current buffer. +;; (set-window-buffer (selected-window) (current-buffer)) +;; (set-window-start (selected-window) show-position)) +;; ;; Then, show a helpful message. +;; (with-output-to-temp-buffer "*Warning*" +;; (save-excursion +;; (set-buffer standard-output) +;; (insert "The target text contains the following non ASCII character(s):\n") +;; (let ((len (length non-safe-chars)) +;; (shown 0)) +;; (while (and non-safe-chars (< shown 3)) +;; (when (> (length (car non-safe-chars)) 2) +;; (setq shown (1+ shown)) +;; (insert (format "%25s: " (car (car non-safe-chars)))) +;; (let ((l (nthcdr 2 (car non-safe-chars)))) +;; (while l +;; (if (or (stringp (car l)) (char-valid-p (car l))) +;; (insert (car l))) +;; (setq l (cdr l)))) +;; (if (> (nth 1 (car non-safe-chars)) 3) +;; (insert "...")) +;; (insert "\n")) +;; (setq non-safe-chars (cdr non-safe-chars))) +;; (if (< shown len) +;; (insert (format "%27s\n" "...")))) +;; (insert (format "\ +;; These can't be encoded safely by the coding system %s. +;; +;; Please select one from the following safe coding systems:\n" +;; default-coding-system)) +;; (let ((pos (point)) +;; (fill-prefix " ")) +;; (mapcar (function (lambda (x) (princ " ") (princ x))) +;; safe-coding-systems) +;; (fill-region-as-paragraph pos (point))))) +;; +;; ;; Read a coding system. +;; (let* ((safe-names (mapcar (lambda (x) (list (symbol-name x))) +;; safe-coding-systems)) +;; (name (completing-read +;; (format "Select coding system (default %s): " +;; (car safe-coding-systems)) +;; safe-names nil t nil nil +;; (car (car safe-names))))) +;; (setq last-coding-system-specified (intern name)) +;; (if (integerp (coding-system-eol-type default-coding-system)) +;; (setq last-coding-system-specified +;; (coding-system-change-eol-conversion +;; last-coding-system-specified +;; (coding-system-eol-type default-coding-system)))) +;; last-coding-system-specified)) +;; (kill-buffer "*Warning*") +;; (while overlays +;; (delete-overlay (car overlays)) +;; (setq overlays (cdr overlays))))))))) + +;; (setq select-safe-coding-system-function 'select-safe-coding-system) + +;; (defun select-message-coding-system () +;; "Return a coding system to encode the outgoing message of the current buffer. +;; It at first tries the first coding system found in these variables +;; in this order: +;; (1) local value of `buffer-file-coding-system' +;; (2) value of `sendmail-coding-system' +;; (3) value of `default-buffer-file-coding-system' +;; (4) value of `default-sendmail-coding-system' +;; If the found coding system can't encode the current buffer, +;; or none of them are bound to a coding system, +;; it asks the user to select a proper coding system." +;; (let ((coding (or (and (local-variable-p 'buffer-file-coding-system) +;; buffer-file-coding-system) +;; sendmail-coding-system +;; default-buffer-file-coding-system +;; default-sendmail-coding-system))) +;; (if (eq coding 'no-conversion) +;; ;; We should never use no-conversion for outgoing mails. +;; (setq coding nil)) +;; (if (fboundp select-safe-coding-system-function) +;; (funcall select-safe-coding-system-function +;; (point-min) (point-max) coding) +;; coding))) -;;; Language support staffs. +;;; Language support stuff. (defvar language-info-alist nil - "Alist of language names vs the corresponding information of various kind. + "Alist of language environment definitions. Each element looks like: (LANGUAGE-NAME . ((KEY . INFO) ...)) -where LANGUAGE-NAME is a string, -KEY is a symbol denoting the kind of information, -INFO is any Lisp object which contains the actual information related -to KEY.") +where LANGUAGE-NAME is a string, the name of the language environment, +KEY is a symbol denoting the kind of information, and +INFO is the data associated with KEY. +Meaningful values for KEY include -(defun get-language-info (language-name key) - "Return the information for LANGUAGE-NAME of the kind KEY. -KEY is a symbol denoting the kind of required information." - (if (symbolp language-name) - (setq language-name (symbol-name language-name))) - (let ((lang-slot (assoc-ignore-case language-name language-info-alist))) + documentation value is documentation of what this language environment + is meant for, and how to use it. + charset value is a list of the character sets used by this + language environment. + sample-text value is one line of text, + written using those character sets, + appropriate for this language environment. + setup-function value is a function to call to switch to this + language environment. + exit-function value is a function to call to leave this + language environment. + coding-system value is a list of coding systems that are good + for saving text written in this language environment. + This list serves as suggestions to the user; + in effect, as a kind of documentation. + coding-priority value is a list of coding systems for this language + environment, in order of decreasing priority. + This is used to set up the coding system priority + list when you switch to this language environment. + input-method value is a default input method for this language + environment. + features value is a list of features requested in this + language environment. + tutorial value is a tutorial file name written in the language.") + +(defun get-language-info (lang-env key) + "Return information listed under KEY for language environment LANG-ENV. +KEY is a symbol denoting the kind of information. +For a list of useful values for KEY and their meanings, +see `language-info-alist'." + (if (symbolp lang-env) + (setq lang-env (symbol-name lang-env))) + (let ((lang-slot (assoc-ignore-case lang-env language-info-alist))) (if lang-slot (cdr (assq key (cdr lang-slot)))))) -(defun set-language-info (language-name key info) - "Set for LANGUAGE-NAME the information INFO under KEY. +(defun set-language-info (lang-env key info) + "Modify part of the definition of language environment LANG-ENV. +Specifically, this stores the information INFO under KEY +in the definition of this language environment. KEY is a symbol denoting the kind of information. -INFO is any Lisp object which contains the actual information. - -Currently, the following KEYs are used by Emacs: - -charset: list of symbols whose values are charsets specific to the language. - -coding-system: list of coding systems specific to the language. - -tutorial: a tutorial file name written in the language. - -sample-text: one line short text containing characters of the language. - -documentation: t or a string describing how Emacs supports the language. - If a string is specified, it is shown before any other information - of the language by the command `describe-language-environment'. +INFO is the value for that information. -setup-function: a function to call for setting up environment - convenient for a user of the language. - -If KEY is documentation or setup-function, you can also specify -a cons cell as INFO, in which case, the car part should be -a normal value as INFO for KEY (as described above), -and the cdr part should be a symbol whose value is a menu keymap -in which an entry for the language is defined. But, only the car part -is actually set as the information. - -We will define more KEYs in the future. To avoid conflict, -if you want to use your own KEY values, make them start with `user-'." - (if (symbolp language-name) - (setq language-name (symbol-name language-name))) +For a list of useful values for KEY and their meanings, +see `language-info-alist'." + (if (symbolp lang-env) + (setq lang-env (symbol-name lang-env))) (let (lang-slot key-slot) - (setq lang-slot (assoc language-name language-info-alist)) + (setq lang-slot (assoc lang-env language-info-alist)) (if (null lang-slot) ; If no slot for the language, add it. - (setq lang-slot (list language-name) + (setq lang-slot (list lang-env) language-info-alist (cons lang-slot language-info-alist))) (setq key-slot (assq key lang-slot)) (if (null key-slot) ; If no slot for the key, add it. (progn (setq key-slot (list key)) (setcdr lang-slot (cons key-slot (cdr lang-slot))))) - ;; Setup menu. - (cond ((eq key 'documentation) - ;; (define-key-after - ;; (if (consp info) - ;; (prog1 (symbol-value (cdr info)) - ;; (setq info (car info))) - ;; describe-language-environment-map) - ;; (vector (intern language-name)) - ;; (cons language-name 'describe-specified-language-support) - ;; t) - (if (consp info) - (setq info (car info))) - (when (featurep 'menubar) - (eval-after-load + (setcdr key-slot info))) + +(defun set-language-info-alist (lang-env alist &optional parents) + "Store ALIST as the definition of language environment LANG-ENV. +ALIST is an alist of KEY and INFO values. See the documentation of +`set-language-info' for the meanings of KEY and INFO." + (if (symbolp lang-env) + (setq lang-env (symbol-name lang-env))) + (let (; (describe-map describe-language-environment-map) + ; (setup-map setup-language-environment-map) + ) + ;; (if parents + ;; (let ((l parents) + ;; map parent-symbol parent) + ;; (while l + ;; (if (symbolp (setq parent-symbol (car l))) + ;; (setq parent (symbol-name parent)) + ;; (setq parent parent-symbol parent-symbol (intern parent))) + ;; (setq map (lookup-key describe-map (vector parent-symbol))) + ;; (if (not map) + ;; (progn + ;; (setq map (intern (format "describe-%s-environment-map" + ;; (downcase parent)))) + ;; (define-prefix-command map) + ;; (define-key-after describe-map (vector parent-symbol) + ;; (cons parent map) t))) + ;; (setq describe-map (symbol-value map)) + ;; (setq map (lookup-key setup-map (vector parent-symbol))) + ;; (if (not map) + ;; (progn + ;; (setq map (intern (format "setup-%s-environment-map" + ;; (downcase parent)))) + ;; (define-prefix-command map) + ;; (define-key-after setup-map (vector parent-symbol) + ;; (cons parent map) t))) + ;; (setq setup-map (symbol-value map)) + ;; (setq l (cdr l))))) + + ;; Set up menu items for this language env. + (let ((doc (assq 'documentation alist))) + (when doc + ;; (define-key-after describe-map (vector (intern lang-env)) + ;; (cons lang-env 'describe-specified-language-support) t) + (when (featurep 'menubar) + (eval-after-load "menubar-items.elc" - `(add-menu-button - '("Mule" "Describe Language Support") - (vector ,language-name - '(describe-language-environment ,language-name) - t)))) - ) - ((eq key 'setup-function) - ;; (define-key-after - ;; (if (consp info) - ;; (prog1 (symbol-value (cdr info)) - ;; (setq info (car info))) - ;; setup-language-environment-map) - ;; (vector (intern language-name)) - ;; (cons language-name 'setup-specified-language-environment) - ;; t) - (if (consp info) - (setq info (car info))) - (when (featurep 'menubar) - (eval-after-load - "menubar-items.elc" - `(add-menu-button - '("Mule" "Set Language Environment") - (vector ,language-name - '(set-language-environment ,language-name) - t)))) - )) + `(add-menu-button + '("Mule" "Describe Language Support") + (vector ,lang-env + '(describe-language-environment ,lang-env) + t)))) + )) + ;; (define-key-after setup-map (vector (intern lang-env)) + ;; (cons lang-env 'setup-specified-language-environment) t) + (when (featurep 'menubar) + (eval-after-load + "menubar-items.elc" + `(add-menu-button + '("Mule" "Set Language Environment") + (vector ,lang-env + '(set-language-environment ,lang-env) + t)))) - (setcdr key-slot info) - )) - -(defun set-language-info-alist (language-name alist) - "Set for LANGUAGE-NAME the information in ALIST. -ALIST is an alist of KEY and INFO. See the documentation of -`set-language-info' for the meanings of KEY and INFO." - (if (symbolp language-name) - (setq language-name (symbol-name language-name))) - (while alist - (set-language-info language-name (car (car alist)) (cdr (car alist))) - (setq alist (cdr alist)))) + (while alist + (set-language-info lang-env (car (car alist)) (cdr (car alist))) + (setq alist (cdr alist))))) (defun read-language-name (key prompt &optional default) - "Read language name which has information for KEY, prompting with PROMPT. -DEFAULT is the default choice of language. -This returns a language name as a string." + "Read a language environment name which has information for KEY. +If KEY is nil, read any language environment. +Prompt with PROMPT. DEFAULT is the default choice of language environment. +This returns a language environment name as a string." (let* ((completion-ignore-case t) (name (completing-read prompt language-info-alist - (function (lambda (elm) (assq key elm))) - t nil default))) + (and key + (function (lambda (elm) (assq key elm)))) + t nil nil default))) (if (and (> (length name) 0) - (get-language-info name key)) + (or (not key) + (get-language-info name key))) name))) ;;; Multilingual input methods. @@ -276,7 +661,7 @@ ";;; %s -- list of LEIM (Library of Emacs Input Method) ;; ;; This file contains a list of LEIM (Library of Emacs Input Method) -;; in the same directory as this file. Loading this file registeres +;; in the same directory as this file. Loading this file registers ;; the whole input methods in Emacs. ;; ;; Each entry has the form: @@ -321,10 +706,13 @@ (put 'current-input-method-title 'permanent-local t) (defcustom default-input-method nil - "*Default input method for multilingual text. + "*Default input method for multilingual text (a string). This is the input method activated automatically by the command `toggle-input-method' (\\[toggle-input-method])." - :group 'mule) + :group 'mule + :type '(choice (const nil) string)) + +(put 'input-method-function 'permanent-local t) (defvar input-method-history nil "History list for some commands that read input methods.") @@ -348,26 +736,40 @@ (put 'describe-current-input-method-function 'permanent-local t) (defvar input-method-alist nil - "Alist of input method names vs the corresponding information to use it. + "Alist of input method names vs how to use them. Each element has the form: - (INPUT-METHOD LANGUAGE-NAME ACTIVATE-FUNC TITLE DESCRIPTION ...) -See the function `register-input-method' for the meanings of each elements.") + (INPUT-METHOD LANGUAGE-ENV ACTIVATE-FUNC TITLE DESCRIPTION ARGS...) +See the function `register-input-method' for the meanings of the elements.") -(defun register-input-method (input-method language-name &rest args) - "Register INPUT-METHOD as an input method for LANGUAGE-NAME. -INPUT-METHOD and LANGUAGE-NAME are symbols or strings. +(defun register-input-method (input-method lang-env &rest args) + "Register INPUT-METHOD as an input method for language environment ENV. +INPUT-METHOD and LANG-ENV are symbols or strings. + The remaining arguments are: - ACTIVATE-FUNC, TITLE, DESCRIPTION, and ARG ... - where, -ACTIVATE-FUNC is a function to call for activating this method. -TITLE is a string shown in mode-line while this method is active, -DESCRIPTION is a string describing about this method, -Arguments to ACTIVATE-FUNC are INPUT-METHOD and ARGs." - (if (symbolp language-name) - (setq language-name (symbol-name language-name))) + ACTIVATE-FUNC, TITLE, DESCRIPTION, and ARGS... +ACTIVATE-FUNC is a function to call to activate this method. +TITLE is a string to show in the mode line when this method is active. +DESCRIPTION is a string describing this method and what it is good for. +The ARGS, if any, are passed as arguments to ACTIVATE-FUNC. +All told, the arguments to ACTIVATE-FUNC are INPUT-METHOD and the ARGS. + +This function is mainly used in the file \"leim-list.el\" which is +created at building time of emacs, registering all quail input methods +contained in the emacs distribution. + +In case you want to register a new quail input method by yourself, be +careful to use the same input method title as given in the third +parameter of `quail-define-package' (if the values are different, the +string specified in this function takes precedence). + +The commands `describe-input-method' and `list-input-methods' need +this duplicated values to show some information about input methods +without loading the affected quail packages." + (if (symbolp lang-env) + (setq lang-env (symbol-name lang-env))) (if (symbolp input-method) (setq input-method (symbol-name input-method))) - (let ((info (cons language-name args)) + (let ((info (cons lang-env args)) (slot (assoc input-method input-method-alist))) (if slot (setcdr slot info) @@ -387,30 +789,41 @@ ;; This binding is necessary because input-method-history is ;; buffer local. (input-method (completing-read prompt input-method-alist - nil t nil 'input-method-history) - ;;default) - )) + nil t nil 'input-method-history + default))) + (if (and input-method (symbolp input-method)) + (setq input-method (symbol-name input-method))) (if (> (length input-method) 0) input-method (if inhibit-null (error "No valid input method is specified"))))) (defun activate-input-method (input-method) - "Turn INPUT-METHOD on. -If some input method is already on, turn it off at first." - (if (symbolp input-method) + "Switch to input method INPUT-METHOD for the current buffer. +If some other input method is already active, turn it off first. +If INPUT-METHOD is nil, deactivate any current input method." + (if (and input-method (symbolp input-method)) (setq input-method (symbol-name input-method))) (if (and current-input-method (not (string= current-input-method input-method))) - (inactivate-input-method)) - (unless current-input-method + (inactivate-input-method)) + (unless (or current-input-method (null input-method)) (let ((slot (assoc input-method input-method-alist))) (if (null slot) (error "Can't activate input method `%s'" input-method)) - (apply (nth 2 slot) input-method (nthcdr 5 slot)) + (let ((func (nth 2 slot))) + (if (functionp func) + (apply (nth 2 slot) input-method (nthcdr 5 slot)) + (if (and (consp func) (symbolp (car func)) (symbolp (cdr func))) + (progn + (require (cdr func)) + (apply (car func) input-method (nthcdr 5 slot))) + (error "Can't activate input method `%s'" input-method)))) (setq current-input-method input-method) (setq current-input-method-title (nth 3 slot)) - (run-hooks 'input-method-activate-hook)))) + (unwind-protect + (run-hooks 'input-method-activate-hook) + (force-mode-line-update))))) (defun inactivate-input-method () "Turn off the current input method." @@ -426,12 +839,12 @@ (unwind-protect (run-hooks 'input-method-inactivate-hook) (setq current-input-method nil - current-input-method-title nil))))) + current-input-method-title nil) + (force-mode-line-update))))) -(defun select-input-method (input-method) - "Select and turn on INPUT-METHOD. -This sets the default input method to what you specify, -and turn it on for the current buffer." +(defun set-input-method (input-method) + "Select and activate input method INPUT-METHOD for the current buffer. +This also sets the default input method to the one you specify." (interactive (let* ((default (or (car input-method-history) default-input-method))) (list (read-input-method-name @@ -443,28 +856,35 @@ (defun toggle-input-method (&optional arg) "Turn on or off a multilingual text input method for the current buffer. -With arg, read an input method from minibuffer and turn it on. +With no prefix argument, if an input method is currently activated, +turn it off. Otherwise, activate an input method -- the one most +recently used, or the one specified in `default-input-method', or +the one read from the minibuffer. -Without arg, if some input method is currently activated, turn it off, -else turn on an input method selected last time -or the default input method (see `default-input-method'). +With a prefix argument, read an input method from the minibuffer and +turn it on. -When there's no input method to turn on, turn on what read from minibuffer." +The default is to use the most recent input method specified +\(not including the currently active input method, if any)." (interactive "P") - (let* ((default (or (car input-method-history) default-input-method))) - (if (and current-input-method (not arg)) - (inactivate-input-method) + (if (and current-input-method (not arg)) + (inactivate-input-method) + (let ((default (or (car input-method-history) default-input-method))) + (if (and arg default (equal current-input-method default) + (> (length input-method-history) 1)) + (setq default (nth 1 input-method-history))) (activate-input-method (if (or arg (not default)) - (read-input-method-name - (if default "Input method (default %s): " "Input method: " ) - default t) + (progn + (read-input-method-name + (if default "Input method (default %s): " "Input method: " ) + default t)) default)) (or default-input-method (setq default-input-method current-input-method))))) (defun describe-input-method (input-method) - "Describe input method INPUT-METHOD." + "Describe input method INPUT-METHOD." (interactive (list (read-input-method-name "Describe input method (default, current choice): "))) @@ -484,12 +904,11 @@ (fboundp describe-current-input-method-function)) (funcall describe-current-input-method-function) (message "No way to describe the current input method `%s'" - (cdr current-input-method)) + current-input-method) (ding)) (error "No input method is activated now"))) -(defun read-multilingual-string (prompt &optional initial-input - input-method) +(defun read-multilingual-string (prompt &optional initial-input input-method) "Read a multilingual string from minibuffer, prompting with string PROMPT. The input method selected last time is activated in minibuffer. If optional second arg INITIAL-INPUT is non-nil, insert it in the minibuffer @@ -499,37 +918,51 @@ or a string." (setq input-method (or input-method + current-input-method default-input-method (read-input-method-name "Input method: " nil t))) (if (and input-method (symbolp input-method)) (setq input-method (symbol-name input-method))) - (let ((current-input-method input-method)) - ;; FSFmacs - ;; (read-string prompt initial-input nil nil t))) - (read-string prompt initial-input nil))) + (let ((prev-input-method current-input-method)) + (unwind-protect + (progn + (activate-input-method input-method) + ;; FSF Emacs + ;; (read-string prompt initial-input nil nil t) + (read-string prompt initial-input nil)) + (activate-input-method prev-input-method)))) ;; Variables to control behavior of input methods. All input methods ;; should react to these variables. -(defcustom input-method-verbose-flag t - "*If this flag is non-nil, input methods give extra guidance. +(defcustom input-method-verbose-flag 'default + "*A flag to control extra guidance given by input methods. +The value should be nil, t, `complex-only', or `default'. The extra guidance is done by showing list of available keys in echo -area. +area. When you use the input method in the minibuffer, the guidance +is shown at the bottom short window (split from the existing window). + +If the value is t, extra guidance is always given, if the value is +nil, extra guidance is always suppressed. -For complex input methods such as `chinese-py' and `japanese', -when you use the input method in the minibuffer, the guidance is -shown at the bottom short window (split from the existing window). -For simple input methods, guidance is not shown -when you are in the minibuffer." - :type 'boolean +If the value is `complex-only', only complex input methods such as +`chinese-py' and `japanese' give extra guidance. + +If the value is `default', complex input methods always give extra +guidance, but simple input methods give it only when you are not in +the minibuffer. + +See also the variable `input-method-highlight-flag'." + :type '(choice (const t) (const nil) (const complex-only) (const default)) :group 'mule) (defcustom input-method-highlight-flag t "*If this flag is non-nil, input methods highlight partially-entered text. For instance, while you are in the middle of a Quail input method sequence, the text inserted so far is temporarily underlined. -The underlining goes away when you finish or abort the input method sequence." +The underlining goes away when you finish or abort the input method sequence. +See also the variable `input-method-verbose-flag'." :type 'boolean :group 'mule) @@ -543,22 +976,53 @@ "Normal hook run just after an input method is inactivated. The variable `current-input-method' still keeps the input method name -just inacitvated.") +just inactivated.") (defvar input-method-after-insert-chunk-hook nil "Normal hook run just after an input method insert some chunk of text.") +(defvar input-method-exit-on-first-char nil + "This flag controls a timing when an input method returns. +Usually, the input method does not return while there's a possibility +that it may find a different translation if a user types another key. +But, it this flag is non-nil, the input method returns as soon as +the current key sequence gets long enough to have some valid translation.") + +(defvar input-method-use-echo-area nil + "This flag controls how an input method shows an intermediate key sequence. +Usually, the input method inserts the intermediate key sequence, +or candidate translations corresponding to the sequence, +at point in the current buffer. +But, if this flag is non-nil, it displays them in echo area instead.") + (defvar input-method-exit-on-invalid-key nil "This flag controls the behaviour of an input method on invalid key input. Usually, when a user types a key which doesn't start any character handled by the input method, the key is handled by turning off the -input method temporalily. After the key is handled, the input method is -back on. +input method temporarily. After that key, the input method is re-enabled. But, if this flag is non-nil, the input method is never back on.") +(defvar set-language-environment-hook nil + "Normal hook run after some language environment is set. + +When you set some hook function here, that effect usually should not +be inherited to another language environment. So, you had better set +another function in `exit-language-environment-hook' (which see) to +cancel the effect.") + +(defvar exit-language-environment-hook nil + "Normal hook run after exiting from some language environment. +When this hook is run, the variable `current-language-environment' +is still bound to the language environment being exited. + +This hook is mainly used for canceling the effect of +`set-language-environment-hook' (which-see).") + +(put 'setup-specified-language-environment 'apropos-inhibit t) + (defun setup-specified-language-environment () - "Set up multi-lingual environment convenient for the specified language." + "Switch to a specified language environment." (interactive) (let (language-name) (if (and (symbolp last-command-event) @@ -568,30 +1032,246 @@ (set-language-environment language-name) (error "Bogus calling sequence")))) -(defvar current-language-environment "English" - "The last language environment specified with `set-language-environment'.") +(defcustom current-language-environment "English" + "The last language environment specified with `set-language-environment'. +This variable should be set only with \\[customize], which is equivalent +to using the function `set-language-environment'." + :link '(custom-manual "(emacs)Language Environments") + :set (lambda (symbol value) (set-language-environment value)) + :get (lambda (x) + (or (car-safe (assoc-ignore-case + (if (symbolp current-language-environment) + (symbol-name current-language-environment) + current-language-environment) + language-info-alist)) + "English")) + :type (cons 'choice (mapcar (lambda (lang) + (list 'const (car lang))) + language-info-alist)) + :initialize 'custom-initialize-default + :group 'mule + :type 'string) + +(defun reset-language-environment () + "Reset multilingual environment of Emacs to the default status. + +The default status is as follows: + + The default value of buffer-file-coding-system is nil. + The default coding system for process I/O is nil. + The default value for the command `set-terminal-coding-system' is nil. + The default value for the command `set-keyboard-coding-system' is nil. + + The order of priorities of coding categories and the coding system + bound to each category are as follows + coding category coding system + -------------------------------------------------- + iso-8-2 iso-8859-1 + iso-8-1 iso-8859-1 + iso-7 iso-2022-7bit + iso-lock-shift iso-2022-lock + iso-8-designate iso-2022-8bit-ss2 + no-conversion raw-text + shift-jis shift_jis + big5 big5 + ucs-4 ---- + utf-8 ---- +" + (interactive) + ;; This function formerly set default-enable-multibyte-characters to t, + ;; but that is incorrect. It should not alter the unibyte/multibyte choice. + + (set-coding-category-system 'iso-7 'iso-2022-7bit) + (set-coding-category-system 'iso-8-1 'iso-8859-1) + (set-coding-category-system 'iso-8-2 'iso-8859-1) + (set-coding-category-system 'iso-lock-shift 'iso-2022-lock) + (set-coding-category-system 'iso-8-designate 'iso-2022-8bit-ss2) + (set-coding-category-system 'no-conversion 'raw-text) + (set-coding-category-system 'shift-jis 'shift_jis) + (set-coding-category-system 'big5 'big5) + (cond ((eq (coding-system-type (coding-category-system 'utf-8)) 'utf-8) + (set-coding-category-system 'ucs-4 'iso-10646-ucs-4) + (set-coding-category-system 'utf-8 'utf-8) + (set-coding-priority-list + '(iso-8-1 + iso-8-2 + iso-7 + iso-lock-shift + iso-8-designate + utf-8 + ucs-4 + no-conversion + shift-jis + big5)) + ) + (t + (set-coding-priority-list + '(iso-8-1 + iso-8-2 + iso-7 + iso-lock-shift + iso-8-designate + no-conversion + shift-jis + big5)) + )) + + ;; (update-coding-systems-internal) + + (set-default-coding-systems nil) + ;; Don't alter the terminal and keyboard coding systems here. + ;; The terminal still supports the same coding system + ;; that it supported a minute ago. +;;; (set-terminal-coding-system-internal nil) +;;; (set-keyboard-coding-system-internal nil) + + ;; (setq nonascii-translation-table nil + ;; nonascii-insert-offset 0) + ) (defun set-language-environment (language-name) "Set up multi-lingual environment for using LANGUAGE-NAME. This sets the coding system priority and the default input method -and sometimes other things." - (interactive (list (read-language-name 'setup-function - "Set language environment: "))) +and sometimes other things. LANGUAGE-NAME should be a string +which is the name of a language environment. For example, \"Latin-1\" +specifies the character set for the major languages of Western Europe." + (interactive (list (read-language-name + nil + "Set language environment (default, English): "))) (if language-name (if (symbolp language-name) (setq language-name (symbol-name language-name))) (setq language-name "English")) - (if (null (get-language-info language-name 'setup-function)) + (or (assoc-ignore-case language-name language-info-alist) (error "Language environment not defined: %S" language-name)) - (funcall (get-language-info language-name 'setup-function)) - (setq current-language-environment language-name) + (if current-language-environment + (let ((func (get-language-info current-language-environment + 'exit-function))) + (run-hooks 'exit-language-environment-hook) + (if (fboundp func) (funcall func)))) + (let ((default-eol-type (coding-system-eol-type + default-buffer-file-coding-system))) + (reset-language-environment) + + (setq current-language-environment language-name) + (set-language-environment-coding-systems language-name default-eol-type)) + (let ((input-method (get-language-info language-name 'input-method))) + (when input-method + (setq default-input-method input-method) + (if input-method-history + (setq input-method-history + (cons input-method + (delete input-method input-method-history)))))) + ;; (let ((nonascii (get-language-info language-name 'nonascii-translation)) + ;; (dos-table + ;; (if (eq window-system 'pc) + ;; (intern + ;; (concat "cp" dos-codepage "-nonascii-translation-table"))))) + ;; (cond + ;; ((char-table-p nonascii) + ;; (setq nonascii-translation-table nonascii)) + ;; ((and (eq window-system 'pc) (boundp dos-table)) + ;; ;; DOS terminals' default is to use a special non-ASCII translation + ;; ;; table as appropriate for the installed codepage. + ;; (setq nonascii-translation-table (symbol-value dos-table))) + ;; ((charsetp nonascii) + ;; (setq nonascii-insert-offset (- (make-char nonascii) 128))))) + + ;; (setq charset-origin-alist + ;; (get-language-info language-name 'charset-origin-alist)) + + ;; Unibyte setups if necessary. + ;; (unless default-enable-multibyte-characters + ;; ;; Syntax and case table. + ;; (let ((syntax (get-language-info language-name 'unibyte-syntax))) + ;; (if syntax + ;; (let ((set-case-syntax-set-multibyte nil)) + ;; (load syntax nil t)) + ;; ;; No information for syntax and case. Reset to the defaults. + ;; (let ((syntax-table (standard-syntax-table)) + ;; (case-table (standard-case-table)) + ;; (ch (if (eq window-system 'pc) 128 160))) + ;; (while (< ch 256) + ;; (modify-syntax-entry ch " " syntax-table) + ;; (aset case-table ch ch) + ;; (setq ch (1+ ch))) + ;; (set-char-table-extra-slot case-table 0 nil) + ;; (set-char-table-extra-slot case-table 1 nil) + ;; (set-char-table-extra-slot case-table 2 nil)) + ;; (set-standard-case-table (standard-case-table)) + ;; (let ((list (buffer-list))) + ;; (while list + ;; (with-current-buffer (car list) + ;; (set-case-table (standard-case-table))) + ;; (setq list (cdr list)))))) + ;; ;; Display table and coding system for terminal. + ;; (let ((coding (get-language-info language-name 'unibyte-display))) + ;; (if coding + ;; (standard-display-european-internal) + ;; (standard-display-default (if (eq window-system 'pc) 128 160) 255) + ;; (aset standard-display-table 146 nil)) + ;; (or (eq window-system 'pc) + ;; (set-terminal-coding-system coding)))) + + (let ((required-features (get-language-info language-name 'features))) + (while required-features + (require (car required-features)) + (setq required-features (cdr required-features)))) + (let ((func (get-language-info language-name 'setup-function))) + (if (fboundp func) + (funcall func))) + (run-hooks 'set-language-environment-hook) (force-mode-line-update t)) +;; (defun standard-display-european-internal () +;; ;; Actually set up direct output of non-ASCII characters. +;; (standard-display-8bit (if (eq window-system 'pc) 128 160) 255) +;; ;; Unibyte Emacs on MS-DOS wants to display all 8-bit characters with +;; ;; the native font, and codes 160 and 146 stand for something very +;; ;; different there. +;; (or (and (eq window-system 'pc) (not default-enable-multibyte-characters)) +;; (progn +;; ;; Make non-line-break space display as a plain space. +;; ;; Most X fonts do the wrong thing for code 160. +;; (aset standard-display-table 160 [32]) +;; ;; Most Windows programs send out apostrophe's as \222. Most X fonts +;; ;; don't contain a character at that position. Map it to the ASCII +;; ;; apostrophe. +;; (aset standard-display-table 146 [39])))) + +(defun set-language-environment-coding-systems (language-name + &optional eol-type) + "Do various coding system setups for language environment LANGUAGE-NAME. + +The optional arg EOL-TYPE specifies the eol-type of the default value +of buffer-file-coding-system set by this function." + (let* ((priority (get-language-info language-name 'coding-priority)) + (default-coding (car priority))) + (if priority + (let ((categories (mapcar 'coding-system-category priority)) + category checked-categories) + (set-default-coding-systems + (if (memq eol-type '(lf crlf cr unix dos mac)) + (coding-system-change-eol-conversion default-coding eol-type) + default-coding)) + ;; (setq default-sendmail-coding-system default-coding) + (while priority + (unless (memq (setq category (car categories)) checked-categories) + (set-coding-category-system category (car priority)) + (setq checked-categories (cons category checked-categories))) + (setq priority (cdr priority) + categories (cdr categories))) + (set-coding-priority-list (nreverse checked-categories)) + ;; (update-coding-systems-internal) + )))) + ;; Print all arguments with `princ', then print "\n". (defsubst princ-list (&rest args) (while args (princ (car args)) (setq args (cdr args))) (princ "\n")) +(put 'describe-specified-language-support 'apropos-inhibit t) + ;; Print a language specific information such as input methods, ;; charsets, and coding systems. This function is intended to be ;; called from the menu: @@ -611,7 +1291,7 @@ (interactive (list (read-language-name 'documentation - "Describe language environment (default, current choise): "))) + "Describe language environment (default, current choice): "))) (if (null language-name) (setq language-name current-language-environment)) (if (or (null language-name) @@ -621,8 +1301,9 @@ (setq language-name (symbol-name language-name))) (let ((doc (get-language-info language-name 'documentation))) (with-output-to-temp-buffer "*Help*" + (princ-list language-name " language environment" "\n") (if (stringp doc) - (progn + (progn (princ-list doc) (terpri))) (let ((str (get-language-info language-name 'sample-text))) @@ -631,9 +1312,15 @@ (princ "Sample text:\n") (princ-list " " str) (terpri)))) - (princ "Input methods:\n") - (let ((l input-method-alist)) - (while l + (let ((input-method (get-language-info language-name 'input-method)) + (l (copy-sequence input-method-alist))) + (princ "Input methods") + (when input-method + (princ (format " (default, %s)" input-method)) + (setq input-method (assoc input-method input-method-alist)) + (setq l (cons input-method (delete input-method l)))) + (princ ":\n") + (while l (if (string= language-name (nth 1 (car l))) (princ-list " " (car (car l)) (format " (`%s' in mode line)" (nth 3 (car l))))) @@ -656,9 +1343,14 @@ (princ ; (format " %s (`%c' in mode line):\n\t%s\n" ;; In XEmacs, `coding-system-mnemonic' returns string. (format " %s (`%s' in mode line):\n\t%s\n" - (car l) - (coding-system-mnemonic (car l)) - (coding-system-doc-string (car l)))) + (car l) + (coding-system-mnemonic (car l)) + (coding-system-doc-string (car l)))) + ;; (let ((aliases (coding-system-get (car l) 'alias-coding-systems))) + ;; (when aliases + ;; (princ "\t") + ;; (princ (cons 'alias: (cdr aliases))) + ;; (terpri))) (setq l (cdr l)))))))) ;;; Charset property @@ -678,7 +1370,7 @@ (defvar char-code-property-table (make-char-table 'generic) "Char-table containing a property list of each character code. -;; + See also the documentation of `get-char-code-property' and `put-char-code-property'") ;; (let ((plist (aref char-code-property-table char))) @@ -699,8 +1391,70 @@ (nconc plist (list propname value)))) (put-char-table char (list propname value) char-code-property-table) ))) -;; (setcar (cdr slot) value) -;; (nconc plist (list propname value)))) -;; (aset char-code-property-table char (list propname value))))) + + +;; Pretty description of encoded string + +;; Alist of ISO 2022 control code vs the corresponding mnemonic string. +;; (defvar iso-2022-control-alist +;; '((?\x1b . "ESC") +;; (?\x0e . "SO") +;; (?\x0f . "SI") +;; (?\x8e . "SS2") +;; (?\x8f . "SS3") +;; (?\x9b . "CSI"))) + +;; (defun encoded-string-description (str coding-system) +;; "Return a pretty description of STR that is encoded by CODING-SYSTEM." +;; (setq str (string-as-unibyte str)) +;; (let ((char (aref str 0)) +;; desc) +;; (when (< char 128) +;; (setq desc (or (cdr (assq char iso-2022-control-alist)) +;; (char-to-string char))) +;; (let ((i 1) +;; (len (length str))) +;; (while (< i len) +;; (setq char (aref str i)) +;; (if (>= char 128) +;; (setq desc nil i len) +;; (setq desc (concat desc " " +;; (or (cdr (assq char iso-2022-control-alist)) +;; (char-to-string char))) +;; i (1+ i)))))) +;; (or desc +;; (mapconcat (function (lambda (x) (format "0x%02x" x))) str " ")))) + +;; (defun encode-coding-char (char coding-system) +;; "Encode CHAR by CODING-SYSTEM and return the resulting string. +;; If CODING-SYSTEM can't safely encode CHAR, return nil." +;; (if (cmpcharp char) +;; (setq char (car (decompose-composite-char char 'list)))) +;; (let ((str1 (char-to-string char)) +;; (str2 (make-string 2 char)) +;; (safe-charsets (and coding-system +;; (coding-system-get coding-system 'safe-charsets))) +;; enc1 enc2 i1 i2) +;; (when (or (eq safe-charsets t) +;; (memq (char-charset char) safe-charsets)) +;; ;; We must find the encoded string of CHAR. But, just encoding +;; ;; CHAR will put extra control sequences (usually to designate +;; ;; ASCII charset) at the tail if type of CODING is ISO 2022. +;; ;; To exclude such tailing bytes, we at first encode one-char +;; ;; string and two-char string, then check how many bytes at the +;; ;; tail of both encoded strings are the same. +;; +;; (setq enc1 (string-as-unibyte (encode-coding-string str1 coding-system)) +;; i1 (length enc1) +;; enc2 (string-as-unibyte (encode-coding-string str2 coding-system)) +;; i2 (length enc2)) +;; (while (and (> i1 0) (= (aref enc1 (1- i1)) (aref enc2 (1- i2)))) +;; (setq i1 (1- i1) i2 (1- i2))) +;; +;; ;; Now (substring enc1 i1) and (substring enc2 i2) are the same, +;; ;; and they are the extra control sequences at the tail to +;; ;; exclude. +;; (substring enc2 0 i2)))) + ;;; mule-cmds.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/mule-files.el --- a/lisp/mule/mule-files.el Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -;;; mule-files.el --- File I/O functions for XEmacs/Mule. - -;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc. -;; Copyright (C) 1995 Amdahl Corporation. -;; Copyright (C) 1995 Sun Microsystems. - -;; This file is part of XEmacs. - -;; XEmacs is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; XEmacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Derived from mule.el in the original Mule but heavily modified -;;; by Ben Wing. Mostly moved to code-files.el - -;; 1997/3/11 modified by MORIOKA Tomohiko to sync with Emacs 20 API. - -;;; Code: - -(setq-default buffer-file-coding-system 'iso-2022-8) - -;;; mule-files.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/mule-help.el --- a/lisp/mule/mule-help.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/mule/mule-help.el Mon Aug 13 11:13:30 2007 +0200 @@ -2,8 +2,8 @@ ;; Copyright (C) 1997 by Free Software Foundation, Inc. -;; Author: SL Baur -;; Keywords: help, internal +;; Author: SL Baur +;; Keywords: help, internal, mule ;; This file is part of XEmacs. @@ -57,7 +57,9 @@ (setq buffer-file-name file) (setq default-directory (expand-file-name "~/")) (setq buffer-auto-save-file-name nil) - (insert-file-contents (locate-data-file filename)) + (let ((coding-system-for-read + (get-language-info lang 'tutorial-coding-system))) + (insert-file-contents (locate-data-file filename))) (goto-char (point-min)) ;; The 'didactic' blank lines: Possibly insert blank lines ;; around <>, and change << >> to [ ]. @@ -83,4 +85,4 @@ (provide 'mule-help) -;;; mule-help.el ends here \ No newline at end of file +;;; mule-help.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/mule-init.el --- a/lisp/mule/mule-init.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/mule/mule-init.el Mon Aug 13 11:13:30 2007 +0200 @@ -116,7 +116,7 @@ (setenv "LC_MESSAGES" "C") (setenv "LC_TIME" "C")))) - ;; Register avairable input methods by loading LEIM list file. + ;; Register available input methods by loading LEIM list file. (load "leim-list.el" 'noerror 'nomessage 'nosuffix) ) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/mule-misc.el --- a/lisp/mule/mule-misc.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/mule/mule-misc.el Mon Aug 13 11:13:30 2007 +0200 @@ -1,6 +1,6 @@ ;; mule-misc.el --- Miscellaneous Mule functions. -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. +;; Copyright (C) 1995,1999 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. ;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc. ;; Copyright (C) 1995 Amdahl Corporation. @@ -64,7 +64,7 @@ (len (length string)) (i 0)) (while (< i len) - (setq col (+ col (charset-columns (char-charset (aref string i))))) + (setq col (+ col (charset-width (char-charset (aref string i))))) (setq i (1+ i))) col)) @@ -163,20 +163,18 @@ (defalias 'sref 'aref) (defalias 'map-char-concat 'mapcar) (defun char-bytes (character) - "Return number of length a CHARACTER occupies in a string or buffer. -It returns only 1 in XEmacs. It is for compatibility with MULE 2.3." + "Return number of bytes a CHARACTER occupies in a string or buffer. +It always returns 1 in XEmacs. It is for compatibility with MULE 2.3." 1) (defalias 'char-length 'char-bytes) (defun char-width (character) "Return number of columns a CHARACTER occupies when displayed." - (charset-columns (char-charset character))) + (charset-width (char-charset character))) (defalias 'char-columns 'char-width) (make-obsolete 'char-columns 'char-width) -(defalias 'charset-description 'charset-doc-string) - (defalias 'find-charset-string 'charsets-in-string) (defalias 'find-charset-region 'charsets-in-region) @@ -192,23 +190,34 @@ because its `find-charset-string' ignores ASCII charset." (delq 'ascii (charsets-in-region start end))) -(defun split-char (char) - "Return list of charset and one or two position-codes of CHAR." - (let ((charset (char-charset char))) - (if (eq charset 'ascii) - (list charset (char-int char)) - (let ((i 0) - (len (charset-dimension charset)) - (code (if (integerp char) - char - (char-int char))) - dest) - (while (< i len) - (setq dest (cons (logand code 127) dest) - code (lsh code -7) - i (1+ i))) - (cons charset dest) - )))) +;(defun split-char (char) +; "Return list of charset and one or two position-codes of CHAR." +; (let ((charset (char-charset char))) +; (if (eq charset 'ascii) +; (list charset (char-int char)) +; (let ((i 0) +; (len (charset-dimension charset)) +; (code (if (integerp char) +; char +; (char-int char))) +; dest) +; (while (< i len) +; (setq dest (cons (logand code 127) dest) +; code (lsh code -7) +; i (1+ i))) +; (cons charset dest) +; )))) + +;(defun split-char-or-char-int (char) +; "Return list of charset and one or two position-codes of CHAR. +;CHAR must be character or integer." +; (if (characterp char) +; (split-char char) +; (let ((c (int-char char))) +; (if c +; (split-char c) +; (list 'ascii c) +; )))) ;;; Commands @@ -292,4 +301,60 @@ ;; (put env-sym 'quail-environ-doc-string doc-string) ;; (put env-sym 'set-quail-environ enable-function)) + +;;; @ coding-system category +;;; + +(defun coding-system-get (coding-system prop) + "Extract a value from CODING-SYSTEM's property list for property PROP." + (or (plist-get + (get (coding-system-name coding-system) 'coding-system-property) + prop) + (condition-case nil + (coding-system-property coding-system prop) + (error nil)))) + +(defun coding-system-put (coding-system prop val) + "Change value in CODING-SYSTEM's property list PROP to VAL." + (put (coding-system-name coding-system) + 'coding-system-property + (plist-put (get (coding-system-name coding-system) + 'coding-system-property) + prop val))) + +(defun coding-system-category (coding-system) + "Return the coding category of CODING-SYSTEM." + (or (coding-system-get coding-system 'category) + (let ((type (coding-system-type coding-system))) + (cond ((eq type 'no-conversion) + 'no-conversion) + ((eq type 'shift-jis) + 'shift-jis) + ((eq type 'ucs-4) + 'ucs-4) + ((eq type 'utf-8) + 'utf-8) + ((eq type 'big5) + 'big5) + ((eq type 'iso2022) + (cond ((coding-system-lock-shift coding-system) + 'iso-lock-shift) + ((coding-system-seven coding-system) + 'iso-7) + (t + (let ((dim 0) + ccs + (i 0)) + (while (< i 4) + (setq ccs (coding-system-charset coding-system i)) + (if (and ccs + (> (charset-dimension ccs) dim)) + (setq dim (charset-dimension ccs)) + ) + (setq i (1+ i))) + (cond ((= dim 1) 'iso-8-1) + ((= dim 2) 'iso-8-2) + (t 'iso-8-designate)) + )))))))) + ;;; mule-misc.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/mule-x-init.el --- a/lisp/mule/mule-x-init.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/mule/mule-x-init.el Mon Aug 13 11:13:30 2007 +0200 @@ -1,6 +1,6 @@ ;;; mule-x-init.el --- initialization code for X Windows under MULE ;; Copyright (C) 1994 Free Software Foundation, Inc. -;; Copyright (C) 1996 Ben Wing +;; Copyright (C) 1996 Ben Wing ;; Author: various ;; Keywords: mule X11 diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/thai-xtis-chars.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mule/thai-xtis-chars.el Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,45 @@ +;;; thai-xtis-chars.el --- definition of the Thai XTIS charset. + +;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN. +;; Licensed to the Free Software Foundation. + +;; Author: MORIOKA Tomohiko + +;; Keywords: mule, multilingual, Thai, XTIS + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Commentary: + +;; For Thai, the pre-composed character set proposed by +;; Virach Sornlertlamvanich is supported. + +;;; Code: + +(make-charset 'thai-xtis "Precomposed Thai (XTIS by Virach)." + '(registry "xtis-0" + dimension 2 + columns 1 + chars 94 + final ?? + graphic 0)) + +(define-category ?x "Precomposed Thai character.") +(modify-category-entry 'thai-xtis ?x) + +;; thai-xtis-chars.el ends here. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/thai-xtis.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mule/thai-xtis.el Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,365 @@ +;;; thai-xtis.el --- Support for Thai (XTIS) -*- coding: iso-2022-7bit; -*- + +;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN. +;; Licensed to the Free Software Foundation. + +;; Author: TAKAHASHI Naoto +;; MORIOKA Tomohiko +;; Created: 1998-03-27 for Emacs-20.3 by TAKAHASHI Naoto +;; 1999-03-29 imported and modified for XEmacs by MORIOKA Tomohiko + +;; Keywords: mule, multilingual, Thai, XTIS + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Commentary: + +;; For Thai, the pre-composed character set proposed by +;; Virach Sornlertlamvanich is supported. + +;;; Code: + +(when (featurep 'xemacs) + (let ((deflist '(;; chars syntax + ("$(?!0(B-$(?NxP0R0S0`0(B-$(?e0(B" "w") + ("$(?p0(B-$(?y0(B" "w") + ("$(?O0f0_0o0z0{0(B" "_") + )) + elm chars len syntax to ch i) + (while deflist + (setq elm (car deflist)) + (setq chars (car elm) + len (length chars) + syntax (nth 1 elm) + i 0) + (while (< i len) + (if (= (aref chars i) ?-) + (setq i (1+ i) + to (nth 1 (split-char (aref chars i)))) + (setq ch (nth 1 (split-char (aref chars i))) + to ch)) + (while (<= ch to) + (modify-syntax-entry (vector 'thai-xtis ch) syntax) + (setq ch (1+ ch))) + (setq i (1+ i))) + (setq deflist (cdr deflist)))) + + (put-charset-property 'thai-xtis 'preferred-coding-system 'tis-620) + ) + +;; This is the ccl-decode-thai-xtis automaton. +;; +;; "WRITE x y" == (insert (make-char 'thai-xtis x y)) +;; "write x" == (insert x) +;; rx' == (tis620-to-thai-xtis-second-byte-bitpattern rx) +;; r3 == "no vower nor tone" +;; r4 == (charset-id 'thai-xtis) +;; +;; | input (= r0) +;; state |-------------------------------------------- +;; | consonant | vowel | tone +;; ---------+-------------+-------------+---------------- +;; r1 == 0 | r1 = r0 | WRITE r0,r3 | WRITE r0,r3 +;; r2 == 0 | | | +;; ---------+-------------+-------------+---------------- +;; r1 == C | WRITE r1,r3 | r2 = r0' | WRITE r1,r3|r0' +;; r2 == 0 | r1 = r0 | | r1 = 0 +;; ---------+-------------+-------------+---------------- +;; r1 == C | WRITE r1,r2 | WRITE r1,r2 | WRITE r1,r2|r0' +;; r2 == V | r1 = r0 | WRITE r0,r3 | r1 = r2 = 0 +;; | r2 = 0 | r1 = r2 = 0 | +;; +;; +;; | input (= r0) +;; state |----------------------------------------- +;; | symbol | ASCII | EOF +;; ---------+-------------+-------------+------------- +;; r1 == 0 | WRITE r0,r3 | write r0 | +;; r2 == 0 | | | +;; ---------+-------------+-------------+------------- +;; r1 == C | WRITE r1,r3 | WRITE r1,r3 | WRITE r1,r3 +;; r2 == 0 | WRITE r0,r3 | write r0 | +;; | r1 = 0 | r1 = 0 | +;; ---------+-------------+-------------+------------- +;; r1 == C | WRITE r1,r2 | WRITE r1,r2 | WRITE r1,r2 +;; r2 == V | WRITE r0,r3 | write r0 | +;; | r1 = r2 = 0 | r1 = r2 = 0 | + + +(eval-and-compile + +;; input : r5 = 1st byte, r6 = 2nd byte +;; Their values will be destroyed. +(define-ccl-program ccl-thai-xtis-write + '(0 + ((r5 = ((r5 & #x7F) << 7)) + (r6 = ((r6 & #x7F) | r5)) + (write-multibyte-character r4 r6)))) + +(define-ccl-program ccl-thai-xtis-consonant + '(0 + (if (r1 == 0) + (r1 = r0) + (if (r2 == 0) + ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write) + (r1 = r0)) + ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) + (r1 = r0) + (r2 = 0)))))) + +(define-ccl-program ccl-thai-xtis-vowel + '(0 + ((if (r1 == 0) + ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)) + ((if (r2 == 0) + (r2 = ((r0 - 204) << 3)) + ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) + (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write) + (r1 = 0) + (r2 = 0)))))))) + +(define-ccl-program ccl-thai-xtis-vowel-d1 + '(0 + ((if (r1 == 0) + ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)) + ((if (r2 == 0) + (r2 = #x38) + ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) + (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write) + (r1 = 0) + (r2 = 0)))))))) + +(define-ccl-program ccl-thai-xtis-vowel-ee + '(0 + ((if (r1 == 0) + ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)) + ((if (r2 == 0) + (r2 = #x78) + ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) + (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write) + (r1 = 0) + (r2 = 0)))))))) + +(define-ccl-program ccl-thai-xtis-tone + '(0 + (if (r1 == 0) + ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)) + (if (r2 == 0) + ((r5 = r1) (r6 = ((r0 - #xE6) | r3)) (call ccl-thai-xtis-write) + (r1 = 0)) + ((r5 = r1) (r6 = ((r0 - #xE6) | r2)) (call ccl-thai-xtis-write) + (r1 = 0) + (r2 = 0)))))) + +(define-ccl-program ccl-thai-xtis-symbol + '(0 + (if (r1 == 0) + ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)) + (if (r2 == 0) + ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write) + (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write) + (r1 = 0)) + ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) + (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write) + (r1 = 0) + (r2 = 0)))))) + +(define-ccl-program ccl-thai-xtis-ascii + '(0 + (if (r1 == 0) + (write r0) + (if (r2 == 0) + ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write) + (write r0) + (r1 = 0)) + ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write) + (write r0) + (r1 = 0) + (r2 = 0)))))) + +(define-ccl-program ccl-thai-xtis-eof + '(0 + (if (r1 != 0) + (if (r2 == 0) + ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write)) + ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)))))) + +(define-ccl-program ccl-decode-thai-xtis + `(4 + ((read r0) + (r1 = 0) + (r2 = 0) + (r3 = #x30) + (r4 = ,(charset-id 'thai-xtis)) + (loop + (if (r0 < 161) + (call ccl-thai-xtis-ascii) + (branch (r0 - 161) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-consonant) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-vowel-d1) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-vowel) + (call ccl-thai-xtis-vowel) + (call ccl-thai-xtis-vowel) + (call ccl-thai-xtis-vowel) + (call ccl-thai-xtis-vowel) + (call ccl-thai-xtis-vowel) + (call ccl-thai-xtis-vowel) + nil + nil + nil + nil + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-tone) + (call ccl-thai-xtis-tone) + (call ccl-thai-xtis-tone) + (call ccl-thai-xtis-tone) + (call ccl-thai-xtis-tone) + (call ccl-thai-xtis-tone) + (call ccl-thai-xtis-tone) + (call ccl-thai-xtis-vowel-ee) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-symbol) + (call ccl-thai-xtis-symbol) + nil + nil + nil)) + (read r0) + (repeat))) + + (call ccl-thai-xtis-eof))) + +) + +(defconst leading-code-private-21 #x9F) + +(define-ccl-program ccl-encode-thai-xtis + `(1 + ((read r0) + (loop + (if (r0 == ,leading-code-private-21) + ((read r1) + (if (r1 == ,(charset-id 'thai-xtis)) + ((read r0) + (write r0) + (read r0) + (r1 = (r0 & 7)) + (r0 = ((r0 - #xB0) >> 3)) + (if (r0 != 0) + (write r0 [0 209 212 213 214 215 216 217 218 238])) + (if (r1 != 0) + (write r1 [0 231 232 233 234 235 236 237])) + (read r0) + (repeat)) + ((write r0 r1) + (read r0) + (repeat)))) + (write-read-repeat r0)))))) + +(if (featurep 'xemacs) + (progn + (make-coding-system + 'tis-620 'ccl + "external=tis620, internal=thai-xtis" + `(mnemonic "TIS620" + decode ,ccl-decode-thai-xtis + encode ,ccl-encode-thai-xtis)) + (coding-system-put 'tis-620 'category 'iso-8-1)) + (make-coding-system + 'tis-620 4 ?T "external=tis620, internal=thai-xtis" + '(ccl-decode-thai-xtis . ccl-encode-thai-xtis) + '((safe-charsets . t))) + ) + + +(set-language-info-alist + "Thai-XTIS" + '((charset thai-xtis) + (coding-system tis-620 iso-2022-7bit) + (tutorial . "TUTORIAL.th") + (tutorial-coding-system . tis-620) + (coding-priority tis-620 iso-2022-7bit) + (sample-text . "$(?!:(B") + (documentation . t))) + +;; thai-xtis.el ends here. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/mule/vietnamese.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mule/vietnamese.el Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,298 @@ +;;; vietnamese.el --- Support for Vietnamese -*- coding: iso-2022-7bit; -*- + +;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. +;; Licensed to the Free Software Foundation. +;; Copyright (C) 1997 MORIOKA Tomohiko + +;; Keywords: multilingual, Vietnamese + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Commentary: + +;; For Vietnames, the character sets VISCII and VSCII are supported. + +;;; Code: + +(eval-and-compile + +(defvar viet-viscii-decode-table + [;; VISCII is a full 8-bit code. + 0 1 ?,2F(B 3 4 ?,2G(B ?,2g(B 7 8 9 10 11 12 13 14 15 + 16 17 18 19 ?,2V(B 21 22 23 24 ?,2[(B 26 27 28 29 ?,2\(B 31 + 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 + 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 + 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 + 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 + 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 + 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 + ?,2U(B ?,2!(B ?,2"(B ?,2#(B ?,2$(B ?,2%(B ?,2&(B ?,2'(B ?,2((B ?,2)(B ?,2*(B ?,2+(B ?,2,(B ?,2-(B ?,2.(B ?,2/(B + ?,20(B ?,21(B ?,22(B ?,25(B ?,2~(B ?,2>(B ?,26(B ?,27(B ?,28(B ?,2v(B ?,2w(B ?,2o(B ?,2|(B ?,2{(B ?,2x(B ?,2O(B + ?,2u(B ?,1!(B ?,1"(B ?,1#(B ?,1$(B ?,1%(B ?,1&(B ?,1'(B ?,1((B ?,1)(B ?,1*(B ?,1+(B ?,1,(B ?,1-(B ?,1.(B ?,1/(B + ?,10(B ?,11(B ?,12(B ?,2^(B ?,2=(B ?,15(B ?,16(B ?,17(B ?,18(B ?,2q(B ?,2Q(B ?,2W(B ?,2X(B ?,1=(B ?,1>(B ?,2_(B + ?,2`(B ?,2a(B ?,2b(B ?,2c(B ?,2d(B ?,2e(B ?,1F(B ?,1G(B ?,2h(B ?,2i(B ?,2j(B ?,2k(B ?,2l(B ?,2m(B ?,2n(B ?,1O(B + ?,2p(B ?,1Q(B ?,2r(B ?,2s(B ?,2t(B ?,1U(B ?,1V(B ?,1W(B ?,1X(B ?,2y(B ?,2z(B ?,1[(B ?,1\(B ?,2}(B ?,1^(B ?,1_(B + ?,1`(B ?,1a(B ?,1b(B ?,1c(B ?,1d(B ?,1e(B ?,1f(B ?,1g(B ?,1h(B ?,1i(B ?,1j(B ?,1k(B ?,1l(B ?,1m(B ?,1n(B ?,1o(B + ?,1p(B ?,1q(B ?,1r(B ?,1s(B ?,1t(B ?,1u(B ?,1v(B ?,1w(B ?,1x(B ?,1y(B ?,1z(B ?,1{(B ?,1|(B ?,1}(B ?,1~(B ?,2f(B ] + "Vietnamese VISCII decoding table.") + +(defvar viet-viscii-encode-table + (let ((table-lower (make-vector 128 0)) + (table-upper (make-vector 128 0)) + (i 0) + char-component) + (while (< i 256) + (setq char-component + (split-char (aref viet-viscii-decode-table i))) + (cond ((eq (car char-component) 'vietnamese-viscii-lower) + (aset table-lower (nth 1 char-component) i)) + ((eq (car char-component) 'vietnamese-viscii-upper) + (aset table-upper (nth 1 char-component) i))) + (setq i (1+ i))) + (cons table-lower table-upper)) + "Vietnamese VISCII encoding table. +Cons of tables for encoding lower-case chars and upper-case characters. +Both tables are indexed by the position code of Vietnamese characters.") + +(defvar viet-vscii-decode-table + [;; VSCII is a full 8-bit code. + 0 ?,2z(B ?,2x(B 3 ?,2W(B ?,2X(B ?,2f(B 7 8 9 10 11 12 13 14 15 + 16 ?,2Q(B ?,2_(B ?,2O(B ?,2V(B ?,2[(B ?,2}(B ?,2\(B 24 25 26 27 28 29 30 31 + 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 + 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 + 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 + 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 + 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 + 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 + ?,2`(B ?,2d(B ?,2c(B ?,2a(B ?,2U(B ?,2#(B ?,2'(B ?,2h(B ?,2k(B ?,2((B ?,2i(B ?,2)(B ?,2.(B ?,2l(B ?,2o(B ?,2n(B + ?,2m(B ?,28(B ?,2r(B ?,2v(B ?,2u(B ?,2s(B ?,2w(B ?,25(B ?,26(B ?,27(B ?,2^(B ?,2>(B ?,2~(B ?,2y(B ?,2|(B ?,2{(B + 160 ?,2e(B ?,2b(B ?,2j(B ?,2t(B ?,2=(B ?,2_(B ?,2p(B ?,1e(B ?,1b(B ?,1j(B ?,1t(B ?,1>(B ?,1y(B ?,1p(B ?,2"(B + 192 193 194 195 196 ?,1`(B ?,1d(B ?,1c(B ?,1a(B ?,1U(B ?,2F(B ?,1"(B ?,1F(B ?,1G(B ?,1!(B ?,2G(B + ?,2!(B ?,2%(B ?,2&(B ?,2g(B ?,2%(B ?,2+(B ?,1#(B ?,1%(B ?,1&(B ?,1g(B ?,1$(B ?,1'(B ?,1h(B ?,2,(B ?,1k(B ?,1((B + ?,1i(B ?,1)(B ?,1+(B ?,1,(B ?,1-(B ?,1*(B ?,1.(B ?,1l(B ?,1o(B ?,2-(B ?,2*(B ?,20(B ?,1n(B ?,1m(B ?,18(B ?,1r(B + ?,21(B ?,1v(B ?,1u(B ?,1s(B ?,1w(B ?,10(B ?,11(B ?,12(B ?,1/(B ?,15(B ?,16(B ?,17(B ?,1^(B ?,1>(B ?,1~(B ?,1y(B + ?,22(B ?,1|(B ?,1{(B ?,1z(B ?,1x(B ?,1W(B ?,1X(B ?,1f(B ?,1Q(B ?,1q(B ?,1O(B ?,1V(B ?,1[(B ?,1}(B ?,1\(B ?,2/(B] + "Vietnamese VSCII decoding table.") + +(defvar viet-vscii-encode-table + (let ((table-lower (make-vector 128 0)) + (table-upper (make-vector 128 0)) + (i 0) + char-component) + (while (< i 256) + (setq char-component + (split-char (aref viet-vscii-decode-table i))) + (cond ((eq (car char-component) 'vietnamese-viscii-lower) + (aset table-lower (nth 1 char-component) i)) + ((eq (car char-component) 'vietnamese-viscii-upper) + (aset table-upper (nth 1 char-component) i))) + (setq i (1+ i))) + (cons table-lower table-upper)) + "Vietnamese VSCII encoding table. +Cons of tables for encoding lower-case chars and upper-case characters. +Both tables are indexed by the position code of Vietnamese characters.") + +) + +(define-ccl-program ccl-decode-viscii + `(3 + ((read r0) + (loop + (write-read-repeat r0 ,viet-viscii-decode-table)) + )) + "CCL program to decode VISCII 1.1") + +;; Multibyte form of a Vietnamese character is as follows (3-byte): +;; LEADING-CODE-PRIVATE-11 LEADING-CODE-EXTENDED-11 POSITION-CODE +;; where LEADING-CODE-EXTENDED-11 for Vietnamese is +;; `vietnamese-viscii-lower' or `vietnamese-viscii-upper'. + +(defvar leading-code-private-11 #x9E) + +(define-ccl-program ccl-encode-viscii + `(1 + ((read r0) + (loop + (if (r0 < 128) + ;; ASCII + (write-read-repeat r0) + ;; not ASCII + (if (r0 != ,leading-code-private-11) + ;; not Vietnamese + (write-read-repeat r0) + ((read-if (r0 == ,(charset-id 'vietnamese-viscii-lower)) + (;; Vietnamese lower + (read r0) + (r0 -= 128) + (write-read-repeat r0 ,(car viet-viscii-encode-table))) + (if (r0 == ,(charset-id 'vietnamese-viscii-upper)) + (;; Vietnamese upper + (read r0) + (r0 -= 128) + (write-read-repeat r0 ,(cdr viet-viscii-encode-table))) + ;; not Vietnamese + (write-read-repeat r0))))))))) + "CCL program to encode VISCII 1.1") + +(define-ccl-program ccl-encode-viscii-font + `(0 + ;; In: R0:vietnamese-viscii-lower/vietnamese-viscii-upper + ;; R1:position code + ;; Out: R1:font code point + (if (r0 == ,(charset-id 'vietnamese-viscii-lower)) + (r1 = r1 ,(car viet-viscii-encode-table)) + (r1 = r1 ,(cdr viet-viscii-encode-table))) + ) + "CCL program to encode Vietnamese chars to VISCII 1.1 font") + +(define-ccl-program ccl-decode-vscii + `(3 + ((read r0) + (loop + (write-read-repeat r0 ,viet-vscii-decode-table)) + )) + "CCL program to decode VSCII-1.") + +(define-ccl-program ccl-encode-vscii + `(1 + ((read r0) + (loop + (if (r0 < 128) + ;; ASCII + (write-read-repeat r0) + ;; not ASCII + (if (r0 != ,leading-code-private-11) + ;; not Vietnamese + (write-read-repeat r0) + (read-if (r0 == ,(charset-id 'vietnamese-viscii-lower)) + (;; Vietnamese lower + (read r0) + (r0 -= 128) + (write-read-repeat r0 ,(car viet-vscii-encode-table))) + (if (r0 == ,(charset-id 'vietnamese-viscii-upper)) + (;; Vietnamese upper + (read r0) + (r0 -= 128) + (write-read-repeat r0 ,(cdr viet-vscii-encode-table))) + ;; not Vietnamese + (write-read-repeat r0)))))))) + "CCL program to encode VSCII-1.") + +(define-ccl-program ccl-encode-vscii-font + `(0 + ;; In: R0:vietnamese-viscii-lower/vietnamese-viscii-upper + ;; R1:position code + ;; Out: R1:font code point + (if (r0 == ,(charset-id 'vietnamese-viscii-lower)) + (r1 = r1 ,(car viet-vscii-encode-table)) + (r1 = r1 ,(cdr viet-vscii-encode-table))) + ) + "CCL program to encode Vietnamese chars to VSCII-1 font.") + + +(make-coding-system + 'viscii 'ccl + "Coding-system used for VISCII 1.1." + `(mnemonic "VISCII" + decode ,ccl-decode-viscii + encode ,ccl-encode-viscii)) + +;; it is not correct, but XEmacs doesn't have `ccl' category... +(coding-system-put 'viscii 'category 'iso-8-1) + +;; (make-coding-system +;; 'vietnamese-viscii 4 ?V +;; "8-bit encoding for Vietnamese VISCII 1.1 (MIME:VISCII)" +;; '(ccl-decode-viscii . ccl-encode-viscii) +;; '((safe-charsets ascii vietnamese-viscii-lower vietnamese-viscii-upper) +;; (mime-charset . viscii) +;; (valid-codes (0 . 255)))) + +;; (define-coding-system-alias 'viscii 'vietnamese-viscii) + +(make-coding-system + 'vscii 'ccl + "Coding-system used for VSCII 1.1." + `(mnemonic "VSCII" + decode ,ccl-decode-vscii + encode ,ccl-encode-vscii)) + +;; (make-coding-system +;; 'vietnamese-vscii 4 ?v +;; "8-bit encoding for Vietnamese VSCII-1" +;; '(ccl-decode-vscii . ccl-encode-vscii) +;; '((safe-charsets ascii vietnamese-viscii-lower vietnamese-viscii-upper) +;; (valid-codes (0 . 255)))) + +;; (define-coding-system-alias 'vscii 'vietnamese-vscii) + +(make-coding-system + 'viqr 'no-conversion + "Coding-system used for VIQR." + '(mnemonic "VIQR" + eol-type lf + post-read-conversion viqr-post-read-conversion + pre-write-conversion viqr-pre-write-conversion)) + +;; (make-coding-system +;; 'vietnamese-viqr 0 ?q +;; "Vietnamese latin transcription (VIQR)" +;; nil +;; '((safe-charsets ascii vietnamese-viscii-lower vietnamese-viscii-upper) +;; (post-read-conversion . viqr-post-read-conversion) +;; (pre-write-conversion . viqr-pre-write-conversion) +;; (charset-origin-alist +;; (vietnamese-viscii-lower "VISCII" viet-encode-viscii-char) +;; (vietnamese-viscii-upper "VISCII" viet-encode-viscii-char)))) + +;; (define-coding-system-alias 'viqr 'vietnamese-viqr) + +;; For VISCII users +(set-charset-ccl-program 'vietnamese-viscii-lower + ccl-encode-viscii-font) +(set-charset-ccl-program 'vietnamese-viscii-upper + ccl-encode-viscii-font) +;; For VSCII users +(set-charset-ccl-program 'vietnamese-viscii-lower ccl-encode-vscii-font) +(set-charset-ccl-program 'vietnamese-viscii-upper ccl-encode-vscii-font) + +;; (setq font-ccl-encoder-alist +;; (cons (cons "viscii" ccl-encode-viscii-font) font-ccl-encoder-alist)) + +;; (setq font-ccl-encoder-alist +;; (cons (cons "vscii" ccl-encode-vscii-font) font-ccl-encoder-alist)) + +;; (defvar viet-viscii-nonascii-translation-table +;; (make-translation-table-from-vector viet-viscii-decode-table) +;; "Value of `nonascii-translation-table' in Vietnamese language environment.") + +(set-language-info-alist + "Vietnamese" '((charset vietnamese-viscii-lower vietnamese-viscii-upper) + (coding-system viscii vscii viqr) + (coding-priority viscii) + (input-method . "vietnamese-viqr") + (features viet-util) + (sample-text . "Vietnamese (Ti,1*(Bng Vi,1.(Bt) Ch,1`(Bo b,1U(Bn") + (documentation . "\ +For Vietnamese, Emacs uses special charsets internally. +They can be decoded from and encoded to VISCC, VSCII, and VIQR. +Current setting put higher priority to the coding system VISCII than VSCII. +If you prefer VSCII, please do: (prefer-coding-system 'vietnamese-vscii)") + )) + +;;; vietnamese.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/obsolete.el --- a/lisp/obsolete.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/obsolete.el Mon Aug 13 11:13:30 2007 +0200 @@ -171,6 +171,10 @@ set Info-directory-list.") (make-obsolete-variable 'Info-default-directory-list 'Info-directory-list) +(defvar init-file-user nil + "This used to be the name of the user whose init file was read at startup.") +(make-obsolete-variable 'init-file-user 'load-user-init-file-p) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;; hooks (make-compatible-variable 'lisp-indent-hook 'lisp-indent-function) @@ -242,6 +246,11 @@ (define-compatible-function-alias 'byte-code-function-p 'compiled-function-p) ;FSFmacs +(define-obsolete-function-alias 'isearch-yank-x-selection + 'isearch-yank-selection) +(define-obsolete-function-alias 'isearch-yank-x-clipboard + 'isearch-yank-clipboard) + ;; too bad there's not a way to check for aref, assq, and nconc ;; being called on the values of functions known to return keymaps, ;; or known to return vectors of events instead of strings... @@ -344,7 +353,7 @@ (setq idx (1+ idx) i (1+ i))) string)) -;; ### This function is not compatible with FSF in some cases. Hard +;; #### This function is not compatible with FSF in some cases. Hard ;; to fix, because it is hard to trace the logic of the FSF function. ;; In case we need the exact behavior, we can always copy the FSF ;; version, which is very long and does lots of unnecessary stuff. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/package-admin.el --- a/lisp/package-admin.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/package-admin.el Mon Aug 13 11:13:30 2007 +0200 @@ -2,7 +2,7 @@ ;; Copyright (C) 1997 by Free Software Foundation, Inc. -;; Author: SL Baur +;; Author: SL Baur ;; Keywords: internal ;; This file is part of XEmacs. @@ -166,7 +166,7 @@ (setq autoload-dir (feature-file package-feature)) (setq autoload-dir (file-name-directory autoload-dir)) (member autoload-dir late-package-load-path)) - ;; Find the corresonding entry in late-package + ;; Find the corresponding entry in late-package (setq pkg-dir (car-safe (member-if (lambda (h) (string-match (concat "^" (regexp-quote h)) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/package-get.el --- a/lisp/package-get.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/package-get.el Mon Aug 13 11:13:30 2007 +0200 @@ -32,7 +32,7 @@ ;; Retrieve a package and any other required packages from an archive ;; ;; -;; Note (JV): Most of this no longer aplies! +;; Note (JV): Most of this no longer applies! ;; ;; The idea: ;; A new XEmacs lisp-only release is generated with the following steps: @@ -180,37 +180,56 @@ (list :tag "Remote" host-name directory) )) :group 'package-get) +;;;###autoload (defcustom package-get-download-sites '( ;; North America ("xemacs.org" "ftp.xemacs.org" "pub/xemacs/packages") - ("cso.uiuc.edu" "ftp.cso.uiuc.edu" "pub/packages/xemacs/packages") + ("crc.ca (Canada)" "ftp.crc.ca" "pub/packages/editors/xemacs/packages") + ("ualberta.ca (Canada)" "sunsite.ualberta.ca" "pub/Mirror/xemacs/packages") + ("uiuc.edu (United States)" "uiarchive.uiuc.edu" "pub/packages/xemacs/packages") + ("unc.edu (United States)" "metalab.unc.edu" "pub/packages/editors/xemacs/packages") + ("utk.edu (United States)" "ftp.sunsite.utk.edu" "pub/xemacs/packages") ;; South America - ("unicamp.br" "ftp.unicamp.br" "pub/xemacs/packages") + ("unicamp.br (Brazil)" "ftp.unicamp.br" "pub/xemacs/packages") ;; Europe - ("sunsite.cnlab-switch.ch" "sunsite.cnlab-switch.ch" "mirror/xemacs/packages") - ("tu-darmstadt.de" "ftp.tu-darmstadt.de" "pub/editors/xemacs/packages") - ("sunsite.auc.dk" "sunsite.auc.dk" "pub/emacs/xemacs/packages") - ("pasteur.fr" "ftp.pasteur.fr" "pub/computing/xemacs/packages") - ("cenatls.cena.dgac.fr" "ftp.cenatls.cena.dgac.fr" "pub/Emacs/xemacs/packages") - ("kfki.hu" "ftp.kfki.hu" "pub/packages/xemacs/packages") - ("uniroma2.it" "ftp.uniroma2.it" "unix/misc/dist/XEMACS/packages") - ("icm.edu.pl" "ftp.icm.edu.pl" "pub/unix/editors/xemacs/packages") - ("sunet.se" "ftp.sunet.se" "pub/gnu/xemacs/packages") - ("doc.ic.ac.uk" "sunsite.doc.ic.ac.uk" "packages/xemacs/packages") - ("srcc.msu.su" "ftp1.srcc.msu.su" "mirror/ftp.xemacs.org/packages") + ("tuwien.ac.at (Austria)" "gd.tuwien.ac.at" "editors/xemacs/packages") + ("auc.dk (Denmark)" "sunsite.auc.dk" "pub/emacs/xemacs/packages") + ("doc.ic.ac.uk (England)" "sunsite.doc.ic.ac.uk" "packages/xemacs/packages") + ("funet.fi (Finland)" "ftp.funet.fi" "pub/mirrors/ftp.xemacs.org/pub/tux/xemacs/packages") + ("cenatls.cena.dgac.fr (France)" "ftp.cenatls.cena.dgac.fr" "Emacs/xemacs/packages") + ("pasteur.fr (France)" "ftp.pasteur.fr" "pub/computing/xemacs/packages") + ("tu-darmstadt.de (Germany)" "ftp.tu-darmstadt.de" "pub/editors/xemacs/packages") + ("kfki.hu (Hungary)" "ftp.kfki.hu" "pub/packages/xemacs/packages") + ("eunet.ie (Ireland)" "ftp.eunet.ie" "mirrors/ftp.xemacs.org/pub/xemacs/packages") + ("uniroma2.it (Italy)" "ftp.uniroma2.it" "unix/misc/dist/XEMACS/packages") + ("uio.no (Norway)" "sunsite.uio.no" "pub/xemacs/packages") + ("icm.edu.pl (Poland)" "ftp.icm.edu.pl" "pub/unix/editors/xemacs/packages") + ("srcc.msu.su (Russia)" "ftp.srcc.msu.su" "mirror/ftp.xemacs.org/packages") + ("sunet.se (Sweden)" "ftp.sunet.se" "pub/gnu/xemacs/packages") + ("cnlab-switch.ch (Switzerland)" "sunsite.cnlab-switch.ch" "mirror/xemacs/packages") ;; Asia - ("usyd.edu.au" "ftp.usyd.edu.au" "pub/Xemacs/packages") - ("netlab.is.tsukuba.ac.jp" "ftp.netlab.is.tsukuba.ac.jp" "pub/GNU/xemacs/packages") - ("jaist.ac.jp" "ftp.jaist.ac.jp" "pub/GNU/xemacs/packages") - ("ring.aist.go.jp" "ring.aist.go.jp" "pub/text/xemacs/packages") - ("ring.asahi-net.or.jp" "ring.asahi-net.or.jp" "pub/text/xemacs/packages") - ("SunSITE.sut.ac.jp" "SunSITE.sut.ac.jp" "pub/archives/packages/xemacs/packages") - ("dti.ad.jp" "ftp.dti.ad.jp" "pub/unix/editor/xemacs/packages") - ("kreonet.re.kr" "ftp.kreonet.re.kr" "pub/tools/emacs/xemacs/packages") + ("aist.go.jp (Japan)" "ring.aist.go.jp" "pub/text/xemacs/packages") + ("asahi-net.or.jp (Japan)" "ring.asahi-net.or.jp" "pub/text/xemacs/packages") + ("dti.ad.jp (Japan)" "ftp.dti.ad.jp" "pub/unix/editor/xemacs/packages") + ("jaist.ac.jp (Japan)" "ftp.jaist.ac.jp" "pub/GNU/xemacs/packages") + ("nucba.ac.jp (Japan)" "mirror.nucba.ac.jp" "mirror/xemacs/packages") + ("sut.ac.jp (Japan)" "sunsite.sut.ac.jp" "pub/archives/packages/xemacs/packages") + ("tsukuba.ac.jp (Japan)" "ftp.netlab.is.tsukuba.ac.jp" "pub/GNU/xemacs/packages") + ("kreonet.re.kr (Korea)" "ftp.kreonet.re.kr" "pub/tools/emacs/xemacs/packages") + ("nctu.edu.tw (Taiwan)" "coda.nctu.edu.tw" "Editors/xemacs/packages") + + ;; Africa + ("sun.ac.za (South Africa)" "ftp.sun.ac.za" "xemacs/packages") + + ;; Middle East + ("isu.net.sa (Saudi Arabia)" "ftp.isu.net.sa" "pub/mirrors/ftp.xemacs.org/packages") + + ;; Australia + ("aarnet.edu.au (Australia)" "mirror.aarnet.edu.au" "pub/xemacs/packages") ) "*List of remote sites available for downloading packages. List format is '(site-description site-name directory-on-site). @@ -224,7 +243,7 @@ :group 'package-get) (defcustom package-get-remove-copy t - "*After copying and installing a package, if this is T, then remove the + "*After copying and installing a package, if this is t, then remove the copy. Otherwise, keep it around." :type 'boolean :group 'package-get) @@ -239,6 +258,10 @@ :type 'file :group 'package-get) +(defvar package-get-user-index-filename + (paths-construct-path (list user-init-directory package-get-base-filename)) + "Name for the user-specific location of the package-get database file.") + (defcustom package-get-always-update nil "*If Non-nil always make sure we are using the latest package index (base). Otherwise respect the `force-current' argument of `package-get-require-base'." @@ -261,11 +284,16 @@ (defun package-get-download-menu () "Build the `Add Download Site' menu." (mapcar (lambda (site) - (vector (car site) - `(package-ui-add-site (quote ,(cdr site))) - :style 'toggle :selected - `(member (quote ,(cdr site)) package-get-remote))) - package-get-download-sites)) + (vector (car site) + `(if (member (quote ,(cdr site)) + package-get-remote) + (setq package-get-remote + (delete (quote ,(cdr site)) package-get-remote)) + (package-ui-add-site (quote ,(cdr site)))) + :style 'toggle + :selected `(member (quote ,(cdr site)) + package-get-remote))) + package-get-download-sites)) ;;;###autoload (defun package-get-require-base (&optional force-current) @@ -328,24 +356,22 @@ "Locate the package-get index file. Do not return remote paths if NO-REMOTE is non-nil." (or (package-get-locate-file package-get-base-filename t no-remote) - (locate-data-file package-get-base-filename) - package-get-base-filename)) - -(defvar package-get-user-package-location user-init-directory) + (if (file-exists-p package-get-user-index-filename) + package-get-user-index-filename))) (defun package-get-maybe-save-index (filename) "Offer to save the current buffer as the local package index file, if different." (let ((location (package-get-locate-index-file t))) (unless (and filename (equal filename location)) - (unless (equal (md5 (current-buffer)) - (with-temp-buffer - (insert-file-contents location) - (md5 (current-buffer)))) - (unless (file-writable-p location) - (setq location (expand-file-name package-get-base-filename - (expand-file-name "etc/" package-get-user-package-location)))) - (when (y-or-n-p (concat "Update package index in" location "? ")) + (unless (and location + (equal (md5 (current-buffer)) + (with-temp-buffer + (insert-file-contents-literally location) + (md5 (current-buffer))))) + (unless (and location (file-writable-p location)) + (setq location package-get-user-index-filename)) + (when (y-or-n-p (concat "Update package index in " location "? ")) (write-file location)))))) @@ -425,7 +451,7 @@ "package-get DB verification? "))))) (t nil))))) (error "Package-get PGP signature failed to verify")) - ;; ToDo: We shoud call package-get-maybe-save-index on the region + ;; ToDo: We should call package-get-maybe-save-index on the region (package-get-update-base-entries content-beg content-end) (message "Updated package-get database")))) @@ -1001,6 +1027,10 @@ (package-get-info-prop (car this-package) 'version)))) (setq this-package (cdr this-package))))) (setq packages (cdr packages))) + (when (interactive-p) + (if found + (message "%S" found) + (message "No appropriate package found"))) found)) ;; diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/package-info.el --- a/lisp/package-info.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/package-info.el Mon Aug 13 11:13:30 2007 +0200 @@ -2,7 +2,7 @@ ;; Copyright (C) 1998 by Free Software Foundation, Inc. -;; Author: SL Baur +;; Author: SL Baur ;; Keywords: internal ;; This file is part of XEmacs. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/package-ui.el --- a/lisp/package-ui.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/package-ui.el Mon Aug 13 11:13:30 2007 +0200 @@ -535,7 +535,7 @@ (set-buffer (event-buffer event)) (goto-char (event-point event)) (popup-menu pui-menu event) - ;; I agreee with dired.el this is seriously bogus. + ;; I agree with dired.el - this is seriously bogus. (while (popup-menu-up-p) (dispatch-event (next-event))))) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/packages.el --- a/lisp/packages.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/packages.el Mon Aug 13 11:13:30 2007 +0200 @@ -2,8 +2,8 @@ ;; Copyright (C) 1997 Free Software Foundation, Inc. -;; Author: Steven L Baur -;; Maintainer: Steven L Baur +;; Author: Steven L Baur +;; Maintainer: Steven L Baur ;; Keywords: internal, lisp, dumped ;; This file is part of XEmacs. @@ -55,7 +55,7 @@ ;;; Package versioning (defvar packages-package-list nil - "database of loaded packages and version numbers") + "Database of loaded packages and version numbers") (defvar packages-hierarchy-depth 1 "Depth of package hierarchies.") @@ -84,16 +84,8 @@ (defvar last-package-load-path nil "Load path for packages last in the load path.") -(defvar package-locations - (list - (list (paths-construct-path '("~" ".xemacs")) - 'early #'(lambda () t)) - (list "site-packages" 'late #'(lambda () t)) - (list "infodock-packages" 'late #'(lambda () (featurep 'infodock))) - (list "mule-packages" 'late #'(lambda () (featurep 'mule))) - (list "xemacs-packages" 'late #'(lambda () t)) - (list "packages" 'late #'(lambda () t))) - "Locations of the various package directories. +(defun packages-compute-package-locations (user-init-directory) + "Compute locations of the various package directories. This is a list each of whose elements describes one directory. A directory description is a three-element list. The first element is either an absolute path or a subdirectory @@ -102,7 +94,16 @@ depending on the load-path segment the hierarchy is supposed to show up in. The third component is a thunk which, if it returns NIL, causes -the directory to be ignored.") +the directory to be ignored." + (list + (list (paths-construct-path (list user-init-directory "mule-packages")) + 'early #'(lambda () (featurep 'mule))) + (list (paths-construct-path (list user-init-directory "xemacs-packages")) + 'early #'(lambda () t)) + (list "site-packages" 'late #'(lambda () t)) + (list "infodock-packages" 'late #'(lambda () (featurep 'infodock))) + (list "mule-packages" 'late #'(lambda () (featurep 'mule))) + (list "xemacs-packages" 'late #'(lambda () t)))) (defun package-get-key-1 (info key) "Locate keyword `key' in list." @@ -122,9 +123,8 @@ (let ((info (if (and attributes (floatp (car attributes))) (list :version (car attributes)) attributes))) - (remassq name packages-package-list) (setq packages-package-list - (cons (cons name info) packages-package-list)))) + (cons (cons name info) (remassq name packages-package-list))))) (defun package-require (name version) (let ((pkg (assq name packages-package-list))) @@ -173,8 +173,7 @@ "dumped-lisp.el" "dumped-pkg-lisp.el" "version.el" - "very-early-lisp.el" - "Installation.el") + "very-early-lisp.el") "Lisp packages that should not be byte compiled.") @@ -203,14 +202,13 @@ (member 'crypt-find-file-hook find-file-hooks))) ;; Compression involved. (if nosuffix - ":.gz:.Z" - ".elc:.elc.gz:elc.Z:.el:.el.gz:.el.Z::.gz:.Z")) + '("" ".gz" ".Z") + '(".elc" ".elc.gz" "elc.Z" ".el" ".el.gz" ".el.Z" "" ".gz" ".Z"))) (t ;; No compression. (if nosuffix "" - ".elc:.el:"))) - 4))) + '(".elc" ".el" ""))))))) (and interactive-call (if result (message "Library is file %s" result) @@ -343,9 +341,7 @@ "Locate a file in a search path DIR-LIST (a list of directories). If no DIR-LIST is supplied, it defaults to `data-directory-list'. This function is basically a wrapper over `locate-file'." - (unless dir-list - (setq dir-list data-directory-list)) - (locate-file name dir-list)) + (locate-file name (or dir-list data-directory-list))) ;; Path setup @@ -433,7 +429,7 @@ (setq package-locations (cdr package-locations))) packages))) -(defun packages-find-packages (roots) +(defun packages-find-packages (roots package-locations) "Find the packages." (let ((envvar-value (getenv "EMACSPACKAGEPATH"))) (if envvar-value @@ -456,7 +452,7 @@ SUFFIXES is a list of names of package subdirectories to look for." (let ((directories (apply - #'append + #'nconc (mapcar #'(lambda (package) (mapcar #'(lambda (suffix) (file-name-as-directory (concat package suffix))) @@ -498,7 +494,7 @@ (defun packages-load-package-lisps (package-load-path base) "Load all Lisp files of a certain name along a load path. BASE is the base name of the files." - (mapc #'(lambda (dir) + (mapcar #'(lambda (dir) (let ((file-name (expand-file-name base dir))) (condition-case error (load file-name t t) @@ -517,7 +513,7 @@ (defun packages-handle-package-dumped-lisps (handle package-load-path) "Load dumped-lisp.el files along a load path. Call HANDLE on each file off definitions of PACKAGE-LISP there." - (mapc #'(lambda (dir) + (mapcar #'(lambda (dir) (let ((file-name (expand-file-name "dumped-lisp.el" dir))) (if (file-exists-p file-name) (let (package-lisp @@ -526,7 +522,7 @@ (load file-name) ;; dumped-lisp.el could have set this ... (if package-lisp - (mapc #'(lambda (base) + (mapcar #'(lambda (base) (funcall handle base)) package-lisp)))))) package-load-path)) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/process.el --- a/lisp/process.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/process.el Mon Aug 13 11:13:30 2007 +0200 @@ -33,9 +33,6 @@ ;;; Code: -(defvar binary-process-output) -(defvar buffer-file-type) - (defgroup processes nil "Process, subshell, compilation, and job control support." :group 'external @@ -115,14 +112,10 @@ you quit again before the process exits." (let ((temp (make-temp-name - (concat (file-name-as-directory (temp-directory)) - (if (memq system-type '(ms-dos windows-nt)) "em" "emacs"))))) + (concat (file-name-as-directory (temp-directory)) "emacs")))) (unwind-protect (progn - (if (memq system-type '(ms-dos windows-nt)) - (let ((buffer-file-type binary-process-output)) - (write-region start end temp nil 'silent)) - (write-region start end temp nil 'silent)) + (write-region start end temp nil 'silent) (if deletep (delete-region start end)) (apply #'call-process program temp buffer displayp args)) (ignore-file-errors (delete-file temp))))) @@ -299,7 +292,7 @@ Remaining arguments are strings to give program as arguments." (apply 'start-process-internal name buffer program program-args)) -(defun open-network-stream (name buffer host service) +(defun open-network-stream (name buffer host service &optional protocol) "Open a TCP connection for a service to a host. Returns a subprocess-object to represent the connection. Input and output work as for subprocesses; `delete-process' closes it. @@ -312,33 +305,38 @@ with any buffer Third arg is name of the host to connect to, or its IP address. Fourth arg SERVICE is name of the service desired, or an integer - specifying a port number to connect to." - (open-network-stream-internal name buffer host service)) + specifying a port number to connect to. +Fifth argument PROTOCOL is a network protocol. Currently 'tcp + (Transmission Control Protocol) and 'udp (User Datagram Protocol) are + supported. When omitted, 'tcp is assumed. + +Ouput via `process-send-string' and input via buffer or filter (see +`set-process-filter') are stream-oriented. That means UDP datagrams are +not guaranteed to be sent and received in discrete packets. (But small +datagrams around 500 bytes that are not truncated by `process-send-string' +are usually fine.) Note further that UDP protocol does not guard against +lost packets." + (open-network-stream-internal name buffer host service protocol)) (defun shell-quote-argument (argument) "Quote an argument for passing as argument to an inferior shell." - (if (eq system-type 'ms-dos) - ;; MS-DOS shells don't have quoting, so don't do any. - argument - (if (eq system-type 'windows-nt) - (concat "\"" argument "\"") - ;; Quote everything except POSIX filename characters. - ;; This should be safe enough even for really weird shells. - (let ((result "") (start 0) end) - (while (string-match "[^-0-9a-zA-Z_./]" argument start) - (setq end (match-beginning 0) - result (concat result (substring argument start end) - "\\" (substring argument end (1+ end))) - start (1+ end))) - (concat result (substring argument start)))))) + (if (eq system-type 'windows-nt) + (nt-quote-process-args (list shell-file-name argument)) + ;; Quote everything except POSIX filename characters. + ;; This should be safe enough even for really weird shells. + (let ((result "") (start 0) end) + (while (string-match "[^-0-9a-zA-Z_./]" argument start) + (setq end (match-beginning 0) + result (concat result (substring argument start end) + "\\" (substring argument end (1+ end))) + start (1+ end))) + (concat result (substring argument start))))) -(defun exec-to-string (command) - "Execute COMMAND as an external process and return the output of that -process as a string" - ;; by "William G. Dubuque" +(defun shell-command-to-string (command) + "Execute shell command COMMAND and return its output as a string." (with-output-to-string (call-process shell-file-name nil t nil shell-command-switch command))) -(defalias 'shell-command-to-string 'exec-to-string) +(defalias 'exec-to-string 'shell-command-to-string) ;;; process.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/rect.el --- a/lisp/rect.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/rect.el Mon Aug 13 11:13:30 2007 +0200 @@ -1,8 +1,8 @@ ;;; rect.el --- rectangle functions for XEmacs. -;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1993, 1994, 1999 Free Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: Didier Verna ;; Keywords: internal ;; This file is part of XEmacs. @@ -22,15 +22,25 @@ ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;; 02111-1307, USA. -;;; Synched up with: FSF 19.34. +;;; Synched up with: to be incorporated in a forthcoming GNU Emacs ;;; Commentary: -;; This package provides the operations on rectangles that are ocumented +;; This package provides the operations on rectangles that are documented ;; in the XEmacs Reference Manual. +;; #### NOTE: this file has been almost completely rewritten by Didier Verna +;; , Jul 99. The purpose of this rewrite is to be less +;; intrusive and fill lines with whitespaces only when needed. A few functions +;; are untouched though, as noted above their definition. + + ;;; Code: +;; #### NOTE: this function is untouched, but not used anymore. +;; `apply-on-rectangle' is used instead. It's still there because it's +;; documented so people might use it in their code, so I've decided not to +;; touch it. --dv ;; XEmacs: extra-args (defun operate-on-rectangle (function start end coerce-tabs &rest extra-args) "Call FUNCTION for each line of rectangle with corners at START, END. @@ -44,15 +54,15 @@ Point is at the end of the segment of this line within the rectangle." (let (startcol startlinepos endcol endlinepos) (save-excursion - (goto-char start) - (setq startcol (current-column)) - (beginning-of-line) - (setq startlinepos (point))) + (goto-char start) + (setq startcol (current-column)) + (beginning-of-line) + (setq startlinepos (point))) (save-excursion - (goto-char end) - (setq endcol (current-column)) - (forward-line 1) - (setq endlinepos (point-marker))) + (goto-char end) + (setq endcol (current-column)) + (forward-line 1) + (setq endlinepos (point-marker))) (if (< endcol startcol) ;; XEmacs (let ((tem startcol)) @@ -74,36 +84,46 @@ (forward-line 1))) (- endcol startcol))) -(defun delete-rectangle-line (startdelpos ignore ignore) - (delete-region startdelpos (point))) - -;; XEmacs: added lines arg -(defun delete-extract-rectangle-line (startdelpos begextra endextra lines) - (save-excursion - (extract-rectangle-line startdelpos begextra endextra lines)) - (delete-region startdelpos (point))) +;; The replacement for `operate-on-rectangle' -- dv +(defun apply-on-rectangle (function start end &rest args) + "Call FUNCTION for each line of rectangle with corners at START and END. +FUNCTION is called with two arguments: the start and end columns of the +rectangle, plus ARGS extra arguments. Point is at the beginning of line +when the function is called." + (let (startcol startpt endcol endpt) + (save-excursion + (goto-char start) + (setq startcol (current-column)) + (beginning-of-line) + (setq startpt (point)) + (goto-char end) + (setq endcol (current-column)) + (forward-line 1) + (setq endpt (point-marker)) + ;; ensure the start column is the left one. + (if (< endcol startcol) + (let ((col startcol)) + (setq startcol endcol endcol col))) + ;; start looping over lines + (goto-char startpt) + (while (< (point) endpt) + (apply function startcol endcol args) + (forward-line 1))) + )) -;; XEmacs: added lines arg -(defun extract-rectangle-line (startdelpos begextra endextra lines) - (let ((line (buffer-substring startdelpos (point))) - (end (point))) - (goto-char startdelpos) - (while (search-forward "\t" end t) - (let ((width (- (current-column) - (save-excursion (forward-char -1) - (current-column))))) - (setq line (concat (substring line 0 (- (point) end 1)) - (spaces-string width) - (substring line (+ (length line) (- (point) end))))))) - (if (or (> begextra 0) (> endextra 0)) - (setq line (concat (spaces-string begextra) - line - (spaces-string endextra)))) - (setcdr lines (cons line (cdr lines))))) ; XEmacs +;; I love ascii art ;-) +(defconst spaces-strings '["" + " " + " " + " " + " " + " " + " " + " " + " "]) -(defconst spaces-strings - (purecopy '["" " " " " " " " " " " " " " " " "])) +;; This function is untouched --dv (defun spaces-string (n) (if (<= n 8) (aref spaces-strings n) (let ((val "")) @@ -111,55 +131,119 @@ (setq val (concat " " val) n (- n 8))) (concat val (aref spaces-strings n))))) - + +;;;###autoload +(defvar killed-rectangle nil + "Rectangle for `yank-rectangle' to insert.") + ;;;###autoload -(defun delete-rectangle (start end) - "Delete (don't save) text in rectangle with point and mark as corners. -The same range of columns is deleted in each line starting with the line -where the region begins and ending with the line where the region ends." - (interactive "r") - (operate-on-rectangle 'delete-rectangle-line start end t)) +(defun kill-rectangle (start end &optional fill) + "Delete the region-rectangle and save it as the last killed one. +You might prefer to use `delete-extract-rectangle' from a program. + +When called from a program, the rectangle's corners are START and END. +With a prefix (or FILL) argument, also fill lines where nothing has to be +deleted." + (interactive "*r\nP") + (when buffer-read-only + (setq killed-rectangle (extract-rectangle start end)) + (barf-if-buffer-read-only)) + (setq killed-rectangle (delete-extract-rectangle start end fill))) ;;;###autoload -(defun delete-extract-rectangle (start end) - "Delete contents of rectangle and return it as a list of strings. -Arguments START and END are the corners of the rectangle. -The value is list of strings, one for each line of the rectangle." - (let ((lines (list nil))) ; XEmacs change - (operate-on-rectangle 'delete-extract-rectangle-line - start end t lines) +(defun delete-rectangle (start end &optional fill) + "Delete the text in the region-rectangle without saving it. +The same range of columns is deleted in each line starting with the line +where the region begins and ending with the line where the region ends. + +When called from a program, the rectangle's corners are START and END. +With a prefix (or FILL) argument, also fill lines where nothing has to be +deleted." + (interactive "*r\nP") + (apply-on-rectangle 'delete-rectangle-line start end fill)) + +(defun delete-rectangle-line (startcol endcol fill) + (let ((pt (point-at-eol))) + (when (= (move-to-column startcol (or fill 'coerce)) startcol) + (if (and (not fill) (<= pt endcol)) + (delete-region (point) pt) + ;; else + (setq pt (point)) + (move-to-column endcol t) + (delete-region pt (point)))) + )) + +;;;###autoload +(defun delete-extract-rectangle (start end &optional fill) + "Delete the contents of the rectangle with corners at START and END, and +return it as a list of strings, one for each line of the rectangle. + +With an optional FILL argument, also fill lines where nothing has to be +deleted." + (let ((lines (list nil))) + (apply-on-rectangle 'delete-extract-rectangle-line start end lines fill) (nreverse (cdr lines)))) +(defun delete-extract-rectangle-line (startcol endcol lines fill) + (let ((pt (point-at-eol))) + (if (< (move-to-column startcol (or fill 'coerce)) startcol) + (setcdr lines (cons (spaces-string (- endcol startcol)) + (cdr lines))) + ;; else + (setq pt (point)) + (move-to-column endcol t) + (setcdr lines (cons (buffer-substring pt (point)) (cdr lines))) + (delete-region pt (point))) + )) + ;;;###autoload (defun extract-rectangle (start end) - "Return contents of rectangle with corners at START and END. -Value is list of strings, one for each line of the rectangle." - (let ((lines (list nil))) ; XEmacs change - (operate-on-rectangle 'extract-rectangle-line start end nil lines) + "Return the contents of the rectangle with corners at START and END, +as a list of strings, one for each line of the rectangle." + (let ((lines (list nil))) + (apply-on-rectangle 'extract-rectangle-line start end lines) (nreverse (cdr lines)))) -;;;###autoload -(defvar killed-rectangle nil - "Rectangle for yank-rectangle to insert.") +;; #### NOTE: this is actually the only function that needs to do complicated +;; stuff like what's happening in `operate-on-rectangle', because the buffer +;; might be read-only. --dv +(defun extract-rectangle-line (startcol endcol lines) + (let (start end begextra endextra line) + (move-to-column startcol) + (setq start (point) + begextra (- (current-column) startcol)) + (move-to-column endcol) + (setq end (point) + endextra (- endcol (current-column))) + (setq line (buffer-substring start (point))) + (if (< begextra 0) + (setq endextra (+ endextra begextra) + begextra 0)) + (if (< endextra 0) + (setq endextra 0)) + (goto-char start) + (while (search-forward "\t" end t) + (let ((width (- (current-column) + (save-excursion (forward-char -1) + (current-column))))) + (setq line (concat (substring line 0 (- (point) end 1)) + (spaces-string width) + (substring line (+ (length line) + (- (point) end))))))) + (if (or (> begextra 0) (> endextra 0)) + (setq line (concat (spaces-string begextra) + line + (spaces-string endextra)))) + (setcdr lines (cons line (cdr lines))))) -;;;###autoload -(defun kill-rectangle (start end) - "Delete rectangle with corners at point and mark; save as last killed one. -Calling from program, supply two args START and END, buffer positions. -But in programs you might prefer to use `delete-extract-rectangle'." - (interactive "r") - (if buffer-read-only - (progn - (setq killed-rectangle (extract-rectangle start end)) - (barf-if-buffer-read-only))) - (setq killed-rectangle (delete-extract-rectangle start end))) - +;; This function is untouched --dv ;;;###autoload (defun yank-rectangle () "Yank the last killed rectangle with upper left corner at point." - (interactive) + (interactive "*") (insert-rectangle killed-rectangle)) +;; This function is untouched --dv ;;;###autoload (defun insert-rectangle (rectangle) "Insert text of RECTANGLE with upper left corner at point. @@ -175,81 +259,71 @@ (while lines (or first (progn - (forward-line 1) - (or (bolp) (insert ?\n)) - (move-to-column insertcolumn t))) + (forward-line 1) + (or (bolp) (insert ?\n)) + (move-to-column insertcolumn t))) (setq first nil) (insert (car lines)) (setq lines (cdr lines))))) ;;;###autoload -(defun open-rectangle (start end) - "Blank out rectangle with corners at point and mark, shifting text right. -The text previously in the region is not overwritten by the blanks, -but instead winds up to the right of the rectangle." - (interactive "r") - (operate-on-rectangle 'open-rectangle-line start end nil) +(defun open-rectangle (start end &optional fill) + "Blank out the region-rectangle, shifting text right. + +When called from a program, the rectangle's corners are START and END. +With a prefix (or FILL) argument, fill with blanks even if there is no text +on the right side of the rectangle." + (interactive "*r\nP") + (apply-on-rectangle 'open-rectangle-line start end fill) (goto-char start)) -(defun open-rectangle-line (startpos begextra endextra) - ;; Column where rectangle ends. - (let ((endcol (+ (current-column) endextra)) - whitewidth) - (goto-char startpos) - ;; Column where rectangle begins. - (let ((begcol (- (current-column) begextra))) - (skip-chars-forward " \t") - ;; Width of whitespace to be deleted and recreated. - (setq whitewidth (- (current-column) begcol))) - ;; Delete the whitespace following the start column. - (delete-region startpos (point)) - ;; Open the desired width, plus same amount of whitespace we just deleted. - (indent-to (+ endcol whitewidth)))) +(defun open-rectangle-line (startcol endcol fill) + (let (spaces) + (when (= (move-to-column startcol (or fill 'coerce)) startcol) + (unless (and (not fill) + (= (point) (point-at-eol))) + (indent-to endcol))) + )) ;;;###autoload (defun string-rectangle (start end string) "Insert STRING on each line of the region-rectangle, shifting text right. -The left edge of the rectangle specifies the column for insertion. -This command does not delete or overwrite any existing text. - -Called from a program, takes three args; START, END and STRING." - (interactive "r\nsString rectangle: ") - (operate-on-rectangle 'string-rectangle-line start end t string)) ; XEmacs +The left edge of the rectangle specifies the column for insertion. This +command does not delete or overwrite any existing text. -;; XEmacs: add string arg -(defun string-rectangle-line (startpos begextra endextra string) - (let (whitespace) - (goto-char startpos) - ;; Compute horizontal width of following whitespace. - (let ((ocol (current-column))) - (skip-chars-forward " \t") - (setq whitespace (- (current-column) ocol))) - ;; Delete the following whitespace. - (delete-region startpos (point)) - ;; Insert the desired string. - (insert string) - ;; Insert the same width of whitespace that we had before. - (indent-to (+ (current-column) whitespace)))) +When called from a program, the rectangle's corners are START and END." + (interactive "*r\nsString rectangle: ") + (apply-on-rectangle 'string-rectangle-line start end string)) + +(defun string-rectangle-line (startcol endcol string) + (move-to-column startcol t) + (insert string)) ;;;###autoload -(defun clear-rectangle (start end) - "Blank out rectangle with corners at point and mark. -The text previously in the region is overwritten by the blanks. -When called from a program, requires two args which specify the corners." - (interactive "r") - (operate-on-rectangle 'clear-rectangle-line start end t)) +(defun clear-rectangle (start end &optional fill) + "Blank out the region-rectangle. +The text previously in the region is overwritten with blanks. + +When called from a program, the rectangle's corners are START and END. +With a prefix (or FILL) argument, also fill with blanks the parts of the +rectangle which were empty." + (interactive "*r\nP") + (apply-on-rectangle 'clear-rectangle-line start end fill)) -(defun clear-rectangle-line (startpos begextra endextra) - ;; Find end of whitespace after the rectangle. - (skip-chars-forward " \t") - (let ((column (+ (current-column) endextra))) - ;; Delete the text in the rectangle, and following whitespace. - (delete-region (point) - (progn (goto-char startpos) - (skip-chars-backward " \t") - (point))) - ;; Reindent out to same column that we were at. - (indent-to column))) +(defun clear-rectangle-line (startcol endcol fill) + (let ((pt (point-at-eol)) + spaces) + (when (= (move-to-column startcol (or fill 'coerce)) startcol) + (if (and (not fill) + (<= (save-excursion (goto-char pt) (current-column)) endcol)) + (delete-region (point) pt) + ;; else + (setq pt (point)) + (move-to-column endcol t) + (setq spaces (- (point) pt)) + (delete-region pt (point)) + (indent-to (+ (current-column) spaces)))) + )) (provide 'rect) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/replace.el --- a/lisp/replace.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/replace.el Mon Aug 13 11:13:30 2007 +0200 @@ -679,6 +679,7 @@ ;; Loop finding occurrences that perhaps should be replaced. (while (and keep-going (not (eobp)) + (or (null limit) (< (point) limit)) (let ((case-fold-search qr-case-fold-search)) (funcall search-function search-string limit)) ;; If the search string matches immediately after @@ -688,7 +689,8 @@ (and regexp-flag (eq lastrepl (match-beginning 0)) (not match-again))) - (if (eobp) + (if (or (eobp) + (and limit (>= (point) limit))) nil ;; Don't replace the null string ;; right after end of previous replacement. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/scrollbar.el --- a/lisp/scrollbar.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/scrollbar.el Mon Aug 13 11:13:30 2007 +0200 @@ -55,7 +55,7 @@ ;; vertical scrollbar functions ;; -;;; ### Move functions from C into Lisp here! +;;; #### Move functions from C into Lisp here! ;; ;; horizontal scrollbar functions diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/select.el --- a/lisp/select.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/select.el Mon Aug 13 11:13:30 2007 +0200 @@ -32,65 +32,87 @@ ;;; Code: +(defvar selected-text-type + (if (featurep 'mule) '(COMPOUND_TEXT STRING) 'STRING) + "The type atom used to obtain selections from the X server. +Can be either a valid X selection data type, or a list of such types. +COMPOUND_TEXT and STRING are the most commonly used data types. +If a list is provided, the types are tried in sequence until +there is a successful conversion.") + +(defvar selection-sets-clipboard nil + "Controls the selection's relationship to the clipboard. +When non-nil, any operation that sets the primary selection will also +set the clipboard.") + (defun copy-primary-selection () "Copy the selection to the Clipboard and the kill ring." (interactive) (and (console-on-window-system-p) (cut-copy-clear-internal 'copy))) -(define-obsolete-function-alias - 'x-copy-primary-selection - 'copy-primary-selection) (defun kill-primary-selection () "Copy the selection to the Clipboard and the kill ring, then delete it." (interactive "*") (and (console-on-window-system-p) (cut-copy-clear-internal 'cut))) -(define-obsolete-function-alias - 'x-kill-primary-selection - 'kill-primary-selection) (defun delete-primary-selection () "Delete the selection without copying it to the Clipboard or the kill ring." (interactive "*") (and (console-on-window-system-p) (cut-copy-clear-internal 'clear))) -(define-obsolete-function-alias - 'x-delete-primary-selection - 'delete-primary-selection) (defun yank-clipboard-selection () "Insert the current Clipboard selection at point." (interactive "*") - (case (device-type (selected-device)) - (x (x-yank-clipboard-selection)) - (mswindows (mswindows-paste-clipboard)) - (otherwise nil))) + (when (console-on-window-system-p) + (setq last-command nil) + (setq this-command 'yank) ; so that yank-pop works. + (let ((clip (get-clipboard))) + (or clip (error "there is no clipboard selection")) + (push-mark) + (insert clip)))) + +(defun get-clipboard () + "Return text pasted to the clipboard." + (get-selection 'CLIPBOARD)) + +(define-device-method get-cutbuffer + "Return the value of one of the cut buffers. +This will do nothing under anything other than X.") + +(defun get-selection-no-error (&optional type data-type) + "Return the value of a Windows selection. +The argument TYPE (default `PRIMARY') says which selection, +and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule) +says how to convert the data. Returns NIL if there is no selection" + (condition-case err (get-selection type data-type) (t nil))) -(defun selection-owner-p (&optional selection) - "Return t if current XEmacs process owns the given Selection. -The arg should be the name of the selection in question, typically one -of the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience, -the symbol nil is the same as PRIMARY, and t is the same as -SECONDARY.)" - (interactive) - (case (device-type (selected-device)) - (x (x-selection-owner-p selection)) - (mswindows (mswindows-selection-owner-p selection)) - (otherwise nil))) +(defun get-selection (&optional type data-type) + "Return the value of a Windows selection. +The argument TYPE (default `PRIMARY') says which selection, +and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule) +says how to convert the data. If there is no selection an error is signalled." + (or type (setq type 'PRIMARY)) + (or data-type (setq data-type selected-text-type)) + (let ((text + (if (consp data-type) + (condition-case err + (get-selection-internal type (car data-type)) + (selection-conversion-error + (if (cdr data-type) + (get-selection type (cdr data-type)) + (signal (car err) (cdr err))))) + (get-selection-internal type data-type)))) + (when (and (consp text) (symbolp (car text))) + (setq text (cdr text))) + (when (not (stringp text)) + (error "Selection is not a string: %S" text)) + text)) -(defun selection-exists-p (&optional selection) - "Whether there is an owner for the given Selection. -The arg should be the name of the selection in question, typically one -of the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience, -the symbol nil is the same as PRIMARY, and t is the same as -SECONDARY." - (interactive) - (case (device-type (selected-device)) - (x (x-selection-exists-p selection)) - (mswindows (mswindows-selection-exists-p)) - (otherwise nil))) - +;; FSFmacs calls this `x-set-selection', and reverses the +;; arguments (duh ...). This order is more logical. (defun own-selection (data &optional type) "Make an Windows selection of type TYPE and value DATA. The argument TYPE (default `PRIMARY') says which selection, @@ -109,26 +131,72 @@ (interactive (if (not current-prefix-arg) (list (read-string "Store text for pasting: ")) (list (substring (region-beginning) (region-end))))) - (case (device-type (selected-device)) - (x (x-own-selection data type)) - (mswindows (mswindows-own-selection data type)) - (otherwise nil))) + ;FSFmacs huh?? It says: + ;; "This is for temporary compatibility with pre-release Emacs 19." + ;(if (stringp type) + ; (setq type (intern type))) + (or (valid-simple-selection-p data) + (and (vectorp data) + (let ((valid t) + (i (1- (length data)))) + (while (>= i 0) + (or (valid-simple-selection-p (aref data i)) + (setq valid nil)) + (setq i (1- i))) + valid)) + (signal 'error (list "invalid selection" data))) + (or type (setq type 'PRIMARY)) + (if (null data) + (disown-selection-internal type) + (own-selection-internal type data) + (when (and (eq type 'PRIMARY) + selection-sets-clipboard) + (own-selection-internal 'CLIPBOARD data))) + (cond ((eq type 'PRIMARY) + (setq primary-selection-extent + (select-make-extent-for-selection + data primary-selection-extent))) + ((eq type 'SECONDARY) + (setq secondary-selection-extent + (select-make-extent-for-selection + data secondary-selection-extent)))) + (setq zmacs-region-stays t) + data) + +(defun dehilight-selection (selection) + "for use as a value of `lost-selection-hooks'." + (cond ((eq selection 'PRIMARY) + (if primary-selection-extent + (let ((inhibit-quit t)) + (if (consp primary-selection-extent) + (mapcar 'delete-extent primary-selection-extent) + (delete-extent primary-selection-extent)) + (setq primary-selection-extent nil))) + (if zmacs-regions (zmacs-deactivate-region))) + ((eq selection 'SECONDARY) + (if secondary-selection-extent + (let ((inhibit-quit t)) + (if (consp secondary-selection-extent) + (mapcar 'delete-extent secondary-selection-extent) + (delete-extent secondary-selection-extent)) + (setq secondary-selection-extent nil))))) + nil) + +(setq lost-selection-hooks 'dehilight-selection) (defun own-clipboard (string) - "Paste the given string to the Clipboard." - (case (device-type (selected-device)) - (x (x-own-clipboard string)) - (mswindows (mswindows-own-clipboard string)) - (otherwise nil))) + "Paste the given string to the window system Clipboard." + (own-selection string 'CLIPBOARD)) (defun disown-selection (&optional secondary-p) "Assuming we own the selection, disown it. With an argument, discard the secondary selection instead of the primary selection." - (case (device-type (selected-device)) - (x (x-disown-selection secondary-p)) - (mswindows (mswindows-disown-selection secondary-p)) - (otherwise nil))) - + (disown-selection-internal (if secondary-p 'SECONDARY 'PRIMARY)) + (when (and selection-sets-clipboard + (or (not secondary-p) + (eq secondary-p 'PRIMARY) + (eq secondary-p 'CLIPBOARD))) + (disown-selection-internal 'CLIPBOARD))) ;; from x-init.el ;; selections and active regions @@ -218,9 +286,6 @@ (default-mouse-track-next-move-rect start end previous-extent) )) previous-extent)))) -(define-obsolete-function-alias - 'x-select-make-extent-for-selection - 'select-make-extent-for-selection) ;; moved from x-select.el (defun valid-simple-selection-p (data) @@ -242,9 +307,6 @@ (marker-buffer (cdr data))) (buffer-live-p (marker-buffer (car data))) (buffer-live-p (marker-buffer (cdr data)))))) -(define-obsolete-function-alias - 'x-valid-simple-selection-p - 'valid-simple-selection-p) (defun cut-copy-clear-internal (mode) (or (memq mode '(cut copy clear)) (error "unkown mode %S" mode)) @@ -287,8 +349,241 @@ (delete-region s e)))) (disown-selection nil) ))) -(define-obsolete-function-alias - 'x-cut-copy-clear-internal - 'cut-copy-clear-internal) + +;;; Functions to convert the selection into various other selection +;;; types. Every selection type that emacs handles is implemented +;;; this way, except for TIMESTAMP, which is a special case. These are +;;; all moved from x-select.el + +(defun select-convert-to-text (selection type value) + (cond ((stringp value) + value) + ((extentp value) + (save-excursion + (set-buffer (extent-object value)) + (save-restriction + (widen) + (buffer-substring (extent-start-position value) + (extent-end-position value))))) + ((and (consp value) + (markerp (car value)) + (markerp (cdr value))) + (or (eq (marker-buffer (car value)) (marker-buffer (cdr value))) + (signal 'error + (list "markers must be in the same buffer" + (car value) (cdr value)))) + (save-excursion + (set-buffer (or (marker-buffer (car value)) + (error "selection is in a killed buffer"))) + (save-restriction + (widen) + (buffer-substring (car value) (cdr value))))) + (t nil))) + +(defun select-convert-to-string (selection type value) + (let ((outval (select-convert-to-text selection type value))) + ;; force the string to be not in Compound Text format. + (if (stringp outval) + (cons 'STRING outval) + outval))) + +(defun select-convert-to-compound-text (selection type value) + ;; converts to compound text automatically + (select-convert-to-text selection type value)) + +(defun select-convert-to-length (selection type value) + (let ((value + (cond ((stringp value) + (length value)) + ((extentp value) + (extent-length value)) + ((and (consp value) + (markerp (car value)) + (markerp (cdr value))) + (or (eq (marker-buffer (car value)) + (marker-buffer (cdr value))) + (signal 'error + (list "markers must be in the same buffer" + (car value) (cdr value)))) + (abs (- (car value) (cdr value))))))) + (if value ; force it to be in 32-bit format. + (cons (ash value -16) (logand value 65535)) + nil))) + +(defun select-convert-to-targets (selection type value) + ;; return a vector of atoms, but remove duplicates first. + (let* ((all (cons 'TIMESTAMP (mapcar 'car selection-converter-alist))) + (rest all)) + (while rest + (cond ((memq (car rest) (cdr rest)) + (setcdr rest (delq (car rest) (cdr rest)))) + ((eq (car (cdr rest)) '_EMACS_INTERNAL) ; shh, it's a secret + (setcdr rest (cdr (cdr rest)))) + (t + (setq rest (cdr rest))))) + (apply 'vector all))) + +(defun select-convert-to-delete (selection type value) + (disown-selection-internal selection) + ;; A return value of nil means that we do not know how to do this conversion, + ;; and replies with an "error". A return value of NULL means that we have + ;; done the conversion (and any side-effects) but have no value to return. + 'NULL) + +(defun select-convert-to-filename (selection type value) + (cond ((extentp value) + (buffer-file-name (or (extent-object value) + (error "selection is in a killed buffer")))) + ((and (consp value) + (markerp (car value)) + (markerp (cdr value))) + (buffer-file-name (or (marker-buffer (car value)) + (error "selection is in a killed buffer")))) + (t nil))) + +(defun select-convert-to-charpos (selection type value) + (let (a b tmp) + (cond ((cond ((extentp value) + (setq a (extent-start-position value) + b (extent-end-position value))) + ((and (consp value) + (markerp (car value)) + (markerp (cdr value))) + (setq a (car value) + b (cdr value)))) + (setq a (1- a) b (1- b)) ; zero-based + (if (< b a) (setq tmp a a b b tmp)) + (cons 'SPAN + (vector (cons (ash a -16) (logand a 65535)) + (cons (ash b -16) (logand b 65535)))))))) + +(defun select-convert-to-lineno (selection type value) + (let (a b buf tmp) + (cond ((cond ((extentp value) + (setq buf (extent-object value) + a (extent-start-position value) + b (extent-end-position value))) + ((and (consp value) + (markerp (car value)) + (markerp (cdr value))) + (setq a (marker-position (car value)) + b (marker-position (cdr value)) + buf (marker-buffer (car value))))) + (save-excursion + (set-buffer buf) + (save-restriction + (widen) + (goto-char a) + (beginning-of-line) + (setq a (1+ (count-lines 1 (point)))) + (goto-char b) + (beginning-of-line) + (setq b (1+ (count-lines 1 (point)))))) + (if (< b a) (setq tmp a a b b tmp)) + (cons 'SPAN + (vector (cons (ash a -16) (logand a 65535)) + (cons (ash b -16) (logand b 65535)))))))) + +(defun select-convert-to-colno (selection type value) + (let (a b buf tmp) + (cond ((cond ((extentp value) + (setq buf (extent-object value) + a (extent-start-position value) + b (extent-end-position value))) + ((and (consp value) + (markerp (car value)) + (markerp (cdr value))) + (setq a (car value) + b (cdr value) + buf (marker-buffer a)))) + (save-excursion + (set-buffer buf) + (goto-char a) + (setq a (current-column)) + (goto-char b) + (setq b (current-column))) + (if (< b a) (setq tmp a a b b tmp)) + (cons 'SPAN + (vector (cons (ash a -16) (logand a 65535)) + (cons (ash b -16) (logand b 65535)))))))) + +(defun select-convert-to-sourceloc (selection type value) + (let (a b buf file-name tmp) + (cond ((cond ((extentp value) + (setq buf (or (extent-object value) + (error "selection is in a killed buffer")) + a (extent-start-position value) + b (extent-end-position value) + file-name (buffer-file-name buf))) + ((and (consp value) + (markerp (car value)) + (markerp (cdr value))) + (setq a (marker-position (car value)) + b (marker-position (cdr value)) + buf (or (marker-buffer (car value)) + (error "selection is in a killed buffer")) + file-name (buffer-file-name buf)))) + (save-excursion + (set-buffer buf) + (save-restriction + (widen) + (goto-char a) + (beginning-of-line) + (setq a (1+ (count-lines 1 (point)))) + (goto-char b) + (beginning-of-line) + (setq b (1+ (count-lines 1 (point)))))) + (if (< b a) (setq tmp a a b b tmp)) + (format "%s:%d" file-name a))))) + +(defun select-convert-to-os (selection type size) + (symbol-name system-type)) + +(defun select-convert-to-host (selection type size) + (system-name)) + +(defun select-convert-to-user (selection type size) + (user-full-name)) + +(defun select-convert-to-class (selection type size) + x-emacs-application-class) + +;; We do not try to determine the name Emacs was invoked with, +;; because it is not clean for a program's behavior to depend on that. +(defun select-convert-to-name (selection type size) + ;invocation-name + "xemacs") + +(defun select-convert-to-integer (selection type value) + (and (integerp value) + (cons (ash value -16) (logand value 65535)))) + +(defun select-convert-to-atom (selection type value) + (and (symbolp value) value)) + +(defun select-convert-to-identity (selection type value) ; used internally + (vector value)) + +(setq selection-converter-alist + '((TEXT . select-convert-to-text) + (STRING . select-convert-to-string) + (COMPOUND_TEXT . select-convert-to-compound-text) + (TARGETS . select-convert-to-targets) + (LENGTH . select-convert-to-length) + (DELETE . select-convert-to-delete) + (FILE_NAME . select-convert-to-filename) + (CHARACTER_POSITION . select-convert-to-charpos) + (SOURCE_LOC . select-convert-to-sourceloc) + (LINE_NUMBER . select-convert-to-lineno) + (COLUMN_NUMBER . select-convert-to-colno) + (OWNER_OS . select-convert-to-os) + (HOST_NAME . select-convert-to-host) + (USER . select-convert-to-user) + (CLASS . select-convert-to-class) + (NAME . select-convert-to-name) + (ATOM . select-convert-to-atom) + (INTEGER . select-convert-to-integer) + (_EMACS_INTERNAL . select-convert-to-identity) + )) ;;; select.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/setup-paths.el --- a/lisp/setup-paths.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/setup-paths.el Mon Aug 13 11:13:30 2007 +0200 @@ -42,10 +42,14 @@ "Depth of load-path searches in core Lisp paths.") (defvar paths-default-info-directories - (list (paths-construct-path '("usr" "local" "info") - (char-to-string directory-sep-char)) - (paths-construct-path '("usr" "info") - (char-to-string directory-sep-char))) + (mapcar (function + (lambda (dirlist) + (paths-construct-path + dirlist (char-to-string directory-sep-char)))) + '(("usr" "local" "info") + ("usr" "info") + ("usr" "local" "share" "info") + ("usr" "share" "info"))) "Directories appended to the end of the info path by default.") (defun paths-find-site-lisp-directory (roots) @@ -69,7 +73,7 @@ (defun paths-find-module-directory (roots) "Find the main modules directory of the XEmacs hierarchy." (paths-find-architecture-directory roots "modules" - configure-module-directory)) + nil configure-module-directory)) (defun paths-construct-load-path (roots early-package-load-path late-package-load-path last-package-load-path @@ -137,7 +141,7 @@ (defun paths-find-doc-directory (roots) "Find the documentation directory." - (paths-find-architecture-directory roots "lib-src")) + (paths-find-architecture-directory roots "lib-src" nil configure-doc-directory)) (defun paths-find-lock-directory (roots) "Find the lock directory." @@ -158,7 +162,8 @@ (defun paths-find-exec-directory (roots) "Find the binary directory." - (paths-find-architecture-directory roots "lib-src" configure-exec-directory)) + (paths-find-architecture-directory roots "lib-src" + nil configure-exec-directory)) (defun paths-construct-exec-path (roots exec-directory early-packages late-packages last-packages) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/simple.el --- a/lisp/simple.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/simple.el Mon Aug 13 11:13:30 2007 +0200 @@ -62,7 +62,7 @@ ;; Mule-2.3, and could probably use some feature additions (like additional wrap ;; styles, etc) -;; 97/06/11 Steve Baur (steve@altair.xemacs.org) Convert use of +;; 97/06/11 Steve Baur (steve@xemacs.org) Convert use of ;; (preceding|following)-char to char-(after|before). ;;; Code: @@ -433,7 +433,7 @@ (and overwrite-mode (not (eolp)) (save-excursion (insert-char ?\ arg)))) -(defcustom delete-key-deletes-forward nil +(defcustom delete-key-deletes-forward t "*If non-nil, the DEL key will erase one character forwards. If nil, the DEL key will erase one character backwards." :type 'boolean @@ -670,7 +670,7 @@ cnt))) ;;; Modified by Bob Weiner, 8/24/95, to print narrowed line number also. -;;; Expanded by Bob Weiner, Altrasoft, on 02/12/1997 +;;; Expanded by Bob Weiner, BeOpen, on 02/12/1997 (defun what-line () "Print the following variants of the line number of point: Region line - displayed line within the active region @@ -2592,7 +2592,8 @@ bounce ;; 97/3/14 jhod: Kinsoku (re-break-point (if (featurep 'mule) - (concat "[ \t\n]\\|" word-across-newline) + (concat "[ \t\n]\\|" word-across-newline + ".\\|." word-across-newline) "[ \t\n]")) ;; end patch (first t)) @@ -2655,20 +2656,23 @@ (if (save-excursion (skip-chars-backward " \t") (= (point) fill-point)) + ;; 1999-09-17 hniksic: turn off Kinsoku until + ;; it's debugged. + (indent-new-comment-line) ;; 97/3/14 jhod: Kinsoku processing - ;(indent-new-comment-line) - (let ((spacep (memq (char-before (point)) '(?\ ?\t)))) - (funcall comment-line-break-function) - ;; if user type space explicitly, leave SPC - ;; even if there is no WAN. - (if spacep - (save-excursion - (goto-char fill-point) - ;; put SPC except that there is SPC - ;; already or there is sentence end. - (or (memq (char-after (point)) '(?\ ?\t)) - (fill-end-of-sentence-p) - (insert ?\ ))))) +; ;(indent-new-comment-line) +; (let ((spacep (memq (char-before (point)) '(?\ ?\t)))) +; (funcall comment-line-break-function) +; ;; if user type space explicitly, leave SPC +; ;; even if there is no WAN. +; (if spacep +; (save-excursion +; (goto-char fill-point) +; ;; put SPC except that there is SPC +; ;; already or there is sentence end. +; (or (memq (char-after (point)) '(?\ ?\t)) +; (fill-end-of-sentence-p) +; (insert ?\ ))))) (save-excursion (goto-char fill-point) (funcall comment-line-break-function))) @@ -2889,6 +2893,7 @@ (if (and comcol (not fill-prefix)) ; XEmacs - (ENE) from fa-extras. (let ((comment-column comcol) (comment-start comstart) + (block-comment-start comstart) (comment-end comment-end)) (and comment-end (not (equal comment-end "")) ; (if (not comment-multi-line) @@ -3625,7 +3630,7 @@ ;; --hniksic (defcustom log-message-ignore-regexps '(;; Note: adding entries to this list slows down messaging - ;; significantly. Wherever possible, use message lables. + ;; significantly. Wherever possible, use message labels. ;; Often-seen messages "\\`\\'" ; empty message diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/site-load.el --- a/lisp/site-load.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/site-load.el Mon Aug 13 11:13:30 2007 +0200 @@ -1,7 +1,7 @@ ;;; site-load.el --- Template file for site-wide XEmacs customization ;; Copyright (C) 1997 Free Software Foundation, Inc. -;; Author: Steven L. Baur +;; Author: Steven L. Baur ;; Keywords: internal ;; This file is part of XEmacs. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/sound.el --- a/lisp/sound.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/sound.el Mon Aug 13 11:13:30 2007 +0200 @@ -105,6 +105,7 @@ :type 'directory ) +;; #### This should really be a list. --hniksic (defcustom sound-extension-list (if (or (eq system-type 'cygwin32) (eq system-type 'windows-nt)) ".wav:" ".au:") @@ -144,7 +145,8 @@ (error "volume not an integer or nil")) (let (buf data - (file (locate-file filename default-sound-directory-list sound-extension-list))) + (file (locate-file filename default-sound-directory-list + sound-extension-list))) (unless file (error "Couldn't load sound file %s" filename)) (unwind-protect diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/startup.el --- a/lisp/startup.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/startup.el Mon Aug 13 11:13:30 2007 +0200 @@ -30,7 +30,7 @@ ;; This file is dumped with XEmacs. -;; -batch, -t, and -nw are processed by main() in emacs.c and are +;; -batch, -t, and -nw are processed by main() in emacs.c and are ;; never seen by lisp code. ;; -version and -help are special-cased as well: they imply -batch, @@ -104,18 +104,22 @@ (defvar emacs-roots nil "List of plausible roots of the XEmacs hierarchy.") -(defvar init-file-user nil - "Identity of user whose `.emacs' file is or was read. -The value is nil if no init file is being used; otherwise, it may be either -the null string, meaning that the init file was taken from the user that -originally logged in, or it may be a string containing a user's name. +(defvar user-init-directory-base ".xemacs" + "Base of directory where user-installed init files may go.") -In either of the latter cases, `(concat \"~\" init-file-user \"/\")' -evaluates to the name of the directory in which the `.emacs' file was -searched for. +(defvar user-init-file-base-list (append + '(".emacs.elc" ".emacs.el" ".emacs") + (and (eq system-type 'windows-nt) + '("_emacs.elc" "_emacs.el" "_emacs"))) + "List of allowed init files. The first one found takes precedence.") -Setting `init-file-user' does not prevent Emacs from loading -`site-start.el'. The only way to do that is to use `--no-site-file'.") +(defvar user-init-directory + (file-name-as-directory + (paths-construct-path (list "~" user-init-directory-base))) + "Directory where user-installed init files may go.") + +(defvar load-user-init-file-p t + "Non-nil if XEmacs should load the user's init file.") ;; #### called `site-run-file' in FSFmacs @@ -200,12 +204,18 @@ (princ (concat "\n" (emacs-version) "\n\n")) (princ (if (featurep 'x) - (concat (emacs-name) - " accepts all standard X Toolkit command line options.\n" - "In addition, the") + (concat "When creating a window on an X display, " + (emacs-name) + " accepts all standard X Toolkit +command line options plus the following: + -iconname Use title as the icon name. + -mc <color> Use color as the mouse color. + -cr <color> Use color as the text-cursor foregound color. + -private Install a private colormap. + +In addition, the") "The")) (princ " following options are accepted: - -t <device> Use TTY <device> instead of the terminal for input and output. This implies the -nw option. -nw Inhibit the use of any window-system-specific @@ -220,7 +230,11 @@ startup. Also implies `-vanilla'. -vanilla Equivalent to -q -no-site-file -no-early-packages. -q Same as -no-init-file. + -user-init-file <file> Use <file> as init file. + -user-init-directory <directory> use <directory> as init directory. -user <user> Load user's init file instead of your own. + Equivalent to -user-init-file ~<user>/.emacs + -user-init-directory ~<user>/.xemacs/ -u <user> Same as -user.\n") (let ((l command-switch-alist) (insert (lambda (&rest x) @@ -382,14 +396,15 @@ (setq emacs-roots (paths-find-emacs-roots invocation-directory invocation-name)) - + (if debug-paths (princ (format "emacs-roots:\n%S\n" emacs-roots) 'external-debugging-output)) - + (if (null emacs-roots) (startup-find-roots-warning) (startup-setup-paths emacs-roots + user-init-directory inhibit-early-packages inhibit-site-lisp debug-paths)) @@ -399,7 +414,7 @@ lisp-directory) (load (expand-file-name (file-name-sans-extension autoload-file-name) lisp-directory) nil t)) - + (if (not inhibit-autoloads) (progn (if (not inhibit-early-packages) @@ -481,16 +496,11 @@ ;; (and (not (equal string "")) string))))) ;; (and ctype ;; (string-match iso-8859-1-locale-regexp ctype))) - ;; (progn + ;; (progn ;; (standard-display-european t) ;; (require 'iso-syntax))) - ;; Figure out which user's init file to load, - ;; either from the environment or from the options. - (setq init-file-user (if (noninteractive) nil (user-login-name))) - ;; If user has not done su, use current $HOME to find .emacs. - (and init-file-user (string= init-file-user (user-real-login-name)) - (setq init-file-user "")) + (setq load-user-init-file-p (not (noninteractive))) ;; Allow (at least) these arguments anywhere in the command line (let ((new-args nil) @@ -500,7 +510,7 @@ (cond ((or (string= arg "-q") (string= arg "-no-init-file")) - (setq init-file-user nil)) + (setq load-user-init-file-p nil)) ((string= arg "-no-site-file") (setq site-start-file nil)) ((or (string= arg "-no-early-packages") @@ -511,11 +521,20 @@ ;; Some work on this one already done in emacs.c. (string= arg "-no-autoloads") (string= arg "--no-autoloads")) - (setq init-file-user nil + (setq load-user-init-file-p nil site-start-file nil)) + ((string= arg "-user-init-file") + (setq user-init-file (pop args))) + ((string= arg "-user-init-directory") + (setq user-init-directory (file-name-as-directory (pop args)))) ((or (string= arg "-u") - (string= arg "-user")) - (setq init-file-user (pop args))) + (string= arg "-user")) + (let* ((user (pop args)) + (home-user (concat "~" user))) + (setq user-init-file (find-user-init-file home-user) + user-init-directory (file-name-as-directory + (paths-construct-path + (list home-user user-init-directory-base)))))) ((string= arg "-debug-init") (setq init-file-debug t)) ((string= arg "-unmapped") @@ -527,7 +546,9 @@ (while args (push (pop args) new-args))) (t (push arg new-args)))) - + + (setq init-file-user (and load-user-init-file-p "")) + (nreverse new-args))) (defconst initial-scratch-message "\ @@ -568,6 +589,11 @@ ;; and deletes the stdio device. (frame-initialize)) + ;; Reinitialize faces if necessary. This function changes face if + ;; it is created during auto-autoloads loading. Otherwise, it + ;; does nothing. + (startup-initialize-custom-faces) + ;; ;; We have normality, I repeat, we have normality. Anything you still ;; can't cope with is therefore your own problem. (And we don't need @@ -576,7 +602,7 @@ ;;; Load init files. (load-init-file) - + (with-current-buffer (get-buffer "*scratch*") (erase-buffer) ;; (insert initial-scratch-message) @@ -601,7 +627,7 @@ ;; If -batch, terminate after processing the command options. (when (noninteractive) (kill-emacs t)))) -(defun load-terminal-library () +(defun load-terminal-library () (when term-file-prefix (let ((term (getenv "TERM")) hyphend) @@ -612,43 +638,26 @@ (setq term (substring term 0 hyphend)) (setq term nil)))))) -(defconst user-init-directory "/.xemacs/" - "Directory where user-installed packages may go.") -(define-obsolete-variable-alias - 'emacs-user-extension-dir - 'user-init-directory) +(defun find-user-init-file (&optional directory) + "Determine the user's init file." + (unless directory + (setq directory "~")) + (dolist (file user-init-file-base-list) + (let ((expanded (paths-construct-path (list directory file)))) + (when (file-exists-p expanded) + (return expanded))))) -(defun load-user-init-file (init-file-user) +(defun load-user-init-file () "This function actually reads the init file, .emacs." - (when init-file-user -;; purge references to init.el and options.el -;; convert these to use paths-construct-path for eventual migration to init.el -;; needs to be converted when idiom for constructing "~user" paths is created -; (setq user-init-file -; (paths-construct-path (list (concat "~" init-file-user) -; user-init-directory -; "init.el"))) -; (unless (file-exists-p (expand-file-name user-init-file)) - (setq user-init-file - (paths-construct-path (list (concat "~" init-file-user) - (cond - ((eq system-type 'ms-dos) "_emacs") - (t ".emacs"))))) -; ) - (load user-init-file t t t) -;; This should not be loaded since custom stuff currently goes into .emacs -; (let ((default-custom-file -; (paths-construct-path (list (concat "~" init-file-user) -; user-init-directory -; "options.el"))) -; (when (string= custom-file default-custom-file) -; (load default-custom-file t t))) - (unless inhibit-default-init - (let ((inhibit-startup-message nil)) - ;; Users are supposed to be told their rights. - ;; (Plus how to get help and how to undo.) - ;; Don't you dare turn this off for anyone except yourself. - (load "default" t t))))) + (if (not user-init-file) + (setq user-init-file (find-user-init-file))) + (load user-init-file t t t) + (unless inhibit-default-init + (let ((inhibit-startup-message nil)) + ;; Users are supposed to be told their rights. + ;; (Plus how to get help and how to undo.) + ;; Don't you dare turn this off for anyone except yourself. + (load "default" t t)))) ;;; Load user's init file and default ones. (defun load-init-file () @@ -669,12 +678,13 @@ (debug-on-error-initial (if (eq init-file-debug t) 'startup init-file-debug))) (let ((debug-on-error debug-on-error-initial)) - (if init-file-debug + (if (and load-user-init-file-p init-file-debug) ;; Do this without a condition-case if the user wants to debug. - (load-user-init-file init-file-user) + (load-user-init-file) (condition-case error (progn - (load-user-init-file init-file-user) + (if load-user-init-file-p + (load-user-init-file)) (setq init-file-had-error nil)) (error (message "Error in init file: %s" (error-message-string error)) @@ -788,7 +798,7 @@ (setq end-of-options t)) (t (setq file-p t))) - + (when file-p (setq file-p nil) (incf file-count) @@ -826,7 +836,7 @@ (setq e (read-key-sequence (let ((p (keymap-prompt map t))) (cond ((symbolp map) - (if p + (if p (format "%s %s " map p) (format "%s " map))) (p) @@ -905,7 +915,7 @@ (defun startup-center-spaces (glyph) ;; Return the number of spaces to insert in order to center ;; the given glyph (may be a string or a pixmap). - ;; Assume spaces are as wide as avg-pixwidth. + ;; Assume spaces are as wide as avg-pixwidth. ;; Won't be quite right for proportional fonts, but it's the best we can do. ;; Maybe the new redisplay will export something a glyph-width function. ;;; #### Yes, there is a glyph-width function but it isn't quite what @@ -916,7 +926,7 @@ ;; This function is used in about.el too. (let* ((avg-pixwidth (round (/ (frame-pixel-width) (frame-width)))) (fill-area-width (* avg-pixwidth (- fill-column left-margin))) - (glyph-pixwidth (cond ((stringp glyph) + (glyph-pixwidth (cond ((stringp glyph) (* avg-pixwidth (length glyph))) ;; #### the pixmap option should be removed ;;((pixmapp glyph) @@ -936,12 +946,12 @@ `( "\ Sun provides support for the WorkShop/XEmacs integration package only. All other XEmacs packages are provided to you \"AS IS\".\n" - ,@(let ((lang (or (getenv "LC_ALL") (getenv "LC_MESSAGES") + ,@(let ((lang (or (getenv "LC_ALL") (getenv "LC_MESSAGES") (getenv "LANG")))) (if (and (not (featurep 'mule)) ;; Already got mule? ;; No Mule support on tty's yet - (not (eq 'tty (console-type))) + (not (eq 'tty (console-type))) lang ;; Non-English locale? (not (string= lang "C")) (not (string-match "^en" lang)) @@ -953,7 +963,7 @@ XEmacs, by either running the command `xemacs-mule', or by using the X resource `ESERVE*defaultXEmacsPath: xemacs-mule' when starting XEmacs from Sun WorkShop. \n"))))) - ((key describe-no-warranty) + ((key describe-no-warranty) ": "(face (red bold) "XEmacs comes with ABSOLUTELY NO WARRANTY\n")) ((key describe-copying) ": conditions to give out copies of XEmacs\n") @@ -961,16 +971,16 @@ ": how to get the latest version\n") "\n--\n" (face italic "\ -Copyright (C) 1985-1998 Free Software Foundation, Inc. +Copyright (C) 1985-1999 Free Software Foundation, Inc. Copyright (C) 1990-1994 Lucid, Inc. Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved. Copyright (C) 1994-1996 Board of Trustees, University of Illinois Copyright (C) 1995-1996 Ben Wing\n")) - + ((face (blue bold underline) "\nInformation, on-line help:\n\n") "XEmacs comes with plenty of documentation...\n\n" ,@(if (string-match "beta" emacs-version) - `((key describe-beta) + `((key describe-beta) ": " (face (red bold) "This is an Experimental version of XEmacs.\n")) `( "\n")) @@ -984,7 +994,7 @@ (face bold "Help") " menu)\n") ((key info) ": read the on-line documentation\n\n") ((key describe-project) ": read about the GNU project\n") - ((key about-xemacs) ": see who's developping XEmacs\n")) + ((key about-xemacs) ": see who's developing XEmacs\n")) ((face (blue bold underline) "\nUseful stuff:\n\n") "Things that you should know rather quickly...\n\n" @@ -999,7 +1009,7 @@ ; "If non-nil, function called to provide the startup logo. ;This function should return an initialized glyph if it is used.") -;; This will hopefully go away when gettext is functionnal. +;; This will hopefully go away when gettext is functional. (defconst splash-frame-static-body `(,(emacs-version) "\n\n" (face italic "`C-' means the control key,`M-' means the meta key\n\n"))) @@ -1020,7 +1030,7 @@ (1+ indice ))) ))) -;; ### This function now returns the (possibly nil) timeout circulating the +;; #### This function now returns the (possibly nil) timeout circulating the ;; splash-frame elements (defun display-splash-frame () (let ((logo xemacs-logo) @@ -1069,7 +1079,8 @@ ;; don't let /tmp_mnt/... get into the load-path or exec-path. (abbreviate-file-name invocation-directory))) -(defun startup-setup-paths (roots &optional +(defun startup-setup-paths (roots user-init-directory + &optional inhibit-early-packages inhibit-site-lisp debug-paths) "Setup all the various paths. @@ -1084,7 +1095,9 @@ early)) (setq late-packages late) (setq last-packages last)) - (packages-find-packages roots)) + (packages-find-packages + roots + (packages-compute-package-locations user-init-directory))) (setq early-package-load-path (packages-find-package-load-path early-packages)) (setq late-package-load-path (packages-find-package-load-path late-packages)) @@ -1128,7 +1141,7 @@ (paths-construct-info-path roots early-packages late-packages last-packages)) - + (if debug-paths (princ (format "Info-directory-list:\n%S\n" Info-directory-list) 'external-debugging-output)) @@ -1137,7 +1150,7 @@ (progn (setq lock-directory (paths-find-lock-directory roots)) (setq superlock-file (paths-find-superlock-file lock-directory)) - + (if debug-paths (progn (princ (format "lock-directory:\n%S\n" lock-directory) @@ -1158,7 +1171,7 @@ (if debug-paths (princ (format "exec-path:\n%S\n" exec-path) 'external-debugging-output)) - + (setq doc-directory (paths-find-doc-directory roots)) (if debug-paths diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/subr.el --- a/lisp/subr.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/subr.el Mon Aug 13 11:13:30 2007 +0200 @@ -223,6 +223,12 @@ The value of this variable may be buffer-local. The buffer about to be killed is current when this hook is run.") +;; called by Frecord_buffer() +(defvar record-buffer-hook nil + "Function or functions to be called when a buffer is recorded. +The value of this variable may be buffer-local. +The buffer being recorded is passed as an argument to the hook.") + ;; in C in FSFmacs (defvar kill-emacs-hook nil "Function or functions to be called when `kill-emacs' is called, @@ -239,6 +245,22 @@ (define-function 'rplaca 'setcar) (define-function 'rplacd 'setcdr) +(defun copy-symbol (symbol &optional copy-properties) + "Return a new uninterned symbol with the same name as SYMBOL. +If COPY-PROPERTIES is non-nil, the new symbol will have a copy of +SYMBOL's value, function, and property lists." + (let ((new (make-symbol (symbol-name symbol)))) + (when copy-properties + ;; This will not copy SYMBOL's chain of forwarding objects, but + ;; I think that's OK. Callers should not expect such magic to + ;; keep working in the copy in the first place. + (and (boundp symbol) + (set new (symbol-value symbol))) + (and (fboundp symbol) + (fset new (symbol-function symbol))) + (setplist new (copy-list (symbol-plist symbol)))) + new)) + ;;;; String functions. ;; XEmacs @@ -294,10 +316,14 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (or pattern (setq pattern "[ \f\t\n\r\v]+")) - ;; The FSF version of this function takes care not to cons in case - ;; of infloop. Maybe we should synch? - (let (parts (start 0)) - (while (string-match pattern string start) + (let (parts (start 0) (len (length string))) + (if (string-match pattern string) + (setq parts (cons (substring string 0 (match-beginning 0)) parts) + start (match-end 0))) + (while (and (< start len) + (string-match pattern string (if (> start (match-beginning 0)) + start + (1+ start)))) (setq parts (cons (substring string start (match-beginning 0)) parts) start (match-end 0))) (nreverse (cons (substring string start) parts)))) @@ -330,7 +356,7 @@ (erase-buffer)))) (defmacro with-current-buffer (buffer &rest body) - "Execute the forms in BODY with BUFFER as the current buffer. + "Temporarily make BUFFER the current buffer and execute the forms in BODY. The value returned is the value of the last form in BODY. See also `with-temp-buffer'." `(save-current-buffer @@ -565,9 +591,6 @@ (interactive) nil) -(define-function 'mapc-internal 'mapc) -(make-obsolete 'mapc-internal 'mapc) - (define-function 'eval-in-buffer 'with-current-buffer) (make-obsolete 'eval-in-buffer 'with-current-buffer) @@ -614,6 +637,32 @@ (t (error "Non-funcallable object: %s" function)))) +;; This function used to be an alias to `buffer-substring', except +;; that FSF Emacs 20.4 added a BUFFER argument in an incompatible way. +;; The new FSF's semantics makes more sense, but we try to support +;; both for backward compatibility. +(defun buffer-string (&optional buffer old-end old-buffer) + "Return the contents of the current buffer as a string. +If narrowing is in effect, this function returns only the visible part +of the buffer. + +If BUFFER is specified, the contents of that buffer are returned. + +The arguments OLD-END and OLD-BUFFER are supported for backward +compatibility with pre-21.2 XEmacsen times when arguments to this +function were (buffer-string &optional START END BUFFER)." + (cond + ((or (stringp buffer) (bufferp buffer)) + ;; Most definitely the new way. + (buffer-substring nil nil buffer)) + ((or (stringp old-buffer) (bufferp old-buffer) + (natnump buffer) (natnump old-end)) + ;; Definitely the old way. + (buffer-substring buffer old-end old-buffer)) + (t + ;; Probably the old way. + (buffer-substring buffer old-end old-buffer)))) + ;; This was not present before. I think Jamie had some objections ;; to this, so I'm leaving this undefined for now. --ben @@ -667,6 +716,5 @@ (define-function 'remove-directory 'delete-directory) (define-function 'set-match-data 'store-match-data) (define-function 'send-string-to-terminal 'external-debugging-output) -(define-function 'buffer-string 'buffer-substring) ;;; subr.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/symbols.el --- a/lisp/symbols.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/symbols.el Mon Aug 13 11:13:30 2007 +0200 @@ -124,7 +124,7 @@ (let ((event (apply getfun harg args))) (if (event-live-p event) nil - (setq event (allocate-event)) + (setq event (make-event)) (apply setfun harg event args)) (character-to-event value event))) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/term/pc-win.el --- a/lisp/term/pc-win.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/term/pc-win.el Mon Aug 13 11:13:30 2007 +0200 @@ -114,7 +114,7 @@ ;; We have only one font, so... (add-hook 'before-init-hook 'msdos-face-setup) ;; --------------------------------------------------------------------------- -;; More or less useful immitations of certain X-functions. A lot of the +;; More or less useful imitations of certain X-functions. A lot of the ;; values returned are questionable, but usually only the form of the ;; returned value matters. Also, by the way, recall that `ignore' is ;; a useful function for returning 'nil regardless of argument. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/term/scoansi.el --- a/lisp/term/scoansi.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/term/scoansi.el Mon Aug 13 11:13:30 2007 +0200 @@ -22,7 +22,7 @@ ;; HISTORY ;; jkj - Jan 18, 1993: Created. -;; jkj - Nov 18, 1993: Mdified to work with Emacs 19.21 +;; jkj - Nov 18, 1993: Modified to work with Emacs 19.21 ;; ;; First of all, the normal cursor movement keys. Some of these, if not diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/text-props.el --- a/lisp/text-props.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/text-props.el Mon Aug 13 11:13:30 2007 +0200 @@ -4,7 +4,7 @@ ;; Copyright (C) 1995 Amdahl Corporation. ;; Copyright (C) 1995 Ben Wing. -;; Author: Jamie Zawinski <jwz@netscape.com> +;; Author: Jamie Zawinski <jwz@jwz.org> ;; Maintainer: XEmacs Development Team ;; Keywords: extensions, wp, faces, dumped diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/toolbar.el --- a/lisp/toolbar.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/toolbar.el Mon Aug 13 11:13:30 2007 +0200 @@ -54,13 +54,13 @@ (defcustom default-toolbar-position ;; added for the options menu - dverna (default-toolbar-position) - "The location of the default toolbar. It can be 'top, 'bootom, 'left or + "The location of the default toolbar. It can be 'top, 'bottom, 'left or 'right. This option can be customized through the options menu." :group 'display - :type '(choice (const :tag "top" 'top) - (const :tag "bottom" 'bottom) - (const :tag "left" 'left) - (const :tag "right" 'right)) + :type '(choice (const :tag "top" top) + (const :tag "bottom" bottom) + (const :tag "left" left) + (const :tag "right" right)) :set #'(lambda (var val) (set-default-toolbar-position val) (setq default-toolbar-position val)) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/update-elc.el --- a/lisp/update-elc.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/update-elc.el Mon Aug 13 11:13:30 2007 +0200 @@ -84,7 +84,7 @@ ;; (print (prin1-to-string update-elc-files-to-compile)) (let (preloaded-file-list site-load-packages) - (load (concat default-directory "../lisp/dumped-lisp.el")) + (load (expand-file-name "../lisp/dumped-lisp.el")) ;; Path setup (let ((package-preloaded-file-list diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/version.el --- a/lisp/version.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/version.el Mon Aug 13 11:13:30 2007 +0200 @@ -37,16 +37,19 @@ (defconst emacs-version (purecopy - (format "%d.%d %s%s%s" + (format "%d.%d %s%s%s%s" emacs-major-version emacs-minor-version - (if xemacs-codename - (concat "\"" xemacs-codename "\"") + (if emacs-patch-level + (format "(patch %d)" emacs-patch-level) "") - " XEmacs Lucid" (if xemacs-betaname (concat " " xemacs-betaname) - ""))) + "") + (if xemacs-codename + (concat " \"" xemacs-codename "\"") + "") + " XEmacs Lucid")) "Version numbers of this version of XEmacs.") (if (featurep 'infodock) @@ -107,16 +110,19 @@ (t (insert version-string)))))) ;; from emacs-vers.el -(defun emacs-version>= (major &optional minor) - "Return true if the Emacs version is >= to the given MAJOR and MINOR numbers. -The MAJOR version number argument is required, but the MINOR version number -argument is optional. If the minor version number is not specified (or is the -symbol `nil') then only the major version numbers are considered in the test." - (if (null minor) - (>= emacs-major-version major) - (or (> emacs-major-version major) - (and (= emacs-major-version major) - (>= emacs-minor-version minor))))) +(defun emacs-version>= (major &optional minor patch) + "Return true if the Emacs version is >= to the given MAJOR, MINOR, + and PATCH numbers. +The MAJOR version number argument is required, but the other arguments +argument are optional. Only the Non-nil arguments are used in the test." + (let ((emacs-patch (or emacs-patch-level emacs-beta-version -1))) + (cond ((> emacs-major-version major)) + ((< emacs-major-version major) nil) + ((null minor)) + ((> emacs-minor-version minor)) + ((< emacs-minor-version minor) nil) + ((null patch)) + ((>= emacs-patch patch))))) ;;; We hope that this alias is easier for people to find. (define-function 'version 'emacs-version) @@ -125,10 +131,9 @@ ;; `what(1)' can extract from the executable or a core file. We don't ;; actually need this to be pointed to from lisp; pure objects can't ;; be GCed. -(or (memq system-type '(windows-nt ms-dos)) - (purecopy (concat "\n@" "(#)" (emacs-version) - "\n@" "(#)" "Configuration: " - system-configuration "\n"))) +(purecopy (concat "\n@" "(#)" (emacs-version) + "\n@" "(#)" "Configuration: " + system-configuration "\n")) ;;Local variables: ;;version-control: never diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/very-early-lisp.el --- a/lisp/very-early-lisp.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/very-early-lisp.el Mon Aug 13 11:13:30 2007 +0200 @@ -2,7 +2,7 @@ ;; Copyright (C) 1998 by Free Software Foundation, Inc. -;; Author: SL Baur <steve@altair.xemacs.org> +;; Author: SL Baur <steve@xemacs.org> ;; Michael Sperber [Mr. Preprocessor] <sperber@Informatik.Uni-Tuebingen.De> ;; Keywords: internal, dumped @@ -32,8 +32,8 @@ ;;; Code: -;;; Macros from Michael Sperber to replace read-time Lisp reader macros #-, #+ -;;; ####fixme duplicated in make-docfile.el and update-elc.el +;;; Intended replacement for read-time Lisp reader macros #-, #+ + (defmacro assemble-list (&rest components) "Assemble a list from COMPONENTS. This is a poor man's backquote: @@ -55,17 +55,17 @@ "Insert STUFF as a list element if FEATURE is a loaded feature. This is intended for use as a component of ASSEMBLE-LIST." (list 'splice - (if (featurep feature) - (list 'list stuff) - '()))) + (list 'if (list 'featurep (list 'quote feature)) + (list 'list stuff) + '()))) (defmacro unless-feature (feature stuff) "Insert STUFF as a list element if FEATURE is NOT a loaded feature. This is intended for use as a component of ASSEMBLE-LIST." (list 'splice - (if (featurep feature) - '() - (list 'list stuff)))) + (list 'if (list 'featurep (list 'quote feature)) + '() + (list 'list stuff)))) (provide 'very-early-lisp) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/view-less.el --- a/lisp/view-less.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/view-less.el Mon Aug 13 11:13:30 2007 +0200 @@ -312,6 +312,7 @@ ;; #### - THIS IS PROBABLY A REALLY DANGEROUS THING TO DO IN A MINOR MODE!! (set-buffer-modified-p buf-mod))) +;;;###autoload (defun toggle-truncate-lines (&optional p) "Toggles the values of truncate-lines. Positive prefix arg sets, negative disables." diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/wid-edit.el --- a/lisp/wid-edit.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/wid-edit.el Mon Aug 13 11:13:30 2007 +0200 @@ -1,9 +1,9 @@ ;;; wid-edit.el --- Functions for creating and using widgets. ;; -;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> -;; Maintainer: Hrvoje Niksic <hniksic@srce.hr> +;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org> ;; Keywords: extensions ;; Version: 1.9960-x ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ @@ -49,7 +49,7 @@ :group 'hypermedia) (defgroup widget-documentation nil - "Options controling the display of documentation strings." + "Options controlling the display of documentation strings." :group 'widgets) (defgroup widget-faces nil @@ -601,7 +601,7 @@ ;; In WIDGET, match the start of VALS. (cond ((widget-get widget :inline) (widget-apply widget :match-inline vals)) - ((and vals + ((and (listp vals) (widget-apply widget :match (car vals))) (cons (list (car vals)) (cdr vals))) (t nil))) @@ -674,7 +674,7 @@ :group 'widgets :type 'boolean) -(defcustom widget-image-conversion +(defcustom widget-image-file-name-suffixes '((xpm ".xpm") (gif ".gif") (png ".png") (jpeg ".jpg" ".jpeg") (xbm ".xbm")) "Conversion alist from image formats to file name suffixes." @@ -723,27 +723,27 @@ (let* ((dirlist (cons (or widget-glyph-directory (locate-data-directory "custom")) data-directory-list)) - (formats widget-image-conversion) - file) - (while (and formats (not file)) - ;; This dance is necessary, because XEmacs signals an - ;; error when it encounters an unrecognized image - ;; format. - (when (valid-image-instantiator-format-p (caar formats)) - (setq file (locate-file image dirlist - (mapconcat #'identity (cdar formats) - ":")))) - (unless file - (pop formats))) + (all-suffixes + (apply #'append + (mapcar + (lambda (el) + (and (valid-image-instantiator-format-p (car el)) + (cdr el))) + widget-image-file-name-suffixes))) + (file (locate-file image dirlist all-suffixes))) (when file - ;; We create a glyph with the file as the default image - ;; instantiator, and the TAG fallback - (let ((glyph (make-glyph `([,(caar formats) :file ,file] - [string :data ,tag])))) - ;; Cache the glyph - (laxputf widget-glyph-cache image glyph) - ;; ...and return it - glyph))))) + (let* ((extension (concat "." (file-name-extension file))) + (format (car (rassoc* extension + widget-image-file-name-suffixes + :test #'member)))) + ;; We create a glyph with the file as the default image + ;; instantiator, and the TAG fallback + (let ((glyph (make-glyph `([,format :file ,file] + [string :data ,tag])))) + ;; Cache the glyph + (laxputf widget-glyph-cache image glyph) + ;; ...and return it + glyph)))))) ((valid-instantiator-p image 'image) ;; A valid image instantiator (e.g. [gif :file "somefile"] etc.) (make-glyph `(,image [string :data ,tag]))) @@ -1898,9 +1898,6 @@ :group 'widgets :type 'boolean) -;; Cache already created GUI objects. -(defvar widget-push-button-cache nil) - (defcustom widget-push-button-prefix "[" "String used as prefix for buttons." :type 'string @@ -1925,7 +1922,7 @@ (tag-glyph (widget-get widget :tag-glyph)) (text (concat widget-push-button-prefix tag widget-push-button-suffix)) - (gui-glyphs (lax-plist-get widget-push-button-cache tag))) + gui) (cond (tag-glyph (widget-glyph-insert widget text tag-glyph)) ;; We must check for console-on-window-system-p here, @@ -1933,18 +1930,10 @@ ;; components for colors, and they are not known on TTYs). ((and widget-push-button-gui (console-on-window-system-p)) - (unless gui-glyphs - (let* ((gui-button-shadow-thickness 1) - (gui (make-gui-button tag 'widget-gui-action widget))) - (setq - gui-glyphs - (list - (make-glyph `(,(nth 0 (aref gui 1)) [string :data ,text])) - (make-glyph `(,(nth 1 (aref gui 1)) [string :data ,text])) - (make-glyph `(,(nth 2 (aref gui 1)) [string :data ,text])))) - (laxputf widget-push-button-cache tag gui-glyphs))) - (widget-glyph-insert-glyph - widget (nth 0 gui-glyphs) (nth 1 gui-glyphs) (nth 2 gui-glyphs))) + (let* ((gui-button-shadow-thickness 1)) + (setq gui (make-glyph + (make-gui-button tag 'widget-gui-action widget)))) + (widget-glyph-insert-glyph widget gui)) (t (insert text))))) @@ -2532,7 +2521,7 @@ found)) (defun widget-checklist-match-up (args vals) - ;; Rerturn the first type from ARGS that matches VALS. + ;; Return the first type from ARGS that matches VALS. (let (current found) (while (and args (null found)) (setq current (car args) @@ -2554,7 +2543,7 @@ result)) (defun widget-checklist-validate (widget) - ;; Ticked chilren must be valid. + ;; Ticked children must be valid. (let ((children (widget-get widget :children)) child button found) (while (and children (not found)) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/widget.el --- a/lisp/widget.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/widget.el Mon Aug 13 11:13:30 2007 +0200 @@ -3,7 +3,7 @@ ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> -;; Maintainer: Hrvoje Niksic <hniksic@srce.hr> +;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org> ;; Keywords: help, extensions, faces, hypermedia, dumped ;; Version: 1.9960-x ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/window.el --- a/lisp/window.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/window.el Mon Aug 13 11:13:30 2007 +0200 @@ -295,8 +295,8 @@ (select-frame frame)))) ;; check to make sure that the window is the full width ;; of the frame - (eq (nth 2 edges) - (frame-pixel-width)) + (window-leftmost-p window) + (window-rightmost-p window) (zerop (nth 0 edges)) ;; The whole buffer must be visible. (pos-visible-in-window-p (point-min) window) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/winnt.el --- a/lisp/winnt.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/winnt.el Mon Aug 13 11:13:30 2007 +0200 @@ -39,11 +39,14 @@ ;; #### Oh if we had an alist of shells and their command switches. (setq shell-command-switch "/c") -;; For appending suffixes to directories and files in shell completions. -(defun nt-shell-mode-hook () - (setq comint-completion-addsuffix '("\\" . " ") - comint-process-echoes t)) -(add-hook 'shell-mode-hook 'nt-shell-mode-hook) +;; For appending suffixes to directories and files in shell +;; completions. This screws up cygwin users so we leave it out for +;; now. Uncomment this if you only ever want to use cmd. + +;(defun nt-shell-mode-hook () +; (setq comint-completion-addsuffix '("\\" . " ") +; comint-process-echoes t)) +;(add-hook 'shell-mode-hook 'nt-shell-mode-hook) ;; Use ";" instead of ":" as a path separator (from files.el). (setq path-separator ";") diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/x-compose.el --- a/lisp/x-compose.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/x-compose.el Mon Aug 13 11:13:30 2007 +0200 @@ -2,7 +2,7 @@ ;; Copyright (C) 1992, 1993, 1997 Free Software Foundation, Inc. -;; Author: Jamie Zawinski <jwz@netscape.com> +;; Author: Jamie Zawinski <jwz@jwz.org> ;; Maintainer: XEmacs Development Team ;; Rewritten by Martin Buchholz far too many times. ;; @@ -73,7 +73,7 @@ ;; work, depending on what system and keyboard you are using. If it ;; doesn't, you'll have to read the man page for xmodmap. You might want ;; to get the "xkeycaps" program from -;; <URL:http://people.netscape.com/jwz/xkeycaps/>, +;; <URL:http://www.jwz.org/xkeycaps/>, ;; which is a graphical front end to xmodmap ;; that hides xmodmap's arcane syntax from you. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/x-faces.el --- a/lisp/x-faces.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/x-faces.el Mon Aug 13 11:13:30 2007 +0200 @@ -3,7 +3,7 @@ ;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc. ;; Copyright (C) 1995, 1996 Ben Wing. -;; Author: Jamie Zawinski <jwz@netscape.com> +;; Author: Jamie Zawinski <jwz@jwz.org> ;; Maintainer: XEmacs Development Team ;; Keywords: extensions, internal, dumped @@ -176,18 +176,19 @@ If it fails, it returns nil." (try-font-name (x-frob-font-weight font "medium") device)) -(defcustom *try-oblique-before-italic-fonts* nil +(defcustom try-oblique-before-italic-fonts nil "*If nil, italic fonts are searched before oblique fonts. If non-nil, oblique fonts are tried before italic fonts. This is mostly applicable to adobe-courier fonts" :type 'boolean - :tag "Try Oblique Before Italic Fonts" :group 'x) +(define-obsolete-variable-alias '*try-oblique-before-italic-fonts* + 'try-oblique-before-italic-fonts) (defun x-make-font-italic (font &optional device) "Given an X font specification, this attempts to make an `italic' font. If it fails, it returns nil." - (if *try-oblique-before-italic-fonts* + (if try-oblique-before-italic-fonts (or (try-font-name (x-frob-font-slant font "o") device) (try-font-name (x-frob-font-slant font "i") device)) (or (try-font-name (x-frob-font-slant font "i") device) @@ -202,18 +203,31 @@ "Given an X font specification, this attempts to make a `bold-italic' font. If it fails, it returns nil." ;; This is haired up to avoid loading the "intermediate" fonts. - (or (try-font-name - (x-frob-font-slant (x-frob-font-weight font "bold") "i") device) - (try-font-name - (x-frob-font-slant (x-frob-font-weight font "bold") "o") device) - (try-font-name - (x-frob-font-slant (x-frob-font-weight font "black") "i") device) - (try-font-name - (x-frob-font-slant (x-frob-font-weight font "black") "o") device) - (try-font-name - (x-frob-font-slant (x-frob-font-weight font "demibold") "i") device) - (try-font-name - (x-frob-font-slant (x-frob-font-weight font "demibold") "o") device))) + (if *try-oblique-before-italic-fonts* + (or (try-font-name + (x-frob-font-slant (x-frob-font-weight font "bold") "o") device) + (try-font-name + (x-frob-font-slant (x-frob-font-weight font "bold") "i") device) + (try-font-name + (x-frob-font-slant (x-frob-font-weight font "black") "o") device) + (try-font-name + (x-frob-font-slant (x-frob-font-weight font "black") "i") device) + (try-font-name + (x-frob-font-slant (x-frob-font-weight font "demibold") "o") device) + (try-font-name + (x-frob-font-slant (x-frob-font-weight font "demibold") "i") device)) + (or (try-font-name + (x-frob-font-slant (x-frob-font-weight font "bold") "i") device) + (try-font-name + (x-frob-font-slant (x-frob-font-weight font "bold") "o") device) + (try-font-name + (x-frob-font-slant (x-frob-font-weight font "black") "i") device) + (try-font-name + (x-frob-font-slant (x-frob-font-weight font "black") "o") device) + (try-font-name + (x-frob-font-slant (x-frob-font-weight font "demibold") "i") device) + (try-font-name + (x-frob-font-slant (x-frob-font-weight font "demibold") "o") device)))) (defun x-font-size (font) "Return the nominal size of the given font. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/x-font-menu.el --- a/lisp/x-font-menu.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/x-font-menu.el Mon Aug 13 11:13:30 2007 +0200 @@ -4,9 +4,10 @@ ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp. ;; Copyright (C) 1997 Sun Microsystems -;; Author: Jamie Zawinski <jwz@netscape.com> +;; Author: Jamie Zawinski <jwz@jwz.org> ;; Restructured by: Jonathan Stigelman <Stig@hackvan.com> ;; Mule-ized by: Martin Buchholz +;; More restructuring for MS-Windows by Andy Piper <andy@xemacs.org> ;; This file is part of XEmacs. @@ -24,105 +25,6 @@ ;; along with XEmacs; see the file COPYING. If not, write to the ;; Free Software Foundation, 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. - -;;; Commentary: -;;; -;;; Creates three menus, "Font", "Size", and "Weight", and puts them on the -;;; "Options" menu. The contents of these menus are the superset of those -;;; properties available on any fonts, but only the intersection of the three -;;; sets is selectable at one time. -;;; -;;; Known Problems: -;;; =============== -;;; Items on the Font menu are selectable if and only if that font exists in -;;; the same size and weight as the current font. This means that some fonts -;;; are simply not reachable from some other fonts - if only one font comes -;;; in only one point size (like "Nil", which comes only in 2), you will never -;;; be able to select it. It would be better if the items on the Fonts menu -;;; were always selectable, and selecting them would set the size to be the -;;; closest size to the current font's size. -;;; -;;; This attempts to change all other faces in an analagous way to the change -;;; that was made to the default face; if it can't, it will skip over the face. -;;; However, this could leave incongruous font sizes around, which may cause -;;; some nonreversibility problems if further changes are made. Perhaps it -;;; should remember the initial fonts of all faces, and derive all subsequent -;;; fonts from that initial state. -;;; -;;; xfontsel(1) is a lot more flexible (but probably harder to understand). -;;; -;;; The code to construct menus from all of the x11 fonts available from the -;;; server is autoloaded and executed the very first time that one of the Font -;;; menus is selected on each device. That is, if XEmacs has frames on two -;;; different devices, then separate font menu information will be maintained -;;; for each X display. If the font path changes after emacs has already -;;; asked the X server on a particular display for its list of fonts, this -;;; won't notice. Also, the first time that a font menu is posted on each -;;; display will entail a lengthy delay, but that's better than slowing down -;;; XEmacs startup. At any time (i.e.: after a font-path change or -;;; immediately after device creation), you can call -;;; `reset-device-font-menus' to rebuild the menus from all currently -;;; available fonts. -;;; -;;; There is knowledge here about the regexp match numbers in -;;; `x-font-regexp' and `x-font-regexp-foundry-and-family' defined in -;;; x-faces.el. -;;; -;;; There are at least three kinds of fonts under X11r5: -;;; -;;; - bitmap fonts, which can be assumed to look as good as possible; -;;; - bitmap fonts which have been (or can be) automatically scaled to -;;; a new size, and which almost always look awful; -;;; - and true outline fonts, which should look ok at any size, but in -;;; practice (on at least some systems) look awful at any size, and -;;; even in theory are unlikely ever to look as good as non-scaled -;;; bitmap fonts. -;;; -;;; It would be nice to get this code to look for non-scaled bitmap fonts -;;; first, then outline fonts, then scaled bitmap fonts as a last resort. -;;; But it's not clear to me how to tell them apart based on their truenames -;;; and/or the result of XListFonts(). I welcome any and all explanations -;;; of the subtleties involved... -;;; -;;; -;;; If You Think You'Re Seeing A Bug: -;;; ================================= -;;; When reporting problems, send the following information: -;;; -;;; - Exactly what behavior you're seeing; -;;; - The output of the `xlsfonts' program; -;;; - The value of the variable `device-fonts-cache'; -;;; - The values of the following expressions, both before and after -;;; making a selection from any of the fonts-related menus: -;;; (face-font 'default) -;;; (font-truename (face-font 'default)) -;;; (font-properties (face-font 'default)) -;;; - The values of the following variables after making a selection: -;;; font-menu-preferred-resolution -;;; font-menu-registry-encoding -;;; -;;; There is a common misconception that "*-courier-medium-r-*-11-*", also -;;; known as "-adobe-courier-medium-r-normal--11-80-100-100-m-60-iso8859-1", -;;; is an 11-point font. It is not -- it is an 11-pixel font at 100dpi, -;;; which is an 8-point font (the number after -11- is the size in tenths -;;; of points). So if you expect to be seeing an "11" entry in the "Size" -;;; menu and are not, this may be why. -;;; -;;; In the real world (aka Solaris), one has to deal with fonts that -;;; appear to be medium-i but are really light-r, and fonts that -;;; resolve to different resolutions depending on the charset: -;;; -;;; (font-instance-truename -;;; (make-font-instance "-*-mincho-medium-i-normal-*-*-*-*-*-*-*-jisx0201*-*")) -;;; ==> -;;; "-morisawa-ryumin light kl-light-r-normal--10-100-72-72-m-50-jisx0201.1976-0" -;;; -;;; (list-fonts "-dt-interface user-medium-r-normal-s*-*-*-*-*-*-*-*-*") -;;; ==> -;;; ("-dt-interface user-medium-r-normal-s sans-12-120-72-72-m-70-iso8859-1" -;;; "-dt-interface user-medium-r-normal-s-14-120-75-75-m-120-jisx0208.1983-0" -;;; "-dt-interface user-medium-r-normal-s-14-120-75-75-m-60-jisx0201.1976-0") - ;;; Code: ;; #### - implement these... @@ -130,30 +32,12 @@ ;;; (defvar font-menu-ignore-proportional-fonts nil ;;; "*If non-nil, then the font menu will only show fixed-width fonts.") -;;;###autoload -(defcustom font-menu-ignore-scaled-fonts t - "*If non-nil, then the font menu will try to show only bitmap fonts." - :type 'boolean - :group 'x) +(require 'font-menu) -;;;###autoload -(defcustom font-menu-this-frame-only-p nil - "*If non-nil, then changing the default font from the font menu will only -affect one frame instead of all frames." - :type 'boolean - :group 'x) - -;; only call XListFonts (and parse) once per device. -;; ( (device . [parsed-list-fonts family-menu size-menu weight-menu]) ...) -(defvar device-fonts-cache nil) - -(defvar font-menu-registry-encoding nil +(defvar x-font-menu-registry-encoding nil "Registry and encoding to use with font menu fonts.") -(defvar font-menu-preferred-resolution "*-*" - "Preferred horizontal and vertical font menu resolution (e.g. \"75-75\").") - -(defvar fonts-menu-junk-families +(defvar x-fonts-menu-junk-families (purecopy (mapconcat #'identity @@ -167,11 +51,6 @@ "\\|")) "A regexp matching font families which are uninteresting (e.g. cursor fonts).") -(eval-when-compile - (defsubst device-fonts-cache () - (or (cdr (assq (selected-device) device-fonts-cache)) - (reset-device-font-menus (selected-device))))) - (defun hack-font-truename (fn) "Filter the output of `font-instance-truename' to deal with Japanese fontsets." (if (string-match "," (font-instance-truename fn)) @@ -186,26 +65,12 @@ ret) (font-instance-truename fn))) -;;;###autoload -(fset 'install-font-menus 'reset-device-font-menus) -(make-obsolete 'install-font-menus 'reset-device-font-menus) - (defvar x-font-regexp-ascii nil "This is used to filter out font families that can't display ASCII text. It must be set at run-time.") -(defun vassoc (key valist) - "Search VALIST for a vector whose first element is equal to KEY. -See also `assoc'." - ;; by Stig@hackvan.com - (let (el) - (catch 'done - (while (setq el (pop valist)) - (and (equal key (aref el 0)) - (throw 'done el)))))) - ;;;###autoload -(defun reset-device-font-menus (&optional device debug) +(defun x-reset-device-font-menus (device &optional debug) "Generates the `Font', `Size', and `Weight' submenus for the Options menu. This is run the first time that a font-menu is needed for each device. If you don't like the lazy invocation of this function, you can add it to @@ -215,107 +80,100 @@ ;; by Stig@hackvan.com ;; #### - this should implement a `menus-only' option, which would ;; recalculate the menus from the cache w/o having to do list-fonts again. - (message "Getting list of fonts from server... ") - (if (or noninteractive - (not (or device (setq device (selected-device)))) - (not (eq (device-type device) 'x))) - nil - (unless x-font-regexp-ascii - (setq x-font-regexp-ascii (if (featurep 'mule) - (charset-registry 'ascii) - "iso8859-1"))) - (setq font-menu-registry-encoding - (if (featurep 'mule) "*-*" "iso8859-1")) - (let ((case-fold-search t) - family size weight entry monospaced-p - dev-cache cache families sizes weights) - (dolist (name (cond ((null debug) ; debugging kludge - (list-fonts "*-*-*-*-*-*-*-*-*-*-*-*-*-*" device)) - ((stringp debug) (split-string debug "\n")) - (t debug))) - (when (and (string-match x-font-regexp-ascii name) - (string-match x-font-regexp name)) - (setq weight (capitalize (match-string 1 name)) - size (string-to-int (match-string 6 name))) - (or (string-match x-font-regexp-foundry-and-family name) - (error "internal error")) - (setq family (capitalize (match-string 1 name))) - (or (string-match x-font-regexp-spacing name) - (error "internal error")) - (setq monospaced-p (string= "m" (match-string 1 name))) - (unless (string-match fonts-menu-junk-families family) - (setq entry (or (vassoc family cache) - (car (setq cache - (cons (vector family nil nil t) - cache))))) - (or (member family families) (push family families)) - (or (member weight weights) (push weight weights)) - (or (member size sizes) (push size sizes)) - (or (member weight (aref entry 1)) (push weight (aref entry 1))) - (or (member size (aref entry 2)) (push size (aref entry 2))) - (aset entry 3 (and (aref entry 3) monospaced-p))))) - ;; - ;; Hack scalable fonts. - ;; Some fonts come only in scalable versions (the only size is 0) - ;; and some fonts come in both scalable and non-scalable versions - ;; (one size is 0). If there are any scalable fonts at all, make - ;; sure that the union of all point sizes contains at least some - ;; common sizes - it's possible that some sensible sizes might end - ;; up not getting mentioned explicitly. - ;; - (if (member 0 sizes) - (let ((common '(60 80 100 120 140 160 180 240))) - (while common - (or;;(member (car common) sizes) ; not enough slack - (let ((rest sizes) - (done nil)) - (while (and (not done) rest) - (if (and (> (car common) (- (car rest) 5)) - (< (car common) (+ (car rest) 5))) - (setq done t)) - (setq rest (cdr rest))) - done) - (setq sizes (cons (car common) sizes))) - (setq common (cdr common))) - (setq sizes (delq 0 sizes)))) + (unless x-font-regexp-ascii + (setq x-font-regexp-ascii (if (featurep 'mule) + (charset-registry 'ascii) + "iso8859-1"))) + (setq x-font-menu-registry-encoding + (if (featurep 'mule) "*-*" "iso8859-1")) + (let ((case-fold-search t) + family size weight entry monospaced-p + dev-cache cache families sizes weights) + (dolist (name (cond ((null debug) ; debugging kludge + (list-fonts "*-*-*-*-*-*-*-*-*-*-*-*-*-*" device)) + ((stringp debug) (split-string debug "\n")) + (t debug))) + (when (and (string-match x-font-regexp-ascii name) + (string-match x-font-regexp name)) + (setq weight (capitalize (match-string 1 name)) + size (string-to-int (match-string 6 name))) + (or (string-match x-font-regexp-foundry-and-family name) + (error "internal error")) + (setq family (capitalize (match-string 1 name))) + (or (string-match x-font-regexp-spacing name) + (error "internal error")) + (setq monospaced-p (string= "m" (match-string 1 name))) + (unless (string-match x-fonts-menu-junk-families family) + (setq entry (or (vassoc family cache) + (car (setq cache + (cons (vector family nil nil t) + cache))))) + (or (member family families) (push family families)) + (or (member weight weights) (push weight weights)) + (or (member size sizes) (push size sizes)) + (or (member weight (aref entry 1)) (push weight (aref entry 1))) + (or (member size (aref entry 2)) (push size (aref entry 2))) + (aset entry 3 (and (aref entry 3) monospaced-p))))) + ;; + ;; Hack scalable fonts. + ;; Some fonts come only in scalable versions (the only size is 0) + ;; and some fonts come in both scalable and non-scalable versions + ;; (one size is 0). If there are any scalable fonts at all, make + ;; sure that the union of all point sizes contains at least some + ;; common sizes - it's possible that some sensible sizes might end + ;; up not getting mentioned explicitly. + ;; + (if (member 0 sizes) + (let ((common '(60 80 100 120 140 160 180 240))) + (while common + (or;;(member (car common) sizes) ; not enough slack + (let ((rest sizes) + (done nil)) + (while (and (not done) rest) + (if (and (> (car common) (- (car rest) 5)) + (< (car common) (+ (car rest) 5))) + (setq done t)) + (setq rest (cdr rest))) + done) + (setq sizes (cons (car common) sizes))) + (setq common (cdr common))) + (setq sizes (delq 0 sizes)))) + + (setq families (sort families 'string-lessp) + weights (sort weights 'string-lessp) + sizes (sort sizes '<)) + + (dolist (entry cache) + (aset entry 1 (sort (aref entry 1) 'string-lessp)) + (aset entry 2 (sort (aref entry 2) '<))) - (setq families (sort families 'string-lessp) - weights (sort weights 'string-lessp) - sizes (sort sizes '<)) - - (dolist (entry cache) - (aset entry 1 (sort (aref entry 1) 'string-lessp)) - (aset entry 2 (sort (aref entry 2) '<))) - - (message "Getting list of fonts from server... done.") - - (setq dev-cache (assq device device-fonts-cache)) - (or dev-cache - (setq dev-cache (car (push (list device) device-fonts-cache)))) - (setcdr - dev-cache - (vector - cache - (mapcar (lambda (x) - (vector x - (list 'font-menu-set-font x nil nil) - ':style 'radio ':active nil ':selected nil)) - families) - (mapcar (lambda (x) - (vector (if (/= 0 (% x 10)) - ;; works with no LISP_FLOAT_TYPE - (concat (int-to-string (/ x 10)) "." - (int-to-string (% x 10))) - (int-to-string (/ x 10))) - (list 'font-menu-set-font nil nil x) - ':style 'radio ':active nil ':selected nil)) - sizes) - (mapcar (lambda (x) - (vector x - (list 'font-menu-set-font nil x nil) - ':style 'radio ':active nil ':selected nil)) - weights))) - (cdr dev-cache)))) + (setq dev-cache (assq device device-fonts-cache)) + (or dev-cache + (setq dev-cache (car (push (list device) device-fonts-cache)))) + (setcdr + dev-cache + (vector + cache + (mapcar (lambda (x) + (vector x + (list 'font-menu-set-font x nil nil) + ':style 'radio ':active nil ':selected nil)) + families) + (mapcar (lambda (x) + (vector (if (/= 0 (% x 10)) + ;; works with no LISP_FLOAT_TYPE + (concat (int-to-string (/ x 10)) "." + (int-to-string (% x 10))) + (int-to-string (/ x 10))) + (list 'font-menu-set-font nil nil x) + ':style 'radio ':active nil ':selected nil)) + sizes) + (mapcar (lambda (x) + (vector x + (list 'font-menu-set-font nil x nil) + ':style 'radio ':active nil ':selected nil)) + weights))) + (cdr dev-cache))) ;; Extract font information from a face. We examine both the ;; user-specified font name and the canonical (`true') font name. @@ -325,7 +183,8 @@ ;; We use the user-specified one if possible, else use the truename. ;; If the user didn't specify one (with "-dt-*-*", for example) ;; get the truename and use the possibly suboptimal data from that. -(defun* font-menu-font-data (face dcache) +;;;###autoload +(defun* x-font-menu-font-data (face dcache) (let* ((case-fold-search t) (domain (if font-menu-this-frame-only-p (selected-frame) @@ -343,7 +202,7 @@ (setq family (capitalize (match-string 1 truename))) (setq entry (vassoc family (aref dcache 0)))) (when (null entry) - (return-from font-menu-font-data (make-vector 5 nil))) + (return-from x-font-menu-font-data (make-vector 5 nil))) (when (string-match x-font-regexp name) (setq weight (capitalize (match-string 1 name))) @@ -358,188 +217,7 @@ (vector entry family size weight slant))) -;;;###autoload -(defun font-menu-family-constructor (ignored) - (catch 'menu - (unless (eq 'x (device-type (selected-device))) - (throw 'menu '(["Cannot parse current font" ding nil]))) - (let* ((dcache (device-fonts-cache)) - (font-data (font-menu-font-data 'default dcache)) - (entry (aref font-data 0)) - (family (aref font-data 1)) - (size (aref font-data 2)) - (weight (aref font-data 3)) - f) - (unless family - (throw 'menu '(["Cannot parse current font" ding nil]))) - ;; Items on the Font menu are enabled iff that font exists in - ;; the same size and weight as the current font (scalable fonts - ;; exist in every size). Only the current font is marked as - ;; selected. - (mapcar - (lambda (item) - (setq f (aref item 0) - entry (vassoc f (aref dcache 0))) - (if (and (member weight (aref entry 1)) - (or (member size (aref entry 2)) - (and (not font-menu-ignore-scaled-fonts) - (member 0 (aref entry 2))))) - (enable-menu-item item) - (disable-menu-item item)) - (if (string-equal family f) - (select-toggle-menu-item item) - (deselect-toggle-menu-item item)) - item) - (aref dcache 1))))) - -;;;###autoload -(defun font-menu-size-constructor (ignored) - (catch 'menu - (unless (eq 'x (device-type (selected-device))) - (throw 'menu '(["Cannot parse current font" ding nil]))) - (let* ((dcache (device-fonts-cache)) - (font-data (font-menu-font-data 'default dcache)) - (entry (aref font-data 0)) - (family (aref font-data 1)) - (size (aref font-data 2)) - ;;(weight (aref font-data 3)) - s) - (unless family - (throw 'menu '(["Cannot parse current font" ding nil]))) - ;; Items on the Size menu are enabled iff current font has - ;; that size. Only the size of the current font is selected. - ;; (If the current font comes in size 0, it is scalable, and - ;; thus has every size.) - (mapcar - (lambda (item) - (setq s (nth 3 (aref item 1))) - (if (or (member s (aref entry 2)) - (and (not font-menu-ignore-scaled-fonts) - (member 0 (aref entry 2)))) - (enable-menu-item item) - (disable-menu-item item)) - (if (eq size s) - (select-toggle-menu-item item) - (deselect-toggle-menu-item item)) - item) - (aref dcache 2))))) - -;;;###autoload -(defun font-menu-weight-constructor (ignored) - (catch 'menu - (unless (eq 'x (device-type (selected-device))) - (throw 'menu '(["Cannot parse current font" ding nil]))) - (let* ((dcache (device-fonts-cache)) - (font-data (font-menu-font-data 'default dcache)) - (entry (aref font-data 0)) - (family (aref font-data 1)) - ;;(size (aref font-data 2)) - (weight (aref font-data 3)) - w) - (unless family - (throw 'menu '(["Cannot parse current font" ding nil]))) - ;; Items on the Weight menu are enabled iff current font - ;; has that weight. Only the weight of the current font - ;; is selected. - (mapcar - (lambda (item) - (setq w (aref item 0)) - (if (member w (aref entry 1)) - (enable-menu-item item) - (disable-menu-item item)) - (if (string-equal weight w) - (select-toggle-menu-item item) - (deselect-toggle-menu-item item)) - item) - (aref dcache 3))))) - - -;;; Changing font sizes - -(defun font-menu-set-font (family weight size) - ;; This is what gets run when an item is selected from any of the three - ;; fonts menus. It needs to be rather clever. - ;; (size is measured in 10ths of points.) - (let* ((dcache (device-fonts-cache)) - (font-data (font-menu-font-data 'default dcache)) - (from-family (aref font-data 1)) - (from-size (aref font-data 2)) - (from-weight (aref font-data 3)) - (from-slant (aref font-data 4)) - new-default-face-font - new-props) - (unless from-family - (signal 'error '("couldn't parse font name for default face"))) - (when weight - (signal 'error '("Setting weight currently not supported"))) - (setq new-default-face-font - (font-menu-load-font (or family from-family) - (or weight from-weight) - (or size from-size) - from-slant - font-menu-preferred-resolution)) - (dolist (face (delq 'default (face-list))) - (when (face-font-instance face) - (message "Changing font of `%s'..." face) - (condition-case c - (font-menu-change-face face - from-family from-weight from-size - family weight size) - (error - (display-error c nil) - (sit-for 1))))) - ;; Set the default face's font after hacking the other faces, so that - ;; the frame size doesn't change until we are all done. - - ;; If we need to be frame local we do the changes ourselves. - (if font-menu-this-frame-only-p - ;;; WMP - we need to honor font-menu-this-frame-only-p here! - (set-face-font 'default new-default-face-font - (and font-menu-this-frame-only-p (selected-frame))) - ;; OK Let Customize do it. - (when (and family (not (equal family from-family))) - (setq new-props (append (list :family family) new-props))) - (when (and size (not (equal size from-size))) - (setq new-props (append - (list :size (concat (int-to-string (/ size 10)) "pt")) new-props))) - (custom-set-face-update-spec 'default '((type x)) new-props) - (message "Font %s" (face-font-name 'default))))) - - -(defun font-menu-change-face (face - from-family from-weight from-size - to-family to-weight to-size) - (or (symbolp face) (signal 'wrong-type-argument (list 'symbolp face))) - (let* ((dcache (device-fonts-cache)) - (font-data (font-menu-font-data face dcache)) - (face-family (aref font-data 1)) - (face-size (aref font-data 2)) - (face-weight (aref font-data 3)) - (face-slant (aref font-data 4))) - - (or face-family - (signal 'error (list "couldn't parse font name for face" face))) - - ;; If this face matches the old default face in the attribute we - ;; are changing, then change it to the new attribute along that - ;; dimension. Also, the face must have its own global attribute. - ;; If its value is inherited, we don't touch it. If any of this - ;; is not true, we leave it alone. - (when (and (face-font face 'global) - (cond - (to-family (string-equal face-family from-family)) - (to-weight (string-equal face-weight from-weight)) - (to-size (= face-size from-size)))) - (set-face-font face - (font-menu-load-font (or to-family face-family) - (or to-weight face-weight) - (or to-size face-size) - face-slant - font-menu-preferred-resolution) - (and font-menu-this-frame-only-p - (selected-frame)))))) - -(defun font-menu-load-font (family weight size slant resolution) +(defun x-font-menu-load-font (family weight size slant resolution) "Try to load a font with the requested properties. The weight, slant and resolution are only hints." (when (integerp size) (setq size (int-to-string size))) @@ -559,18 +237,10 @@ (make-font-instance (concat "-*-" family "-" weight "-" slant "-*-*-*-" size "-" resolution "-*-*-" - font-menu-registry-encoding) + x-font-menu-registry-encoding) nil t)) (throw 'got-font font)))))))) -(defun flush-device-fonts-cache (device) - ;; by Stig@hackvan.com - (let ((elt (assq device device-fonts-cache))) - (and elt - (setq device-fonts-cache (delq elt device-fonts-cache))))) - -(add-hook 'delete-device-hook 'flush-device-fonts-cache) - (provide 'x-font-menu) ;;; x-font-menu.el ends here diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/x-iso8859-1.el --- a/lisp/x-iso8859-1.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/x-iso8859-1.el Mon Aug 13 11:13:30 2007 +0200 @@ -2,7 +2,7 @@ ;; Copyright (C) 1992, 1993, 1997 Free Software Foundation, Inc. -;; Author: Jamie Zawinski <jwz@netscape.com> +;; Author: Jamie Zawinski <jwz@jwz.org> ;; Created: 15-jun-92 ;; Maintainer: XEmacs Development Team ;; Keywords: extensions, internal, dumped diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/x-mouse.el --- a/lisp/x-mouse.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/x-mouse.el Mon Aug 13 11:13:30 2007 +0200 @@ -36,6 +36,8 @@ ;;(define-key global-map '(shift button2) 'x-mouse-kill) (define-key global-map '(control button2) 'x-set-point-and-move-selection) +(define-obsolete-function-alias 'x-insert-selection 'insert-selection) + (defun x-mouse-kill (event) "Kill the text between the point and mouse and copy it to the clipboard and to the cut buffer" @@ -43,51 +45,10 @@ (let ((old-point (point))) (mouse-set-point event) (let ((s (buffer-substring old-point (point)))) - (x-own-clipboard s) + (own-clipboard s) (x-store-cutbuffer s)) (kill-region old-point (point)))) -(defun x-yank-function () - "Insert the current X selection or, if there is none, insert the X cutbuffer. -A mark is pushed, so that the inserted text lies between point and mark." - (push-mark) - (if (region-active-p) - (if (consp zmacs-region-extent) - ;; pirated code from insert-rectangle in rect.el - ;; perhaps that code should be modified to handle a list of extents - ;; as the rectangle to be inserted? - (let ((lines zmacs-region-extent) - (insertcolumn (current-column)) - (first t)) - (push-mark) - (while lines - (or first - (progn - (forward-line 1) - (or (bolp) (insert ?\n)) - (move-to-column insertcolumn t))) - (setq first nil) - (insert (extent-string (car lines))) - (setq lines (cdr lines)))) - (insert (extent-string zmacs-region-extent))) - (x-insert-selection t))) - -(defun x-insert-selection (&optional check-cutbuffer-p move-point-event) - "Insert the current selection into buffer at point." - (interactive "P") - (let ((text (if check-cutbuffer-p - (or (condition-case () (x-get-selection) (error ())) - (x-get-cutbuffer) - (error "No selection or cut buffer available")) - (x-get-selection)))) - (cond (move-point-event - (mouse-set-point move-point-event) - (push-mark (point))) - ((interactive-p) - (push-mark (point)))) - (insert text) - )) - (make-obsolete 'x-set-point-and-insert-selection 'mouse-yank) (defun x-set-point-and-insert-selection (event) "Set point where clicked and insert the primary selection or the cut buffer." @@ -102,9 +63,9 @@ ;; to fail; just let the appropriate error message get issued. (We need ;; to insert the selection and set point first, or the selection may ;; get inserted at the wrong place.) - (and (x-selection-owner-p) + (and (selection-owner-p) primary-selection-extent - (x-insert-selection t event)) + (insert-selection t event)) (kill-primary-selection)) (defun mouse-track-and-copy-to-cutbuffer (event) diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/x-select.el --- a/lisp/x-select.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/x-select.el Mon Aug 13 11:13:30 2007 +0200 @@ -35,95 +35,30 @@ ;;; Code: -(defvar x-selected-text-type - (if (featurep 'mule) '(COMPOUND_TEXT STRING) 'STRING) - "The type atom used to obtain selections from the X server. -Can be either a valid X selection data type, or a list of such types. -COMPOUND_TEXT and STRING are the most commonly used data types. -If a list is provided, the types are tried in sequence until -there is a successful conversion.") - -(defun x-get-selection (&optional type data-type) - "Return the value of an X Windows selection. -The argument TYPE (default `PRIMARY') says which selection, -and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule) -says how to convert the data." - (or type (setq type 'PRIMARY)) - (or data-type (setq data-type x-selected-text-type)) - (let ((text - (if (consp data-type) - (condition-case err - (x-get-selection-internal type (car data-type)) - (selection-conversion-error - (if (cdr data-type) - (x-get-selection type (cdr data-type)) - (signal (car err) (cdr err))))) - (x-get-selection-internal type data-type)))) - (when (and (consp text) (symbolp (car text))) - (setq text (cdr text))) - (when (not (stringp text)) - (error "Selection is not a string: %S" text)) - text)) +(define-obsolete-function-alias 'x-selection-exists-p 'selection-exists-p) +(define-obsolete-function-alias 'x-selection-owner-p 'selection-owner-p) +(define-obsolete-variable-alias 'x-selection-converter-alist 'selection-converter-alist) +(define-obsolete-variable-alias 'x-lost-selection-hooks 'lost-selection-hooks) +(define-obsolete-variable-alias 'x-selected-text-type 'selected-text-type) +(define-obsolete-function-alias 'x-valid-simple-selection-p 'valid-simple-selection-p) +(define-obsolete-function-alias 'x-own-selection 'own-selection) +(define-obsolete-function-alias 'x-disown-selection 'disown-selection) +(define-obsolete-function-alias 'x-delete-primary-selection 'delete-primary-selection) +(define-obsolete-function-alias 'x-copy-primary-selection 'copy-primary-selection) +(define-obsolete-function-alias 'x-kill-primary-selection 'kill-primary-selection) +(define-obsolete-function-alias 'x-select-make-extent-for-selection + 'select-make-extent-for-selection) +(define-obsolete-function-alias 'x-cut-copy-clear-internal 'cut-copy-clear-internal) +(define-obsolete-function-alias 'x-get-selection 'get-selection) +(define-obsolete-function-alias 'x-get-clipboard 'get-clipboard) +(define-obsolete-function-alias 'x-yank-clipboard-selection + 'yank-clipboard-selection) +(define-obsolete-function-alias 'x-disown-selection-internal + 'disown-selection-internal) (defun x-get-secondary-selection () "Return text selected from some X window." - (x-get-selection 'SECONDARY)) - -(defun x-get-clipboard () - "Return text pasted to the clipboard." - (x-get-selection 'CLIPBOARD)) - -;; FSFmacs calls this `x-set-selection', and reverses the -;; arguments (duh ...). This order is more logical. -(defun x-own-selection (data &optional type) - "Make an X Windows selection of type TYPE and value DATA. -The argument TYPE (default `PRIMARY') says which selection, -and DATA specifies the contents. DATA may be a string, -a symbol, an integer (or a cons of two integers or list of two integers). - -The selection may also be a cons of two markers pointing to the same buffer, -or an overlay. In these cases, the selection is considered to be the text -between the markers *at whatever time the selection is examined*. -Thus, editing done in the buffer after you specify the selection -can alter the effective value of the selection. - -The data may also be a vector of valid non-vector selection values. - -Interactively, the text of the region is used as the selection value." - (interactive (if (not current-prefix-arg) - (list (read-string "Store text for pasting: ")) - (list (substring (region-beginning) (region-end))))) - ;FSFmacs huh?? It says: - ;; "This is for temporary compatibility with pre-release Emacs 19." - ;(if (stringp type) - ; (setq type (intern type))) - (or (x-valid-simple-selection-p data) - (and (vectorp data) - (let ((valid t) - (i (1- (length data)))) - (while (>= i 0) - (or (x-valid-simple-selection-p (aref data i)) - (setq valid nil)) - (setq i (1- i))) - valid)) - (signal 'error (list "invalid selection" data))) - (or type (setq type 'PRIMARY)) - (if data - (x-own-selection-internal type data) - (x-disown-selection-internal type)) - (cond ((eq type 'PRIMARY) - (setq primary-selection-extent - (select-make-extent-for-selection - data primary-selection-extent))) - ((eq type 'SECONDARY) - (setq secondary-selection-extent - (select-make-extent-for-selection - data secondary-selection-extent)))) - (setq zmacs-region-stays t) - data) - -(defun x-valid-simple-selection-p (data) - (valid-simple-selection-p data)) + (get-selection 'SECONDARY)) (defun x-own-secondary-selection (selection &optional type) "Make a secondary X Selection of the given argument. The argument may be a @@ -134,39 +69,7 @@ (list (cons ;; these need not be ordered. (copy-marker (point-marker)) (copy-marker (mark-marker)))))) - (x-own-selection selection 'SECONDARY)) - - -(defun x-own-clipboard (string) - "Paste the given string to the X Clipboard." - (x-own-selection string 'CLIPBOARD)) - - -(defun x-disown-selection (&optional secondary-p) - "Assuming we own the selection, disown it. With an argument, discard the -secondary selection instead of the primary selection." - (x-disown-selection-internal (if secondary-p 'SECONDARY 'PRIMARY))) - -(defun x-dehilight-selection (selection) - "for use as a value of `x-lost-selection-hooks'." - (cond ((eq selection 'PRIMARY) - (if primary-selection-extent - (let ((inhibit-quit t)) - (if (consp primary-selection-extent) - (mapcar 'delete-extent primary-selection-extent) - (delete-extent primary-selection-extent)) - (setq primary-selection-extent nil))) - (if zmacs-regions (zmacs-deactivate-region))) - ((eq selection 'SECONDARY) - (if secondary-selection-extent - (let ((inhibit-quit t)) - (if (consp secondary-selection-extent) - (mapcar 'delete-extent secondary-selection-extent) - (delete-extent secondary-selection-extent)) - (setq secondary-selection-extent nil))))) - nil) - -(setq x-lost-selection-hooks 'x-dehilight-selection) + (own-selection selection 'SECONDARY)) (defun x-notice-selection-requests (selection type successful) "for possible use as the value of x-sent-selection-hooks." @@ -199,8 +102,8 @@ (defun xselect-kill-buffer-hook-1 (selection) (let (value) - (if (and (x-selection-owner-p selection) - (setq value (x-get-selection-internal selection '_EMACS_INTERNAL)) + (if (and (selection-owner-p selection) + (setq value (get-selection-internal selection '_EMACS_INTERNAL)) ;; The _EMACS_INTERNAL selection type has a converter registered ;; for it that does no translation. This only works if emacs is ;; requesting the selection from itself. We could have done this @@ -212,7 +115,7 @@ (and (extent-live-p value) (eq (current-buffer) (extent-object value))) (and (extentp value) (not (extent-live-p value))))) - (x-disown-selection-internal selection)))) + (disown-selection-internal selection)))) ;;; Cut Buffer support @@ -250,253 +153,6 @@ (x-store-cutbuffer-internal 'CUT_BUFFER0 string)))) -;;; Random utility functions - -(defun x-yank-clipboard-selection () - "Insert the current Clipboard selection at point." - (interactive "*") - (setq last-command nil) - (setq this-command 'yank) ; so that yank-pop works. - (let ((clip (x-get-clipboard))) - (or clip (error "there is no clipboard selection")) - (push-mark) - (insert clip))) - -;;; Functions to convert the selection into various other selection types. -;;; Every selection type that emacs handles is implemented this way, except -;;; for TIMESTAMP, which is a special case. - -(defun xselect-convert-to-text (selection type value) - (cond ((stringp value) - value) - ((extentp value) - (save-excursion - (set-buffer (extent-object value)) - (save-restriction - (widen) - (buffer-substring (extent-start-position value) - (extent-end-position value))))) - ((and (consp value) - (markerp (car value)) - (markerp (cdr value))) - (or (eq (marker-buffer (car value)) (marker-buffer (cdr value))) - (signal 'error - (list "markers must be in the same buffer" - (car value) (cdr value)))) - (save-excursion - (set-buffer (or (marker-buffer (car value)) - (error "selection is in a killed buffer"))) - (save-restriction - (widen) - (buffer-substring (car value) (cdr value))))) - (t nil))) - -(defun xselect-convert-to-string (selection type value) - (let ((outval (xselect-convert-to-text selection type value))) - ;; force the string to be not in Compound Text format. - (if (stringp outval) - (cons 'STRING outval) - outval))) - -(defun xselect-convert-to-compound-text (selection type value) - ;; converts to compound text automatically - (xselect-convert-to-text selection type value)) - -(defun xselect-convert-to-length (selection type value) - (let ((value - (cond ((stringp value) - (length value)) - ((extentp value) - (extent-length value)) - ((and (consp value) - (markerp (car value)) - (markerp (cdr value))) - (or (eq (marker-buffer (car value)) - (marker-buffer (cdr value))) - (signal 'error - (list "markers must be in the same buffer" - (car value) (cdr value)))) - (abs (- (car value) (cdr value))))))) - (if value ; force it to be in 32-bit format. - (cons (ash value -16) (logand value 65535)) - nil))) - -(defun xselect-convert-to-targets (selection type value) - ;; return a vector of atoms, but remove duplicates first. - (let* ((all (cons 'TIMESTAMP (mapcar 'car selection-converter-alist))) - (rest all)) - (while rest - (cond ((memq (car rest) (cdr rest)) - (setcdr rest (delq (car rest) (cdr rest)))) - ((eq (car (cdr rest)) '_EMACS_INTERNAL) ; shh, it's a secret - (setcdr rest (cdr (cdr rest)))) - (t - (setq rest (cdr rest))))) - (apply 'vector all))) - -(defun xselect-convert-to-delete (selection type value) - (x-disown-selection-internal selection) - ;; A return value of nil means that we do not know how to do this conversion, - ;; and replies with an "error". A return value of NULL means that we have - ;; done the conversion (and any side-effects) but have no value to return. - 'NULL) - -(defun xselect-convert-to-filename (selection type value) - (cond ((extentp value) - (buffer-file-name (or (extent-object value) - (error "selection is in a killed buffer")))) - ((and (consp value) - (markerp (car value)) - (markerp (cdr value))) - (buffer-file-name (or (marker-buffer (car value)) - (error "selection is in a killed buffer")))) - (t nil))) - -(defun xselect-convert-to-charpos (selection type value) - (let (a b tmp) - (cond ((cond ((extentp value) - (setq a (extent-start-position value) - b (extent-end-position value))) - ((and (consp value) - (markerp (car value)) - (markerp (cdr value))) - (setq a (car value) - b (cdr value)))) - (setq a (1- a) b (1- b)) ; zero-based - (if (< b a) (setq tmp a a b b tmp)) - (cons 'SPAN - (vector (cons (ash a -16) (logand a 65535)) - (cons (ash b -16) (logand b 65535)))))))) - -(defun xselect-convert-to-lineno (selection type value) - (let (a b buf tmp) - (cond ((cond ((extentp value) - (setq buf (extent-object value) - a (extent-start-position value) - b (extent-end-position value))) - ((and (consp value) - (markerp (car value)) - (markerp (cdr value))) - (setq a (marker-position (car value)) - b (marker-position (cdr value)) - buf (marker-buffer (car value))))) - (save-excursion - (set-buffer buf) - (save-restriction - (widen) - (goto-char a) - (beginning-of-line) - (setq a (1+ (count-lines 1 (point)))) - (goto-char b) - (beginning-of-line) - (setq b (1+ (count-lines 1 (point)))))) - (if (< b a) (setq tmp a a b b tmp)) - (cons 'SPAN - (vector (cons (ash a -16) (logand a 65535)) - (cons (ash b -16) (logand b 65535)))))))) - -(defun xselect-convert-to-colno (selection type value) - (let (a b buf tmp) - (cond ((cond ((extentp value) - (setq buf (extent-object value) - a (extent-start-position value) - b (extent-end-position value))) - ((and (consp value) - (markerp (car value)) - (markerp (cdr value))) - (setq a (car value) - b (cdr value) - buf (marker-buffer a)))) - (save-excursion - (set-buffer buf) - (goto-char a) - (setq a (current-column)) - (goto-char b) - (setq b (current-column))) - (if (< b a) (setq tmp a a b b tmp)) - (cons 'SPAN - (vector (cons (ash a -16) (logand a 65535)) - (cons (ash b -16) (logand b 65535)))))))) - -(defun xselect-convert-to-sourceloc (selection type value) - (let (a b buf file-name tmp) - (cond ((cond ((extentp value) - (setq buf (or (extent-object value) - (error "selection is in a killed buffer")) - a (extent-start-position value) - b (extent-end-position value) - file-name (buffer-file-name buf))) - ((and (consp value) - (markerp (car value)) - (markerp (cdr value))) - (setq a (marker-position (car value)) - b (marker-position (cdr value)) - buf (or (marker-buffer (car value)) - (error "selection is in a killed buffer")) - file-name (buffer-file-name buf)))) - (save-excursion - (set-buffer buf) - (save-restriction - (widen) - (goto-char a) - (beginning-of-line) - (setq a (1+ (count-lines 1 (point)))) - (goto-char b) - (beginning-of-line) - (setq b (1+ (count-lines 1 (point)))))) - (if (< b a) (setq tmp a a b b tmp)) - (format "%s:%d" file-name a))))) - -(defun xselect-convert-to-os (selection type size) - (symbol-name system-type)) - -(defun xselect-convert-to-host (selection type size) - (system-name)) - -(defun xselect-convert-to-user (selection type size) - (user-full-name)) - -(defun xselect-convert-to-class (selection type size) - x-emacs-application-class) - -;; We do not try to determine the name Emacs was invoked with, -;; because it is not clean for a program's behavior to depend on that. -(defun xselect-convert-to-name (selection type size) - ;invocation-name - "xemacs") - -(defun xselect-convert-to-integer (selection type value) - (and (integerp value) - (cons (ash value -16) (logand value 65535)))) - -(defun xselect-convert-to-atom (selection type value) - (and (symbolp value) value)) - -(defun xselect-convert-to-identity (selection type value) ; used internally - (vector value)) - -(setq selection-converter-alist - '((TEXT . xselect-convert-to-text) - (STRING . xselect-convert-to-string) - (COMPOUND_TEXT . xselect-convert-to-compound-text) - (TARGETS . xselect-convert-to-targets) - (LENGTH . xselect-convert-to-length) - (DELETE . xselect-convert-to-delete) - (FILE_NAME . xselect-convert-to-filename) - (CHARACTER_POSITION . xselect-convert-to-charpos) - (SOURCE_LOC . xselect-convert-to-sourceloc) - (LINE_NUMBER . xselect-convert-to-lineno) - (COLUMN_NUMBER . xselect-convert-to-colno) - (OWNER_OS . xselect-convert-to-os) - (HOST_NAME . xselect-convert-to-host) - (USER . xselect-convert-to-user) - (CLASS . xselect-convert-to-class) - (NAME . xselect-convert-to-name) - (ATOM . xselect-convert-to-atom) - (INTEGER . xselect-convert-to-integer) - (_EMACS_INTERNAL . xselect-convert-to-identity) - )) - ;FSFmacs (provide 'select) ;;; x-select.el ends here. diff -r f4aeb21a5bad -r 74fd4e045ea6 lisp/x-win-sun.el --- a/lisp/x-win-sun.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/x-win-sun.el Mon Aug 13 11:13:30 2007 +0200 @@ -246,8 +246,10 @@ ;;; themselves are in x-win.el in case someone wants to use them when ;;; not running on a Sun display.) - (define-key global-map 'find 'ow-find) - (define-key global-map '(shift find) 'ow-find-backward) + (or (lookup-key global-map 'find) + (define-key global-map 'find 'ow-find)) + (or (lookup-key global-map '(shift find)) + (define-key global-map '(shift find) 'ow-find-backward)) ) diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/ChangeLog --- a/lwlib/ChangeLog Mon Aug 13 11:12:06 2007 +0200 +++ b/lwlib/ChangeLog Mon Aug 13 11:13:30 2007 +0200 @@ -1,3 +1,425 @@ +2000-02-16 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.29 is released. + +2000-02-09 Valdis Kletnieks <Valdis.Kletnieks@vt.edu> + + * config.h.in (ATHENA_INCLUDE): Workaround bugs in both xlc and + old gccs. + +2000-02-07 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.28 is released. + +2000-01-25 Andy Piper <andy@xemacs.org> + + * xlwtabs.c (TabsChangeManaged): Make sure we unmanage the hilight + widget as well. + +2000-01-28 Martin Buchholz <martin@xemacs.org> + + * xlwgauge.c (GaugeConvert): bcopy ==> memcpy + +2000-01-24 Andy Piper <andy@xemacs.org> + + * xlwtabs.c (XawTabsSetTop): Unhighlight before changing the + stacking order. + (XawTabsSetHighlight): Don't unhighlight here. + +2000-01-22 Martin Buchholz <martin@xemacs.org> + + * *.h: Use consistent C-standards-approved guard macro names. + +2000-01-18 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.27 is released. + +2000-01-15 Andy Piper <andy@xemacs.org> + + * lwlib-Xlw.c (lw_update_one_widget): make sure global + properties gets set. + +2000-01-07 Martin Buchholz <martin@xemacs.org> + + * config.h.in (ATHENA_INCLUDE): CPP trickery to make old cpps happy. + This extends support for gcc 2.6 (e.g. on BSD/OS 2.0) + + * lwlib.c: Fix up memset calls. + + * lwlib-Xm.c (xm_update_text): Warning suppression. + (xm_update_text_field): Warning suppression. + +2000-01-03 Martin Buchholz <martin@xemacs.org> + + * lwlib-Xaw.c (xaw_update_one_widget): Emergency fix for this crash: + (yes-or-no-p-dialog-box "Yes or No") + +1999-12-31 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.26 is released. + +1999-12-29 Andy Piper <andy@xemacs.org> + + * xlwtabs.c (TabsHighlight): use displayChildren for highlighting + not num_children. + (TabsPage): ditto. + +1999-12-24 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.25 is released. + +1999-12-23 Andy Piper <andy@xemacs.org> + + * lwlib.c (lw_copy_widget_value_args): don't create empty + widget_args just because someone might use them later. This makes + all widgets look like they've changed. + +1999-12-22 Andy Piper <andy@xemacs.org> + + * xlwtabs.c: Fix for X11R5 from Damon Lipparelli + <lipp@primus.com>. + +1999-12-21 Martin Buchholz <martin@xemacs.org> + + * xlwscrollbar.c (seg_pixel_sizes): ((expr)) ==> (expr) + +1999-12-12 Daniel Pittman <daniel@danann.net> + + * lwlib-Xaw.c: + * xlwcheckbox.c: + * xlwgauge.h: + * xlwgaugeP.h: + * xlwradio.c: + * xlwradio.h: + * xlwradioP.h: + Clean up Athena widget support: + - Athena headers now use dynamic include paths. + +1999-12-08 Andy Piper <andy@xemacs.org> + + * xlwtabs.c: sync with Tabs 2.2. + * xlwtabP.h: ditto. + +1999-12-14 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.24 is released. + +1999-12-14 Andy Piper <andy@xemacs.org> + + * xlwtabs.c (TabsResize): reset need_layout so that we don't go + into infloop death. + +1999-12-14 Andy Piper <andy@xemacs.org> + + * xlwtabs.c (TabsSetValues): re-allocate GCs if font has changed. + +1999-12-13 Andy Piper <andy@xemacs.org> + + * xlwtabs.c (TabsResize): We need to expose the tabs after + clearing the window they are in. + +1999-12-08 Andy Piper <andy@xemacs.org> + + * xlwtabs.c: sync with Tabs 2.1. + +1999-12-07 Andy Piper <andy@xemacs.org> + + * lwlib-Xlw.c (lw_lucid_widget_p): make sure we pick up the + clip-window as well. + +1999-12-07 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.23 is released. + +1999-12-05 Andy Piper <andy@xemacs.org> + + * xlwtabs.c: back up to previous rev to make syncing easier. Fix + gcc moans. + + * lwlib-Xaw.c (xaw_update_one_widget): use XtIsSubclass. + +1999-11-29 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.22 is released + +1999-11-28 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.21 is released. + +1999-11-26 Martin Buchholz <martin@xemacs.org> + + * xlwtabs.c: Remove unused variables. Fix warnings. + +1999-11-10 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.20 is released + +1999-09-09 Andy Piper <andy@xemacs.org> + + * xlwtabs.c: updated tabs widget from Ed Falk. + * xlwtabs.h: ditto. + * xlwtabsP.h: ditto. + +1999-09-22 Martin Buchholz <martin@xemacs.org> + + * lwlib-internal.h: + * lwlib-utils.h: + Move declaration of destroy_all_children from lwlib-internal.h to + lwlib-utils.h, where it belongs. + +1999-09-21 Andy Piper <andy@xemacs.org> + + * lwlib-Xm.c (xm_update_label): don't clobber pixmap type labels + with text. + +1999-09-22 Martin Buchholz <martin@xemacs.org> + + * xlwtabs.c: Fix C++ compilability. + +1999-09-18 Andy Piper <andy@xemacs.org> + + * xlwtabs.c: Put in tabs sync because clipping should fix useability + problems. + +1999-09-13 Andy Piper <andy@xemacs.org> + + * xlwtabs.c: Back out tabs sync because of reported useability + problems. + +1999-09-09 Andy Piper <andy@xemacs.org> + + * xlwtabs.c: updated tabs widget from Ed Falk. + * xlwtabs.h: ditto. + * xlwtabsP.h: ditto. + * xlwgcs.c: ditto. + * xlwgcs.h: ditto. + +1999-09-03 Martin Buchholz <martin@xemacs.org> + + * xlwgauge.c: Ansify. + Include <stdlib.h> to get prototype for atoi(). + (GaugeSelect): Call GaugeExpose with the right number of args. + (GaugeLoseSel): Call GaugeExpose with the right number of args. + (GaugeConvert): This is a XtConvertSelectionProc, + so 5th parameter must be of type XtPointer, not XPointer. + (GaugeGetValue): This is a XtTimerCallbackProc, + so 2nd parameter must be of type XtIntervalId *, not XtIntervalId. + + +1999-09-01 Martin Buchholz <martin@xemacs.org> + + * lwlib.c (free_widget_value_contents): Use proper type for cast. + + * xlwradio.c: Use function prototypes everywhere. + * xlwcheckbox.c: + * xlwradio.c: + * xlwradioP.h: Move declarations of non-static functions defined + in xlwradio.c into xlwradioP.h. + +1999-09-02 Andy Piper <andy@xemacs.org> + + * xlwgcs.c: include xmu.h + +1999-09-01 Andy Piper <andy@xemacs.org> + + * xlwgauge.c: rearrange headers yet again. + * xlwcheckbox.c: ditto. + * xlwradio.c: ditto. + * xlwtabs.c: ditto. + +1999-09-01 Andy Piper <andy@xemacs.org> + + * xlwgauge.c: use xmu.h + * xlwcheckbox.c: ditto. + * xlwradio.c: ditto. + +1999-08-31 Andy Piper <andy@xemacs.org> + + * xlwtabs.c: + * xlwgcs.c: + * xlwradio.c: + * xlwcheckbox.c: + * xlwgauge.c: Fix for losing systems without Xmu. + +1999-08-31 Andy Piper <andy@xemacs.org> + + * lwlib-Xm.c (xm_update_one_widget): fix for AIX compiler lossage. + +1999-08-30 Andy Piper <andy@xemacs.org> + + * lwlib.c (free_widget_value_contents): be more precise about + freeing user defined args. + + * lwlib-Xaw.c (xaw_update_one_widget): make sure we use val not + its contents for hierarchies one deep. + +1999-08-29 Andy Piper <andy@xemacs.org> + + * xlwtabs.c: temporary fixes pending a new release. + * xlwtabsP.h: ditto. + + * lwlib-Xm.c (xm_update_one_widget): update user defined args. + (xm_create_label): set args after creation as well as before. + + * lwlib-Xlw.c (xlw_create_tab_control): orient tabs horizontally. + (xlw_update_tab_control): actually update the children rather than + the parent. + + * lwlib-Xaw.c (xaw_update_one_widget): update user defined args. + (xaw_create_label): set args after creation as well as before. + +1999-08-23 Andy Piper <andy@xemacs.org> + + * lwlib-Xm.c (xm_update_label): don't concatenate value to itself. + + * lwlib-Xm.c (xm_create_label_field): new function for creating labels. + (xm_creation_table): use it. + + * lwlib-Xaw.c (xaw_create_label_field): new function for creating labels. + (xaw_creation_table): use it. + +1999-08-16 Andy Piper <andy@xemacs.org> + + * lwlib.h: declare free_widget_value_tree. + + * lwlib.c (free_widget_value_tree): make non-static. + + * lwlib-Xm.c (xm_update_label): free val_string when updating. + +1999-08-04 Andy Piper <andy@xemacs.org> + + * lwlib-Xm.c (mark_dead_instance_destroyed): change so that its + defined for widgets. + (xm_nosel_callback): ditto. + + * xlwtabsP.h: sync with 1.5. + + * xlwtabs.c: sync with 1.18. + +1999-07-28 Andy Piper <andy@xemacs.org> + + * xlwtabs.c: new lucid tabs widget from Ed Falk. + * xlwtabs.h: ditto. + * xlwtabsP.h: ditto. + * xlwgcs.c: GC manipulation for tab widgets. + * xlwgcs.h: ditto. + + * xlwgauge.c: new athena gauge widget from Ed Falk. + * xlwgauge.h: ditto. + * xlwgaugeP.h: ditto. + + * xlwradio.c: new athena radio widget from Ed Falk. + * xlwradio.h: ditto. + * xlwradioP.h: ditto. + + * xlwcheckbox.c: new athena checkbox widget from Ed Falk. + * xlwcheckbox.h: ditto. + * xlwcheckboxP.h: ditto. + + * lwlib-utils.c (destroy_all_children): moved from lwlib-Xm.c. + + * lwlib-internal.h: declare destroy_all_children. + + * lwlib-config.c: add widget checks. + + * lwlib-Xm.h: declare xm_create_label; + + * lwlib-Xm.c (destroy_all_children): move to lwlib-utils.c. + (xm_update_label): enable for widgets. + (xm_update_one_widget): ditto. + (xm_create_button): rename in line with lwlib-Xaw.c + (xm_create_progress): ditto. + (xm_create_text_field): ditto. + (xm_create_combo_box): ditto. + (xm_create_label): new function. + (xm_creation_table): rename widget creation functions. + (xm_destroy_instance): enable for widgets. + (xm_generic_callback): ditto. + (xm_generic_callback): ditto. + + * lwlib-Xlw.c (xlw_tab_control_callback): new function. a special + callback that calls the correct function depending on what tab is + selected. + (xlw_create_tab_control): new function. + (build_tabs_in_widget): new function. puts tabs in a tab widget, + uses Xaw or Xm depending on how XEmacs was compiled. + (xlw_update_tab_control): update the resources for each + tab. optionally rebuild the contents of the tab widget. + (xlw_creation_table): add tab widget creation function. + (lw_lucid_widget_p): add tab widget. + (xlw_update_one_widget): ditto. + + * lwlib-Xaw.h: declare xaw_create_label; + + * lwlib-Xaw.c (lw_xaw_widget_p): add widgets classes. + (xaw_update_one_widget): ditto. + (xaw_update_one_value): add code from the Xm version. + (xaw_generic_callback): add Xm hack for setting command + states. beef up lookup of call data. + (xaw_create_button): new function. + (xaw_create_label): new function for use by tab widget. + (xaw_create_progress): new function. + (xaw_create_text_field): new function. + (xaw_creation_table): add new widget type creation functions. + + * Makefile.in.in: add dependencies for new lw widgets. + +1999-07-30 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.19 is released + +1999-07-13 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.18 is released + +1999-07-05 Didier Verna <verna@inf.enst.fr> + + * lwlib-Xm.c (xm_update_one_widget): add missing #ifdefs around + call to xm_update_label. + +1999-06-28 Andy Piper <andy@xemacs.org> + + * lwlib-Xm.c: unconditionally enable text field & list code. + (make_progress): new function. creates a slider. + (make_text_field): new function. creates an edit field. + (make_combo_box): new function. creates a combo box. + (xm_creation_table): add new widget functions. + +1999-06-25 Andy Piper <andy@xemacs.org> + + * lwlib.h (_widget_value): add arglist slots. + declare new functions. + + * lwlib.c (free_widget_value_contents): handle arglists when + freeing. + (lw_add_value_args_to_args): new function. add arglist entries + from a widget_value structure. + + * lwlib-Xm.c (make_button): new function, create a motif button + for display in a buffer as a glyph. + (xm_creation_table): add make_button. + +1999-06-22 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.17 is released + +1999-06-11 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.16 is released + +1999-06-04 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.15 is released + +1999-05-17 Jerry James <jerry@cs.ucsb.edu> + + * xlwmenu.c (make_shadow_gcs): Test bottom_shadow_pixmap before + using it. + +1999-05-14 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.14 is released + 1999-03-12 XEmacs Build Bot <builds@cvs.xemacs.org> * XEmacs 21.2.13 is released diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/Makefile.in.in --- a/lwlib/Makefile.in.in Mon Aug 13 11:12:06 2007 +0200 +++ b/lwlib/Makefile.in.in Mon Aug 13 11:13:30 2007 +0200 @@ -95,11 +95,18 @@ ## Following correct as of 19980312 -lwlib-Xaw.o: $(CONFIG_H) lwlib-Xaw.h lwlib-internal.h lwlib.h xlwmenu.h -lwlib-Xlw.o: $(CONFIG_H) lwlib-Xlw.h lwlib-internal.h lwlib.h xlwmenu.h xlwscrollbar.h +lwlib-Xaw.o: $(CONFIG_H) lwlib-Xaw.h lwlib-internal.h lwlib.h xlwmenu.h xlwradio.h \ +xlwgauge.h xlwcheckbox.h +lwlib-Xlw.o: $(CONFIG_H) lwlib-Xlw.h lwlib-internal.h lwlib.h xlwmenu.h xlwscrollbar.h \ +xlwtabs.h xlwgcs.h lwlib-Xm.o: $(CONFIG_H) lwlib-Xm.h lwlib-internal.h lwlib-utils.h lwlib.h xlwmenu.h lwlib-config.o: $(CONFIG_H) lwlib.h xlwmenu.h lwlib-utils.o: $(CONFIG_H) lwlib-utils.h lwlib.o: $(CONFIG_H) lwlib-Xaw.h lwlib-Xlw.h lwlib-Xm.h lwlib-internal.h lwlib-utils.h lwlib.h xlwmenu.h xlwmenu.o: $(CONFIG_H) lwlib.h xlwmenu.h xlwmenuP.h xlwscrollbar.o: $(CONFIG_H) xlwscrollbar.h xlwscrollbarP.h +xlwtabs.o: $(CONFIG_H) xlwtabs.h xlwtabsP.h +xlwradio.o: $(CONFIG_H) xlwradio.h xlwradioP.h +xlwcheckbox.o: $(CONFIG_H) xlwcheckbox.h xlwcheckboxP.h +xlwgauge.o: $(CONFIG_H) xlwgauge.h xlwgaugeP.h +xlwgcs.o: $(CONFIG_H) xlwgcs.h diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/config.h.in --- a/lwlib/config.h.in Mon Aug 13 11:12:06 2007 +0200 +++ b/lwlib/config.h.in Mon Aug 13 11:13:30 2007 +0200 @@ -29,4 +29,19 @@ #undef NEED_ATHENA #undef NEED_LUCID +/* The path to the Athena widgets - the usual value is `X11/Xaw' */ +#undef ATHENA_H_PATH + +/* For use in #include statements. + You can't use macros directly within the <> of a #include statement. + The multiply nested macros are necessary to make old gcc's happy. + However, those nested macros are too much for AIX xlc to deal with. */ +#if defined(_AIX) && !defined(__GNUC__) +#define ATHENA_INCLUDE(header_file) <ATHENA_H_PATH/header_file> +#else +#define INCLUDE_GLUE_2(dirname,basename) <##dirname##/##basename##> +#define INCLUDE_GLUE_1(dirname,basename) INCLUDE_GLUE_2(dirname,basename) +#define ATHENA_INCLUDE(header_file) INCLUDE_GLUE_1(ATHENA_H_PATH,header_file) +#endif + #endif /* _LWLIB_CONFIG_H_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/lwlib-Xaw.c --- a/lwlib/lwlib-Xaw.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lwlib/lwlib-Xaw.c Mon Aug 13 11:13:30 2007 +0200 @@ -33,15 +33,23 @@ #include <X11/Shell.h> #ifdef LWLIB_SCROLLBARS_ATHENA -#include <X11/Xaw/Scrollbar.h> +#include ATHENA_INCLUDE(Scrollbar.h) #endif #ifdef LWLIB_DIALOGS_ATHENA -#include <X11/Xaw/Dialog.h> -#include <X11/Xaw/Form.h> -#include <X11/Xaw/Command.h> -#include <X11/Xaw/Label.h> +#include ATHENA_INCLUDE(Dialog.h) +#include ATHENA_INCLUDE(Form.h) +#include ATHENA_INCLUDE(Command.h) +#include ATHENA_INCLUDE(Label.h) #endif - +#ifdef LWLIB_WIDGETS_ATHENA +#include ATHENA_INCLUDE(Toggle.h) +#include "xlwradio.h" +#include "xlwcheckbox.h" +#include "xlwgauge.h" +#ifndef NEED_MOTIF +#include ATHENA_INCLUDE(AsciiText.h) +#endif +#endif #include <X11/Xatom.h> static void xaw_generic_callback (Widget, XtPointer, XtPointer); @@ -57,6 +65,14 @@ #ifdef LWLIB_DIALOGS_ATHENA || XtIsSubclass (widget, dialogWidgetClass) #endif +#ifdef LWLIB_WIDGETS_ATHENA + || XtIsSubclass (widget, labelWidgetClass) + || XtIsSubclass (widget, toggleWidgetClass) + || XtIsSubclass (widget, gaugeWidgetClass) +#if 0 + || XtIsSubclass (widget, textWidgetClass) +#endif +#endif ); } @@ -110,6 +126,9 @@ xaw_update_one_widget (widget_instance *instance, Widget widget, widget_value *val, Boolean deep_p) { + if (val->args && val->args->nargs) + XtSetValues (widget, val->args->args, val->args->nargs); + if (0) ; #ifdef LWLIB_SCROLLBARS_ATHENA @@ -125,6 +144,16 @@ XtSetArg (al [0], XtNlabel, val->contents->value); XtSetValues (widget, al, 1); } +#endif /* LWLIB_DIALOGS_ATHENA */ +#ifdef LWLIB_WIDGETS_ATHENA + else if (XtClass (widget) == labelWidgetClass) + { + Arg al [1]; + XtSetArg (al [0], XtNlabel, val->value); + XtSetValues (widget, al, 1); + } +#endif /* LWLIB_WIDGETS_ATHENA */ +#if defined (LWLIB_DIALOGS_ATHENA) || defined (LWLIB_WIDGETS_ATHENA) else if (XtIsSubclass (widget, commandWidgetClass)) { Dimension bw = 0; @@ -154,6 +183,14 @@ XtRemoveAllCallbacks (widget, XtNcallback); XtAddCallback (widget, XtNcallback, xaw_generic_callback, instance); +#ifdef LWLIB_WIDGETS_ATHENA + /* set the selected state */ + if (XtIsSubclass (widget, toggleWidgetClass)) + { + XtSetArg (al [0], XtNstate, val->selected); + XtSetValues (widget, al, 1); + } +#endif /* LWLIB_WIDGETS_ATHENA */ } #endif /* LWLIB_DIALOGS_ATHENA */ } @@ -162,9 +199,36 @@ xaw_update_one_value (widget_instance *instance, Widget widget, widget_value *val) { - /* This function is not used by the scrollbars and those are the only - Athena widget implemented at the moment so do nothing. */ - return; +#ifdef LWLIB_WIDGETS_ATHENA + widget_value *old_wv; + + /* copy the call_data slot into the "return" widget_value */ + for (old_wv = instance->info->val->contents; old_wv; old_wv = old_wv->next) + if (!strcmp (val->name, old_wv->name)) + { + val->call_data = old_wv->call_data; + break; + } + + if (XtIsSubclass (widget, toggleWidgetClass)) + { + Arg al [1]; + XtSetArg (al [0], XtNstate, &val->selected); + XtGetValues (widget, al, 1); + val->edited = True; + } +#ifndef NEED_MOTIF + else if (XtIsSubclass (widget, asciiTextWidgetClass)) + { + Arg al [1]; + if (val->value) + free (val->value); + XtSetArg (al [0], XtNstring, &val->value); + XtGetValues (widget, al, 1); + val->edited = True; + } +#endif +#endif /* LWLIB_WIDGETS_ATHENA */ } void @@ -265,8 +329,8 @@ static Boolean actions_initted = False; static Widget -make_dialog (CONST char* name, Widget parent, Boolean pop_up_p, - CONST char* shell_title, CONST char* icon_name, +make_dialog (const char* name, Widget parent, Boolean pop_up_p, + const char* shell_title, const char* icon_name, Boolean text_input_slot, Boolean radio_box, Boolean list, int left_buttons, int right_buttons) @@ -374,8 +438,8 @@ Widget parent = instance->parent; Widget widget; Boolean pop_up_p = instance->pop_up_p; - CONST char *shell_name = 0; - CONST char *icon_name = 0; + const char *shell_name = 0; + const char *icon_name = 0; Boolean text_input_slot = False; Boolean radio_box = False; Boolean list = False; @@ -440,7 +504,21 @@ Widget instance_widget; LWLIB_ID id; XtPointer user_data; +#ifdef LWLIB_WIDGETS_ATHENA + /* We want the selected status to change only when we decide it + should change. Yuck but correct. */ + if (XtIsSubclass (widget, toggleWidgetClass)) + { + Boolean check; + Arg al [1]; + XtSetArg (al [0], XtNstate, &check); + XtGetValues (widget, al, 1); + + XtSetArg (al [0], XtNstate, !check); + XtSetValues (widget, al, 1); + } +#endif /* LWLIB_WIDGETS_ATHENA */ lw_internal_update_other_instances (widget, closure, call_data); if (! instance) @@ -464,17 +542,26 @@ #else /* Damn! Athena doesn't give us a way to hang our own data on the buttons, so we have to go find it... I guess this assumes that - all instances of a button have the same call data. */ + all instances of a button have the same call data. + + ... Which is a totally bogus assumption --andyp */ { - widget_value *val = instance->info->val->contents; - char *name = XtName (widget); - while (val) + widget_value *val = instance->info->val; + /* If the widget is a buffer/gutter widget then we already have + the one we are looking for, so don't try and descend the widget + tree. */ + if (val->contents) { - if (val->name && !strcmp (val->name, name)) - break; - val = val->next; + char *name = XtName (widget); + val = val->contents; + while (val) + { + if (val->name && !strcmp (val->name, name)) + break; + val = val->next; + } + if (! val) abort (); } - if (! val) abort (); user_data = val->call_data; } #endif @@ -614,12 +701,163 @@ } #endif /* LWLIB_SCROLLBARS_ATHENA */ +#ifdef LWLIB_WIDGETS_ATHENA +/* glyph widgets */ +static Widget +xaw_create_button (widget_instance *instance) +{ + Arg al[20]; + int ac = 0; + Widget button = 0; + widget_value* val = instance->info->val; + + XtSetArg (al [ac], XtNsensitive, val->enabled); ac++; + XtSetArg (al [ac], XtNmappedWhenManaged, FALSE); ac++; + XtSetArg (al [ac], XtNjustify, XtJustifyCenter); ac++; + /* The highlight doesn't appear to be dynamically set which makes it + look ugly. I think this may be a LessTif bug but for now we just + get rid of it. */ + XtSetArg (al [ac], XtNhighlightThickness, (Dimension)0);ac++; + + /* add any args the user supplied for creation time */ + lw_add_value_args_to_args (val, al, &ac); + + if (!val->call_data) + button = XtCreateManagedWidget (val->name, labelWidgetClass, + instance->parent, al, ac); + + else + { + if (val->type == TOGGLE_TYPE || val->type == RADIO_TYPE) + { + XtSetArg (al [ac], XtNstate, val->selected); ac++; + button = XtCreateManagedWidget + (val->name, + val->type == TOGGLE_TYPE ? checkboxWidgetClass : radioWidgetClass, + instance->parent, al, ac); + } + else + { + button = XtCreateManagedWidget (val->name, commandWidgetClass, + instance->parent, al, ac); + } + XtRemoveAllCallbacks (button, XtNcallback); + XtAddCallback (button, XtNcallback, xaw_generic_callback, (XtPointer)instance); + } + + XtManageChild (button); + + return button; +} + +static Widget +xaw_create_label_field (widget_instance *instance) +{ + return xaw_create_label (instance->parent, instance->info->val); +} + +Widget +xaw_create_label (Widget parent, widget_value* val) +{ + Arg al[20]; + int ac = 0; + Widget label = 0; + + XtSetArg (al [ac], XtNsensitive, val->enabled); ac++; + XtSetArg (al [ac], XtNmappedWhenManaged, FALSE); ac++; + XtSetArg (al [ac], XtNjustify, XtJustifyCenter); ac++; + + /* add any args the user supplied for creation time */ + lw_add_value_args_to_args (val, al, &ac); + + label = XtCreateManagedWidget (val->name, labelWidgetClass, + parent, al, ac); + + /* Do it again for arguments that have no effect until the widget is realized. */ + ac = 0; + lw_add_value_args_to_args (val, al, &ac); + XtSetValues (label, al, ac); + + return label; +} + +static Widget +xaw_create_progress (widget_instance *instance) +{ + Arg al[20]; + int ac = 0; + Widget scale = 0; + widget_value* val = instance->info->val; + + if (!val->call_data) + { + XtSetArg (al [ac], XtNsensitive, False); ac++; + } + else + { + XtSetArg (al [ac], XtNsensitive, val->enabled); ac++; + } + XtSetArg (al [ac], XtNmappedWhenManaged, FALSE); ac++; + XtSetArg (al [ac], XtNorientation, XtorientHorizontal); ac++; + XtSetArg (al [ac], XtNhighlightThickness, (Dimension)0);ac++; + XtSetArg (al [ac], XtNntics, (Cardinal)10);ac++; + + /* add any args the user supplied for creation time */ + lw_add_value_args_to_args (val, al, &ac); + + scale = XtCreateManagedWidget (val->name, gaugeWidgetClass, + instance->parent, al, ac); + /* add the callback */ + if (val->call_data) + XtAddCallback (scale, XtNgetValue, xaw_generic_callback, (XtPointer)instance); + + XtManageChild (scale); + + return scale; +} + +#ifndef NEED_MOTIF +static Widget +xaw_create_text_field (widget_instance *instance) +{ + Arg al[20]; + int ac = 0; + Widget text = 0; + widget_value* val = instance->info->val; + + XtSetArg (al [ac], XtNsensitive, val->enabled && val->call_data); ac++; + XtSetArg (al [ac], XtNmappedWhenManaged, FALSE); ac++; + XtSetArg (al [ac], XtNhighlightThickness, (Dimension)0); ac++; + XtSetArg (al [ac], XtNtype, XawAsciiString); ac++; + XtSetArg (al [ac], XtNeditType, XawtextEdit); ac++; + + /* add any args the user supplied for creation time */ + lw_add_value_args_to_args (val, al, &ac); + + text = XtCreateManagedWidget (val->name, asciiTextWidgetClass, + instance->parent, al, ac); + XtManageChild (text); + + return text; +} +#endif +#endif /* LWLIB_WIDGETS_ATHENA */ + widget_creation_entry xaw_creation_table [] = { #ifdef LWLIB_SCROLLBARS_ATHENA - {"vertical-scrollbar", xaw_create_vertical_scrollbar}, - {"horizontal-scrollbar", xaw_create_horizontal_scrollbar}, + {"vertical-scrollbar", xaw_create_vertical_scrollbar }, + {"horizontal-scrollbar", xaw_create_horizontal_scrollbar }, +#endif +#ifdef LWLIB_WIDGETS_ATHENA + {"button", xaw_create_button }, + { "label", xaw_create_label_field }, +#ifndef NEED_MOTIF + {"text-field", xaw_create_text_field }, +#endif + {"progress", xaw_create_progress }, #endif {NULL, NULL} }; + diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/lwlib-Xaw.h --- a/lwlib/lwlib-Xaw.h Mon Aug 13 11:12:06 2007 +0200 +++ b/lwlib/lwlib-Xaw.h Mon Aug 13 11:13:30 2007 +0200 @@ -1,5 +1,5 @@ -#ifndef LWLIB_XAW_H -#define LWLIB_XAW_H +#ifndef INCLUDED_lwlib_Xaw_h_ +#define INCLUDED_lwlib_Xaw_h_ #include "lwlib-internal.h" @@ -8,6 +8,9 @@ Widget xaw_create_dialog (widget_instance* instance); +Widget +xaw_create_label (Widget parent, widget_value* val); + Boolean lw_xaw_widget_p (Widget widget); @@ -28,4 +31,4 @@ void xaw_pop_instance (widget_instance* instance, Boolean up); -#endif /* LWLIB_XAW_H */ +#endif /* INCLUDED_lwlib_Xaw_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/lwlib-Xlw.c --- a/lwlib/lwlib-Xlw.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lwlib/lwlib-Xlw.c Mon Aug 13 11:13:30 2007 +0200 @@ -20,20 +20,35 @@ #include <config.h> #include <stdlib.h> /* for abort () */ +#include <stdio.h> /* for abort () */ #include <limits.h> #include "lwlib-Xlw.h" +#include "lwlib-utils.h" #include <X11/StringDefs.h> #include <X11/IntrinsicP.h> #include <X11/ObjectP.h> #include <X11/CompositeP.h> #include <X11/Shell.h> +#ifdef HAVE_WIDGETS +#include "../src/EmacsManager.h" +#endif #ifdef LWLIB_MENUBARS_LUCID #include "xlwmenu.h" #endif #ifdef LWLIB_SCROLLBARS_LUCID #include "xlwscrollbar.h" #endif +#ifdef LWLIB_TABS_LUCID +#ifdef NEED_MOTIF +#include "lwlib-Xm.h" +#endif +#ifdef NEED_ATHENA +#include "lwlib-Xaw.h" +#endif +#include "../src/xmu.h" +#include "xlwtabs.h" +#endif @@ -301,6 +316,172 @@ #endif /* LWLIB_SCROLLBARS_LUCID */ +#ifdef LWLIB_TABS_LUCID +/* tab control + + lwlib is such an incredible hairy crock. I just cannot believe + it! There are random dependencies between functions, there is a + total lack of genericity, even though it initially appears to be + generic. It should all be junked and begun again. Building tabs are + an example - in theory we should be able to reuse a lot of the + general stuff because we want to put labels of whatever toolkit we + are using in the tab. Instead we have to hack it by hand. */ +static void +xlw_tab_control_callback (Widget w, XtPointer client_data, XtPointer call_data) +{ + /* call data is the topmost widget */ + widget_instance* instance = (widget_instance*)client_data; + Widget top = (Widget)call_data; + char *name = XtName (top); + widget_value* widget_val; + XtPointer widget_arg; + LWLIB_ID id; + lw_callback post_activate_cb; + + if (w->core.being_destroyed) + return; + + /* Grab these values before running any functions, in case running + the selection_cb causes the widget to be destroyed. */ + id = instance->info->id; + post_activate_cb = instance->info->post_activate_cb; + + /* search for the widget_val for the selected tab */ + for (widget_val = instance->info->val->contents; widget_val; + widget_val = widget_val->next) + { + if (!strcmp (widget_val->name, name)) + break; + } + + widget_arg = widget_val ? widget_val->call_data : NULL; + + if (instance->info->selection_cb && + widget_val && + widget_val->enabled && + !widget_val->contents) + instance->info->selection_cb (w, id, widget_arg); + + if (post_activate_cb) + post_activate_cb (w, id, widget_arg); +} + +static Widget +xlw_create_tab_control (widget_instance *instance) +{ + Arg al[20]; + int ac = 0; + Widget tab = 0; + widget_value* val = instance->info->val; + + XtSetArg (al [ac], XtNsensitive, val->enabled); ac++; + XtSetArg (al [ac], XtNmappedWhenManaged, FALSE); ac++; + XtSetArg (al [ac], XtNorientation, XtorientHorizontal); ac++; + XtSetArg (al [ac], XtNresizable, False); ac++; + + /* add any args the user supplied for creation time */ + lw_add_value_args_to_args (val, al, &ac); + + tab = XtCreateManagedWidget (val->name, tabsWidgetClass, + instance->parent, al, ac); + XtRemoveAllCallbacks (tab, XtNcallback); + XtAddCallback (tab, XtNcallback, xlw_tab_control_callback, (XtPointer)instance); + + XtManageChild (tab); + + return tab; +} + +static void build_tabs_in_widget (widget_instance* instance, Widget widget, + widget_value* val) +{ + widget_value* cur = val; + for (cur = val; cur; cur = cur->next) + { + if (cur->value) + { +#ifdef LWLIB_WIDGETS_MOTIF + xm_create_label (widget, cur); +#else + xaw_create_label (widget, cur); +#endif + } + cur->change = NO_CHANGE; + } +} + +static void +xlw_update_tab_control (widget_instance* instance, Widget widget, widget_value* val) +{ + Widget* children; + unsigned int num_children; + int i; + widget_value *cur = 0; + + XtRemoveAllCallbacks (widget, XtNcallback); + XtAddCallback (widget, XtNcallback, xlw_tab_control_callback, (XtPointer)instance); + + if (val->change == STRUCTURAL_CHANGE + || + (val->contents && val->contents->change == STRUCTURAL_CHANGE)) + { + destroy_all_children (widget); + build_tabs_in_widget (instance, widget, val->contents); + } + + children = XtCompositeChildren (widget, &num_children); + if (children) + { + for (i = 0, cur = val->contents; i < num_children; i++) + { + if (!cur) + abort (); + if (children [i]->core.being_destroyed + || strcmp (XtName (children [i]), cur->name)) + continue; +#ifdef NEED_MOTIF + if (lw_motif_widget_p (children [i])) + xm_update_one_widget (instance, children [i], cur, False); +#endif +#ifdef NEED_ATHENA + if (lw_xaw_widget_p (children [i])) + xaw_update_one_widget (instance, children [i], cur, False); +#endif + cur = cur->next; + } + XtFree ((char *) children); + } + if (cur) + abort (); +} +#endif /* LWLIB_TABS_LUCID */ + +#ifdef HAVE_WIDGETS +static Widget +xlw_create_clip_window (widget_instance *instance) +{ + Arg al[20]; + int ac = 0; + Widget clip = 0; + widget_value* val = instance->info->val; + + XtSetArg (al [ac], XtNmappedWhenManaged, FALSE); ac++; + XtSetArg (al [ac], XtNsensitive, TRUE); ac++; + /* add any args the user supplied for creation time */ + lw_add_value_args_to_args (val, al, &ac); + + /* Create a clip window to contain the subwidget. Incredibly the + XEmacs manager seems to be the most appropriate widget for + this. Nothing else is simple enough and yet does what is + required. */ + clip = XtCreateManagedWidget (val->name, + emacsManagerWidgetClass, + instance->parent, al, ac); + + return clip; +} +#endif + widget_creation_entry xlw_creation_table [] = { @@ -312,6 +493,12 @@ {"vertical-scrollbar", xlw_create_vertical_scrollbar}, {"horizontal-scrollbar", xlw_create_horizontal_scrollbar}, #endif +#ifdef LWLIB_TABS_LUCID + {"tab-control", xlw_create_tab_control}, +#endif +#ifdef HAVE_WIDGETS + {"clip-window", xlw_create_clip_window}, +#endif {NULL, NULL} }; @@ -327,12 +514,20 @@ if (the_class == xlwScrollBarWidgetClass) return True; #endif +#ifdef LWLIB_TABS_LUCID + if (the_class == tabsWidgetClass) + return True; +#endif #ifdef LWLIB_MENUBARS_LUCID if (the_class == overrideShellWidgetClass) return XtClass (((CompositeWidget)widget)->composite.children [0]) == xlwMenuWidgetClass; #endif +#ifdef HAVE_WIDGETS + if (the_class == emacsManagerWidgetClass) + return True; +#endif return False; } @@ -340,9 +535,10 @@ xlw_update_one_widget (widget_instance* instance, Widget widget, widget_value* val, Boolean deep_p) { - WidgetClass class; - - class = XtClass (widget); + WidgetClass class = XtClass (widget); + /* Update up global arg values. */ + if (val->args && val->args->nargs) + XtSetValues (widget, val->args->args, val->args->nargs); if (0) ; @@ -365,6 +561,12 @@ xlw_update_scrollbar (instance, widget, val); } #endif +#ifdef LWLIB_TABS_LUCID + else if (class == tabsWidgetClass) + { + xlw_update_tab_control (instance, widget, val); + } +#endif } void diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/lwlib-Xm.c --- a/lwlib/lwlib-Xm.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lwlib/lwlib-Xm.c Mon Aug 13 11:13:30 2007 +0200 @@ -4,13 +4,13 @@ This file is part of the Lucid Widget Library. -The Lucid Widget Library is free software; you can redistribute it and/or +The Lucid Widget Library is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. The Lucid Widget Library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of +but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. @@ -60,17 +60,23 @@ #include <Xm/Separator.h> #include <Xm/DialogS.h> #include <Xm/Form.h> +#ifdef LWLIB_WIDGETS_MOTIF +#include <Xm/Scale.h> +#if XmVERSION > 1 +#include <Xm/ComboBoxP.h> +#endif +#endif #ifdef LWLIB_MENUBARS_MOTIF static void xm_pull_down_callback (Widget, XtPointer, XtPointer); -#if 0 -static void xm_pop_down_callback (Widget, XtPointer, XtPointer); -#endif /* 0 */ #endif static void xm_internal_update_other_instances (Widget, XtPointer, XtPointer); +static void xm_pop_down_callback (Widget, XtPointer, XtPointer); static void xm_generic_callback (Widget, XtPointer, XtPointer); -#ifdef LWLIB_DIALOGS_MOTIF +static void mark_dead_instance_destroyed (Widget widget, XtPointer closure, + XtPointer call_data); +#if defined (LWLIB_DIALOGS_MOTIF) || defined (LWLIB_WIDGETS_MOTIF) static void xm_nosel_callback (Widget, XtPointer, XtPointer); #endif #ifdef LWLIB_SCROLLBARS_MOTIF @@ -84,7 +90,7 @@ #endif /* Structures to keep destroyed instances */ -typedef struct _destroyed_instance +typedef struct _destroyed_instance { char* name; char* type; @@ -124,7 +130,7 @@ instance->next = NULL; return instance; } - + static void free_destroyed_instance (destroyed_instance* instance) { @@ -143,7 +149,7 @@ Boolean lw_motif_widget_p (Widget widget) { - return + return #ifdef LWLIB_DIALOGS_MOTIF XtClass (widget) == xmDialogShellWidgetClass || #endif @@ -155,7 +161,7 @@ { XtResource resource; char *result = NULL; - + resource.resource_name = "labelString"; resource.resource_class = "LabelString"; /* #### should be Xmsomething... */ resource.resource_type = XtRString; @@ -169,35 +175,6 @@ return result; } -#ifdef LWLIB_MENUBARS_MOTIF - -static void -destroy_all_children (Widget widget) -{ - Widget* children; - unsigned int number; - int i; - - children = XtCompositeChildren (widget, &number); - if (children) - { - /* Unmanage all children and destroy them. They will only be - * really destroyed when we get out of DispatchEvent. */ - for (i = 0; i < number; i++) - { - Widget child = children [i]; - if (!child->core.being_destroyed) - { - XtUnmanageChild (child); - XtDestroyWidget (child); - } - } - XtFree ((char *) children); - } -} - -#endif /* LWLIB_MENUBARS_MOTIF */ - #ifdef LWLIB_DIALOGS_MOTIF @@ -219,7 +196,7 @@ #endif /* LWLIB_DIALOGS_MOTIF */ -#if defined (LWLIB_DIALOGS_MOTIF) || defined (LWLIB_MENUBARS_MOTIF) +#if defined (LWLIB_DIALOGS_MOTIF) || defined (LWLIB_MENUBARS_MOTIF) || defined (LWLIB_WIDGETS_MOTIF) /* update the label of anything subclass of a label */ static void @@ -231,6 +208,14 @@ XmString name_string = NULL; Arg al [20]; int ac = 0; + int type; + + /* Don't clobber pixmap types. */ + XtSetArg (al [0], XmNlabelType, &type); + XtGetValues (widget, al, 1); + + if (type == XmPIXMAP) + return; if (val->value) { @@ -260,30 +245,36 @@ char *res_name = NULL; res_name = resource_string (widget, val->name); + /* Concatenating the value with itself seems just plain daft. */ if (!res_name) - res_name = val->name; - - name_string = - XmStringCreateLtoR (res_name, XmSTRING_DEFAULT_CHARSET); - - value_name = XtMalloc (strlen (val->value) + 2); - *value_name = 0; - strcat (value_name, " "); - strcat (value_name, val->value); - - val_string = - XmStringCreateLtoR (value_name, XmSTRING_DEFAULT_CHARSET); - - built_string = - XmStringConcat (name_string, val_string); - - XtFree (value_name); + { + built_string = + XmStringCreateLtoR (val->value, XmSTRING_DEFAULT_CHARSET); + } + else + { + name_string = + XmStringCreateLtoR (res_name, XmSTRING_DEFAULT_CHARSET); + + value_name = XtMalloc (strlen (val->value) + 2); + *value_name = 0; + strcat (value_name, " "); + strcat (value_name, val->value); + + val_string = + XmStringCreateLtoR (value_name, XmSTRING_DEFAULT_CHARSET); + + built_string = + XmStringConcat (name_string, val_string); + + XtFree (value_name); + } } XtSetArg (al [ac], XmNlabelString, built_string); ac++; XtSetArg (al [ac], XmNlabelType, XmSTRING); ac++; } - + if (val->key) { key_string = XmStringCreateLtoR (val->key, XmSTRING_DEFAULT_CHARSET); @@ -301,6 +292,9 @@ if (name_string) XmStringFree (name_string); + + if (val_string) + XmStringFree (val_string); } #endif /* defined (LWLIB_DIALOGS_MOTIF) || defined (LWLIB_MENUBARS_MOTIF) */ @@ -363,7 +357,7 @@ XtRemoveAllCallbacks (widget, XmNcascadingCallback); XtAddCallback (widget, XmNcascadingCallback, xm_pull_down_callback, instance); - } + } } #endif /* LWLIB_MENUBARS_MOTIF */ @@ -378,7 +372,7 @@ instance); XtSetArg (al [0], XmNset, val->selected); XtSetArg (al [1], XmNalignment, XmALIGNMENT_BEGINNING); - XtSetValues (widget, al, 2); + XtSetValues (widget, al, 1); } static void @@ -423,6 +417,29 @@ } } +#if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1 +/* update of combo box */ +static void +xm_update_combo_box (widget_instance* instance, Widget widget, widget_value* val) +{ + widget_value* cur; + int i; + XtRemoveAllCallbacks (widget, XmNselectionCallback); + XtAddCallback (widget, XmNselectionCallback, xm_generic_callback, + instance); + for (cur = val->contents, i = 0; cur; cur = cur->next) + if (cur->value) + { + XmString xmstr = XmStringCreate (cur->value, XmSTRING_DEFAULT_CHARSET); + i += 1; + XmListAddItem (CB_List (widget), xmstr, 0); + if (cur->selected) + XmListSelectPos (CB_List (widget), i, False); + XmStringFree (xmstr); + } +} +#endif + #ifdef LWLIB_MENUBARS_MOTIF /* update a popup menu, pulldown menu or a menubar */ @@ -459,7 +476,7 @@ num_children = 0; for (child_index = 0, cur = val; cur; child_index++, cur = cur->next) - { + { ac = 0; button = 0; XtSetArg (al [ac], XmNsensitive, cur->enabled); ac++; @@ -577,7 +594,7 @@ menu = NULL; XtSetArg (al [0], XmNsubMenuId, &menu); XtGetValues (widget, al, 1); - + contents = val->contents; if (!menu) @@ -658,14 +675,12 @@ #endif /* LWLIB_MENUBARS_MOTIF */ -#ifdef LWLIB_DIALOGS_MOTIF - /* update text widgets */ static void xm_update_text (widget_instance* instance, Widget widget, widget_value* val) { - XmTextSetString (widget, val->value ? val->value : ""); + XmTextSetString (widget, val->value ? val->value : (char *) ""); XtRemoveAllCallbacks (widget, XmNactivateCallback); XtAddCallback (widget, XmNactivateCallback, xm_generic_callback, instance); XtRemoveAllCallbacks (widget, XmNvalueChangedCallback); @@ -677,7 +692,7 @@ xm_update_text_field (widget_instance* instance, Widget widget, widget_value* val) { - XmTextFieldSetString (widget, val->value ? val->value : ""); + XmTextFieldSetString (widget, val->value ? val->value : (char *) ""); XtRemoveAllCallbacks (widget, XmNactivateCallback); XtAddCallback (widget, XmNactivateCallback, xm_generic_callback, instance); XtRemoveAllCallbacks (widget, XmNvalueChangedCallback); @@ -685,7 +700,6 @@ xm_internal_update_other_instances, instance); } -#endif /* LWLIB_DIALOGS_MOTIF */ #ifdef LWLIB_SCROLLBARS_MOTIF @@ -768,22 +782,24 @@ widget_value* val, Boolean deep_p) { WidgetClass class; - Arg al [2]; - + Arg al [20]; + int ac = 0; + /* Mark as not edited */ val->edited = False; /* Common to all widget types */ - XtSetArg (al [0], XmNsensitive, val->enabled); - XtSetArg (al [1], XmNuserData, val->call_data); - XtSetValues (widget, al, 2); + XtSetArg (al [ac], XmNsensitive, val->enabled); ac++; + XtSetArg (al [ac], XmNuserData, val->call_data); ac++; + lw_add_value_args_to_args (val, al, &ac); -#if defined (LWLIB_DIALOGS_MOTIF) || defined (LWLIB_MENUBARS_MOTIF) + XtSetValues (widget, al, ac); + +#if defined (LWLIB_DIALOGS_MOTIF) || defined (LWLIB_MENUBARS_MOTIF) || defined (LWLIB_WIDGETS_MOTIF) /* Common to all label like widgets */ if (XtIsSubclass (widget, xmLabelWidgetClass)) xm_update_label (instance, widget, val); #endif - class = XtClass (widget); /* Class specific things */ if (class == xmPushButtonWidgetClass || @@ -808,7 +824,7 @@ XtSetArg (al [0], XmNradioBehavior, &radiobox); XtGetValues (widget, al, 1); - + if (radiobox) xm_update_radiobox (instance, widget, val); #ifdef LWLIB_MENUBARS_MOTIF @@ -816,7 +832,6 @@ xm_update_menu (instance, widget, val, deep_p); #endif } -#ifdef LWLIB_DIALOGS_MOTIF else if (class == xmTextWidgetClass) { xm_update_text (instance, widget, val); @@ -825,11 +840,16 @@ { xm_update_text_field (instance, widget, val); } -#endif else if (class == xmListWidgetClass) { xm_update_list (instance, widget, val); } +#if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1 + else if (class == xmComboBoxWidgetClass) + { + xm_update_combo_box (instance, widget, val); + } +#endif #ifdef LWLIB_SCROLLBARS_MOTIF else if (class == xmScrollBarWidgetClass) { @@ -853,7 +873,7 @@ val->call_data = old_wv->call_data; break; } - + if (class == xmToggleButtonWidgetClass || class == xmToggleButtonGadgetClass) { Arg al [1]; @@ -861,7 +881,6 @@ XtGetValues (widget, al, 1); val->edited = True; } -#ifdef LWLIB_DIALOGS_MOTIF else if (class == xmTextWidgetClass) { if (val->value) @@ -876,7 +895,6 @@ val->value = XmTextFieldGetString (widget); val->edited = True; } -#endif else if (class == xmRowColumnWidgetClass) { Boolean radiobox = 0; @@ -908,11 +926,20 @@ val->edited = True; } } - else if (class == xmListWidgetClass) + else if (class == xmListWidgetClass +#if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1 + || class == xmComboBoxWidgetClass +#endif + ) { int pos_cnt; int* pos_list; - if (XmListGetSelectedPos (widget, &pos_list, &pos_cnt)) + Widget list = widget; +#if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1 + if (class == xmComboBoxWidgetClass) + list = CB_List (widget); +#endif + if (XmListGetSelectedPos (list, &pos_list, &pos_cnt)) { int i; widget_value* cur; @@ -946,7 +973,7 @@ /* This function is for activating a button from a program. It's wrong because we pass a NULL argument in the call_data which is not Motif compatible. This is used from the XmNdefaultAction callback of the List widgets to - have a dble-click put down a dialog box like the button woudl do. + have a double-click put down a dialog box like the button would do. I could not find a way to do that with accelerators. */ static void @@ -996,7 +1023,7 @@ /* This is a kludge to disable drag-and-drop in dialog boxes. The symptom was a segv down in libXm somewhere if you used the middle button on a dialog box to begin a drag; when you released the button to make a drop - things would lose if you were not over the button where you started the + things would lose if you were not over the button where you started the drag (canceling the operation). This was probably due to the fact that the dialog boxes were not set up to handle a drag but were trying to do so anyway for some reason. @@ -1011,7 +1038,7 @@ static Widget make_dialog (char* name, Widget parent, Boolean pop_up_p, - CONST char* shell_title, CONST char* icon_name, + const char* shell_title, const char* icon_name, Boolean text_input_slot, Boolean radio_box, Boolean list, int left_buttons, int right_buttons) { @@ -1029,7 +1056,7 @@ Arg al[64]; /* Arg List */ int ac; /* Arg Count */ int i; - + #ifdef DND_KLUDGE XtTranslations dnd_override = XtParseTranslationTable (disable_dnd_trans); # define DO_DND_KLUDGE(widget) XtOverrideTranslations ((widget), dnd_override) @@ -1077,7 +1104,7 @@ XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; XtSetArg(al[ac], XmNrightOffset, 13); ac++; row = XmCreateRowColumn (form, "row", al, ac); - + n_children = 0; for (i = 0; i < left_buttons; i++) { @@ -1119,7 +1146,7 @@ al, ac); DO_DND_KLUDGE (children [n_children]); n_children++; - + for (i = 0; i < right_buttons; i++) { char button_name [16]; @@ -1131,9 +1158,9 @@ if (! button) button = children [n_children]; n_children++; } - + XtManageChildren (children, n_children); - + ac = 0; XtSetArg(al[ac], XmNtopAttachment, XmATTACH_NONE); ac++; XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; @@ -1232,7 +1259,7 @@ list activate the default button */ XtAddCallback (value, XmNdefaultActionCallback, activate_button, button); } - + ac = 0; XtSetArg(al[ac], XmNalignment, XmALIGNMENT_BEGINNING); ac++; XtSetArg(al[ac], XmNtopAttachment, XmATTACH_FORM); ac++; @@ -1248,7 +1275,7 @@ XtSetArg(al[ac], XmNrightOffset, 13); ac++; message = XmCreateLabel (form, "message", al, ac); DO_DND_KLUDGE (message); - + if (list) XtManageChild (value); @@ -1263,7 +1290,7 @@ children [i] = icon; i++; children [i] = icon_separator; i++; XtManageChildren (children, i); - + if (text_input_slot || list) { XtInstallAccelerators (value, button); @@ -1274,7 +1301,7 @@ XtInstallAccelerators (form, button); XmProcessTraversal(value, XmTRAVERSE_CURRENT); } - + #ifdef DND_KLUDGE XtFree ((char *) dnd_override); #endif @@ -1321,14 +1348,6 @@ } static void -mark_dead_instance_destroyed (Widget widget, XtPointer closure, - XtPointer call_data) -{ - destroyed_instance* instance = (destroyed_instance*)closure; - instance->widget = NULL; -} - -static void recenter_widget (Widget widget) { Widget parent = XtParent (widget); @@ -1353,7 +1372,7 @@ x = (Position) ((parent_width - child_width) / 2); y = (Position) ((parent_height - child_height) / 2); - + XtTranslateCoords (parent, x, y, &x, &y); if ((Dimension) (x + child_width) > screen_width) @@ -1419,8 +1438,8 @@ Widget parent = instance->parent; Widget widget; Boolean pop_up_p = instance->pop_up_p; - CONST char* shell_name = 0; - CONST char* icon_name = 0; + const char* shell_name = 0; + const char* icon_name = 0; Boolean text_input_slot = False; Boolean radio_box = False; Boolean list = False; @@ -1466,7 +1485,7 @@ shell_name = "Question"; break; } - + total_buttons = name [1] - '0'; if (name [3] == 'T' || name [3] == 't') @@ -1476,9 +1495,9 @@ } else if (name [3]) right_buttons = name [4] - '0'; - + left_buttons = total_buttons - right_buttons; - + widget = make_dialog (name, parent, pop_up_p, shell_name, icon_name, text_input_slot, radio_box, list, left_buttons, right_buttons); @@ -1537,7 +1556,7 @@ { {xm_scrollbar_callback, NULL}, {NULL, NULL} }; callbacks[0].closure = (XtPointer) instance; - + XtSetArg (al[ac], XmNminimum, 1); ac++; XtSetArg (al[ac], XmNmaximum, INT_MAX); ac++; XtSetArg (al[ac], XmNincrement, 1); ac++; @@ -1571,10 +1590,196 @@ #endif /* LWLIB_SCROLLBARS_MOTIF */ - /* Table of functions to create widgets */ +#ifdef LWLIB_WIDGETS_MOTIF +/* glyph widgets */ +static Widget +xm_create_button (widget_instance *instance) +{ + Arg al[20]; + int ac = 0; + Widget button = 0; + widget_value* val = instance->info->val; + + XtSetArg (al [ac], XmNsensitive, val->enabled); ac++; + XtSetArg (al [ac], XmNalignment, XmALIGNMENT_BEGINNING); ac++; + XtSetArg (al [ac], XmNuserData, val->call_data); ac++; + XtSetArg (al [ac], XmNmappedWhenManaged, FALSE); ac++; + /* The highlight doesn't appear to be dynamically set which makes it + look ugly. I think this may be a LessTif bug but for now we just + get rid of it. */ + XtSetArg (al [ac], XmNhighlightThickness, (Dimension)0);ac++; + + /* add any args the user supplied for creation time */ + lw_add_value_args_to_args (val, al, &ac); + + if (!val->call_data) + button = XmCreateLabel (instance->parent, val->name, al, ac); + + else if (val->type == TOGGLE_TYPE || val->type == RADIO_TYPE) + { + XtSetArg (al [ac], XmNset, val->selected); ac++; + XtSetArg (al [ac], XmNindicatorType, + (val->type == TOGGLE_TYPE ? + XmN_OF_MANY : XmONE_OF_MANY)); ac++; + XtSetArg (al [ac], XmNvisibleWhenOff, True); ac++; + button = XmCreateToggleButton (instance->parent, val->name, al, ac); + XtRemoveAllCallbacks (button, XmNvalueChangedCallback); + XtAddCallback (button, XmNvalueChangedCallback, xm_generic_callback, + (XtPointer)instance); + } + else + { + button = XmCreatePushButton (instance->parent, val->name, al, ac); + XtAddCallback (button, XmNactivateCallback, xm_generic_callback, + (XtPointer)instance); + } + + XtManageChild (button); + + return button; +} + +static Widget +xm_create_progress (widget_instance *instance) +{ + Arg al[20]; + int ac = 0; + Widget scale = 0; + widget_value* val = instance->info->val; + + if (!val->call_data) + { + XtSetArg (al [ac], XmNsensitive, False); ac++; + } + else + { + XtSetArg (al [ac], XmNsensitive, val->enabled); ac++; + } + XtSetArg (al [ac], XmNalignment, XmALIGNMENT_BEGINNING); ac++; + XtSetArg (al [ac], XmNuserData, val->call_data); ac++; + XtSetArg (al [ac], XmNmappedWhenManaged, FALSE); ac++; + XtSetArg (al [ac], XmNorientation, XmHORIZONTAL); ac++; + /* The highlight doesn't appear to be dynamically set which makes it + look ugly. I think this may be a LessTif bug but for now we just + get rid of it. */ + XtSetArg (al [ac], XmNhighlightThickness, (Dimension)0);ac++; + /* add any args the user supplied for creation time */ + lw_add_value_args_to_args (val, al, &ac); + + scale = XmCreateScale (instance->parent, val->name, al, ac); + if (val->call_data) + XtAddCallback (scale, XmNvalueChangedCallback, xm_generic_callback, + (XtPointer)instance); + + XtManageChild (scale); + + return scale; +} + +static Widget +xm_create_text_field (widget_instance *instance) +{ + Arg al[20]; + int ac = 0; + Widget text = 0; + widget_value* val = instance->info->val; + + XtSetArg (al [ac], XmNsensitive, val->enabled && val->call_data); ac++; + XtSetArg (al [ac], XmNalignment, XmALIGNMENT_BEGINNING); ac++; + XtSetArg (al [ac], XmNuserData, val->call_data); ac++; + XtSetArg (al [ac], XmNmappedWhenManaged, FALSE); ac++; + /* The highlight doesn't appear to be dynamically set which makes it + look ugly. I think this may be a LessTif bug but for now we just + get rid of it. */ + XtSetArg (al [ac], XmNhighlightThickness, (Dimension)0);ac++; + + /* add any args the user supplied for creation time */ + lw_add_value_args_to_args (val, al, &ac); + + text = XmCreateTextField (instance->parent, val->name, al, ac); + if (val->call_data) + XtAddCallback (text, XmNvalueChangedCallback, xm_generic_callback, + (XtPointer)instance); + + XtManageChild (text); + + return text; +} + +static Widget +xm_create_label_field (widget_instance *instance) +{ + return xm_create_label (instance->parent, instance->info->val); +} + +Widget +xm_create_label (Widget parent, widget_value* val) +{ + Arg al[20]; + int ac = 0; + Widget label = 0; + + XtSetArg (al [ac], XmNsensitive, val->enabled); ac++; + XtSetArg (al [ac], XmNalignment, XmALIGNMENT_BEGINNING); ac++; + XtSetArg (al [ac], XmNmappedWhenManaged, FALSE); ac++; + /* The highlight doesn't appear to be dynamically set which makes it + look ugly. I think this may be a LessTif bug but for now we just + get rid of it. */ + XtSetArg (al [ac], XmNhighlightThickness, (Dimension)0);ac++; + + /* add any args the user supplied for creation time */ + lw_add_value_args_to_args (val, al, &ac); + + label = XmCreateLabel (parent, val->name, al, ac); + + XtManageChild (label); + + /* Do it again for arguments that have no effect until the widget is realized. */ + ac = 0; + lw_add_value_args_to_args (val, al, &ac); + XtSetValues (label, al, ac); + + return label; +} + +#if XmVERSION > 1 +static Widget +xm_create_combo_box (widget_instance *instance) +{ + Arg al[20]; + int ac = 0; + Widget combo = 0; + widget_value* val = instance->info->val; + + XtSetArg (al [ac], XmNsensitive, val->enabled); ac++; + XtSetArg (al [ac], XmNalignment, XmALIGNMENT_BEGINNING); ac++; + XtSetArg (al [ac], XmNuserData, val->call_data); ac++; + XtSetArg (al [ac], XmNmappedWhenManaged, FALSE); ac++; + /* The highlight doesn't appear to be dynamically set which makes it + look ugly. I think this may be a LessTif bug but for now we just + get rid of it. */ + XtSetArg (al [ac], XmNhighlightThickness, (Dimension)0);ac++; + + /* add any args the user supplied for creation time */ + lw_add_value_args_to_args (val, al, &ac); + + combo = XmCreateDropDownComboBox (instance->parent, val->name, al, ac); + if (val->call_data) + XtAddCallback (combo, XmNselectionCallback, xm_generic_callback, + (XtPointer)instance); + + XtManageChild (combo); + + return combo; +} +#endif +#endif /* LWLIB_WIDGETS_MOTIF */ + + +/* Table of functions to create widgets */ widget_creation_entry -xm_creation_table [] = +xm_creation_table [] = { #ifdef LWLIB_MENUBARS_MOTIF {"menubar", make_menubar}, @@ -1584,6 +1789,15 @@ {"vertical-scrollbar", make_vertical_scrollbar}, {"horizontal-scrollbar", make_horizontal_scrollbar}, #endif +#ifdef LWLIB_WIDGETS_MOTIF + {"button", xm_create_button}, + {"progress", xm_create_progress}, + {"text-field", xm_create_text_field}, + {"label", xm_create_label_field}, +#if XmVERSION > 1 + {"combo-box", xm_create_combo_box}, +#endif +#endif {NULL, NULL} }; @@ -1591,7 +1805,7 @@ void xm_destroy_instance (widget_instance* instance) { -#ifdef LWLIB_DIALOGS_MOTIF +#if defined (LWLIB_DIALOGS_MOTIF) || defined (LWLIB_WIDGETS_MOTIF) /* It appears that this is used only for dialog boxes. */ Widget widget = instance->widget; /* recycle the dialog boxes */ @@ -1622,7 +1836,7 @@ XtDestroyWidget (instance->widget); } -#endif /* LWLIB_DIALOGS_MOTIF */ +#endif /* LWLIB_DIALOGS_MOTIF || LWLIB_WIDGETS_MOTIF */ } /* popup utility */ @@ -1700,12 +1914,12 @@ if (up) XtManageChild (widget); else - XtUnmanageChild (widget); + XtUnmanageChild (widget); } } -/* motif callback */ +/* motif callback */ enum do_call_type { pre_activate, selection, no_selection, post_activate }; @@ -1755,7 +1969,7 @@ } /* Like lw_internal_update_other_instances except that it does not do - anything if its shell parent is not managed. This is to protect + anything if its shell parent is not managed. This is to protect lw_internal_update_other_instances to dereference freed memory if the widget was ``destroyed'' by caching it in the all_destroyed_instances list */ @@ -1775,7 +1989,7 @@ static void xm_generic_callback (Widget widget, XtPointer closure, XtPointer call_data) { -#if (defined (LWLIB_MENUBARS_MOTIF) || defined (LWLIB_DIALOGS_MOTIF)) +#if (defined (LWLIB_MENUBARS_MOTIF) || defined (LWLIB_DIALOGS_MOTIF) || defined (LWLIB_WIDGETS_MOTIF)) /* We want the selected status to change only when we decide it should change. Yuck but correct. */ if (XtClass (widget) == xmToggleButtonWidgetClass @@ -1790,30 +2004,17 @@ XtSetArg (al [0], XmNset, !check); XtSetValues (widget, al, 1); } -#endif +#endif lw_internal_update_other_instances (widget, closure, call_data); do_call (widget, closure, selection); } -#ifdef LWLIB_DIALOGS_MOTIF - static void -xm_nosel_callback (Widget widget, XtPointer closure, XtPointer call_data) +xm_pop_down_callback (Widget widget, XtPointer closure, XtPointer call_data) { - /* This callback is only called when a dialog box is dismissed with the wm's - destroy button (WM_DELETE_WINDOW.) We want the dialog box to be destroyed - in that case, not just unmapped, so that it releases its keyboard grabs. - But there are problems with running our callbacks while the widget is in - the process of being destroyed, so we set XmNdeleteResponse to XmUNMAP - instead of XmDESTROY and then destroy it ourself after having run the - callback. - */ - do_call (widget, closure, no_selection); - XtDestroyWidget (widget); + do_call (widget, closure, post_activate); } -#endif - #ifdef LWLIB_MENUBARS_MOTIF static void @@ -1823,21 +2024,13 @@ if (call_data) { /* new behavior for incremental menu construction */ - + } else -#endif +#endif do_call (widget, closure, pre_activate); } -#if 0 -static void -xm_pop_down_callback (Widget widget, XtPointer closure, XtPointer call_data) -{ - do_call (widget, closure, post_activate); -} -#endif /* 0 */ - #endif /* LWLIB_MENUBARS_MOTIF */ #ifdef LWLIB_SCROLLBARS_MOTIF @@ -1930,6 +2123,31 @@ } #endif /* LWLIB_SCROLLBARS_MOTIF */ +#if defined (LWLIB_DIALOGS_MOTIF) || defined (LWLIB_WIDGETS_MOTIF) +static void +mark_dead_instance_destroyed (Widget widget, XtPointer closure, + XtPointer call_data) +{ + destroyed_instance* instance = (destroyed_instance*)closure; + instance->widget = NULL; +} + +static void +xm_nosel_callback (Widget widget, XtPointer closure, XtPointer call_data) +{ + /* This callback is only called when a dialog box is dismissed with the wm's + destroy button (WM_DELETE_WINDOW.) We want the dialog box to be destroyed + in that case, not just unmapped, so that it releases its keyboard grabs. + But there are problems with running our callbacks while the widget is in + the process of being destroyed, so we set XmNdeleteResponse to XmUNMAP + instead of XmDESTROY and then destroy it ourself after having run the + callback. + */ + do_call (widget, closure, no_selection); + XtDestroyWidget (widget); +} +#endif + /* set the keyboard focus */ void diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/lwlib-Xm.h --- a/lwlib/lwlib-Xm.h Mon Aug 13 11:12:06 2007 +0200 +++ b/lwlib/lwlib-Xm.h Mon Aug 13 11:13:30 2007 +0200 @@ -1,5 +1,5 @@ -#ifndef LWLIB_XM_H -#define LWLIB_XM_H +#ifndef INCLUDED_lwlib_Xm_h_ +#define INCLUDED_lwlib_Xm_h_ #include "lwlib-internal.h" @@ -8,6 +8,9 @@ Widget xm_create_dialog (widget_instance* instance); +Widget +xm_create_label (Widget parent, widget_value* val); + Boolean lw_motif_widget_p (Widget widget); @@ -33,4 +36,4 @@ extern Widget first_child (Widget); /* garbage */ -#endif /* LWLIB_XM_H */ +#endif /* INCLUDED_lwlib_Xm_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/lwlib-config.c --- a/lwlib/lwlib-config.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lwlib/lwlib-config.c Mon Aug 13 11:13:30 2007 +0200 @@ -88,3 +88,13 @@ int lwlib_does_not_support_dialogs; # endif #endif + +#ifdef LWLIB_WIDGETS_MOTIF +int lwlib_widgets_motif; +#else +# ifdef LWLIB_WIDGETS_ATHENA +int lwlib_widgets_athena; +# else +int lwlib_does_not_support_widgets; +# endif +#endif diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/lwlib-internal.h --- a/lwlib/lwlib-internal.h Mon Aug 13 11:12:06 2007 +0200 +++ b/lwlib/lwlib-internal.h Mon Aug 13 11:13:30 2007 +0200 @@ -1,5 +1,5 @@ -#ifndef LWLIB_INTERNAL_H -#define LWLIB_INTERNAL_H +#ifndef INCLUDED_lwlib_internal_h_ +#define INCLUDED_lwlib_internal_h_ #include "lwlib.h" @@ -39,7 +39,7 @@ typedef struct _widget_creation_entry { - CONST char* type; + const char* type; widget_creation_function function; } widget_creation_entry; @@ -55,5 +55,4 @@ widget_info *lw_get_widget_info (LWLIB_ID id); -#endif /* LWLIB_INTERNAL_H */ - +#endif /* INCLUDED_lwlib_internal_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/lwlib-utils.c --- a/lwlib/lwlib-utils.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lwlib/lwlib-utils.c Mon Aug 13 11:13:30 2007 +0200 @@ -31,6 +31,31 @@ #include <X11/ObjectP.h> #include "lwlib-utils.h" +void +destroy_all_children (Widget widget) +{ + Widget* children; + unsigned int number; + int i; + + children = XtCompositeChildren (widget, &number); + if (children) + { + /* Unmanage all children and destroy them. They will only be + * really destroyed when we get out of DispatchEvent. */ + for (i = 0; i < number; i++) + { + Widget child = children [i]; + if (!child->core.being_destroyed) + { + XtUnmanageChild (child); + XtDestroyWidget (child); + } + } + XtFree ((char *) children); + } +} + /* Redisplay the contents of the widget, without first clearing it. */ void XtNoClearRefreshWidget (Widget widget) diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/lwlib-utils.h --- a/lwlib/lwlib-utils.h Mon Aug 13 11:12:06 2007 +0200 +++ b/lwlib/lwlib-utils.h Mon Aug 13 11:13:30 2007 +0200 @@ -1,6 +1,7 @@ -#ifndef _LWLIB_UTILS_H_ -#define _LWLIB_UTILS_H_ +#ifndef INCLUDED_lwlib_utils_h_ +#define INCLUDED_lwlib_utils_h_ +void destroy_all_children (Widget widget); void XtNoClearRefreshWidget (Widget); typedef void (*XtApplyToWidgetsProc) (Widget, XtPointer); @@ -20,4 +21,5 @@ #ifdef USE_DEBUG_MALLOC #include <dmalloc.h> #endif -#endif /* _LWLIB_UTILS_H_ */ + +#endif /* INCLUDED_lwlib_utils_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/lwlib.c --- a/lwlib/lwlib.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lwlib/lwlib.c Mon Aug 13 11:13:30 2007 +0200 @@ -40,6 +40,9 @@ #endif #ifdef NEED_MOTIF #include "lwlib-Xm.h" +#ifdef LWLIB_WIDGETS_MOTIF +#include <Xm/Xm.h> +#endif #endif #ifdef NEED_ATHENA #include "lwlib-Xaw.h" @@ -67,13 +70,13 @@ /* Forward declarations */ -static void -instantiate_widget_instance (widget_instance *instance); +static void instantiate_widget_instance (widget_instance *instance); +static void free_widget_value_args (widget_value* wv); /* utility functions for widget_instance and widget_info */ static char * -safe_strdup (CONST char *s) +safe_strdup (const char *s) { char *result; if (! s) return 0; @@ -108,7 +111,7 @@ } if (wv) { - memset (wv, 0, sizeof (widget_value)); + memset (wv, '\0', sizeof (widget_value)); } return wv; } @@ -125,8 +128,6 @@ widget_value_free_list = wv; } -static void free_widget_value_tree (widget_value *wv); - static void free_widget_value_contents (widget_value *wv) { @@ -155,6 +156,9 @@ free_widget_value_tree (wv->contents); wv->contents = (widget_value *) 0xDEADBEEF; } + + free_widget_value_args (wv); + if (wv->next) { free_widget_value_tree (wv->next); @@ -162,7 +166,7 @@ } } -static void +void free_widget_value_tree (widget_value *wv) { if (!wv) @@ -184,7 +188,7 @@ if (val->scrollbar_data) *copy->scrollbar_data = *val->scrollbar_data; else - memset (copy->scrollbar_data, 0, sizeof (scrollbar_values)); + memset (copy->scrollbar_data, '\0', sizeof (scrollbar_values)); } /* @@ -231,6 +235,41 @@ #endif /* NEED_SCROLLBARS */ +#ifdef HAVE_WIDGETS +/* + * Return true if old->args was not equivalent + * to new->args. + */ +static Boolean +merge_widget_value_args (widget_value *old, widget_value *new) +{ + Boolean changed = False; + + if (new->args && !old->args) + { + lw_copy_widget_value_args (new, old); + changed = True; + } + /* Generally we don't want to lose values that are already in the + widget. */ + else if (!new->args && old->args) + { + lw_copy_widget_value_args (old, new); + changed = True; + } + else if (new->args && old->args) + { + /* #### Do something more sensible here than just copying the + new values (like actually merging the values). */ + free_widget_value_args (old); + lw_copy_widget_value_args (new, old); + changed = True; + } + + return changed; +} +#endif /* HAVE_WIDGETS */ + /* Make a complete copy of a widget_value tree. Store CHANGE into the widget_value tree's `change' field. */ @@ -263,6 +302,8 @@ copy->next = copy_widget_value_tree (val->next, change); copy->toolkit_data = NULL; copy->free_toolkit_data = False; + + lw_copy_widget_value_args (val, copy); #ifdef NEED_SCROLLBARS copy_scrollbar_values (val, copy); #endif @@ -289,7 +330,7 @@ } static widget_info * -allocate_widget_info (CONST char *type, CONST char *name, +allocate_widget_info (const char *type, const char *name, LWLIB_ID id, widget_value *val, lw_callback pre_activate_cb, lw_callback selection_cb, lw_callback post_activate_cb) @@ -317,7 +358,7 @@ safe_free_str (info->type); safe_free_str (info->name); free_widget_value_tree (info->val); - memset ((void*)info, 0xDEADBEEF, sizeof (widget_info)); + memset (info, '\0', sizeof (widget_info)); free (info); } @@ -352,7 +393,7 @@ static void free_widget_instance (widget_instance *instance) { - memset ((void *) instance, 0xDEADBEEF, sizeof (widget_instance)); + memset (instance, '\0', sizeof (widget_instance)); free (instance); } @@ -462,7 +503,7 @@ /* utility function for widget_value */ static Boolean -safe_strcmp (CONST char *s1, CONST char *s2) +safe_strcmp (const char *s1, const char *s2) { if (!!s1 ^ !!s2) return True; return (s1 && s2) ? strcmp (s1, s2) : s1 ? False : !!s2; @@ -577,6 +618,14 @@ change = max (change, INVISIBLE_CHANGE); val1->call_data = val2->call_data; } +#ifdef HAVE_WIDGETS + if (merge_widget_value_args (val1, val2)) + { + EXPLAIN (val1->name, change, VISIBLE_CHANGE, "widget change", 0, 0); + change = max (change, VISIBLE_CHANGE); + } +#endif + #ifdef NEED_SCROLLBARS if (merge_scrollbar_values (val1, val2)) { @@ -641,7 +690,7 @@ /* modifying the widgets */ static Widget -name_to_widget (widget_instance *instance, CONST char *name) +name_to_widget (widget_instance *instance, const char *name) { Widget widget = NULL; @@ -778,7 +827,7 @@ static widget_creation_function -find_in_table (CONST char *type, widget_creation_entry *table) +find_in_table (const char *type, widget_creation_entry *table) { widget_creation_entry *cur; for (cur = table; cur->type; cur++) @@ -788,7 +837,7 @@ } static Boolean -dialog_spec_p (CONST char *name) +dialog_spec_p (const char *name) { /* return True if name matches [EILPQeilpq][1-9][Bb] or [EILPQeilpq][1-9][Bb][Rr][1-9] */ @@ -872,7 +921,7 @@ } void -lw_register_widget (CONST char *type, CONST char *name, +lw_register_widget (const char *type, const char *name, LWLIB_ID id, widget_value *val, lw_callback pre_activate_cb, lw_callback selection_cb, lw_callback post_activate_cb) @@ -908,7 +957,7 @@ } Widget -lw_create_widget (CONST char *type, CONST char *name, +lw_create_widget (const char *type, const char *name, LWLIB_ID id, widget_value *val, Widget parent, Boolean pop_up_p, lw_callback pre_activate_cb, lw_callback selection_cb, lw_callback post_activate_cb) @@ -1300,3 +1349,71 @@ } } } + +void lw_add_value_args_to_args (widget_value* wv, ArgList addto, int* offset) +{ + int i; + if (wv->args && wv->args->nargs) + { + for (i = 0; i<wv->args->nargs; i++) + { + addto[i + *offset] = wv->args->args[i]; + } + *offset += wv->args->nargs; + } +} + +void lw_add_widget_value_arg (widget_value* wv, String name, XtArgVal value) +{ + if (!wv->args) + { + wv->args = (widget_args *) malloc (sizeof (widget_args)); + memset (wv->args, '\0', sizeof (widget_args)); + wv->args->ref_count = 1; + wv->args->nargs = 0; + wv->args->args = (ArgList) malloc (sizeof (Arg) * 10); + memset (wv->args->args, '\0', sizeof (Arg) * 10); + } + + if (wv->args->nargs > 10) + return; + + XtSetArg (wv->args->args [wv->args->nargs], name, value); wv->args->nargs++; +} + +static void free_widget_value_args (widget_value* wv) +{ + if (wv->args) + { + if (--wv->args->ref_count <= 0) + { +#ifdef LWLIB_WIDGETS_MOTIF + int i; + for (i = 0; i < wv->args->nargs; i++) + { + if (!strcmp (wv->args->args[i].name, XmNfontList)) + XmFontListFree ((XmFontList)wv->args->args[i].value); + } +#endif + free (wv->args->args); + free (wv->args); + wv->args = (widget_args*)0xDEADBEEF; + } + } +} + +void lw_copy_widget_value_args (widget_value* val, widget_value* copy) +{ + if (!val->args) + { + if (copy->args) + free_widget_value_args (copy); + copy->args = 0; + } + else + { + copy->args = val->args; + copy->args->ref_count++; + } +} + diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/lwlib.h --- a/lwlib/lwlib.h Mon Aug 13 11:12:06 2007 +0200 +++ b/lwlib/lwlib.h Mon Aug 13 11:13:30 2007 +0200 @@ -1,17 +1,8 @@ -#ifndef LWLIB_H -#define LWLIB_H - -#undef CONST +#ifndef INCLUDED_lwlib_h_ +#define INCLUDED_lwlib_h_ #include <X11/Intrinsic.h> -/* To eliminate use of `const' in the lwlib sources, define CONST_IS_LOSING. */ -#ifdef CONST_IS_LOSING -# define CONST -#else -# define CONST const -#endif - #if defined (LWLIB_MENUBARS_LUCID) || defined (LWLIB_MENUBARS_MOTIF) || defined (LWLIB_MENUBARS_ATHENA) #define NEED_MENUBARS #endif @@ -106,6 +97,17 @@ int scrollbar_x, scrollbar_y; } scrollbar_values; +typedef struct _widget_args +{ + /* some things are only possible at creation time. args are applied + to widgets at creation time. */ + ArgList args; + int nargs; + /* Copying args is impossible so we make the caller give us heap allocated + args and free them when on-one wants them any more. */ + int ref_count; +} widget_args; + typedef struct _widget_value { /* This slot is only partially utilized right now. */ @@ -147,10 +149,12 @@ /* data defining a scrollbar; only valid if type == "scrollbar" */ scrollbar_values *scrollbar_data; + /* A reference counted arg structure. */ + struct _widget_args *args; /* we resource the widget_value structures; this points to the next - one on the free list if this one has been deallocated. - */ + one on the free list if this one has been deallocated. */ struct _widget_value *free_list; + } widget_value; @@ -176,13 +180,17 @@ /* do this for the other toolkits too */ #endif /* LWLIB_MENUBARS_LUCID */ -void lw_register_widget (CONST char* type, CONST char* name, LWLIB_ID id, +#if defined (LWLIB_TABS_LUCID) +#include "xlwtabs.h" +#endif + +void lw_register_widget (const char* type, const char* name, LWLIB_ID id, widget_value* val, lw_callback pre_activate_cb, lw_callback selection_cb, lw_callback post_activate_cb); Widget lw_get_widget (LWLIB_ID id, Widget parent, Boolean pop_up_p); Widget lw_make_widget (LWLIB_ID id, Widget parent, Boolean pop_up_p); -Widget lw_create_widget (CONST char* type, CONST char* name, LWLIB_ID id, +Widget lw_create_widget (const char* type, const char* name, LWLIB_ID id, widget_value* val, Widget parent, Boolean pop_up_p, lw_callback pre_activate_cb, lw_callback selection_cb, @@ -201,9 +209,13 @@ Boolean lw_get_some_values (LWLIB_ID id, widget_value* val); void lw_pop_up_all_widgets (LWLIB_ID id); void lw_pop_down_all_widgets (LWLIB_ID id); +void lw_add_value_args_to_args (widget_value* wv, ArgList addto, int* offset); +void lw_add_widget_value_arg (widget_value* wv, String name, XtArgVal value); +void lw_copy_widget_value_args (widget_value* copy, widget_value* val); widget_value *malloc_widget_value (void); void free_widget_value (widget_value *); +void free_widget_value_tree (widget_value *wv); widget_value *replace_widget_value_tree (widget_value*, widget_value*); void lw_popup_menu (Widget, XEvent *); @@ -214,4 +226,4 @@ /* Silly Energize hack to invert the "sheet" button */ void lw_show_busy (Widget w, Boolean busy); -#endif /* LWLIB_H */ +#endif /* INCLUDED_lwlib_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/xlwcheckbox.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lwlib/xlwcheckbox.c Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,415 @@ +/* Checkbox Widget for XEmacs. + Copyright (C) 1999 Edward A. Falk + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Checkbox.c 1.1 */ + +/* + * Checkbox.c - Checkbox button widget + * + * Author: Edward A. Falk + * falk@falconer.vip.best.com + * + * Date: June 30, 1997 + * + * Overview: This widget is identical to the Radio widget in behavior, + * except that the button is square and has a check mark. + */ + + +#include <config.h> +#include <stdio.h> + +#include <X11/IntrinsicP.h> +#include <X11/StringDefs.h> +#include ATHENA_INCLUDE(XawInit.h) +#include "../src/xmu.h" +#include "xlwcheckboxP.h" + + +/* by using the same size for the checkbox as for the diamond box, + * we can let the Radio widget do the vast majority of the work. + */ + +#define BOX_SIZE 8 +#define DRAW_CHECK 0 /* don't draw the check mark */ + +#define cclass(w) ((CheckboxWidgetClass)((w)->core.widget_class)) + +#ifdef _ThreeDP_h +#define swid(cw) ((cw)->threeD.shadow_width) +#else +#define swid(cw) ((cw)->core.border_width) +#endif + +#define bsize(cw) (cclass(cw)->radio_class.dsize) +#define bs(cw) (bsize(cw) + 2*swid(cw)) + + +#if DRAW_CHECK +#define check_width 14 +#define check_height 14 +static u_char check_bits[] = { + 0x00, 0x00, 0x00, 0x20, 0x00, 0x18, 0x00, 0x0c, 0x00, 0x06, 0x00, 0x03, + 0x8c, 0x03, 0xde, 0x01, 0xff, 0x01, 0xfe, 0x00, 0xfc, 0x00, 0x78, 0x00, + 0x70, 0x00, 0x20, 0x00}; +#endif + + +/**************************************************************** + * + * Full class record constant + * + ****************************************************************/ + + +#if DRAW_CHECK +static char defaultTranslations[] = + "<EnterWindow>: highlight()\n\ + <LeaveWindow>: unpress(draw) unhighlight()\n\ + <Btn1Down>: press()\n\ + <Btn1Down>,<Btn1Up>: unpress(nodraw) toggle() notify()"; +#endif + + + +#define offset(field) XtOffsetOf(CheckboxRec, field) +static XtResource resources[] = { + {XtNtristate, XtCTristate, XtRBoolean, sizeof(Boolean), + offset(checkbox.tristate), XtRImmediate, (XtPointer)FALSE}, +} ; +#undef offset + + /* Member functions */ + +static void CheckboxClassInit (void); +static void CheckboxInit (Widget, Widget, ArgList, Cardinal *); +#if DRAW_CHECK +static void CheckboxRealize (Widget, Mask *, XSetWindowAttributes *); +#endif +static void DrawCheck (Widget); + + + /* Action procs */ +#if DRAW_CHECK +static void CheckboxPress (Widget, XEvent *, String *, Cardinal *); +static void CheckboxUnpress (Widget, XEvent *, String *, Cardinal *); +#endif + + /* internal privates */ + +#if DRAW_CHECK +static XtActionsRec actionsList[] = +{ + {"press", CheckboxPress}, + {"unpress", CheckboxUnpress}, +} ; +#endif + +#define SuperClass ((RadioWidgetClass)&radioClassRec) + +CheckboxClassRec checkboxClassRec = { + { + (WidgetClass) SuperClass, /* superclass */ + "Checkbox", /* class_name */ + sizeof(CheckboxRec), /* size */ + CheckboxClassInit, /* class_initialize */ + NULL, /* class_part_initialize */ + FALSE, /* class_inited */ + CheckboxInit, /* initialize */ + NULL, /* initialize_hook */ +#if DRAW_CHECK + CheckboxRealize, /* realize */ + actionsList, /* actions */ + XtNumber(actionsList), /* num_actions */ +#else + XtInheritRealize, /* realize */ + NULL, /* actions */ + 0, /* num_actions */ +#endif + resources, /* resources */ + XtNumber(resources), /* resource_count */ + NULLQUARK, /* xrm_class */ + TRUE, /* compress_motion */ + TRUE, /* compress_exposure */ + TRUE, /* compress_enterleave */ + FALSE, /* visible_interest */ + NULL, /* destroy */ + XtInheritResize, /* resize */ + XtInheritExpose, /* expose */ + NULL, /* set_values */ + NULL, /* set_values_hook */ + XtInheritSetValuesAlmost, /* set_values_almost */ + NULL, /* get_values_hook */ + NULL, /* accept_focus */ + XtVersion, /* version */ + NULL, /* callback_private */ +#if DRAW_CHECK + defaultTranslations, /* tm_table */ +#else + XtInheritTranslations, /* tm_table */ +#endif + XtInheritQueryGeometry, /* query_geometry */ + XtInheritDisplayAccelerator, /* display_accelerator */ + NULL /* extension */ + }, /* CoreClass fields initialization */ + { + XtInheritChangeSensitive /* change_sensitive */ + }, /* SimpleClass fields initialization */ +#ifdef _ThreeDP_h + { + XtInheritXaw3dShadowDraw /* field not used */ + }, /* ThreeDClass fields initialization */ +#endif + { + 0 /* field not used */ + }, /* LabelClass fields initialization */ + { + 0 /* field not used */ + }, /* CommandClass fields initialization */ + { + RadioSet, /* Set Procedure. */ + RadioUnset, /* Unset Procedure. */ + NULL /* extension. */ + }, /* ToggleClass fields initialization */ + { + BOX_SIZE, + DrawCheck, /* draw procedure */ + NULL /* extension. */ + }, /* RadioClass fields initialization */ + { + NULL /* extension. */ + }, /* CheckboxClass fields initialization */ +}; + + /* for public consumption */ +WidgetClass checkboxWidgetClass = (WidgetClass) &checkboxClassRec; + + + + + + +/**************************************************************** + * + * Class Methods + * + ****************************************************************/ + +static void +CheckboxClassInit (void) +{ + XawInitializeWidgetSet(); +} + + +/*ARGSUSED*/ +static void +CheckboxInit (Widget request, + Widget new, + ArgList args, + Cardinal *num_args) +{ +#if DRAW_CHECK + CheckboxWidget cw = (CheckboxWidget) new; + cw->checkbox.checkmark = None ; + cw->checkbox.checkmark_GC = None ; +#endif +} + + +#if DRAW_CHECK +static void +CheckboxRealize(Widget w, + Mask *valueMask, + XSetWindowAttributes *attributes) +{ + CheckboxWidget cw = (CheckboxWidget) w; + XtGCMask value_mask, dynamic_mask, dontcare_mask ; + XGCValues values ; + + /* first, call superclass realize */ + (*checkboxWidgetClass->core_class.superclass->core_class.realize) + (w, valueMask, attributes); + + /* TODO: cache this via xmu */ + if( cw->checkbox.checkmark == None ) + cw->checkbox.checkmark = + XCreateBitmapFromData( XtDisplay(w), XtWindow(w), + check_bits,check_width,check_height); + + values.fill_style = FillStippled ; + values.stipple = cw->checkbox.checkmark ; + values.foreground = cw->label.foreground ; + value_mask = GCFillStyle | GCStipple | GCForeground ; + dynamic_mask = GCTileStipXOrigin | GCTileStipYOrigin ; + dontcare_mask = GCLineWidth | GCLineStyle | GCCapStyle | GCJoinStyle | + GCFont | GCSubwindowMode | GCGraphicsExposures | + GCDashOffset | GCDashList | GCArcMode ; + cw->checkbox.checkmark_GC = + XtAllocateGC(w, 0, value_mask, &values, dynamic_mask, dontcare_mask) ; +} +#endif + + +/* Function Name: CheckboxDestroy + * Description: Destroy Callback for checkbox widget. + * Arguments: w - the checkbox widget that is being destroyed. + * junk, grabage - not used. + * Returns: none. + */ + +/* ARGSUSED */ +static void +CheckboxDestroy (Widget w, + XtPointer junk, + XtPointer garbage) +{ +#if DRAW_CHECK + CheckboxWidget cw = (CheckboxWidget) w; + + /* TODO: cache this via xmu */ + if( cw->checkbox.checkmark != None ) + XFreePixmap( XtDisplay(w), cw->checkbox.checkmark ) ; + if( cw->checkbox.checkmark_GC != None ) + XtReleaseGC(w, cw->checkbox.checkmark_GC) ; +#endif +} + + + +#if DRAW_CHECK +/************************************************************ + * + * Actions Procedures + * + ************************************************************/ + +/* ARGSUSED */ +static void +CheckboxPress (Widget w, + XEvent *event, + String *params, /* unused */ + Cardinal *num_params) /* unused */ +{ + CheckboxWidget cw = (CheckboxWidget) w ; + if( !cw->checkbox.pressed ) { + cw->checkbox.pressed = TRUE ; + ((CheckboxWidgetClass)(w->core.widget_class))->radio_class.drawDiamond(w) ; + } +} + +static void +CheckboxUnpress (Widget w, + XEvent *event, + String *params, /* unused */ + Cardinal *num_params) /* unused */ +{ + CheckboxWidget cw = (CheckboxWidget) w ; + int i ; + + if( cw->checkbox.pressed ) { + cw->checkbox.pressed = FALSE ; + if( *num_params > 0 && **params == 'd' ) + ((CheckboxWidgetClass)(w->core.widget_class))->radio_class.drawDiamond(w); + } +} +#endif + + + + + +/************************************************************ + * + * Internal Procedures + * + ************************************************************/ + +static void +DrawCheck (Widget w) +{ + CheckboxWidget cw = (CheckboxWidget) w ; + Display *dpy = XtDisplay(w) ; + Window win = XtWindow(w) ; + GC gc ; + +#ifdef _ThreeDP_h + XPoint pts[6] ; +#endif + Dimension s = swid(cw); + Dimension bsz = bsize(cw); + Position bx,by ; /* Check upper-left */ + Dimension bw,bh ; +#ifdef _ThreeDP_h + GC top, bot; +#endif + GC ctr ; + + /* foreground GC */ + gc = XtIsSensitive(w) ? cw->command.normal_GC : cw->label.gray_GC ; + + bw = bh = bs(cw) ; + bx = cw->label.internal_width ; + by = cw->core.height/2 - bh/2 ; + +#ifdef _ThreeDP_h + if( !cw->command.set ) { + top = cw->threeD.top_shadow_GC ; + bot = cw->threeD.bot_shadow_GC ; + } else { + top = cw->threeD.bot_shadow_GC ; + bot = cw->threeD.top_shadow_GC ; + } + ctr = cw->command.inverse_GC ; +#else + ctr = cw->command.set ? cw->command.normal_GC : cw->command.inverse_GC ; +#endif + + XFillRectangle(dpy,win,ctr, bx+s,by+s, bsz,bsz) ; + +#ifdef _ThreeDP_h + /* top-left shadow */ + pts[0].x = bx ; pts[0].y = by ; + pts[1].x = bw ; pts[1].y = 0 ; + pts[2].x = -s ; pts[2].y = s ; + pts[3].x = -bsz ; pts[3].y = 0 ; + pts[4].x = 0 ; pts[4].y = bsz ; + pts[5].x = -s ; pts[5].y = s ; + XFillPolygon(dpy,win,top, pts,6, Nonconvex,CoordModePrevious) ; + /* bottom-right shadow */ + pts[0].x = bx+bw ; pts[0].y = by+bh ; + pts[1].x = -bw ; pts[1].y = 0 ; + pts[2].x = s ; pts[2].y = -s ; + pts[3].x = bsz ; pts[3].y = 0 ; + pts[4].x = 0 ; pts[4].y = -bsz ; + pts[5].x = s ; pts[5].y = -s ; + XFillPolygon(dpy,win,bot, pts,6, Nonconvex,CoordModePrevious) ; +#else + XDrawRectangle(dpy,win,gc, bx+s,by+s, bsz,bsz) ; +#endif + +#if DRAW_CHECK + if( cw->command.set && cw->checkbox.checkmark_GC != None ) { + XSetTSOrigin(dpy,cw->checkbox.checkmark_GC, bx+s, by+s) ; + XFillRectangle(dpy,win,cw->checkbox.checkmark_GC, + bx+s, by+s, check_width,check_height) ; + } +#endif +} diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/xlwcheckbox.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lwlib/xlwcheckbox.h Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,103 @@ +/* Checkbox Widget for XEmacs. + Copyright (C) 1999 Edward A. Falk + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Checkbox.h 1.1 */ + +/* + * Checkbox.h - Checkbox widget + * + * Author: Edward A. Falk + * falk@falconer.vip.best.com + * + * Date: June 30, 1997 + */ + +#ifndef _XawCheckbox_h +#define _XawCheckbox_h + +/*********************************************************************** + * + * Checkbox Widget + * + * The Checkbox widget is identical to the Radio widget in behavior but + * not in appearance. The Checkbox widget looks like a small diamond + * shaped button to the left of the label. + * + ***********************************************************************/ + +#include "xlwradio.h" + +/* Resources: + + Name Class RepType Default Value + ---- ----- ------- ------------- + tristate Tristate Boolean FALSE + + radioGroup RadioGroup Widget NULL + radioData RadioData Pointer (XPointer) Widget + state State Boolean Off + background Background Pixel XtDefaultBackground + bitmap Pixmap Pixmap None + border BorderColor Pixel XtDefaultForeground + borderWidth BorderWidth Dimension 1 + callback Callback Pointer NULL + cursor Cursor Cursor None + destroyCallback Callback Pointer NULL + font Font XFontStructx* XtDefaultFont + foreground Foreground Pixel XtDefaultForeground + height Height Dimension text height + highlightThickness Thickness Dimension 2 + insensitiveBorder sensitive Pixmap Gray + internalHeight Height Dimension 2 + internalWidth Width Dimension 4 + justify Justify XtJustify XtJustifyCenter + label Label String NULL + mappedWhenManaged MappedWhenManaged Boolean True + resize Resize Boolean True + sensitive Sensitive Boolean True + width Width Dimension text width + x Position Position 0 + y Position Position 0 + +*/ + +/* + * These should be in StringDefs.h but aren't so we will define + * them here if they are needed. + */ + + +#define XtCTristate "Tristate" + +#define XtNtristate "tristate" + +extern WidgetClass checkboxWidgetClass; + +typedef struct _CheckboxClassRec *CheckboxWidgetClass; +typedef struct _CheckboxRec *CheckboxWidget; + + +/************************************************************ + * + * Public Functions + * + ************************************************************/ + +#endif /* _XawCheckbox_h */ diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/xlwcheckboxP.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lwlib/xlwcheckboxP.h Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,95 @@ +/* Checkbox Widget for XEmacs. + Copyright (C) 1999 Edward A. Falk + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* + * CheckboxP.h - Private definitions for Checkbox widget + * + * Author: Edward A. Falk + * falk@falconer.vip.best.com + * + * Date: June 30, 1997 + */ + +#ifndef _XawCheckboxP_h +#define _XawCheckboxP_h + +#include "xlwcheckbox.h" +#include "xlwradioP.h" + +/************************************ + * + * Class structure + * + ***********************************/ + + /* New fields for the Checkbox widget class record */ +typedef struct _CheckboxClass { + XtPointer extension; +} CheckboxClassPart; + + /* Full class record declaration */ +typedef struct _CheckboxClassRec { + CoreClassPart core_class; + SimpleClassPart simple_class; +#ifdef _ThreeDP_h + ThreeDClassPart threeD_class; +#endif + LabelClassPart label_class; + CommandClassPart command_class; + ToggleClassPart toggle_class; + RadioClassPart radio_class; + CheckboxClassPart checkbox_class; +} CheckboxClassRec; + +extern CheckboxClassRec checkboxClassRec; + +/*************************************** + * + * Instance (widget) structure + * + **************************************/ + + /* New fields for the Checkbox widget record */ +typedef struct { + /* resources */ + Boolean tristate ; + + /* private data */ + Boolean pressed ; + Pixmap checkmark ; /* TODO: share these via xmu? */ + GC checkmark_GC ; + XtPointer extension; +} CheckboxPart; + + /* Full widget declaration */ +typedef struct _CheckboxRec { + CorePart core; + SimplePart simple; +#ifdef _ThreeDP_h + ThreeDPart threeD; +#endif + LabelPart label; + CommandPart command; + TogglePart toggle; + RadioPart radio; + CheckboxPart checkbox; +} CheckboxRec; + +#endif /* _XawCheckboxP_h */ diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/xlwgauge.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lwlib/xlwgauge.c Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,1138 @@ +/* Gauge Widget for XEmacs. + Copyright (C) 1999 Edward A. Falk + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Gauge.c 1.2 */ + +/* + * Gauge.c - Gauge widget + * + * Author: Edward A. Falk + * falk@falconer.vip.best.com + * + * Date: July 9, 1997 + * + * Note: for fun and demonstration purposes, I have added selection + * capabilities to this widget. If you select the widget, you create + * a primary selection containing the current value of the widget in + * both integer and string form. If you copy into the widget, the + * primary selection is converted to an integer value and the gauge is + * set to that value. + */ + +/* TODO: display time instead of value + */ + +#define DEF_LEN 50 /* default width (or height for vertical gauge) */ +#define MIN_LEN 10 /* minimum reasonable width (height) */ +#define TIC_LEN 6 /* length of tic marks */ +#define GA_WID 3 /* width of gauge */ +#define MS_PER_SEC 1000 + +#include <config.h> +#include <stdlib.h> +#include <stdio.h> +#include <ctype.h> +#include <X11/IntrinsicP.h> +#include <X11/Xatom.h> +#include <X11/StringDefs.h> +#include ATHENA_INCLUDE(XawInit.h) +#include "xlwgaugeP.h" +#include "../src/xmu.h" +#ifdef HAVE_XMU +#include <X11/Xmu/Atoms.h> +#include <X11/Xmu/Drawing.h> +#include <X11/Xmu/StdSel.h> +#endif + + +/**************************************************************** + * + * Gauge resources + * + ****************************************************************/ + + +static char defaultTranslations[] = + "<Btn1Up>: select()\n\ + <Key>F1: select(CLIPBOARD)\n\ + <Btn2Up>: paste()\n\ + <Key>F2: paste(CLIPBOARD)" ; + + + +#define offset(field) XtOffsetOf(GaugeRec, field) +static XtResource resources[] = { + {XtNvalue, XtCValue, XtRInt, sizeof(int), + offset(gauge.value), XtRImmediate, (XtPointer)0}, + {XtNminValue, XtCMinValue, XtRInt, sizeof(int), + offset(gauge.v0), XtRImmediate, (XtPointer)0}, + {XtNmaxValue, XtCMaxValue, XtRInt, sizeof(int), + offset(gauge.v1), XtRImmediate, (XtPointer)100}, + {XtNntics, XtCNTics, XtRInt, sizeof(int), + offset(gauge.ntics), XtRImmediate, (XtPointer) 0}, + {XtNnlabels, XtCNLabels, XtRInt, sizeof(int), + offset(gauge.nlabels), XtRImmediate, (XtPointer) 0}, + {XtNlabels, XtCLabels, XtRStringArray, sizeof(String *), + offset(gauge.labels), XtRStringArray, NULL}, + {XtNautoScaleUp, XtCAutoScaleUp, XtRBoolean, sizeof(Boolean), + offset(gauge.autoScaleUp), XtRImmediate, FALSE}, + {XtNautoScaleDown, XtCAutoScaleDown, XtRBoolean, sizeof(Boolean), + offset(gauge.autoScaleDown), XtRImmediate, FALSE}, + {XtNorientation, XtCOrientation, XtROrientation, sizeof(XtOrientation), + offset(gauge.orientation), XtRImmediate, (XtPointer)XtorientHorizontal}, + {XtNupdate, XtCInterval, XtRInt, sizeof(int), + offset(gauge.update), XtRImmediate, (XtPointer)0}, + {XtNgetValue, XtCCallback, XtRCallback, sizeof(XtPointer), + offset(gauge.getValue), XtRImmediate, (XtPointer)NULL}, +}; +#undef offset + + + + /* member functions */ + +static void GaugeClassInit (void); +static void GaugeInit (Widget, Widget, ArgList, Cardinal *); +static void GaugeDestroy (Widget); +static void GaugeResize (Widget); +static void GaugeExpose (Widget, XEvent *, Region); +static Boolean GaugeSetValues (Widget, Widget, Widget, ArgList, Cardinal *); +static XtGeometryResult GaugeQueryGeometry (Widget, XtWidgetGeometry *, + XtWidgetGeometry *); + + /* action procs */ + +static void GaugeSelect (Widget, XEvent *, String *, Cardinal *); +static void GaugePaste (Widget, XEvent *, String *, Cardinal *); + + /* internal privates */ + +static void GaugeSize (GaugeWidget, Dimension *, Dimension *, Dimension); +static void MaxLabel (GaugeWidget, Dimension *, Dimension *, + Dimension *, Dimension *); +static void AutoScale (GaugeWidget); +static void EnableUpdate (GaugeWidget); +static void DisableUpdate (GaugeWidget); + +static void GaugeGetValue (XtPointer, XtIntervalId *); +static void GaugeMercury (Display *, Window, GC, GaugeWidget, Cardinal, Cardinal); + +static Boolean GaugeConvert (Widget, Atom *, Atom *, Atom *, + XtPointer *, u_long *, int *); +static void GaugeLoseSel (Widget, Atom *); +static void GaugeDoneSel (Widget, Atom *, Atom *); +static void GaugeGetSelCB (Widget, XtPointer, Atom *, Atom *, + XtPointer, u_long *, int *); + +static GC Get_GC (GaugeWidget, Pixel); + + +static XtActionsRec actionsList[] = +{ + {"select", GaugeSelect}, + {"paste", GaugePaste}, +} ; + + + +/**************************************************************** + * + * Full class record constant + * + ****************************************************************/ + +GaugeClassRec gaugeClassRec = { + { +/* core_class fields */ + /* superclass */ (WidgetClass) &labelClassRec, + /* class_name */ "Gauge", + /* widget_size */ sizeof(GaugeRec), + /* class_initialize */ GaugeClassInit, + /* class_part_initialize */ NULL, + /* class_inited */ FALSE, + /* initialize */ GaugeInit, + /* initialize_hook */ NULL, + /* realize */ XtInheritRealize, /* TODO? */ + /* actions */ actionsList, + /* num_actions */ XtNumber(actionsList), + /* resources */ resources, + /* num_resources */ XtNumber(resources), + /* xrm_class */ NULLQUARK, + /* compress_motion */ TRUE, + /* compress_exposure */ TRUE, + /* compress_enterleave */ TRUE, + /* visible_interest */ FALSE, + /* destroy */ GaugeDestroy, + /* resize */ GaugeResize, + /* expose */ GaugeExpose, + /* set_values */ GaugeSetValues, + /* set_values_hook */ NULL, + /* set_values_almost */ XtInheritSetValuesAlmost, + /* get_values_hook */ NULL, + /* accept_focus */ NULL, + /* version */ XtVersion, + /* callback_private */ NULL, + /* tm_table */ defaultTranslations, + /* query_geometry */ GaugeQueryGeometry, + /* display_accelerator */ XtInheritDisplayAccelerator, + /* extension */ NULL + }, +/* Simple class fields initialization */ + { + /* change_sensitive */ XtInheritChangeSensitive + }, +#ifdef _ThreeDP_h +/* ThreeD class fields initialization */ + { + XtInheritXaw3dShadowDraw /* shadowdraw */ + }, +#endif +/* Label class fields initialization */ + { + /* ignore */ 0 + }, +/* Gauge class fields initialization */ + { + /* extension */ NULL + }, +}; + +WidgetClass gaugeWidgetClass = (WidgetClass)&gaugeClassRec; + + + + +/**************************************************************** + * + * Member Procedures + * + ****************************************************************/ + +static void +GaugeClassInit (void) +{ + XawInitializeWidgetSet(); +#ifdef HAVE_XMU + XtAddConverter(XtRString, XtROrientation, XmuCvtStringToOrientation, + NULL, 0) ; +#endif +} + + + +/* ARGSUSED */ +static void +GaugeInit (Widget request, + Widget new, + ArgList args, + Cardinal *num_args) +{ + GaugeWidget gw = (GaugeWidget) new; + + if( gw->gauge.v0 == 0 && gw->gauge.v1 == 0 ) { + gw->gauge.autoScaleUp = gw->gauge.autoScaleDown = TRUE ; + AutoScale(gw) ; + } + + /* If size not explicitly set, set it to our preferred size now. */ + + if( request->core.width == 0 || request->core.height == 0 ) + { + Dimension w,h ; + GaugeSize(gw, &w,&h, DEF_LEN) ; + if( request->core.width == 0 ) + new->core.width = w ; + if( request->core.height == 0 ) + new->core.height = h ; + gw->core.widget_class->core_class.resize(new) ; + } + + gw->gauge.selected = None ; + gw->gauge.selstr = NULL ; + + if( gw->gauge.update > 0 ) + EnableUpdate(gw) ; + + gw->gauge.inverse_GC = Get_GC(gw, gw->core.background_pixel) ; +} + +static void +GaugeDestroy (Widget w) +{ + GaugeWidget gw = (GaugeWidget)w; + + if( gw->gauge.selstr != NULL ) + XtFree(gw->gauge.selstr) ; + + if( gw->gauge.selected != None ) + XtDisownSelection(w, gw->gauge.selected, CurrentTime) ; + + XtReleaseGC(w, gw->gauge.inverse_GC) ; + + if( gw->gauge.update > 0 ) + DisableUpdate(gw) ; +} + + +/* React to size change from manager. Label widget will compute some + * internal stuff, but we need to override. + */ + +static void +GaugeResize (Widget w) +{ + GaugeWidget gw = (GaugeWidget)w; + int size ; /* height (width) of gauge */ + int vmargin ; /* vertical (horizontal) margin */ + int hmargin ; /* horizontal (vertical) margin */ + + vmargin = gw->gauge.orientation == XtorientHorizontal ? + gw->label.internal_height : gw->label.internal_width ; + hmargin = gw->gauge.orientation == XtorientHorizontal ? + gw->label.internal_width : gw->label.internal_height ; + + /* TODO: need to call parent resize proc? I don't think so since + * we're recomputing everything from scratch anyway. + */ + + /* find total height (width) of contents */ + + size = GA_WID+2 ; /* gauge itself + edges */ + + if( gw->gauge.ntics > 1 ) /* tic marks */ + size += vmargin + TIC_LEN ; + + if( gw->gauge.nlabels > 1 ) + { + Dimension lwm, lw0, lw1 ; /* width of max, left, right labels */ + Dimension lh ; + + MaxLabel(gw,&lwm,&lh, &lw0,&lw1) ; + + if( gw->gauge.orientation == XtorientHorizontal ) + { + gw->gauge.margin0 = lw0 / 2 ; + gw->gauge.margin1 = lw1 / 2 ; + size += lh + vmargin ; + } + else + { + gw->gauge.margin0 = + gw->gauge.margin1 = lh / 2 ; + size += lwm + vmargin ; + } + } + else + gw->gauge.margin0 = gw->gauge.margin1 = 0 ; + + gw->gauge.margin0 += hmargin ; + gw->gauge.margin1 += hmargin ; + + /* Now distribute height (width) over components */ + + if( gw->gauge.orientation == XtorientHorizontal ) + gw->gauge.gmargin = (gw->core.height-size)/2 ; + else + gw->gauge.gmargin = (gw->core.width-size)/2 ; + + gw->gauge.tmargin = gw->gauge.gmargin + GA_WID+2 + vmargin ; + if( gw->gauge.ntics > 1 ) + gw->gauge.lmargin = gw->gauge.tmargin + TIC_LEN + vmargin ; + else + gw->gauge.lmargin = gw->gauge.tmargin ; +} + +/* + * Repaint the widget window + */ + +/* ARGSUSED */ +static void +GaugeExpose (Widget w, + XEvent *event, + Region region) +{ + GaugeWidget gw = (GaugeWidget) w; +register Display *dpy = XtDisplay(w) ; +register Window win = XtWindow(w) ; + GC gc; /* foreground, background */ + GC gctop, gcbot ; /* dark, light shadows */ + + int len ; /* length (width or height) of widget */ + int hgt ; /* height (width) of widget */ + int e0,e1 ; /* ends of the gauge */ + int x ; + int y ; /* vertical (horizontal) position */ + int i ; + int v0 = gw->gauge.v0 ; + int v1 = gw->gauge.v1 ; + int value = gw->gauge.value ; + + gc = XtIsSensitive(w) ? gw->label.normal_GC : gw->label.gray_GC ; + + +#ifdef _ThreeDP_h + gctop = gw->threeD.bot_shadow_GC ; + gcbot = gw->threeD.top_shadow_GC ; +#else + gctop = gcbot = gc ; +#endif + + if( gw->gauge.orientation == XtorientHorizontal ) { + len = gw->core.width ; + hgt = gw->core.height ; + } else { + len = gw->core.height ; + hgt = gw->core.width ; + } + + /* if the gauge is selected, signify by drawing the background + * in a constrasting color. + */ + + if( gw->gauge.selected ) + { + XFillRectangle(dpy,win, gc, 0,0, w->core.width,w->core.height) ; + gc = gw->gauge.inverse_GC ; + } + + e0 = gw->gauge.margin0 ; /* left (top) end */ + e1 = len - gw->gauge.margin1 -1 ; /* right (bottom) end */ + + /* Draw the Gauge itself */ + + y = gw->gauge.gmargin ; + + if( gw->gauge.orientation == XtorientHorizontal ) /* horizontal */ + { + XDrawLine(dpy,win,gctop, e0+1,y, e1-1,y) ; + XDrawLine(dpy,win,gctop, e0,y+1, e0,y+GA_WID) ; + XDrawLine(dpy,win,gcbot, e0+1, y+GA_WID+1, e1-1, y+GA_WID+1) ; + XDrawLine(dpy,win,gcbot, e1,y+1, e1,y+GA_WID) ; + } + else /* vertical */ + { + XDrawLine(dpy,win,gctop, y,e0+1, y,e1-1) ; + XDrawLine(dpy,win,gctop, y+1,e0, y+GA_WID,e0) ; + XDrawLine(dpy,win,gcbot, y+GA_WID+1,e0+1, y+GA_WID+1, e1-1) ; + XDrawLine(dpy,win,gcbot, y+1,e1, y+GA_WID,e1) ; + } + + + /* draw the mercury */ + + GaugeMercury(dpy, win, gc, gw, 0,value) ; + + + if( gw->gauge.ntics > 1 ) + { + y = gw->gauge.tmargin ; + for(i=0; i<gw->gauge.ntics; ++i) + { + x = e0 + i*(e1-e0-1)/(gw->gauge.ntics-1) ; + if( gw->gauge.orientation == XtorientHorizontal ) { + XDrawLine(dpy,win,gcbot, x,y+1, x,y+TIC_LEN-2) ; + XDrawLine(dpy,win,gcbot, x,y, x+1,y) ; + XDrawLine(dpy,win,gctop, x+1,y+1, x+1,y+TIC_LEN-2) ; + XDrawLine(dpy,win,gctop, x,y+TIC_LEN-1, x+1,y+TIC_LEN-1) ; + } + else { + XDrawLine(dpy,win,gcbot, y+1,x, y+TIC_LEN-2,x) ; + XDrawLine(dpy,win,gcbot, y,x, y,x+1) ; + XDrawLine(dpy,win,gctop, y+1,x+1, y+TIC_LEN-2,x+1) ; + XDrawLine(dpy,win,gctop, y+TIC_LEN-1,x, y+TIC_LEN-1,x+1) ; + } + } + } + + /* draw labels */ + if( gw->gauge.nlabels > 1 ) + { + char label[20], *s = label ; + int len, w,h =0 ; + + if( gw->gauge.orientation == XtorientHorizontal ) + y = gw->gauge.lmargin + gw->label.font->max_bounds.ascent - 1 ; + else { + y = gw->gauge.lmargin ; + h = gw->label.font->max_bounds.ascent / 2 ; + } + + for(i=0; i<gw->gauge.nlabels; ++i) + { + if( gw->gauge.labels == NULL ) + sprintf(label, "%d", v0+i*(v1 - v0)/(gw->gauge.nlabels - 1)) ; + else + s = gw->gauge.labels[i] ; + if( s != NULL ) { + x = e0 + i*(e1-e0-1)/(gw->gauge.nlabels-1) ; + len = strlen(s) ; + if( gw->gauge.orientation == XtorientHorizontal ) { + w = XTextWidth(gw->label.font, s, len) ; + XDrawString(dpy,win,gc, x-w/2,y, s,len) ; + } + else { + XDrawString(dpy,win,gc, y,x+h, s,len) ; + } + } + } + } +} + + +/* + * Set specified arguments into widget + */ + +static Boolean +GaugeSetValues (Widget old, + Widget request, + Widget new, + ArgList args, + Cardinal *num_args) +{ + GaugeWidget oldgw = (GaugeWidget) old; + GaugeWidget gw = (GaugeWidget) new; + Boolean was_resized = False; + + if( gw->gauge.selected != None ) { + XtDisownSelection(new, gw->gauge.selected, CurrentTime) ; + gw->gauge.selected = None ; + } + + /* Changes to v0,v1,labels, ntics, nlabels require resize & redraw. */ + /* Change to value requires redraw and possible resize if autoscale */ + + was_resized = + gw->gauge.v0 != oldgw->gauge.v0 || + gw->gauge.v1 != oldgw->gauge.v1 || + gw->gauge.ntics != oldgw->gauge.ntics || + gw->gauge.nlabels != oldgw->gauge.nlabels || + gw->gauge.labels != oldgw->gauge.labels ; + + if( (gw->gauge.autoScaleUp && gw->gauge.value > gw->gauge.v1) || + (gw->gauge.autoScaleDown && gw->gauge.value < gw->gauge.v1/3 )) + { + AutoScale(gw) ; + was_resized = TRUE ; + } + + if( was_resized ) { + if( gw->label.resize ) + GaugeSize(gw, &gw->core.width, &gw->core.height, DEF_LEN) ; + else + GaugeResize(new) ; + } + + if( gw->gauge.update != oldgw->gauge.update ) + { + if( gw->gauge.update > 0 ) + EnableUpdate(gw) ; + else + DisableUpdate(gw) ; + } + + if( gw->core.background_pixel != oldgw->core.background_pixel ) + { + XtReleaseGC(new, gw->gauge.inverse_GC) ; + gw->gauge.inverse_GC = Get_GC(gw, gw->core.background_pixel) ; + } + + return was_resized || gw->gauge.value != oldgw->gauge.value || + XtIsSensitive(old) != XtIsSensitive(new); +} + + +static XtGeometryResult +GaugeQueryGeometry (Widget w, + XtWidgetGeometry *intended, + XtWidgetGeometry *preferred) +{ + register GaugeWidget gw = (GaugeWidget)w; + + if( intended->width == w->core.width && + intended->height == w->core.height ) + return XtGeometryNo ; + + preferred->request_mode = CWWidth | CWHeight; + GaugeSize(gw, &preferred->width, &preferred->height, DEF_LEN) ; + + if( (!(intended->request_mode & CWWidth) || + intended->width >= preferred->width) && + (!(intended->request_mode & CWHeight) || + intended->height >= preferred->height) ) + return XtGeometryYes; + else + return XtGeometryAlmost; +} + + + + +/**************************************************************** + * + * Action Procedures + * + ****************************************************************/ + +static void +GaugeSelect (Widget w, + XEvent *event, + String *params, + Cardinal *num_params) +{ + GaugeWidget gw = (GaugeWidget)w ; + Atom seln = XA_PRIMARY ; + + if( gw->gauge.selected != None ) { + XtDisownSelection(w, gw->gauge.selected, CurrentTime) ; + gw->gauge.selected = None ; + } + + if( *num_params > 0 ) { + seln = XInternAtom(XtDisplay(w), params[0], False) ; + printf("atom %s is %ld\n", params[0], seln) ; + } + + if( ! XtOwnSelection(w, seln, event->xbutton.time, GaugeConvert, + GaugeLoseSel, GaugeDoneSel) ) + { + /* in real code, this error message would be replaced by + * something more elegant, or at least deleted + */ + + fprintf(stderr, "Gauge failed to get selection, try again\n") ; + } + else + { + gw->gauge.selected = TRUE ; + gw->gauge.selstr = (String)XtMalloc(4*sizeof(int)) ; + sprintf(gw->gauge.selstr, "%d", gw->gauge.value) ; + GaugeExpose(w,0,0) ; + } +} + + +static Boolean +GaugeConvert (Widget w, + Atom *selection, /* usually XA_PRIMARY */ + Atom *target, /* requested target */ + Atom *type, /* returned type */ + XtPointer *value, /* returned value */ + u_long *length, /* returned length */ + int *format) /* returned format */ +{ + GaugeWidget gw = (GaugeWidget)w ; + XSelectionRequestEvent *req ; + + printf( "requesting selection %s:%s\n", + XGetAtomName(XtDisplay(w),*selection), + XGetAtomName(XtDisplay(w),*target)); + +#ifdef HAVE_XMU + if( *target == XA_TARGETS(XtDisplay(w)) ) + { + Atom *rval, *stdTargets ; + u_long stdLength ; + + /* XmuConvertStandardSelection can handle this. This function + * will return a list of standard targets. We prepend TEXT, + * STRING and INTEGER to the list and return it. + */ + + req = XtGetSelectionRequest(w, *selection, NULL) ; + XmuConvertStandardSelection(w, req->time, selection, target, + type, (XPointer*)&stdTargets, &stdLength, format) ; + + *type = XA_ATOM ; /* TODO: needed? */ + *length = stdLength + 3 ; + rval = (Atom *) XtMalloc(sizeof(Atom)*(stdLength+3)) ; + *value = (XtPointer) rval ; + *rval++ = XA_INTEGER ; + *rval++ = XA_STRING ; + *rval++ = XA_TEXT(XtDisplay(w)) ; + memcpy((char *)rval, (char *)stdTargets, stdLength*sizeof(Atom)) ; + XtFree((char*) stdTargets) ; + *format = 8*sizeof(Atom) ; /* TODO: needed? */ + return True ; + } + + else +#endif + if( *target == XA_INTEGER ) + { + *type = XA_INTEGER ; + *length = 1 ; + *value = (XtPointer) &gw->gauge.value ; + *format = 8*sizeof(int) ; + return True ; + } + + else if( *target == XA_STRING +#ifdef HAVE_XMU + || + *target == XA_TEXT(XtDisplay(w)) +#endif + ) + { + *type = *target ; + *length = strlen(gw->gauge.selstr)*sizeof(char) ; + *value = (XtPointer) gw->gauge.selstr ; + *format = 8 ; + return True ; + } + + else + { + /* anything else, we just give it to XmuConvertStandardSelection() */ +#ifdef HAVE_XMU + req = XtGetSelectionRequest(w, *selection, NULL) ; + if( XmuConvertStandardSelection(w, req->time, selection, target, + type, (XPointer *) value, length, format) ) + return True ; + else +#endif + { + printf( + "Gauge: requestor is requesting unsupported selection %s:%s\n", + XGetAtomName(XtDisplay(w),*selection), + XGetAtomName(XtDisplay(w),*target)); + return False ; + } + } +} + + + +static void +GaugeLoseSel (Widget w, + Atom *selection) /* usually XA_PRIMARY */ +{ + GaugeWidget gw = (GaugeWidget)w ; + Display *dpy = XtDisplay(w) ; + Window win = XtWindow(w) ; + + if( gw->gauge.selstr != NULL ) { + XtFree(gw->gauge.selstr) ; + gw->gauge.selstr = NULL ; + } + + gw->gauge.selected = False ; + XClearWindow(dpy,win) ; + GaugeExpose(w,0,0) ; +} + + +static void +GaugeDoneSel (Widget w, + Atom *selection, /* usually XA_PRIMARY */ + Atom *target) /* requested target */ +{ + /* selection done, anything to do? */ +} + + +static void +GaugePaste (Widget w, + XEvent *event, + String *params, + Cardinal *num_params) +{ + Atom seln = XA_PRIMARY ; + + if( *num_params > 0 ) { + seln = XInternAtom(XtDisplay(w), params[0], False) ; + printf("atom %s is %ld\n", params[0], seln) ; + } + + /* try for integer value first */ + XtGetSelectionValue(w, seln, XA_INTEGER, + GaugeGetSelCB, (XtPointer)XA_INTEGER, + event->xbutton.time) ; +} + +static void +GaugeGetSelCB (Widget w, + XtPointer client, + Atom *selection, + Atom *type, + XtPointer value, + u_long *length, + int *format) +{ + Display *dpy = XtDisplay(w) ; + Atom target = (Atom)client ; + int *iptr ; + char *cptr ; + + if( *type == XA_INTEGER ) { + iptr = (int *)value ; + XawGaugeSetValue(w, *iptr) ; + } + + else if( *type == XA_STRING +#ifdef HAVE_XMU + || + *type == XA_TEXT(dpy) +#endif + ) + { + cptr = (char *)value ; + XawGaugeSetValue(w, atoi(cptr)) ; + } + + /* failed, try string */ + else if( *type == None && target == XA_INTEGER ) + XtGetSelectionValue(w, *selection, XA_STRING, + GaugeGetSelCB, (XtPointer)XA_STRING, + CurrentTime) ; +} + + + +/**************************************************************** + * + * Public Procedures + * + ****************************************************************/ + + + /* Change gauge value. Only undraw or draw what needs to be + * changed. + */ + +void +XawGaugeSetValue (Widget w, + Cardinal value) +{ + GaugeWidget gw = (GaugeWidget)w ; + int oldvalue ; + GC gc ; + + if( gw->gauge.selected != None ) { + XtDisownSelection(w, gw->gauge.selected, CurrentTime) ; + gw->gauge.selected = None ; + } + + if( !XtIsRealized(w) ) { + gw->gauge.value = value ; + return ; + } + + /* need to rescale? */ + if(( gw->gauge.autoScaleUp && value > gw->gauge.v1) || + (gw->gauge.autoScaleDown && value < gw->gauge.v1/3 )) + { + XtVaSetValues(w, XtNvalue, value, 0) ; + return ; + } + + oldvalue = gw->gauge.value ; + gw->gauge.value = value ; + + gc = XtIsSensitive(w) ? gw->label.normal_GC : gw->label.gray_GC ; + GaugeMercury(XtDisplay(w), XtWindow(w), gc, gw, oldvalue,value) ; +} + + +Cardinal +XawGaugeGetValue (Widget w) +{ + GaugeWidget gw = (GaugeWidget)w ; + return gw->gauge.value ; +} + + + + +/**************************************************************** + * + * Private Procedures + * + ****************************************************************/ + + /* draw the mercury over a specific region */ + +static void +GaugeMercury (Display *dpy, + Window win, + GC gc, + GaugeWidget gw, + Cardinal val0, + Cardinal val1) +{ + int v0 = gw->gauge.v0 ; + int v1 = gw->gauge.v1 ; + int vd = v1 - v0 ; + Dimension len ; /* length (width or height) of gauge */ + Position e0, e1 ; /* gauge ends */ + Position p0, p1 ; /* mercury ends */ + int y ; /* vertical (horizontal) position */ + Boolean undraw = FALSE ; + + len = gw->gauge.orientation == XtorientHorizontal ? + gw->core.width : gw->core.height ; + + e0 = gw->gauge.margin0 ; /* left (top) end */ + e1 = len - gw->gauge.margin1 -1 ; /* right (bottom) end */ + + if( vd <= 0 ) vd = 1 ; + + if( val0 < v0 ) val0 = v0 ; + else if( val0 > v1 ) val0 = v1 ; + if( val1 < v0 ) val1 = v0 ; + else if( val1 > v1 ) val1 = v1 ; + + p0 = (val0-v0)*(e1-e0-1)/vd ; + p1 = (val1-v0)*(e1-e0-1)/vd ; + + if( p1 == p0 ) + return ; + + y = gw->gauge.gmargin ; + + if( p1 < p0 ) + { + Position tmp = p0 ; + p0 = p1 ; + p1 = tmp ; + gc = gw->label.normal_GC ; + XSetForeground(dpy,gc, gw->core.background_pixel) ; + undraw = TRUE ; + } + + if( gw->gauge.orientation == XtorientHorizontal ) + XFillRectangle(dpy,win,gc, e0+p0+1,y+1, p1-p0,GA_WID) ; + else + XFillRectangle(dpy,win,gc, y+1,e1-p1, GA_WID,p1-p0) ; + + if( undraw ) + XSetForeground(dpy,gc, gw->label.foreground) ; +} + + + +/* Search the labels, find the largest one. */ +/* TODO: handle vertical fonts? */ + +static void +MaxLabel (GaugeWidget gw, + Dimension *wid, /* max label width */ + Dimension *hgt, /* max label height */ + Dimension *w0, /* width of first label */ + Dimension *w1) /* width of last label */ +{ + char lstr[80], *lbl ; + int w ; + XFontStruct *font = gw->label.font ; + int i ; + int lw = 0; + int v0 = gw->gauge.v0 ; + int dv = gw->gauge.v1 - v0 ; + int n = gw->gauge.nlabels ; + + if( n > 0 ) + { + if( --n <= 0 ) {n = 1 ; v0 += dv/2 ;} + + /* loop through all labels, figure out how much room they + * need. + */ + w = 0 ; + for(i=0; i<gw->gauge.nlabels; ++i) + { + if( gw->gauge.labels == NULL ) /* numeric labels */ + sprintf(lbl = lstr,"%d", v0 + i*dv/n) ; + else + lbl = gw->gauge.labels[i] ; + + if( lbl != NULL ) { + lw = XTextWidth(font, lbl, strlen(lbl)) ; + w = Max( w, lw ) ; + } + else + lw = 0 ; + + if( i == 0 && w0 != NULL ) *w0 = lw ; + } + if( w1 != NULL ) *w1 = lw ; + + *wid = w ; + *hgt = font->max_bounds.ascent + font->max_bounds.descent ; + } + else + *wid = *hgt = 0 ; +} + + +/* Determine the preferred size for this widget. choose 100x100 for + * debugging. + */ + +static void +GaugeSize (GaugeWidget gw, + Dimension *wid, + Dimension *hgt, + Dimension min_len) +{ + int w,h ; /* width, height of gauge */ + int vmargin ; /* vertical margin */ + int hmargin ; /* horizontal margin */ + + hmargin = gw->label.internal_width ; + vmargin = gw->label.internal_height ; + + /* find total height (width) of contents */ + + + /* find minimum size for undecorated gauge */ + + if( gw->gauge.orientation == XtorientHorizontal ) + { + w = min_len ; + h = GA_WID+2 ; /* gauge itself + edges */ + } + else + { + w = GA_WID+2 ; + h = min_len ; + } + + if( gw->gauge.ntics > 0 ) + { + if( gw->gauge.orientation == XtorientHorizontal ) + { + w = Max(w, gw->gauge.ntics*3) ; + h += vmargin + TIC_LEN ; + } + else + { + w += hmargin + TIC_LEN ; + h = Max(h, gw->gauge.ntics*3) ; + } + } + + + /* If labels are requested, this gets a little interesting. + * We want the end labels centered on the ends of the gauge and + * the centers of the labels evenly spaced. The labels at the ends + * will not be the same width, meaning that the gauge itself need + * not be centered in the widget. + * + * First, determine the spacing. This is the width of the widest + * label, plus the internal margin. Total length of the gauge is + * spacing * (nlabels-1). To this, we add half the width of the + * left-most label and half the width of the right-most label + * to get the entire desired width of the widget. + */ + if( gw->gauge.nlabels > 0 ) + { + Dimension lwm, lw0, lw1 ; /* width of max, left, right labels */ + Dimension lh ; + + MaxLabel(gw,&lwm,&lh, &lw0,&lw1) ; + + if( gw->gauge.orientation == XtorientHorizontal ) + { + lwm = (lwm+hmargin) * (gw->gauge.nlabels-1) + (lw0+lw1)/2 ; + w = Max(w, lwm) ; + h += lh + vmargin ; + } + else + { + lh = lh*gw->gauge.nlabels + (gw->gauge.nlabels - 1)*vmargin ; + h = Max(h, lh) ; + w += lwm + hmargin ; + } + } + + w += hmargin*2 ; + h += vmargin*2 ; + + *wid = w ; + *hgt = h ; +} + + + +static void +AutoScale (GaugeWidget gw) +{ + static int scales[3] = {1,2,5} ; + int sptr = 0, smult=1 ; + + if( gw->gauge.autoScaleDown ) + gw->gauge.v1 = 0 ; + while( gw->gauge.value > gw->gauge.v1 ) + { + if( ++sptr > 2 ) { + sptr = 0 ; + smult *= 10 ; + } + gw->gauge.v1 = scales[sptr] * smult ; + } +} + +static void +EnableUpdate (GaugeWidget gw) +{ + gw->gauge.intervalId = + XtAppAddTimeOut(XtWidgetToApplicationContext((Widget)gw), + gw->gauge.update * MS_PER_SEC, GaugeGetValue, + (XtPointer)gw) ; +} + +static void +DisableUpdate (GaugeWidget gw) +{ + XtRemoveTimeOut(gw->gauge.intervalId) ; +} + +static void +GaugeGetValue (XtPointer clientData, + XtIntervalId *intervalId) +{ + GaugeWidget gw = (GaugeWidget)clientData ; + Cardinal value ; + + if( gw->gauge.update > 0 ) + EnableUpdate(gw) ; + + if( gw->gauge.getValue != NULL ) + { + XtCallCallbackList((Widget)gw, gw->gauge.getValue, (XtPointer)&value); + XawGaugeSetValue((Widget)gw, value) ; + } +} + + +static GC +Get_GC (GaugeWidget gw, + Pixel fg) +{ + XGCValues values ; +#define vmask GCForeground +#define umask (GCBackground|GCSubwindowMode|GCGraphicsExposures|GCDashOffset\ + |GCFont|GCDashList|GCArcMode) + + values.foreground = fg ; + + return XtAllocateGC((Widget)gw, 0, vmask, &values, 0L, umask) ; +} diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/xlwgauge.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lwlib/xlwgauge.h Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,184 @@ +/* Gauge Widget for XEmacs. + Copyright (C) 1999 Edward A. Falk + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Gauge.h 1.1 */ + +/* + * Gauge.h - Gauge widget + * + * Author: Edward A. Falk + * falk@falconer.vip.best.com + * + * Date: July 8, 1997 + */ + +#ifndef _XawGauge_h +#define _XawGauge_h + +/*********************************************************************** + * + * Gauge Widget + * + * The Gauge widget looks something like a thermometer. Application + * defines the values at the ends of the range and the current value + * and Gauge draws accordingly. Gauge does not accept input. + * + ***********************************************************************/ + +#include ATHENA_INCLUDE(Label.h) + +/* Resources: + + Name Class RepType Default Value + ---- ----- ------- ------------- + value Value Cardinal 0 + minValue MinValue Cardinal 0 + maxValue MaxValue Cardinal 100 + ntics NTics Cardinal 0 + + nlabels NLabels Cardinal 0 ++ + labels Labels String * NULL +++ + orientation Orientation XtOrientation horizontal + autoScaleUp AutoScaleUp Boolean FALSE ++++ + autoScaleDown AutoScaleDown Boolean FALSE ++++ + getValue Callback XtCallbackList NULL +++++ + update Interval int 0 (seconds) = disabled + + encoding Encoding unsigned char XawTextEncoding8bit + font Font XFontStruct* XtDefaultFont + foreground Foreground Pixel XtDefaultForeground + internalHeight Height Dimension 2 + internalWidth Width Dimension 4 + resize Resize Boolean True + background Background Pixel XtDefaultBackground + bitmap Pixmap Pixmap None + border BorderColor Pixel XtDefaultForeground + borderWidth BorderWidth Dimension 1 + cursor Cursor Cursor None + cursorName Cursor String NULL + destroyCallback Callback XtCallbackList NULL + height Height Dimension varies + insensitiveBorder Insensitive Pixmap Gray + mappedWhenManaged MappedWhenManaged Boolean True + pointerColor Foreground Pixel XtDefaultForeground + pointerColorBackground Background Pixel XtDefaultBackground + sensitive Sensitive Boolean True + width Width Dimension text width + x Position Position 0 + y Position Position 0 + + + Ntics sets the number of tic marks next to the gauge. If 0, no + tic marks will be drawn. + ++ Nlabels sets the number of labels next to the gauge. + +++ Labels is an array of nul-terminated strings to be used as labels. + If this field is NULL but nlabels is > 0, then numeric labels will be + provided. NOTE: the labels are not copied to any internal memory; they + must be stored in static memory provided by the appliction. + ++++ AutoScale allows the gauge to set its own value limits. Default is + False unless upper & lower limits are both 0. + + +++++ The GetValue() callback proc is called with these arguments: + static void + myGetValue(gauge, client, rval) + Widget gauge ; + XtPointer client ; + XtPointer rval ; + { + *(Cardinal *)rval = value ; + } + +*/ + +/* + * Resource names not provided in StringDefs.h + */ + +#ifndef XtNvalue +#define XtNvalue "value" +#define XtCValue "Value" +#endif + +#ifndef XtNorientation +#define XtNorientation "orientation" +#define XtCOrientation "Orientation" +#endif + +#define XtNntics "ntics" +#define XtCNTics "NTics" + +#ifndef XtNnlabels +#define XtNnlabels "nlabels" +#define XtCNLabels "NLabels" +#endif +#ifndef XtNlabels +#define XtNlabels "labels" +#define XtCLabels "Labels" +#endif + +#ifndef XtNminValue +#define XtNminValue "minValue" +#define XtCMinValue "MinValue" +#endif +#ifndef XtNmaxValue +#define XtNmaxValue "maxValue" +#define XtCMaxValue "MaxValue" +#endif + +#ifndef XtNautoScaleUp +#define XtNautoScaleUp "autoScaleUp" +#define XtCAutoScaleUp "AutoScaleUp" +#define XtNautoScaleDown "autoScaleDown" +#define XtCAutoScaleDown "AutoScaleDown" +#endif + +#ifndef XtNupdate +#define XtNupdate "update" +#endif + +#ifndef XtNgetValue +#define XtNgetValue "getValue" +#endif + + +/* Class record constants */ + +extern WidgetClass gaugeWidgetClass; + +typedef struct _GaugeClassRec *GaugeWidgetClass; +typedef struct _GaugeRec *GaugeWidget; + + +_XFUNCPROTOBEGIN + +extern void XawGaugeSetValue( +#if NeedFunctionPrototypes + Widget gauge, + Cardinal value +#endif +); + +extern Cardinal XawGaugeGetValue( +#if NeedFunctionPrototypes + Widget gauge +#endif +); + +_XFUNCPROTOEND + +#endif /* _XawGauge_h */ diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/xlwgaugeP.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lwlib/xlwgaugeP.h Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,103 @@ +/* Gauge Widget for XEmacs. + Copyright (C) 1999 Edward A. Falk + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* + * GaugeP.h - Gauge widget + * + * Author: Edward A. Falk + * falk@falconer.vip.best.com + * + * Date: July 9, 1997 + */ + +#ifndef _XawGaugeP_h +#define _XawGaugeP_h + +/*********************************************************************** + * + * Gauge Widget Private Data + * + * Gauge has little in common with the label widget, but can make use + * of some label resources, so is subclassed from label. + * + ***********************************************************************/ + +#include "xlwgauge.h" +#include ATHENA_INCLUDE(LabelP.h) + +/* New fields for the Gauge widget class record */ + +typedef struct {XtPointer extension;} GaugeClassPart; + +/* Full class record declaration */ +typedef struct _GaugeClassRec { + CoreClassPart core_class; + SimpleClassPart simple_class; +#ifdef _ThreeDP_h + ThreeDClassPart threeD_class; +#endif + LabelClassPart label_class; + GaugeClassPart gauge_class; +} GaugeClassRec; + +extern GaugeClassRec gaugeClassRec; + +/* New fields for the Gauge widget record */ +typedef struct { + /* resources */ + int value, v0,v1 ; + int ntics, nlabels ; + String *labels ; + XtOrientation orientation ; + Boolean autoScaleUp ; /* scales automatically */ + Boolean autoScaleDown ; /* scales automatically */ + int update ; /* update interval */ + XtCallbackList getValue ; /* proc to call to fetch a point */ + + /* private state */ + Dimension gmargin ; /* edges <-> gauge */ + Dimension tmargin ; /* top (left) edge <-> tic marks */ + Dimension lmargin ; /* tic marks <-> labels */ + Dimension margin0 ; /* left/bottom margin */ + Dimension margin1 ; /* right/top margin */ + XtIntervalId intervalId ; + Atom selected ; + String selstr ; /* selection string, if any */ + GC inverse_GC ; +} GaugePart; + + +/**************************************************************** + * + * Full instance record declaration + * + ****************************************************************/ + +typedef struct _GaugeRec { + CorePart core; + SimplePart simple; +#ifdef _ThreeDP_h + ThreeDPart threeD; +#endif + LabelPart label; + GaugePart gauge; +} GaugeRec; + +#endif /* _XawGaugeP_h */ diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/xlwgcs.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lwlib/xlwgcs.c Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,545 @@ + /* Tabs Widget for XEmacs. + Copyright (C) 1999 Edward A. Falk + + This file is part of XEmacs. + + XEmacs is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by the + Free Software Foundation; either version 2, or (at your option) any + later version. + + XEmacs is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + for more details. + + You should have received a copy of the GNU General Public License + along with XEmacs; see the file COPYING. If not, write to + the Free Software Foundation, Inc., 59 Temple Place - Suite 330, + Boston, MA 02111-1307, USA. */ + +/* Synched up with: Gcs.c 1.7 */ + + /* #### This code is duplicated many times within lwlib and XEmacs. It + should be modularised. */ + +/* + * Gcs.c - Utility functions to allocate GCs. + * + * Author: Edward A. Falk + * falk@falconer.vip.best.com + * + * Date: Sept 29, 1998 + */ + +/* Functions: + * + * GC AllocFgGC(w, fg, font) + * Return a GC with foreground set as specified. + * If font is None, then the returned GC is allocated with font specified + * as a "don't care" value. + * + * GC + * AllocBackgroundGC(w, font) + * Return a GC with the foreground set to the widget's background color. + * + * GC + * AllocGreyGC(w, fg, font, contrast, be_nice_to_cmap) + * Widget w ; + * Pixel fg ; + * Font font ; + * int contrast ; + * int be_nice_to_cmap ; + * + * Return a GC suitable for rendering a widget in its "inactive" color. + * Normally returns a GC with a color somewhere between the widget's + * background color and the specified foreground. If font is None, then + * the returned GC is allocated with font specified as "don't care". + * If be_nice_to_cmap is True, the returned GC is created using a 50% + * dither instead of a new color. + * + * + * GC + * AllocShadeGC(w, fg, bg, font, contrast, be_nice_to_cmap) + * Widget w ; + * Pixel fg, bg ; + * Font font ; + * int contrast ; + * int be_nice_to_cmap ; + * + * Return a GC suitable for rendering in a shade somewhere between + * bg and fg, as determined by contrast (0 = bg, 100 = fg) + * If font is None, then the returned GC is allocated with + * font specified as "don't care". If be_nice_to_cmap + * is True, the returned GC is created using a 50% dither + * instead of a new color. + * + * + * GC + * AllocTopShadowGC(w, contrast, be_nice_to_cmap) + * Return a GC suitable for rendering the "top shadow" decorations of + * a widget. Returns a GC with foreground computed from widget's + * background color and contrast. If be_nice_to_cmap is True, the + * returned GC will use a foreground color of white. If widget depth + * is 1, this function will use a foreground color of black. + * + * GC + * AllocBotShadowGC(w, contrast, be_nice_to_cmap) + * Return a GC suitable for rendering the "bottom shadow" decorations + * of a widget. Returns a GC with foreground computed from widget's + * background color and contrast. If be_nice_to_cmap is True, the + * returned GC will use a foreground color of black. + * + * GC + * AllocArmGC(w, contrast, be_nice_to_cmap) + * Return a GC suitable for rendering the "armed" decorations of a + * widget. This GC would typically be used to fill in the widget's + * background. Returns a GC with foreground computed from widget's + * background color and contrast. If be_nice_to_cmap is True, the + * returned GC will use a foreground color of black and a 50% dither. + * + * + * void + * Draw3dBox(w, x,y,wid,hgt,s, topgc, botgc) + * Utility function. Draws a raised shadow box with outside dimensions + * as specified by x,y,wid,hgt and shadow width specified by s. + * A lowered shadow box may be generated by swapping topgc and botgc. + * + */ + +#include <config.h> +#include <stdio.h> + +#include <X11/Xlib.h> +#include <X11/IntrinsicP.h> +#include <X11/StringDefs.h> +#include "../src/xmu.h" +#include "xlwgcs.h" + + /* Color & GC allocation. + * + * Frame widgets use the following graphics contexts: + * + * Foreground tab label text drawn this way + * Insensitive Fg foreground color greyed out. + * Background frame background color + * Top shadow upper-left highlight around widget + * Bottom shadow lower-right highlight around widget + * Arm shadow button pressed and ready to be released + * + * + * GC's are defined as follows, depending on attributes and + * window depth: + * + * Monochrome: + * Foreground = foreground color attribute or BlackPixel() + * Grey = Foreground color + 50% dither + * Background = background color attribute or WhitePixel() + * top shadow = foreground + * bottom shadow = foreground + * arm shadow = (what?) + * + * Color, beNiceToColormap=true: + * Foreground = foreground color attribute or BlackPixel() + * Grey = Foreground color + 50% dither + * Background = background color attribute or WhitePixel() + * top shadow = white + * bottom shadow = black + * arm shadow = (what?) + * + * Color, beNiceToColormap=false: + * Foreground = foreground color attribute or BlackPixel() + * Grey = (foreground color + background color)/2 + * Background = background color attribute or WhitePixel() + * top shadow = background * 1.2 + * bottom shadow = background * .6 + * arm shadow = background * .8 + * + * Special cases: + * If background is white, ?? + * if background is black, ?? + * + * + * If the widget's background is solid white or solid black, + * this code just picks some numbers. (The choice is designed + * to be compatibile with ThreeD interface.) + */ + + + +#if XtSpecificationRelease < 5 + +static GC XtAllocateGC(Widget, int, u_long, XGCValues *, u_long, u_long) ; + +#endif + + +#if NeedFunctionPrototypes +static Pixmap getDitherPixmap(Widget, int contrast) ; +#else +static Pixmap getDitherPixmap() ; +#endif + + /* return a GC with the specified foreground and optional font */ + +GC +AllocFgGC(Widget w, Pixel fg, Font font) +{ + XGCValues values ; + u_long vmask, dcmask ; + + values.foreground = fg ; + values.font = font ; + + if( font != None ) { + vmask = GCForeground|GCFont ; + dcmask = GCSubwindowMode|GCDashOffset| + GCDashList|GCArcMode|GCBackground|GCGraphicsExposures ; + } else { + vmask = GCForeground ; + dcmask = GCFont|GCSubwindowMode|GCDashOffset| + GCDashList|GCArcMode|GCBackground|GCGraphicsExposures ; + } + + return XtAllocateGC(w, w->core.depth, vmask, &values, 0L, dcmask) ; +} + + + /* return gc with widget background color as the foreground */ + +GC +AllocBackgroundGC(Widget w, Font font) +{ + return AllocFgGC(w, w->core.background_pixel, font) ; +} + + + /* Allocate an "inactive" GC. Color is grey (possibly via + * dither pattern). + */ + +GC +AllocGreyGC(Widget w, Pixel fg, Font font, int contrast, Bool be_nice_to_cmap) +{ + return AllocShadeGC(w, fg, w->core.background_pixel, + font, contrast, be_nice_to_cmap) ; +} + + + /* Allocate a GC somewhere between two colors. */ + +GC +AllocShadeGC(Widget w, Pixel fg, Pixel bg, Font font, + int contrast, Bool be_nice_to_cmap) +{ + XGCValues values ; + u_long vmask, dcmask ; + + values.foreground = fg ; + values.background = bg ; + values.font = font ; + + if( font != None ) { + vmask = GCForeground|GCFont ; + dcmask = GCSubwindowMode|GCDashOffset| + GCDashList|GCArcMode|GCGraphicsExposures ; + } else { + vmask = GCForeground; + dcmask = GCFont|GCSubwindowMode|GCDashOffset| + GCDashList|GCArcMode|GCGraphicsExposures ; + } +#ifdef HAVE_XMU + if( be_nice_to_cmap || w->core.depth == 1) + { + if( contrast <= 5 ) + values.foreground = bg ; + else if( contrast >= 95 ) + values.foreground = fg ; + else { + vmask |= GCBackground|GCStipple|GCFillStyle ; + values.fill_style = FillOpaqueStippled ; + values.stipple = getDitherPixmap(w, contrast) ; + } + + return XtAllocateGC(w, w->core.depth, vmask, &values, 0L, dcmask) ; + } + else +#endif + { + dcmask |= GCBackground ; + values.foreground = AllocGreyPixel(w, fg, bg, contrast) ; + return XtAllocateGC(w, w->core.depth, vmask, &values, 0L, dcmask) ; + } +} + + /* return top-shadow gc. */ + +GC +AllocTopShadowGC(Widget w, int contrast, Bool be_nice_to_cmap) +{ + Screen *scr = XtScreen (w); + XGCValues values ; + + if( w->core.depth == 1 ) + values.foreground = BlackPixelOfScreen(scr) ; + else if( be_nice_to_cmap ) + values.foreground = WhitePixelOfScreen(scr) ; + else + values.foreground = AllocShadowPixel(w, 100+contrast) ; + + return XtAllocateGC(w, w->core.depth, + GCForeground, &values, + 0L, + GCBackground|GCFont|GCSubwindowMode|GCGraphicsExposures| + GCDashOffset|GCDashList|GCArcMode) ; +} + + /* return bottom-shadow gc. */ + +GC +AllocBotShadowGC(Widget w, int contrast, Bool be_nice_to_cmap) +{ + Screen *scr = XtScreen (w); + XGCValues values ; + + if( w->core.depth == 1 || be_nice_to_cmap ) + values.foreground = BlackPixelOfScreen(scr) ; + else + values.foreground = AllocShadowPixel(w, 100-contrast) ; + + return XtAllocateGC(w, w->core.depth, + GCForeground, &values, + 0L, + GCBackground|GCFont|GCSubwindowMode|GCGraphicsExposures| + GCDashOffset|GCDashList|GCArcMode) ; +} + + /* return arm-shadow gc. */ + +GC +AllocArmGC(Widget w, int contrast, Bool be_nice_to_cmap) +{ + Screen *scr = XtScreen (w); + XGCValues values ; + + /* Not clear exactly what we should do here. Take a look at + * Xaw3d to see what they do. + */ +#ifdef HAVE_XMU + if( w->core.depth == 1 || be_nice_to_cmap ) + { + values.background = w->core.background_pixel ; + if( values.background == BlackPixelOfScreen(scr) ) + values.foreground = WhitePixelOfScreen(scr) ; + else + values.foreground = BlackPixelOfScreen(scr) ; + values.fill_style = FillStippled ; + values.stipple = XmuCreateStippledPixmap(XtScreen(w), 1L, 0L, 1) ; + + return XtAllocateGC(w, w->core.depth, + GCForeground|GCBackground|GCStipple|GCFillStyle, + &values, 0L, + GCFont|GCSubwindowMode|GCGraphicsExposures| + GCDashOffset|GCDashList|GCArcMode) ; + } + else +#endif + { + values.foreground = AllocShadowPixel(w, 100-contrast) ; + return XtAllocateGC(w, w->core.depth, + GCForeground, &values, + 0L, + GCBackground|GCFont|GCSubwindowMode|GCGraphicsExposures| + GCDashOffset|GCDashList|GCArcMode) ; + } +} + + +Pixel +AllocShadowPixel(Widget w, int scale) +{ + XColor get_c, set_c ; + Display *dpy = XtDisplay(w) ; + Screen *scr = XtScreen(w) ; + Colormap cmap ; + Pixel maxColor ; + + cmap = w->core.colormap ; + + get_c.pixel = w->core.background_pixel ; + if( get_c.pixel == WhitePixelOfScreen(scr) || + get_c.pixel == BlackPixelOfScreen(scr) ) + { + /* what we *ought* to do is choose gray75 as the base color, + * or perhaps gray83. Instead, we choose colors that are + * the same as ThreeD would choose. + */ + if( scale > 100 ) scale = 200 - scale ; + set_c.red = set_c.green = set_c.blue = 65535*scale/100 ; + } + else + { + XQueryColor(dpy, cmap, &get_c) ; + /* adjust scale so that brightest component does not + * exceed 65535; otherwise hue would change. + */ + if( scale > 100 ) { + maxColor = Max(get_c.red, Max(get_c.green, get_c.blue)) ; + if( scale*maxColor > 65535*100 ) + scale = 65535*100/maxColor ; + } + set_c.red = scale * get_c.red / 100 ; + set_c.green = scale * get_c.green / 100 ; + set_c.blue = scale * get_c.blue / 100 ; + } + set_c.flags = DoRed | DoGreen | DoBlue ; + if( XAllocColor(dpy, cmap, &set_c) ) + return set_c.pixel ; + else if( scale > 100 ) + return WhitePixelOfScreen(scr) ; + else + return BlackPixelOfScreen(scr) ; +} + + + /* Allocate a pixel partway between foreground and background */ + + +Pixel +AllocGreyPixel(Widget w, Pixel fg, Pixel bg, int scale) +{ + XColor get_cf, get_cb ; + Display *dpy = XtDisplay(w) ; + Colormap cmap ; + + cmap = w->core.colormap ; + + get_cf.pixel = fg ; + get_cb.pixel = bg ; + + XQueryColor(dpy, cmap, &get_cf) ; + XQueryColor(dpy, cmap, &get_cb) ; + + return AllocGreyPixelC(w, &get_cf, &get_cb, scale) ; +} + + + + /* Allocate a pixel partway between foreground and background */ + + +Pixel +AllocGreyPixelC(Widget w, XColor *fg, XColor *bg, int scale) +{ + XColor set_c ; + Display *dpy = XtDisplay(w) ; + int r,g,b ; + Colormap cmap = w->core.colormap ; + + r = (fg->red * scale + bg->red * (100-scale)) / 100 ; + g = (fg->green * scale + bg->green * (100-scale)) / 100 ; + b = (fg->blue * scale + bg->blue * (100-scale)) / 100 ; + + if( scale > 100 || scale < 0 ) /* look out for overflow */ + { + int minc, maxc ; + maxc = Max(r, Max(g,b)) ; + minc = Min(r, Min(g,b)) ; + if( maxc > 65535 ) + { + maxc /= 16 ; + r = r*(65535/16) / maxc ; + g = g*(65535/16) / maxc ; + b = b*(65535/16) / maxc ; + } + if( minc < 0 ) + { + r = Max(r,0) ; + g = Max(g,0) ; + b = Max(b,0) ; + } + } + + set_c.red = r ; set_c.green = g ; set_c.blue = b ; + set_c.flags = DoRed | DoGreen | DoBlue ; + (void)XAllocColor(dpy, cmap, &set_c) ; + return set_c.pixel ; +} + + + + + + /* draw a 3-d box */ + +void +Draw3dBox(Widget w, int x, int y, int wid, int hgt, int s, GC topgc, GC botgc) +{ + Display *dpy = XtDisplay(w) ; + Window win = XtWindow(w) ; + + if( s == 0 ) return ; + + if( s == 1 ) { + XDrawLine(dpy,win,botgc, x,y+hgt-1, x+wid-1,y+hgt-1) ; + XDrawLine(dpy,win,botgc, x+wid-1,y, x+wid-1,y+hgt-1) ; + XDrawLine(dpy,win,topgc, x,y, x,y+hgt-1) ; + XDrawLine(dpy,win,topgc, x,y, x+wid-1,y) ; + } + else + { + XPoint pts[6] ; + + /* bottom-right shadow */ + pts[0].x = x ; pts[0].y = y + hgt ; + pts[1].x = s ; pts[1].y = -s ; + pts[2].x = wid-2*s ; pts[2].y = 0 ; + pts[3].x = 0 ; pts[3].y = -(hgt-2*s) ; + pts[4].x = s ; pts[4].y = -s ; + pts[5].x = 0 ; pts[5].y = hgt ; + XFillPolygon(dpy,win,botgc, pts,6, Nonconvex,CoordModePrevious) ; + + /* top-left shadow */ + pts[0].x = x ; pts[0].y = y ; + pts[1].x = wid ; pts[1].y = 0 ; + pts[2].x = -s ; pts[2].y = s ; + pts[3].x = -wid+2*s ; pts[3].y = 0 ; + pts[4].x = 0 ; pts[4].y = hgt-2*s ; + pts[5].x = -s ; pts[5].y = s ; + XFillPolygon(dpy,win,topgc, pts,6, Nonconvex,CoordModePrevious) ; + } +} + +#if XtSpecificationRelease < 5 + +static GC +XtAllocateGC(Widget w, int depth, u_long mask, XGCValues *values, + u_long dynamic, du_long ontcare) +{ + return XtGetGC(w, mask, values) ; +} +#endif + + +static u_char screen0[2] = {0,0} ; +static u_char screen25[2] = {0,0xaa} ; +static u_char screen75[2] = {0xaa,0xff} ; +static u_char screen100[2] = {0xff,0xff} ; + +static Pixmap +getDitherPixmap(Widget w, int contrast) +{ + Display *dpy = XtDisplay(w) ; + Window win = XtWindow(w) ; + + if( contrast <= 5 ) + return XCreateBitmapFromData(dpy,win, (char *)screen0, 2,2) ; + else if( contrast <= 37 ) + return XCreateBitmapFromData(dpy,win, (char *)screen25, 2,2) ; + else if( contrast <= 62 ) + return XmuCreateStippledPixmap(XtScreen(w), 1L, 0L, 1) ; + else if( contrast <= 95 ) + return XCreateBitmapFromData(dpy,win, (char *)screen75, 2,2) ; + else + return XCreateBitmapFromData(dpy,win, (char *)screen100, 2,2) ; +} diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/xlwgcs.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lwlib/xlwgcs.h Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,144 @@ + /* Tabs Widget for XEmacs. + Copyright (C) 1999 Edward A. Falk + + This file is part of XEmacs. + + XEmacs is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by the + Free Software Foundation; either version 2, or (at your option) any + later version. + + XEmacs is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + for more details. + + You should have received a copy of the GNU General Public License + along with XEmacs; see the file COPYING. If not, write to + the Free Software Foundation, Inc., 59 Temple Place - Suite 330, + Boston, MA 02111-1307, USA. */ + + /* Synched up with: Gcs 1.7 */ + + +#ifndef GCS_H +#define GCS_H + +/* Overview of functions provided here: + * + * AllocFgGC() + * Given a foreground pixel & a font, return an appropriate GC + * + * AllocBackgroundGC() + * Given a widget, return a GC for painting the background color + * + * AllocShadeGC() + * Given foreground, background, a contrast value & be_nice_to_colormap + * flag, return a GC suitable for rendering in an intermediate color, + * as determined by constrast. May return a dither pattern or a + * solid color, as appropriate. + * + * Contrast 0 = background color, 100 = foreground color. It is legal + * for contrast to be more than 100 or less than 0. + * + * AllocGreyGC() + * Given widget, foreground, font, contrast & be_nice_to_colormap, + * return a shade GC (see above) based on foreground and widget + * background. + * + * AllocTopShadowGC() + * Given widget, contrast & be_nice_to_colormap, return a GC suitable + * for rendering the top shadow. + * + * Contrast 0 = use background pixel. Contrast > 0 = use brighter + * colors. + * + * AllocBotShadowGC() + * Given widget, contrast & be_nice_to_colormap, return a GC suitable + * for rendering the bottom shadow. + * + * Contrast 0 = use background pixel. Contrast > 0 = use darker + * colors. + * + * AllocArmShadowGC() + * Given widget, contrast & be_nice_to_colormap, return a GC suitable + * for rendering the "armed" shadow. + * + * Contrast 0 = use background pixel. Contrast > 0 = use darker + * colors. + * + * AllocShadowPixel() + * Given a widget & scale factor, allocate & return a color darker + * or lighter than the background pixel, as determined by scale. + * + * Scale 100 = use background pixel. Scale > 100 = brighter color, + * Scale < 100 = darker color. + * + * AllocGreyPixel() + * Given two pixel values and scale factor, allocate & return a + * pixel value between them, according to scale. + * + * Scale == 0: background color + * Scale == 100: foreground color + * 0<Scale<100: intermediate color + * Scale > 100: more foreground + * Scale < 0: more background + * + * + * AllocGreyPixelC() + * Given two color values and scale factor, allocate & return a + * pixel value between them, according to scale. + * + * Scale == 0: background color + * Scale == 100: foreground color + * 0<Scale<100: intermediate color + * Scale > 100: more foreground + * Scale < 0: more background + * + * Draw3dBox() + * Given box dimensions, shadow width, top shadow GC & bottom shadow GC, + * draw a 3-d box. + */ + +#if NeedFunctionPrototypes + +extern GC AllocFgGC( Widget w, Pixel fg, Font font) ; +extern GC AllocBackgroundGC( Widget w, Font font) ; +extern GC AllocShadeGC( Widget w, Pixel fg, Pixel bg, Font, + int contrast, Bool ) ; +extern GC AllocGreyGC( Widget w, Pixel fg, Font, int, Bool ) ; +extern GC AllocTopShadowGC( Widget w, int contrast, int ) ; +extern GC AllocBotShadowGC( Widget w, int contrast, int ) ; +extern GC AllocArmGC( Widget w, int contrast, int) ; +extern Pixel AllocShadowPixel(Widget, int scale) ; +extern Pixel AllocGreyPixel(Widget, Pixel fg, Pixel bg, int scale) ; +extern Pixel AllocGreyPixelC(Widget, XColor *fg, XColor *bg, int scale) ; +extern void Draw3dBox(Widget w, int x, int y, int wid, int hgt, int s, + GC topgc, GC botgc) ; + +#if XtSpecificationRelease < 5 +extern GC XtAllocateGC(Widget, int depth, u_long mask, + XGCValues *, u_long dynamic, u_long dontcare) ; +#endif + +#else + +extern GC AllocFgGC() ; +extern GC AllocBackgroundGC() ; +extern GC AllocShadeGC() ; +extern GC AllocGreyGC() ; +extern GC AllocTopShadowGC() ; +extern GC AllocBotShadowGC() ; +extern GC AllocArmGC() ; +extern Pixel AllocShadowPixel() ; +extern Pixel AllocGreyPixel() ; +extern Pixel AllocGreyPixelC() ; +extern void Draw3dBox() ; + +#if XtSpecificationRelease < 5 +extern GC XtAllocateGC() ; +#endif + +#endif + +#endif /* GCS_H */ diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/xlwmenu.c --- a/lwlib/xlwmenu.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lwlib/xlwmenu.c Mon Aug 13 11:13:30 2007 +0200 @@ -423,10 +423,9 @@ int i, j; #ifdef NEED_MOTIF + chars = ""; if (!XmStringGetLtoR (string, XmFONTLIST_DEFAULT_TAG, &chars)) - { - chars = ""; - } + chars = ""; #else chars = string; #endif @@ -458,7 +457,7 @@ } static void -massage_resource_name (CONST char *in, char *out) +massage_resource_name (const char *in, char *out) { /* Turn a random string into something suitable for using as a resource. For example: @@ -521,7 +520,7 @@ * not inserted if value is a zero length string. */ static char* -parameterize_string (CONST char *string, CONST char *value) +parameterize_string (const char *string, const char *value) { char *percent; char *result; @@ -872,7 +871,9 @@ char *chars; #ifdef NEED_MOTIF - XmStringGetLtoR (string, XmFONTLIST_DEFAULT_TAG, &chars); + chars = ""; + if (!XmStringGetLtoR (string, XmFONTLIST_DEFAULT_TAG, &chars)) + chars = ""; #else chars = string; #endif @@ -1528,7 +1529,7 @@ 2 * mw->menu.vertical_margin + 2 * mw->menu.shadow_thickness); /* no left column decoration */ - *toggle_width = mw->menu.horizontal_margin + mw->menu.shadow_thickness;; + *toggle_width = mw->menu.horizontal_margin + mw->menu.shadow_thickness; *label_width = string_width_u (mw, resource_widget_value (mw, val)); *bindings_width = mw->menu.horizontal_margin + mw->menu.shadow_thickness; @@ -1872,7 +1873,7 @@ static struct _shadow_names { - CONST char * name; + const char * name; shadow_type type; } shadow_names[] = { @@ -2824,8 +2825,8 @@ xgcv.foreground = mw->menu.bottom_shadow_color; /* xgcv.stipple = mw->menu.bottom_shadow_pixmap; gtb */ #ifdef NEED_MOTIF - if (mw->menu.top_shadow_pixmap && - mw->menu.top_shadow_pixmap != XmUNSPECIFIED_PIXMAP) + if (mw->menu.bottom_shadow_pixmap && + mw->menu.bottom_shadow_pixmap != XmUNSPECIFIED_PIXMAP) xgcv.stipple = mw->menu.bottom_shadow_pixmap; else xgcv.stipple = 0; diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/xlwmenu.h --- a/lwlib/xlwmenu.h Mon Aug 13 11:12:06 2007 +0200 +++ b/lwlib/xlwmenu.h Mon Aug 13 11:13:30 2007 +0200 @@ -1,5 +1,5 @@ -#ifndef _XlwMenu_h -#define _XlwMenu_h +#ifndef INCLUDED_xlwmenu_h_ +#define INCLUDED_xlwmenu_h_ /*********************************************************************** * @@ -90,4 +90,4 @@ widget_value *xlw_get_entries (int allp); int xlw_menu_level (void); -#endif /* _XlwMenu_h */ +#endif /* INCLUDED_xlwmenu_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/xlwmenuP.h --- a/lwlib/xlwmenuP.h Mon Aug 13 11:12:06 2007 +0200 +++ b/lwlib/xlwmenuP.h Mon Aug 13 11:13:30 2007 +0200 @@ -1,5 +1,5 @@ -#ifndef _XlwMenuP_h -#define _XlwMenuP_h +#ifndef INCLUDED_xlwmenuP_h_ +#define INCLUDED_xlwmenuP_h_ #include "xlwmenu.h" #include <X11/CoreP.h> @@ -117,4 +117,4 @@ /* Class pointer. */ extern XlwMenuClassRec xlwMenuClassRec; -#endif /* _XlwMenuP_h */ +#endif /* INCLUDED_xlwmenuP_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/xlwradio.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lwlib/xlwradio.c Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,590 @@ +/* Radio Widget for XEmacs. + Copyright (C) 1999 Edward A. Falk + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Radio.c 1.1 */ + +/* + * Radio.c - Radio button widget + * + * Author: Edward A. Falk + * falk@falconer.vip.best.com + * + * Date: June 30, 1997 + * + * + * Overview: This widget is identical to the Toggle widget in behavior, + * but completely different in appearance. This widget looks like a small + * diamond-shaped button with a label to the right. + * + * To make this work, we subclass the Toggle widget to inherit its behavior + * and to inherit the label-drawing function from which Toggle is + * subclassed. We then completely replace the Expose, Set, Unset + * and Highlight member functions. + * + * The Set and Unset actions are slightly unorthodox. In Toggle's + * ClassInit function, Toggle searches the Command actions list and + * "steals" the Set and Unset functions, caching pointers to them in its + * class record. It then calls these functions from its own ToggleSet + * and Toggle actions. + * + * We, in turn, override the Set() and Unset() actions in our own ClassRec. + */ + + +#include <config.h> +#include <stdio.h> + +#include <X11/IntrinsicP.h> +#include <X11/StringDefs.h> +#include ATHENA_INCLUDE(XawInit.h) +#include "../src/xmu.h" +#include "xlwradioP.h" + +#define BOX_SIZE 13 + +#define rclass(w) ((RadioWidgetClass)((w)->core.widget_class)) + + +#ifdef _ThreeDP_h +#define swid(rw) ((rw)->threeD.shadow_width) +#else +#define swid(rw) ((rw)->core.border_width) +#endif + +#define bsize(rw) (rclass(rw)->radio_class.dsize) +#define bs(rw) (bsize(rw) + 2*swid(rw)) + + + +/**************************************************************** + * + * Full class record constant + * + ****************************************************************/ + + /* The translations table from Toggle do not need to be + * overridden by Radio + */ + + + /* Member functions */ + +static void RadioInit (Widget, Widget, ArgList, Cardinal *); +static void RadioExpose (Widget, XEvent *, Region); +static void RadioResize (Widget); +static void RadioDestroy (Widget, XtPointer, XtPointer); +static void RadioClassInit (void); +static void RadioClassPartInit (WidgetClass); +static Boolean RadioSetValues (Widget, Widget, Widget, ArgList, Cardinal *); +static void DrawDiamond (Widget); +static XtGeometryResult RadioQueryGeometry (Widget, XtWidgetGeometry *, + XtWidgetGeometry *); + + /* Action procs */ + +static void RadioHighlight (Widget, XEvent *, String *, Cardinal *); +static void RadioUnhighlight (Widget, XEvent *, String *, Cardinal *); + + /* internal privates */ + +static void RadioSize (RadioWidget, Dimension *, Dimension *); + + /* The actions table from Toggle is almost perfect, but we need + * to override Highlight, Set, and Unset. + */ + +static XtActionsRec actionsList[] = +{ + {"highlight", RadioHighlight}, + {"unhighlight", RadioUnhighlight}, +}; + +#define SuperClass ((ToggleWidgetClass)&toggleClassRec) + +RadioClassRec radioClassRec = { + { + (WidgetClass) SuperClass, /* superclass */ + "Radio", /* class_name */ + sizeof(RadioRec), /* size */ + RadioClassInit, /* class_initialize */ + RadioClassPartInit, /* class_part_initialize */ + FALSE, /* class_inited */ + RadioInit, /* initialize */ + NULL, /* initialize_hook */ + XtInheritRealize, /* realize */ + actionsList, /* actions */ + XtNumber(actionsList), /* num_actions */ + NULL, /* resources */ + 0, /* resource_count */ + NULLQUARK, /* xrm_class */ + TRUE, /* compress_motion */ + TRUE, /* compress_exposure */ + TRUE, /* compress_enterleave */ + FALSE, /* visible_interest */ + NULL, /* destroy */ + RadioResize, /* resize */ + RadioExpose, /* expose */ + RadioSetValues, /* set_values */ + NULL, /* set_values_hook */ + XtInheritSetValuesAlmost, /* set_values_almost */ + NULL, /* get_values_hook */ + NULL, /* accept_focus */ + XtVersion, /* version */ + NULL, /* callback_private */ + XtInheritTranslations, /* tm_table */ + RadioQueryGeometry, /* query_geometry */ + XtInheritDisplayAccelerator, /* display_accelerator */ + NULL /* extension */ + }, /* CoreClass fields initialization */ + { + XtInheritChangeSensitive /* change_sensitive */ + }, /* SimpleClass fields initialization */ +#ifdef _ThreeDP_h + { + XtInheritXaw3dShadowDraw /* field not used */ + }, /* ThreeDClass fields initialization */ +#endif + { + 0 /* field not used */ + }, /* LabelClass fields initialization */ + { + 0 /* field not used */ + }, /* CommandClass fields initialization */ + { + RadioSet, /* Set Procedure. */ + RadioUnset, /* Unset Procedure. */ + NULL /* extension. */ + }, /* ToggleClass fields initialization */ + { + BOX_SIZE, + DrawDiamond, /* draw procedure */ + NULL /* extension. */ + } /* RadioClass fields initialization */ +}; + + /* for public consumption */ +WidgetClass radioWidgetClass = (WidgetClass) &radioClassRec; + + + + + + +/**************************************************************** + * + * Class Methods + * + ****************************************************************/ + +static void +RadioClassInit (void) +{ + XawInitializeWidgetSet(); +} + +static void +RadioClassPartInit (WidgetClass class) +{ + RadioWidgetClass c = (RadioWidgetClass) class ; + RadioWidgetClass super = (RadioWidgetClass)c->core_class.superclass ; + + if( c->radio_class.drawDiamond == NULL || + c->radio_class.drawDiamond == XtInheritDrawDiamond ) + { + c->radio_class.drawDiamond = super->radio_class.drawDiamond ; + } +} + + + + +/*ARGSUSED*/ +static void +RadioInit (Widget request, + Widget new, + ArgList args, + Cardinal *num_args) +{ + RadioWidget rw = (RadioWidget) new; + RadioWidget rw_req = (RadioWidget) request; + Dimension w,h ; + + /* Select initial size for the widget */ + if( rw_req->core.width == 0 || rw_req->core.height == 0 ) + { + RadioSize(rw, &w,&h) ; + if( rw_req->core.width == 0 ) + rw->core.width = w ; + if( rw_req->core.height == 0 ) + rw->core.height = h ; + rw->core.widget_class->core_class.resize(new) ; + } +} + +/* Function Name: RadioDestroy + * Description: Destroy Callback for radio widget. + * Arguments: w - the radio widget that is being destroyed. + * junk, grabage - not used. + * Returns: none. + */ + +/* ARGSUSED */ +static void +RadioDestroy (Widget w, + XtPointer junk, + XtPointer garbage) +{ + /* TODO: get rid of this */ +} + + +/* React to size change from manager. Label widget will compute some internal + * stuff, but we need to override. This code requires knowledge of the + * internals of the Label widget. + */ + +static void +RadioResize (Widget w) +{ + RadioWidget rw = (RadioWidget)w ; + + /* call parent resize proc */ + SuperClass->core_class.resize(w) ; + + /* override label offset */ + + switch( rw->label.justify ) { + case XtJustifyLeft: + rw->label.label_x += bs(rw) + rw->label.internal_width ; + break ; + case XtJustifyRight: + break ; + case XtJustifyCenter: + default: + rw->label.label_x += (bs(rw) + rw->label.internal_width)/2 ; + break ; + } +} + + +/* + * Repaint the widget window. + */ + +static void +RadioExpose (Widget w, + XEvent *event, + Region region) +{ + RadioWidget rw = (RadioWidget) w ; + Display *dpy = XtDisplay(w) ; + Window win = XtWindow(w) ; + GC gc ; + Pixmap left_bitmap ; + extern WidgetClass labelWidgetClass ; + + /* Note: the Label widget examines the region to decide if anything + * needs to be drawn. I'm not sure that this is worth the effort, + * but it bears thinking on. + */ + + /* Command widget may sometimes override the label GC in order + * to draw inverse video. We don't use inverse video, so we need + * to restore the label's normal GC. + */ + rw->label.normal_GC = rw->command.normal_GC ; + + + /* Let label widget draw the label. If there was an lbm_x + * field, we could let Label draw the bitmap too. But there + * isn't, so we need to temporarily remove the bitmap and + * draw it ourself later. + */ + left_bitmap = rw->label.left_bitmap ; + rw->label.left_bitmap = None ; + labelWidgetClass->core_class.expose(w,event,region) ; + rw->label.left_bitmap = left_bitmap ; + + /* now manually draw the left bitmap. TODO: 3-d look, xaw-xpm */ + gc = XtIsSensitive(w) ? rw->label.normal_GC : rw->label.gray_GC ; + if( left_bitmap != None && rw->label.lbm_width > 0 ) + { + /* TODO: handle pixmaps */ + XCopyPlane(dpy, left_bitmap, win, gc, + 0,0, rw->label.lbm_width, rw->label.lbm_height, + (int) rw->label.internal_width*2 + bs(rw), + (int) rw->label.internal_height + rw->label.lbm_y, + (u_long) 1L) ; + } + + /* Finally, the button itself */ + ((RadioWidgetClass)(w->core.widget_class))->radio_class.drawDiamond(w) ; +} + + + + +/************************************************************ + * + * Set specified arguments into widget + * + ***********************************************************/ + + +/* ARGSUSED */ +static Boolean +RadioSetValues (Widget current, + Widget request, + Widget new, + ArgList args, + Cardinal *num_args) +{ + RadioWidget oldrw = (RadioWidget) current; + RadioWidget newrw = (RadioWidget) new; + + /* Need to find out if the size of the widget changed. Set new size + * if it did and resize is permitted. One way to determine of the + * widget changed size would be to scan the args list. Another way + * is to compare the old and new widgets and see if any of several + * size-related fields have been changed. The Label widget chose the + * former method, but I choose the latter. + */ + + if( newrw->label.resize && + ( newrw->core.width != oldrw->core.width || + newrw->core.height != oldrw->core.height || + newrw->core.border_width != oldrw->core.border_width ) ) + { + RadioSize(newrw, &newrw->core.width, &newrw->core.height) ; + } + + return FALSE ; +} + +static XtGeometryResult +RadioQueryGeometry (Widget w, + XtWidgetGeometry *intended, + XtWidgetGeometry *preferred) +{ + RadioWidget rw = (RadioWidget) w; + + preferred->request_mode = CWWidth | CWHeight; + RadioSize(rw, &preferred->width, &preferred->height) ; + + if ( ((intended->request_mode & (CWWidth | CWHeight)) + == (CWWidth | CWHeight)) && + intended->width == preferred->width && + intended->height == preferred->height) + return XtGeometryYes; + else if (preferred->width == w->core.width && + preferred->height == w->core.height) + return XtGeometryNo; + else + return XtGeometryAlmost; +} + + + + + +/************************************************************ + * + * Action Procedures + * + ************************************************************/ + +/* + * Draw the highlight border around the widget. The Command widget + * did this by drawing through a mask. We do it by just drawing the + * border. + */ + +static void +DrawHighlight (Widget w, + GC gc) +{ + RadioWidget rw = (RadioWidget)w; + XRectangle rects[4] ; + Dimension ht = rw->command.highlight_thickness ; + + if( ht <= 0 || + ht > rw->core.width/2 || + ht > rw->core.height/2 ) + return ; + + if( ! XtIsRealized(w) ) + return ; + + rects[0].x = 0 ; rects[0].y = 0 ; + rects[0].width = rw->core.width ; rects[0].height = ht ; + rects[1].x = 0 ; rects[1].y = rw->core.height - ht ; + rects[1].width = rw->core.width ; rects[1].height = ht ; + rects[2].x = 0 ; rects[2].y = ht ; + rects[2].width = ht ; rects[2].height = rw->core.height - ht*2 ; + rects[3].x = rw->core.width - ht ; rects[3].y = ht ; + rects[3].width = ht ; rects[3].height = rw->core.height - ht*2 ; + XFillRectangles( XtDisplay(w), XtWindow(w), gc, rects, 4) ; +} + +static void +RadioHighlight (Widget w, + XEvent *event, + String *params, + Cardinal *num_params) +{ + RadioWidget rw = (RadioWidget)w; + DrawHighlight(w, rw->command.normal_GC) ; +} + + +static void +RadioUnhighlight (Widget w, + XEvent *event, + String *params, + Cardinal *num_params) +{ + RadioWidget rw = (RadioWidget)w; + DrawHighlight(w, rw->command.inverse_GC) ; +} + + +/* ARGSUSED */ +void +RadioSet (Widget w, + XEvent *event, + String *params, /* unused */ + Cardinal *num_params) /* unused */ +{ + RadioWidget rw = (RadioWidget)w; + RadioWidgetClass class = (RadioWidgetClass) w->core.widget_class ; + + if( rw->command.set ) + return ; + + rw->command.set = TRUE ; + if( XtIsRealized(w) ) + class->radio_class.drawDiamond(w) ; +} + + +/* ARGSUSED */ +void +RadioUnset (Widget w, + XEvent *event, + String *params, /* unused */ + Cardinal *num_params) /* unused */ +{ + RadioWidget rw = (RadioWidget)w; + RadioWidgetClass class = (RadioWidgetClass) w->core.widget_class ; + + if( ! rw->command.set ) + return ; + + rw->command.set = FALSE ; + if( XtIsRealized(w) ) + class->radio_class.drawDiamond(w) ; +} + + + + +/************************************************************ + * + * Internal Procedures + * + ************************************************************/ + + +/* Size of widget. Width is size of box plus width of border around + * box plus width of label plus three margins plus the size of the left + * bitmap, if any. Height is max(box,bitmap,label) plus two margins. + */ + +static void +RadioSize (RadioWidget rw, + Dimension *w, + Dimension *h) +{ + *w = rw->label.label_width + bs(rw) + LEFT_OFFSET(rw) + + 3 * rw->label.internal_width ; + *h = Max( rw->label.label_height, bs(rw) ) + + 2 * rw->label.internal_width ; +} + + +static void +DrawDiamond (Widget w) +{ + RadioWidget rw = (RadioWidget) w ; + Display *dpy = XtDisplay(w) ; + Window win = XtWindow(w) ; + GC gc, gci ; + + XPoint pts[5] ; + Dimension del = bsize(rw)/2 ; + Position x,y ; /* diamond center */ +#ifdef _ThreeDP_h + int i=0; + Dimension s = swid(rw) ; + GC top, bot, ctr ; +#endif + gc = XtIsSensitive(w) ? rw->command.normal_GC : rw->label.gray_GC ; + + gci = rw->command.set ? rw->command.normal_GC : rw->command.inverse_GC ; + + x = rw->label.internal_width + bs(rw)/2 ; + y = rw->core.height/2 ; + +#ifdef _ThreeDP_h + if( ! rw->command.set ) { + top = rw->threeD.top_shadow_GC ; + bot = rw->threeD.bot_shadow_GC ; + ctr = gc ; /* TODO */ + } else { + top = rw->threeD.bot_shadow_GC ; + bot = rw->threeD.top_shadow_GC ; + ctr = gc ; /* TODO */ + } +#endif + + pts[0].x = x - del ; + pts[0].y = y ; + pts[1].x = x ; + pts[1].y = y - del ; + pts[2].x = x + del ; + pts[2].y = y ; + pts[3].x = x ; + pts[3].y = y + del ; + pts[4] = pts[0] ; + XFillPolygon(dpy,win,gci, pts,4, Convex, CoordModeOrigin) ; + +#ifdef _ThreeDP_h + for(i=0; i<s; ++i) { + XDrawLine(dpy,win,bot, x-i-del,y, x,y+del+i) ; + XDrawLine(dpy,win,bot, x+del+i,y, x,y+del+i) ; + } + for(i=0; i<s; ++i) { + XDrawLine(dpy,win,top, x-del-i,y, x,y-del-i) ; + XDrawLine(dpy,win,top, x+del+i,y, x,y-del-i) ; + } +#else + XDrawLines(dpy,win,gc, pts,5, CoordModeOrigin) ; +#endif +} diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/xlwradio.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lwlib/xlwradio.h Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,97 @@ +/* Radio Widget for XEmacs. + Copyright (C) 1999 Edward A. Falk + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Radio.h 1.1 */ + +/* + * Radio.h - Radio button widget + * + * Author: Edward A. Falk + * falk@falconer.vip.best.com + * + * Date: June 30, 1997 + */ + +#ifndef _XawRadio_h +#define _XawRadio_h + +/*********************************************************************** + * + * Radio Widget + * + * The Radio widget is identical to the Toggle widget in behavior but + * not in appearance. The Radio widget looks like a small diamond + * shaped button to the left of the label. + * + ***********************************************************************/ + +#include ATHENA_INCLUDE(Toggle.h) + +/* Resources: + + Name Class RepType Default Value + ---- ----- ------- ------------- + radioGroup RadioGroup Widget NULL + radioData RadioData Pointer (XPointer) Widget + state State Boolean Off + background Background Pixel XtDefaultBackground + bitmap Pixmap Pixmap None + border BorderColor Pixel XtDefaultForeground + borderWidth BorderWidth Dimension 1 + callback Callback Pointer NULL + cursor Cursor Cursor None + destroyCallback Callback Pointer NULL + font Font XFontStructx* XtDefaultFont + foreground Foreground Pixel XtDefaultForeground + height Height Dimension text height + highlightThickness Thickness Dimension 2 + insensitiveBorder sensitive Pixmap Gray + internalHeight Height Dimension 2 + internalWidth Width Dimension 4 + justify Justify XtJustify XtJustifyCenter + label Label String NULL + mappedWhenManaged MappedWhenManaged Boolean True + resize Resize Boolean True + sensitive Sensitive Boolean True + width Width Dimension text width + x Position Position 0 + y Position Position 0 + +*/ + +/* + * These should be in StringDefs.h but aren't so we will define + * them here if they are needed. + */ + + +extern WidgetClass radioWidgetClass; + +typedef struct _RadioClassRec *RadioWidgetClass; +typedef struct _RadioRec *RadioWidget; + + +/************************************************************ + * + * Public Functions + * + ************************************************************/ + +#endif /* _XawRadio_h */ diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/xlwradioP.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lwlib/xlwradioP.h Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,116 @@ +/* Radio Widget for XEmacs. + Copyright (C) 1999 Edward A. Falk + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* + * RadioP.h - Private definitions for Radio widget + * + * Author: Edward A. Falk + * falk@falconer.vip.best.com + * + * Date: June 30, 1997 + * + */ + +#ifndef _XawRadioP_h +#define _XawRadioP_h + +#include "xlwradio.h" +#include ATHENA_INCLUDE(ToggleP.h) + +/*********************************************************************** + * + * Radio Widget Private Data + * + ***********************************************************************/ + +#define streq(a, b) ( strcmp((a), (b)) == 0 ) + +typedef void (*XawDiamondProc) (Widget); + +void RadioSet (Widget w, + XEvent *event, + String *params, /* unused */ + Cardinal *num_params); /* unused */ + +void RadioUnset (Widget w, + XEvent *event, + String *params, /* unused */ + Cardinal *num_params); /* unused */ + +/************************************ + * + * Class structure + * + ***********************************/ + + /* New fields for the Radio widget class record */ +typedef struct _RadioClass { + Dimension dsize ; /* diamond size */ + XawDiamondProc drawDiamond ; + /* TODO: 3-d and xaw-xpm features? */ + XtPointer extension; +} RadioClassPart; + +#define XtInheritDrawDiamond ((XawDiamondProc)_XtInherit) + + /* Full class record declaration */ +typedef struct _RadioClassRec { + CoreClassPart core_class; + SimpleClassPart simple_class; +#ifdef _ThreeDP_h + ThreeDClassPart threeD_class; +#endif + LabelClassPart label_class; + CommandClassPart command_class; + ToggleClassPart toggle_class; + RadioClassPart radio_class; +} RadioClassRec; + +extern RadioClassRec radioClassRec; + +/*************************************** + * + * Instance (widget) structure + * + **************************************/ + + /* New fields for the Radio widget record */ +typedef struct { + /* resources */ + /* TODO: 3-d and xaw-xpm features? */ + + /* private data */ + XtPointer extension; +} RadioPart; + + /* Full widget declaration */ +typedef struct _RadioRec { + CorePart core; + SimplePart simple; +#ifdef _ThreeDP_h + ThreeDPart threeD; +#endif + LabelPart label; + CommandPart command; + TogglePart toggle; + RadioPart radio; +} RadioRec; + +#endif /* _XawRadioP_h */ diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/xlwscrollbar.c --- a/lwlib/xlwscrollbar.c Mon Aug 13 11:12:06 2007 +0200 +++ b/lwlib/xlwscrollbar.c Mon Aug 13 11:13:30 2007 +0200 @@ -979,7 +979,7 @@ if (ss < SS_MIN) { /* add a percent amount for integer rounding */ - float tmp = ((((float) (SS_MIN - ss) * (float) value)) / total) + 0.5; + float tmp = (((float) (SS_MIN - ss) * (float) value) / total) + 0.5; above -= (int) tmp; ss = SS_MIN; diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/xlwscrollbar.h --- a/lwlib/xlwscrollbar.h Mon Aug 13 11:12:06 2007 +0200 +++ b/lwlib/xlwscrollbar.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,8 +20,8 @@ /* Created by Douglas Keller <dkeller@vnet.ibm.com> */ -#ifndef _XlwScrollbar_h -#define _XlwScrollbar_h +#ifndef INCLUDED_xlwscrollbar_h_ +#define INCLUDED_xlwscrollbar_h_ #include <X11/Core.h> @@ -140,4 +140,4 @@ void XlwScrollBarSetValues(Widget widget, int value, int sliderSize, int increment, int pageIncrement, Boolean notify); -#endif +#endif /* INCLUDED_xlwscrollbar_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/xlwtabs.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lwlib/xlwtabs.c Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,2101 @@ + /* Tabs Widget for XEmacs. + Copyright (C) 1999 Edward A. Falk + + This file is part of XEmacs. + + XEmacs is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by the + Free Software Foundation; either version 2, or (at your option) any + later version. + + XEmacs is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + for more details. + + You should have received a copy of the GNU General Public License + along with XEmacs; see the file COPYING. If not, write to + the Free Software Foundation, Inc., 59 Temple Place - Suite 330, + Boston, MA 02111-1307, USA. */ + + /* Synched up with: Tabs.c 1.27 */ + + /* + * Tabs.c - Index Tabs composite widget + * + * Author: Edward A. Falk + * falk@falconer.vip.best.com + * + * Date: July 29, 1997 + * + * + * Overall layout of this widget is as follows: + * + * ________ ,---------. _________ + * | label || Label || Label | \ tabs + * |________|| ||_________| / + * |+----------------------------+| \ + * || || | + * || child widget window || > frame + * |+----------------------------+| | + * +------------------------------+ / + * + * The height of the tabs includes the shadow width, top and bottom + * margins, and the height of the text. + * + * The height of the frame includes the top and bottom shadow width and the + * size of the child widget window. + * + * The tabs overlap the frame and each other vertically by the shadow + * width, so that when the topmost tab is drawn, it obliterates part of + * the frame. + */ + +/* + * TODO: min child height = tab height + */ + +#include <config.h> +#include <stdio.h> + +#include <X11/Xlib.h> +#include <X11/IntrinsicP.h> +#include <X11/StringDefs.h> +#include "../src/xmu.h" +#include "xlwtabsP.h" +#include "xlwgcs.h" + +#define MIN_WID 10 +#define MIN_HGT 10 +#define INDENT 3 /* tabs indented from edge by this much */ +#define SPACING 0 /* distance between tabs */ +#define SHADWID 1 /* default shadow width */ +#define TABDELTA 2 /* top tab grows this many pixels */ +#define TABLDELTA 2 /* top tab label offset this many pixels */ + + +/**************************************************************** + * + * IndexTabs Resources + * + ****************************************************************/ + +static char defaultTranslations[] = "\ + <BtnUp>: select() \n\ + <FocusIn>: highlight() \n\ + <FocusOut>: unhighlight() \n\ + <Key>Page_Up: page(up) \n\ + <Key>KP_Page_Up: page(up) \n\ + <Key>Prior: page(up) \n\ + <Key>KP_Prior: page(up) \n\ + <Key>Page_Down: page(down) \n\ + <Key>KP_Page_Down: page(down) \n\ + <Key>Next: page(down) \n\ + <Key>KP_Next: page(down) \n\ + <Key>Home: page(home) \n\ + <Key>KP_Home: page(home) \n\ + <Key>End: page(end) \n\ + <Key>KP_End: page(end) \n\ + <Key>Up: highlight(up) \n\ + <Key>KP_Up: highlight(up) \n\ + <Key>Down: highlight(down) \n\ + <Key>KP_Down: highlight(down) \n\ + <Key> : page(select) \n\ + " ; + +static char accelTable[] = " #augment\n\ + <Key>Page_Up: page(up) \n\ + <Key>KP_Page_Up: page(up) \n\ + <Key>Prior: page(up) \n\ + <Key>KP_Prior: page(up) \n\ + <Key>Page_Down: page(down) \n\ + <Key>KP_Page_Down: page(down) \n\ + <Key>Next: page(down) \n\ + <Key>KP_Next: page(down) \n\ + <Key>Home: page(home) \n\ + <Key>KP_Home: page(home) \n\ + <Key>End: page(end) \n\ + <Key>KP_End: page(end) \n\ + <Key>Up: highlight(up) \n\ + <Key>KP_Up: highlight(up) \n\ + <Key>Down: highlight(down) \n\ + <Key>KP_Down: highlight(down) \n\ + <Key> : page(select) \n\ + " ; +static XtAccelerators defaultAccelerators ; + +#define offset(field) XtOffsetOf(TabsRec, tabs.field) +static XtResource resources[] = { + + {XtNselectInsensitive, XtCSelectInsensitive, XtRBoolean, sizeof(Boolean), + offset(selectInsensitive), XtRImmediate, (XtPointer) True}, + {XtNfont, XtCFont, XtRFontStruct, sizeof(XFontStruct *), + offset(font), XtRString, (XtPointer) XtDefaultFont}, + {XtNinternalWidth, XtCWidth, XtRDimension, sizeof(Dimension), + offset(internalWidth), XtRImmediate, (XtPointer)4 }, + {XtNinternalHeight, XtCHeight, XtRDimension, sizeof(Dimension), + offset(internalHeight), XtRImmediate, (XtPointer)4 }, + {XtNborderWidth, XtCBorderWidth, XtRDimension, sizeof(Dimension), + XtOffsetOf(RectObjRec,rectangle.border_width), XtRImmediate, (XtPointer)0}, + {XtNtopWidget, XtCTopWidget, XtRWidget, sizeof(Widget), + offset(topWidget), XtRImmediate, NULL}, + {XtNcallback, XtCCallback, XtRCallback, sizeof(XtPointer), + offset(callbacks), XtRCallback, NULL}, + {XtNpopdownCallback, XtCCallback, XtRCallback, sizeof(XtPointer), + offset(popdownCallbacks), XtRCallback, NULL}, + {XtNbeNiceToColormap, XtCBeNiceToColormap, XtRBoolean, sizeof(Boolean), + offset(be_nice_to_cmap), XtRImmediate, (XtPointer) True}, + {XtNtopShadowContrast, XtCTopShadowContrast, XtRInt, sizeof(int), + offset(top_shadow_contrast), XtRImmediate, (XtPointer) 20}, + {XtNbottomShadowContrast, XtCBottomShadowContrast, XtRInt, sizeof(int), + offset(bot_shadow_contrast), XtRImmediate, (XtPointer) 40}, + {XtNinsensitiveContrast, XtCInsensitiveContrast, XtRInt, sizeof(int), + offset(insensitive_contrast), XtRImmediate, (XtPointer) 33}, + {XtNaccelerators, XtCAccelerators, XtRAcceleratorTable,sizeof(XtTranslations), + XtOffsetOf(TabsRec,core.accelerators), XtRString, accelTable}, +}; +#undef offset + + + + /* constraint resources */ + +#define offset(field) XtOffsetOf(TabsConstraintsRec, tabs.field) +static XtResource tabsConstraintResources[] = { + {XtNtabLabel, XtCLabel, XtRString, sizeof(String), + offset(label), XtRString, NULL}, + {XtNtabLeftBitmap, XtCLeftBitmap, XtRBitmap, sizeof(Pixmap), + offset(left_bitmap), XtRImmediate, None}, + {XtNtabForeground, XtCForeground, XtRPixel, sizeof(Pixel), + offset(foreground), XtRString, (XtPointer) XtDefaultForeground}, + {XtNresizable, XtCResizable, XtRBoolean, sizeof(Boolean), + offset(resizable), XtRImmediate, (XtPointer) True}, +} ; +#undef offset + + + + +#if !NeedFunctionPrototypes + + /* FORWARD REFERENCES: */ + + /* member functions */ + +static void TabsClassInit(); +static void TabsInit(); +static void TabsResize(); +static void TabsExpose(); +static void TabsDestroy(); +static void TabsRealize(); +static Boolean TabsSetValues(); +static Boolean TabsAcceptFocus(); +static XtGeometryResult TabsQueryGeometry(); +static XtGeometryResult TabsGeometryManager(); +static void TabsChangeManaged(); +static void TabsConstraintInitialize() ; +static Boolean TabsConstraintSetValues() ; + + /* action procs */ + +static void TabsSelect() ; +static void TabsPage() ; +static void TabsHighlight() ; +static void TabsUnhighlight() ; + + /* internal privates */ + +static void TabsAllocGCs() ; /* get rendering GCs */ +static void TabsFreeGCs() ; /* return rendering GCs */ +static void DrawTabs() ; /* draw all tabs */ +static void DrawTab() ; /* draw one index tab */ +static void DrawFrame() ; /* draw frame around contents */ +static void DrawTrim() ; /* draw trim around a tab */ +static void DrawBorder() ; /* draw border */ +static void DrawHighlight() ; /* draw highlight */ +static void UndrawTab() ; /* undraw interior of a tab */ +static void TabWidth() ; /* recompute tab size */ +static void GetPreferredSizes() ; /* query all children for their sizes */ +static void MaxChild() ; /* find max preferred child size */ +static int PreferredSize() ; /* compute preferred size */ +static int PreferredSize2() ; /* compute preferred size */ +static int PreferredSize3() ; /* compute preferred size */ +static void MakeSizeRequest() ; /* try to change size */ +static void getBitmapInfo() ; +static int TabLayout() ; /* lay out tabs */ +static void TabsShuffleRows() ; /* bring current tab to bottom row */ + +static void TabsAllocFgGC() ; +static void TabsAllocGreyGC() ; + +#else + +static void TabsClassInit(void) ; +static void TabsInit( Widget req, Widget new, ArgList, Cardinal *nargs) ; +static void TabsConstraintInitialize(Widget, Widget, ArgList, Cardinal *) ; +static void TabsRealize(Widget, Mask *, XSetWindowAttributes *) ; +static void TabsDestroy( Widget w) ; +static void TabsResize( Widget w) ; +static void TabsExpose( Widget w, XEvent *event, Region region) ; +static Boolean TabsSetValues(Widget, Widget, Widget, ArgList, Cardinal *) ; +static Boolean TabsAcceptFocus(Widget, Time *); +static Boolean TabsConstraintSetValues(Widget, Widget, Widget, + ArgList, Cardinal *) ; +static XtGeometryResult TabsQueryGeometry(Widget, + XtWidgetGeometry *, XtWidgetGeometry *) ; +static XtGeometryResult TabsGeometryManager(Widget, + XtWidgetGeometry *, XtWidgetGeometry *) ; +static void TabsChangeManaged( Widget w) ; + +static void TabsSelect(Widget, XEvent *, String *, Cardinal *) ; +static void TabsPage(Widget, XEvent *, String *, Cardinal *) ; +static void TabsHighlight(Widget, XEvent *, String *, Cardinal *) ; +static void TabsUnhighlight(Widget, XEvent *, String *, Cardinal *) ; + +static void DrawTabs( TabsWidget tw, Bool labels) ; +static void DrawTab( TabsWidget tw, Widget child, Bool labels) ; +static void DrawFrame( TabsWidget tw) ; +static void DrawTrim( TabsWidget, int x, int y, + int wid, int hgt, Bool bottom, Bool undraw) ; +static void DrawBorder( TabsWidget tw, Widget child, Bool undraw) ; +static void DrawHighlight( TabsWidget tw, Widget child, Bool undraw) ; +static void UndrawTab( TabsWidget tw, Widget child) ; + +static void TabWidth( Widget w) ; +static int TabLayout( TabsWidget, int wid, int hgt, Dimension *r_hgt, + Bool query_only) ; +static void GetPreferredSizes(TabsWidget) ; +static void MaxChild(TabsWidget, Widget except, Dimension, Dimension) ; +static void TabsShuffleRows( TabsWidget tw) ; +static int PreferredSize( TabsWidget, + Dimension *reply_width, Dimension *reply_height, + Dimension *reply_cw, Dimension *reply_ch) ; +static int PreferredSize2( TabsWidget, int cw, int ch, + Dimension *rw, Dimension *rh) ; +static int PreferredSize3( TabsWidget, int wid, int hgt, + Dimension *rw, Dimension *rh) ; +static void MakeSizeRequest(TabsWidget) ; + +static void TabsAllocGCs(TabsWidget) ; +static void TabsFreeGCs(TabsWidget) ; +static void getBitmapInfo( TabsWidget tw, TabsConstraints tab) ; +static void TabsAllocFgGC( TabsWidget tw) ; +static void TabsAllocGreyGC( TabsWidget tw) ; + +#endif + +#define AddRect(i,xx,yy,w,h) \ + do{rects[(i)].x=(xx); rects[i].y=(yy); \ + rects[i].width=(w); rects[i].height=(h);}while(0) + +static XtActionsRec actionsList[] = + { + {"select", TabsSelect}, + {"page", TabsPage}, + {"highlight", TabsHighlight}, + {"unhighlight", TabsUnhighlight}, + } ; + + +/**************************************************************** +* +* Full class record constant +* +****************************************************************/ + +#ifndef NEED_MOTIF +#define SuperClass (&constraintClassRec) +#else +#define SuperClass (&xmManagerClassRec) +#endif + +TabsClassRec tabsClassRec = { + { +/* core_class fields */ + /* superclass */ (WidgetClass) SuperClass, + /* class_name */ "Tabs", + /* widget_size */ sizeof(TabsRec), + /* class_initialize */ TabsClassInit, + /* class_part_init */ NULL, /* TODO? */ + /* class_inited */ FALSE, + /* initialize */ TabsInit, + /* initialize_hook */ NULL, + /* realize */ TabsRealize, + /* actions */ actionsList, + /* num_actions */ XtNumber(actionsList), + /* resources */ resources, + /* num_resources */ XtNumber(resources), + /* xrm_class */ NULLQUARK, + /* compress_motion */ TRUE, +#if XtSpecificationRelease < 6 + /* compress_exposure */ XtExposeCompressMaximal, +#else + /* compress_exposure */ XtExposeCompressMaximal|XtExposeNoRegion, +#endif + /* compress_enterleave*/ TRUE, + /* visible_interest */ TRUE, + /* destroy */ TabsDestroy, + /* resize */ TabsResize, + /* expose */ TabsExpose, + /* set_values */ TabsSetValues, + /* set_values_hook */ NULL, + /* set_values_almost */ XtInheritSetValuesAlmost, + /* get_values_hook */ NULL, + /* accept_focus */ TabsAcceptFocus, + /* version */ XtVersion, + /* callback_private */ NULL, + /* tm_table */ defaultTranslations, + /* query_geometry */ TabsQueryGeometry, + /* display_accelerator*/ XtInheritDisplayAccelerator, + /* extension */ NULL + }, + { +/* composite_class fields */ + /* geometry_manager */ TabsGeometryManager, + /* change_managed */ TabsChangeManaged, + /* insert_child */ XtInheritInsertChild, /* TODO? */ + /* delete_child */ XtInheritDeleteChild, /* TODO? */ + /* extension */ NULL + }, + { +/* constraint_class fields */ + /* subresources */ tabsConstraintResources, + /* subresource_count */ XtNumber(tabsConstraintResources), + /* constraint_size */ sizeof(TabsConstraintsRec), + /* initialize */ TabsConstraintInitialize, + /* destroy */ NULL, + /* set_values */ TabsConstraintSetValues, + /* extension */ NULL, + }, +#ifdef NEED_MOTIF +/* Manager Class fields */ + { + /* translations */ NULL, + /* syn_resources */ NULL, + /* num_syn_resources */ 0, + /* syn_constraint_resources */ NULL, + /* num_syn_constraint_resources */ 0, + /* parent_process */ XmInheritParentProcess, + /* extension */ NULL + }, +#endif + { +/* Tabs class fields */ + /* extension */ NULL, + } +}; + +WidgetClass tabsWidgetClass = (WidgetClass)&tabsClassRec; + + + +#ifdef DEBUG +#ifdef __STDC__ +#define assert(e) \ + if(!(e)) fprintf(stderr,"yak! %s at %s:%d\n",#e,__FILE__,__LINE__) +#else +#define assert(e) \ + if(!(e)) fprintf(stderr,"yak! e at %s:%d\n",__FILE__,__LINE__) +#endif +#else +#define assert(e) +#endif + + + + +/**************************************************************** + * + * Member Procedures + * + ****************************************************************/ + +static void +TabsClassInit(void) +{ + defaultAccelerators = XtParseAcceleratorTable(accelTable) ; + /* TODO: register converter for labels? */ +} + + + + /* Init a newly created tabs widget. Compute height of tabs + * and optionally compute size of widget. */ + +/* ARGSUSED */ + +static void +TabsInit(Widget request, Widget new, ArgList args, Cardinal *num_args) +{ + TabsWidget newTw = (TabsWidget)new; + + newTw->tabs.numRows = 0 ; + newTw->tabs.displayChildren = 0; + + GetPreferredSizes(newTw) ; + + /* height is easy, it's the same for all tabs: + * TODO: font height + height of tallest bitmap. + */ + newTw->tabs.tab_height = 2 * newTw->tabs.internalHeight + SHADWID ; + + if( newTw->tabs.font != NULL ) + newTw->tabs.tab_height += newTw->tabs.font->max_bounds.ascent + + newTw->tabs.font->max_bounds.descent ; + + /* GC allocation is deferred until XtRealize() */ + + /* if size not explicitly set, set it to our preferred size now. */ + + if( request->core.width == 0 || request->core.height == 0 ) + { + Dimension w,h ; + PreferredSize(newTw, &w, &h, NULL,NULL) ; + if( request->core.width == 0 ) new->core.width = w ; + if( request->core.height == 0 ) new->core.height = h ; + XtClass(new)->core_class.resize(new) ; + } + + /* defer GC allocation, etc., until Realize() time. */ + newTw->tabs.foregroundGC = + newTw->tabs.backgroundGC = + newTw->tabs.greyGC = + newTw->tabs.topGC = + newTw->tabs.botGC = None ; + + newTw->tabs.grey50 = None ; + + newTw->tabs.needs_layout = False ; + + newTw->tabs.hilight = NULL ; + +#ifdef NEED_MOTIF + newTw->manager.navigation_type = XmTAB_GROUP ; + newTw->manager.traversal_on = True ; +#endif +} + + + /* Init the constraint part of a new tab child. Compute the + * size of the tab. + */ +/* ARGSUSED */ +static void +TabsConstraintInitialize(Widget request, Widget new, + ArgList args, Cardinal *num_args) +{ + TabsConstraints tab = (TabsConstraints) new->core.constraints ; + tab->tabs.greyAlloc = False ; /* defer allocation of pixel */ + + getBitmapInfo((TabsWidget)XtParent(new), tab) ; + TabWidth(new) ; +} + + + + /* Called when tabs widget first realized. Create the window + * and allocate the GCs + */ + +static void +TabsRealize(Widget w, Mask *valueMask, XSetWindowAttributes *attributes) +{ + TabsWidget tw = (TabsWidget) w; + + attributes->bit_gravity = NorthWestGravity; + *valueMask |= CWBitGravity; + + SuperClass->core_class.realize(w, valueMask, attributes); + + TabsAllocGCs(tw) ; +} + + + +static void +TabsDestroy(Widget w) +{ + TabsFreeGCs((TabsWidget)w) ; +} + + + /* Parent has resized us. This will require that the tabs be + * laid out again. + */ + +static void +TabsResize(Widget w) +{ + TabsWidget tw = (TabsWidget) w; + int i ; + int num_children = tw->composite.num_children ; + Widget *childP ; + TabsConstraints tab ; + Dimension cw,ch,bw ; + + /* Our size has now been dictated by the parent. Lay out the + * tabs, lay out the frame, lay out the children. Remember + * that the tabs overlap each other and the frame by shadowWidth. + * Also, the top tab is larger than the others, so if there's only + * one row, the widget must be made taller to accommodate this. + * + * Once the tabs are laid out, if there is more than one + * row, we may need to shuffle the rows to bring the top tab + * to the bottom row. + */ + + tw->tabs.needs_layout = False ; + + if( num_children > 0 && tw->composite.children != NULL ) + { + /* Loop through the tabs and assign rows & x positions */ + (void) TabLayout(tw, tw->core.width, tw->core.height, NULL, False) ; + num_children = tw->tabs.displayChildren; + + /* assign a top widget, bring it to bottom row. */ + TabsShuffleRows(tw) ; + + /* now assign child positions & sizes. Positions are all the + * same: just inside the frame. Sizes are also all the same. + */ + + tw->tabs.child_width = cw = tw->core.width - 2 * SHADWID ; + tw->tabs.child_height = ch = + tw->core.height - tw->tabs.tab_total - 2 * SHADWID ; + + + for(i=0, childP=tw->composite.children; + i < num_children; + ++i, ++childP) + if( XtIsManaged(*childP) ) + { + tab = (TabsConstraints) (*childP)->core.constraints ; + bw = (*childP)->core.border_width ; + XtConfigureWidget(*childP, SHADWID,tw->tabs.tab_total+SHADWID, + cw-bw*2,ch-bw*2, bw) ; + } + if( XtIsRealized(w) ) { + XClearWindow(XtDisplay((Widget)tw), XtWindow((Widget)tw)) ; + /* should not be necessary to explicitly repaint after a + * resize, but XEmacs folks tell me it is. + */ + XtClass(tw)->core_class.expose((Widget)tw,NULL,None) ; + } + } +} /* Resize */ + + + + /* Redraw entire Tabs widget */ + +/* ARGSUSED */ +static void +TabsExpose(Widget w, XEvent *event, Region region) +{ + TabsWidget tw = (TabsWidget) w; + + if( tw->tabs.needs_layout ) + XtClass(w)->core_class.resize(w) ; + + DrawTabs(tw, True) ; +} + + + /* Called when any Tabs widget resources are changed. */ + +/* ARGSUSED */ +static Boolean +TabsSetValues(Widget current, Widget request, Widget new, + ArgList args, Cardinal *num_args) +{ + TabsWidget curtw = (TabsWidget) current ; + TabsWidget tw = (TabsWidget) new ; + Boolean needRedraw = False ; + Widget *childP ; + int i ; + + + if( tw->tabs.font != curtw->tabs.font || + tw->tabs.internalWidth != curtw->tabs.internalWidth || + tw->tabs.internalHeight != curtw->tabs.internalHeight ) + { + tw->tabs.tab_height = 2 * tw->tabs.internalHeight + SHADWID ; + + if( tw->tabs.font != NULL ) + tw->tabs.tab_height += tw->tabs.font->max_bounds.ascent + + tw->tabs.font->max_bounds.descent ; + + /* Tab size has changed. Resize all tabs and request a new size */ + for(i=0, childP=tw->composite.children; + i < tw->composite.num_children; + ++i, ++childP) + if( XtIsManaged(*childP) ) + TabWidth(*childP) ; + PreferredSize(tw, &tw->core.width, &tw->core.height, NULL,NULL) ; + needRedraw = True ; + tw->tabs.needs_layout = True ; + } + + /* TODO: if any color changes, need to recompute GCs and redraw */ + + if( tw->core.background_pixel != curtw->core.background_pixel || + tw->core.background_pixmap != curtw->core.background_pixmap || + tw->tabs.font != curtw->tabs.font ) + if( XtIsRealized(new) ) + { + TabsFreeGCs(tw) ; + TabsAllocGCs(tw) ; + needRedraw = True ; + } + + if( tw->core.sensitive != curtw->core.sensitive ) + needRedraw = True ; + + /* If top widget changes, need to change stacking order, redraw tabs. + * Window system will handle the redraws. + */ + + if( tw->tabs.topWidget != curtw->tabs.topWidget ) + { + if( XtIsRealized(tw->tabs.topWidget) ) + { + Widget w = tw->tabs.topWidget ; + TabsConstraints tab = (TabsConstraints) w->core.constraints ; + + XRaiseWindow(XtDisplay(w), XtWindow(w)) ; +#ifdef NEED_MOTIF + XtVaSetValues(curtw->tabs.topWidget, XmNtraversalOn, False, 0) ; + XtVaSetValues(w, XmNtraversalOn, True, 0) ; +#endif + + if( tab->tabs.row != tw->tabs.numRows-1 ) + TabsShuffleRows(tw) ; + + needRedraw = True ; + } + else + tw->tabs.needs_layout = True ; + } + + return needRedraw ; +} + + + /* Called when any child constraint resources change. */ + +/* ARGSUSED */ +static Boolean +TabsConstraintSetValues(Widget current, Widget request, Widget new, + ArgList args, Cardinal *num_args) +{ + TabsWidget tw = (TabsWidget) XtParent(new) ; + TabsConstraints ctab = (TabsConstraints) current->core.constraints ; + TabsConstraints tab = (TabsConstraints) new->core.constraints ; + + + /* if label changes, need to re-layout the entire widget */ + /* if foreground changes, need to redraw tab label */ + + /* TODO: only need resize of new bitmap has different dimensions + * from old bitmap. + */ + + if( tab->tabs.label != ctab->tabs.label || /* Tab size has changed. */ + tab->tabs.left_bitmap != ctab->tabs.left_bitmap ) + { + TabWidth(new) ; + tw->tabs.needs_layout = True ; + + if( tab->tabs.left_bitmap != ctab->tabs.left_bitmap ) + getBitmapInfo(tw, tab) ; + + /* If there are no subclass ConstraintSetValues procedures remaining + * to be invoked, and if the preferred size has changed, ask + * for a resize. + */ + if( XtClass((Widget)tw) == tabsWidgetClass ) + MakeSizeRequest(tw) ; + } + + + /* The child widget itself never needs a redisplay, but the parent + * Tabs widget might. + */ + + if( XtIsRealized(new) ) + { + if( tw->tabs.needs_layout ) { + XClearWindow(XtDisplay((Widget)tw), XtWindow((Widget)tw)) ; + XtClass(tw)->core_class.expose((Widget)tw,NULL,None) ; + } + + else if( tab->tabs.foreground != ctab->tabs.foreground ) + DrawTab(tw, new, True) ; + } + + return False ; +} + + +static Boolean +TabsAcceptFocus(Widget w, Time *t) +{ + if( !w->core.being_destroyed && XtIsRealized(w) && + XtIsSensitive(w) && XtIsManaged(w) && w->core.visible ) + { + Widget p ; + for(p = XtParent(w); !XtIsShell(p); p = XtParent(p)) ; + XtSetKeyboardFocus(p,w) ; + return True ; + } + else + return False ; +} + + + +/* + * Return preferred size. Happily accept anything >= our preferred size. + * (TODO: is that the right thing to do? Should we always return "almost" + * if offerred more than we need?) + */ + +static XtGeometryResult +TabsQueryGeometry(Widget w, + XtWidgetGeometry *intended, XtWidgetGeometry *preferred) +{ + register TabsWidget tw = (TabsWidget)w ; + XtGeometryMask mode = intended->request_mode ; + + preferred->request_mode = CWWidth | CWHeight ; + PreferredSize(tw, &preferred->width, &preferred->height, NULL,NULL) ; + + if( (!(mode & CWWidth) || intended->width == w->core.width) && + (!(mode & CWHeight) || intended->height == w->core.height) ) + return XtGeometryNo ; + + if( (!(mode & CWWidth) || intended->width >= preferred->width) && + (!(mode & CWHeight) || intended->height >= preferred->height) ) + return XtGeometryYes; + + return XtGeometryAlmost; +} + + + +/* + * Geometry Manager; called when a child wants to be resized. + */ + +static XtGeometryResult +TabsGeometryManager(Widget w, XtWidgetGeometry *req, XtWidgetGeometry *reply) +{ + TabsWidget tw = (TabsWidget) XtParent(w); + Dimension s = SHADWID ; + TabsConstraints tab = (TabsConstraints)w->core.constraints; + XtGeometryResult result ; + Dimension rw, rh ; + + /* Position request always denied */ + + if( ((req->request_mode & CWX) && req->x != w->core.x) || + ((req->request_mode & CWY) && req->y != w->core.y) || + !tab->tabs.resizable ) + return XtGeometryNo ; + + /* Make all three fields in the request valid */ + if( !(req->request_mode & CWWidth) ) + req->width = w->core.width; + if( !(req->request_mode & CWHeight) ) + req->height = w->core.height; + if( !(req->request_mode & CWBorderWidth) ) + req->border_width = w->core.border_width; + + if( req->width == w->core.width && + req->height == w->core.height && + req->border_width == w->core.border_width ) + return XtGeometryNo ; + + rw = req->width + 2 * req->border_width ; + rh = req->height + 2 * req->border_width ; + + /* find out how big the children want to be now */ + MaxChild(tw, w, rw, rh) ; + + + /* Size changes must see if the new size can be accommodated. + * The Tabs widget keeps all of its children the same + * size. A request to shrink will be accepted only if the + * new size is still big enough for all other children. A + * request to shrink that is not big enough for all children + * returns an "almost" response with the new proposed size + * or a "no" response if unable to shrink at all. + * + * A request to grow will be accepted only if the Tabs parent can + * grow to accommodate. + * + * TODO: + * We could get fancy here and re-arrange the tabs if it is + * necessary to compromise with the parent, but we'll save that + * for another day. + */ + + if (req->request_mode & (CWWidth | CWHeight | CWBorderWidth)) + { + Dimension cw,ch ; /* children's preferred size */ + Dimension aw,ah ; /* available size we can give child */ + Dimension th ; /* space used by tabs */ + Dimension wid,hgt ; /* Tabs widget size */ + + cw = tw->tabs.max_cw ; + ch = tw->tabs.max_ch ; + + /* find out what *my* resulting preferred size would be */ + + PreferredSize2(tw, cw, ch, &wid, &hgt) ; + + /* Would my size change? If so, ask to be resized. */ + + if( wid != tw->core.width || hgt != tw->core.height ) + { + Dimension oldWid = tw->core.width, oldHgt = tw->core.height ; + XtWidgetGeometry myrequest, myreply ; + + myrequest.width = wid ; + myrequest.height = hgt ; + myrequest.request_mode = CWWidth | CWHeight ; + + /* If child is only querying, or if we're going to have to + * offer the child a compromise, then make this a query only. + */ + + if( (req->request_mode & XtCWQueryOnly) || rw < cw || rh < ch ) + myrequest.request_mode |= XtCWQueryOnly ; + + result = XtMakeGeometryRequest((Widget)tw, &myrequest, &myreply) ; + + /* !$@# Athena Box widget changes the core size even if QueryOnly + * is set. I'm convinced this is a bug. At any rate, to work + * around the bug, we need to restore the core size after every + * query geometry request. This is only partly effective, + * as there may be other boxes further up the tree. + */ + if( myrequest.request_mode & XtCWQueryOnly ) { + tw->core.width = oldWid ; + tw->core.height = oldHgt ; + } + + /* based on the parent's response, determine what the + * resulting Tabs widget size would be. + */ + + switch( result ) { + case XtGeometryYes: + case XtGeometryDone: + tw->tabs.needs_layout = True ; + break ; + + case XtGeometryNo: + wid = tw->core.width ; + hgt = tw->core.height ; + break ; + + case XtGeometryAlmost: + wid = myreply.width ; + hgt = myreply.height ; + tw->tabs.needs_layout = True ; + break ; + } + } + + /* Within the constraints imposed by the parent, what is + * the max size we can give the child? + */ + (void) TabLayout(tw, wid, hgt, &th, True) ; + aw = wid - 2*s ; + ah = hgt - th - 2*s ; + + /* OK, make our decision. If requested size is >= max sibling + * preferred size, AND requested size <= available size, then + * we accept. Otherwise, we offer a compromise. + */ + + if( rw == aw && rh == ah ) + { + /* Acceptable. If this wasn't a query, change *all* children + * to this size. + */ + if( req->request_mode & XtCWQueryOnly ) + return XtGeometryYes ; + else + { + Widget *childP = tw->composite.children ; + int i,bw ; + w->core.border_width = req->border_width ; + for(i=tw->tabs.displayChildren; --i >= 0; ++childP) + if( XtIsManaged(*childP) ) + { + bw = (*childP)->core.border_width ; + XtConfigureWidget(*childP, s,tw->tabs.tab_total+s, + rw-2*bw, rh-2*bw, bw) ; + } +#ifdef COMMENT + /* TODO: under what conditions will we need to redraw? */ + XClearWindow(XtDisplay((Widget)tw), XtWindow((Widget)tw)) ; + XtClass(tw)->core_class.expose((Widget)tw,NULL,NULL) ; +#endif /* COMMENT */ + return XtGeometryDone ; + } + } + + /* Cannot grant child's request. Describe what we *can* do + * and return counter-offer. + */ + reply->width = aw - 2 * req->border_width ; + reply->height = ah - 2 * req->border_width ; + reply->border_width = req->border_width ; + reply->request_mode = CWWidth | CWHeight | CWBorderWidth ; + return XtGeometryAlmost ; + } + + return XtGeometryYes ; +} + + + + + /* The number of children we manage has changed; recompute + * size from scratch. + */ + +static void +TabsChangeManaged(Widget w) +{ + TabsWidget tw = (TabsWidget)w ; + Widget *childP = tw->composite.children ; + int i ; + + if( tw->tabs.topWidget != NULL && + ( !XtIsManaged(tw->tabs.topWidget) || + tw->tabs.topWidget->core.being_destroyed ) ) + tw->tabs.topWidget = NULL ; + + /* Check whether the highlight tab is still valid. */ + if( tw->tabs.hilight != NULL && + ( !XtIsManaged(tw->tabs.hilight) || + tw->tabs.hilight->core.being_destroyed ) ) + tw->tabs.hilight = NULL ; + + GetPreferredSizes(tw) ; + MakeSizeRequest(tw) ; + + XtClass(w)->core_class.resize(w) ; + if( XtIsRealized(w) ) + { + Display *dpy = XtDisplay(w) ; + XClearWindow(dpy, XtWindow(w)) ; + XtClass(w)->core_class.expose(w,NULL,NULL) ; + + /* make sure the top widget stays on top. This requires + * making sure that all new children are realized first. + */ + if( tw->tabs.topWidget != NULL && XtIsRealized(tw->tabs.topWidget) ) + { + for(i=tw->tabs.displayChildren; --i >= 0; ++childP) + if( !XtIsRealized(*childP) ) + XtRealizeWidget(*childP) ; + + XRaiseWindow(dpy, XtWindow(tw->tabs.topWidget)) ; + } + } + +#ifdef NEED_MOTIF + /* Only top widget may receive input */ + + for(childP = tw->composite.children, i=tw->composite.num_children; + --i >= 0; + ++childP) + { + XtVaSetValues(*childP, XmNtraversalOn, False, 0) ; + } + + if( tw->tabs.topWidget != NULL ) + XtVaSetValues(tw->tabs.topWidget, XmNtraversalOn, True, 0) ; +#endif +} + + + + +/**************************************************************** + * + * Action Procedures + * + ****************************************************************/ + + + /* User clicks on a tab, figure out which one it was. */ + +/* ARGSUSED */ +static void +TabsSelect(Widget w, XEvent *event, String *params, Cardinal *num_params) +{ + TabsWidget tw = (TabsWidget) w ; + Widget *childP ; + Position x,y ; + Dimension h = tw->tabs.tab_height ; + int i ; + +#ifdef NEED_MOTIF + XmProcessTraversal (w, XmTRAVERSE_CURRENT) ; +#endif + + /* TODO: is there an Xmu function or something to do this instead? */ + switch( event->type ) { + case ButtonPress: + case ButtonRelease: + x = event->xbutton.x ; y = event->xbutton.y ; break ; + case KeyPress: + case KeyRelease: + x = event->xkey.x ; y = event->xkey.y ; break ; + default: + return ; + } + + /* TODO: determine which tab was clicked, if any. Set that + * widget to be top of stacking order with XawTabsSetTop(). + */ + for(i=0, childP=tw->composite.children; + i < tw->tabs.displayChildren; + ++i, ++childP) + if( XtIsManaged(*childP) ) + { + TabsConstraints tab = (TabsConstraints)(*childP)->core.constraints; + if( x > tab->tabs.x && x < tab->tabs.x + tab->tabs.width && + y > tab->tabs.y && y < tab->tabs.y + h ) + { + if( *childP != tw->tabs.topWidget && + (XtIsSensitive(*childP) || tw->tabs.selectInsensitive) ) + XawTabsSetTop(*childP, True) ; + break ; + } + } +} + + + /* User hits a key */ + +static void +TabsPage(Widget w, XEvent *event, String *params, Cardinal *num_params) +{ + TabsWidget tw = (TabsWidget) w ; + Widget newtop = NULL; + Widget *childP ; + int idx ; + int nc = tw->tabs.displayChildren ; + + if( nc <= 0 ) + return ; + + if( *num_params < 1 ) { + XtAppWarning(XtWidgetToApplicationContext(w), + "Tabs: page() action called with no arguments") ; + return ; + } + + if( tw->tabs.topWidget == NULL ) + tw->tabs.topWidget = tw->composite.children[0] ; + + for(idx=0, childP=tw->composite.children; idx < nc; ++idx, ++childP ) + if( tw->tabs.topWidget == *childP ) + break ; + + switch( params[0][0] ) { + case 'u': /* up */ + case 'U': + if( --idx < 0 ) + idx = nc-1 ; + newtop = tw->composite.children[idx] ; + break ; + + case 'd': /* down */ + case 'D': + if( ++idx >= nc ) + idx = 0 ; + newtop = tw->composite.children[idx] ; + break ; + + case 'h': + case 'H': + default: + newtop = tw->composite.children[0] ; + break ; + + case 'e': + case 'E': + newtop = tw->composite.children[nc-1] ; + break ; + + case 's': /* selected */ + case 'S': + if( (newtop = tw->tabs.hilight) == NULL ) + return ; + break ; + } + + XawTabsSetTop(newtop, True) ; +} + + + /* User hits up/down key */ + +static void +TabsHighlight(Widget w, XEvent *event, String *params, Cardinal *num_params) +{ + TabsWidget tw = (TabsWidget) w ; + Widget newhl = NULL; + Widget *childP ; + int idx ; + int nc = tw->tabs.displayChildren ; + + if( nc <= 0 ) + return ; + + if( *num_params < 1 ) + { + if( tw->tabs.hilight != NULL ) + DrawHighlight(tw, tw->tabs.hilight, False) ; + return ; + } + + if( tw->tabs.hilight == NULL ) + newhl = tw->composite.children[0] ; + + else + { + /* find index of currently highlit child */ + for(idx=0, childP=tw->composite.children; idx < nc; ++idx, ++childP ) + if( tw->tabs.hilight == *childP ) + break ; + + switch( params[0][0] ) { + case 'u': /* up */ + case 'U': + if( --idx < 0 ) + idx = nc-1 ; + newhl = tw->composite.children[idx] ; + break ; + + case 'd': /* down */ + case 'D': + if( ++idx >= nc ) + idx = 0 ; + newhl = tw->composite.children[idx] ; + break ; + + case 'h': + case 'H': + newhl = tw->composite.children[0] ; + break ; + + case 'e': + case 'E': + newhl = tw->composite.children[nc-1] ; + break ; + + default: + newhl = tw->tabs.hilight ; + break ; + } + } + + XawTabsSetHighlight(w, newhl) ; +} + + + +static void +TabsUnhighlight(Widget w, XEvent *event, String *params, Cardinal *num_params) +{ + TabsWidget tw = (TabsWidget) w ; + int nc = tw->composite.num_children ; + + if( nc <= 0 ) + return ; + + if( tw->tabs.hilight != NULL ) + DrawHighlight(tw, tw->tabs.hilight, True) ; +} + + + + + +/**************************************************************** + * + * Public Procedures + * + ****************************************************************/ + + + /* Set the top tab, optionally call all callbacks. */ +void +XawTabsSetTop(Widget w, Bool callCallbacks) +{ + TabsWidget tw = (TabsWidget)w->core.parent ; + TabsConstraints tab ; + Widget oldtop = tw->tabs.topWidget ; + + if( !XtIsSubclass(w->core.parent, tabsWidgetClass) ) + { + char line[256] ; + sprintf(line, "XawTabsSetTop: widget \"%.64s\" is not the child of a tabs widget.", XtName(w)) ; + XtAppWarning(XtWidgetToApplicationContext(w), line) ; + return ; + } + + if( callCallbacks ) + XtCallCallbackList(w, tw->tabs.popdownCallbacks, + (XtPointer)tw->tabs.topWidget) ; + + if( !XtIsRealized(w) ) { + tw->tabs.topWidget = w ; + tw->tabs.needs_layout = True ; + tw->tabs.hilight = NULL; /* The highlight tab might disappear. */ + return ; + } + + XRaiseWindow(XtDisplay(w), XtWindow(w)) ; +#ifdef NEED_MOTIF + XtVaSetValues(oldtop, XmNtraversalOn, False, 0) ; + XtVaSetValues(w, XmNtraversalOn, True, 0) ; +#endif + + tab = (TabsConstraints) w->core.constraints ; + + /* Unhighlight before we start messing with the stacking order. */ + if( tw->tabs.hilight != NULL ) + { + DrawHighlight(tw, tw->tabs.hilight, True) ; + tw->tabs.hilight = NULL; + } + + if( tab->tabs.row == 0 ) + { + /* Easy case; undraw current top, undraw new top, assign new + * top, redraw all borders. + * We *could* just erase and execute a full redraw, but I like to + * reduce screen flicker. + */ + UndrawTab(tw, oldtop) ; /* undraw old */ + DrawBorder(tw, oldtop, True) ; + UndrawTab(tw, w) ; /* undraw new */ + DrawBorder(tw, w, True) ; + tw->tabs.topWidget = w ; + DrawTab(tw, oldtop, True) ; /* redraw old */ + DrawTab(tw, w, True) ; /* redraw new */ + DrawTabs(tw, False) ; + } + else + { + tw->tabs.topWidget = w ; + TabsShuffleRows(tw) ; + XClearWindow(XtDisplay((Widget)tw), XtWindow((Widget)tw)) ; + XtClass(tw)->core_class.expose((Widget)tw,NULL,None) ; + } + + XawTabsSetHighlight((Widget)tw, w) ; + + if( callCallbacks ) + XtCallCallbackList(w, tw->tabs.callbacks, (XtPointer)w) ; +} + + + /* Set the top tab, optionally call all callbacks. */ +void +XawTabsSetHighlight(Widget t, Widget w) +{ + TabsWidget tw = (TabsWidget)t ; + + if( !XtIsSubclass(t, tabsWidgetClass) ) + return ; + + if( XtIsRealized(t) && w != tw->tabs.hilight ) + { + if( w != NULL ) + DrawHighlight(tw, w, False) ; + } + + tw->tabs.hilight = w ; +} + + + + +/**************************************************************** + * + * Private Procedures + * + ****************************************************************/ + + +static void +TabsAllocGCs(TabsWidget tw) +{ + TabsAllocFgGC(tw) ; + TabsAllocGreyGC(tw) ; + tw->tabs.backgroundGC = AllocBackgroundGC((Widget)tw, None) ; + tw->tabs.topGC = AllocTopShadowGC((Widget)tw, + tw->tabs.top_shadow_contrast, tw->tabs.be_nice_to_cmap) ; + tw->tabs.botGC = AllocBotShadowGC((Widget)tw, + tw->tabs.bot_shadow_contrast, tw->tabs.be_nice_to_cmap) ; +} + + +static void +TabsFreeGCs(TabsWidget tw) +{ + Widget w = (Widget) tw; + + XtReleaseGC(w, tw->tabs.foregroundGC) ; + XtReleaseGC(w, tw->tabs.greyGC) ; + XtReleaseGC(w, tw->tabs.backgroundGC) ; + XtReleaseGC(w, tw->tabs.topGC) ; + XtReleaseGC(w, tw->tabs.botGC) ; +#ifdef HAVE_XMU + XmuReleaseStippledPixmap(XtScreen(w), tw->tabs.grey50) ; +#endif +} + + + + + + /* Redraw entire Tabs widget */ + +static void +DrawTabs(TabsWidget tw, Bool labels) +{ + Widget *childP ; + int i,j ; + Dimension s = SHADWID ; + Dimension th = tw->tabs.tab_height ; + Position y ; + TabsConstraints tab ; + + if( !XtIsRealized((Widget)tw)) + return ; + + /* draw tabs and frames by row except for the top tab, which + * is drawn last. (This is inefficiently written, but should not + * be too slow as long as there are not a lot of rows.) + */ + + y = tw->tabs.numRows == 1 ? TABDELTA : 0 ; + for(i=0; i<tw->tabs.numRows; ++i, y += th) + { + for( j=tw->tabs.displayChildren, childP=tw->composite.children; + --j >= 0; ++childP ) + if( XtIsManaged(*childP) ) + { + tab = (TabsConstraints)(*childP)->core.constraints; + if( tab->tabs.row == i && *childP != tw->tabs.topWidget ) + DrawTab(tw, *childP, labels) ; + } + if( i != tw->tabs.numRows -1 ) + DrawTrim(tw, 0,y+th, tw->core.width, th+s, False,False) ; + } + + DrawFrame(tw) ; + + /* and now the top tab */ + if( tw->tabs.topWidget != NULL ) + DrawTab(tw, tw->tabs.topWidget, labels) ; +} + + + +/* Draw one tab. Corners are rounded very slightly. */ + +static void +DrawTab(TabsWidget tw, Widget child, Bool labels) +{ + GC gc ; + int x,y ; + + if( !XtIsRealized((Widget)tw)) + return ; + + DrawBorder(tw, child, False) ; + + if( labels ) + { + TabsConstraints tab = (TabsConstraints)child->core.constraints; + Display *dpy = XtDisplay((Widget)tw) ; + Window win = XtWindow((Widget)tw) ; + String lbl = tab->tabs.label != NULL ? + tab->tabs.label : XtName(child) ; + + if( XtIsSensitive(child) ) + { + gc = tw->tabs.foregroundGC ; + XSetForeground(dpy, gc, tab->tabs.foreground) ; + } + else + { + /* grey pixel allocation deferred until now */ + if( !tab->tabs.greyAlloc ) + { + if( tw->tabs.be_nice_to_cmap || tw->core.depth == 1 ) + tab->tabs.grey = tab->tabs.foreground ; + else + tab->tabs.grey = AllocGreyPixel((Widget)tw, + tab->tabs.foreground, + tw->core.background_pixel, + tw->tabs.insensitive_contrast ) ; + tab->tabs.greyAlloc = True ; + } + gc = tw->tabs.greyGC ; + XSetForeground(dpy, gc, tab->tabs.grey) ; + } + + x = tab->tabs.x ; + y = tab->tabs.y ; + if( child == tw->tabs.topWidget ) + y -= TABLDELTA ; + + if( tab->tabs.left_bitmap != None && tab->tabs.lbm_width > 0 ) + { + if( tab->tabs.lbm_depth == 1 ) + XCopyPlane(dpy, tab->tabs.left_bitmap, win,gc, + 0,0, tab->tabs.lbm_width, tab->tabs.lbm_height, + x+tab->tabs.lbm_x, y+tab->tabs.lbm_y, 1L) ; + else + XCopyArea(dpy, tab->tabs.left_bitmap, win,gc, + 0,0, tab->tabs.lbm_width, tab->tabs.lbm_height, + x+tab->tabs.lbm_x, y+tab->tabs.lbm_y) ; + } + + if( lbl != NULL && tw->tabs.font != NULL ) + XDrawString(dpy,win,gc, + x+tab->tabs.l_x, y+tab->tabs.l_y, + lbl, (int)strlen(lbl)) ; + } + + if( child == tw->tabs.hilight ) + DrawHighlight(tw, child, False) ; +} + + + /* draw frame all the way around the child windows. */ + +static void +DrawFrame(TabsWidget tw) +{ + GC topgc = tw->tabs.topGC ; + GC botgc = tw->tabs.botGC ; + Dimension s = SHADWID ; + Dimension ch = tw->tabs.child_height ; + Draw3dBox((Widget)tw, 0,tw->tabs.tab_total, + tw->core.width, ch+2*s, s, topgc, botgc) ; +} + + + /* draw trim around a tab or underneath a row of tabs */ + +static void +DrawTrim(TabsWidget tw, /* widget */ + int x, /* upper-left corner */ + int y, + int wid, /* total size */ + int hgt, + Bool bottom, /* draw bottom? */ + Bool undraw) /* undraw all */ +{ + Display *dpy = XtDisplay((Widget)tw) ; + Window win = XtWindow((Widget)tw) ; + GC bggc = tw->tabs.backgroundGC ; + GC topgc = undraw ? bggc : tw->tabs.topGC ; + GC botgc = undraw ? bggc : tw->tabs.botGC ; + if( bottom ) + XDrawLine(dpy,win,bggc, x,y+hgt-1, x+wid-1,y+hgt-1) ; /* bottom */ + XDrawLine(dpy,win,topgc, x,y+2, x,y+hgt-2) ; /* left */ + XDrawPoint(dpy,win,topgc, x+1,y+1) ; /* corner */ + XDrawLine(dpy,win,topgc, x+2,y, x+wid-3,y) ; /* top */ + XDrawLine(dpy,win,botgc, x+wid-2,y+1, x+wid-2,y+hgt-2) ; /* right */ + XDrawLine(dpy,win,botgc, x+wid-1,y+2, x+wid-1,y+hgt-2) ; /* right */ +} + + +/* Draw one tab border. */ + +static void +DrawBorder(TabsWidget tw, Widget child, Bool undraw) +{ + TabsConstraints tab = (TabsConstraints)child->core.constraints; + Position x = tab->tabs.x ; + Position y = tab->tabs.y ; + Dimension twid = tab->tabs.width ; + Dimension thgt = tw->tabs.tab_height ; + + /* top tab requires a little special attention; it overlaps + * neighboring tabs slightly, so the background must be cleared + * in the region of the overlap to partially erase those neighbors. + * TODO: is this worth doing with regions instead? + */ + if( child == tw->tabs.topWidget ) + { + Display *dpy = XtDisplay((Widget)tw) ; + Window win = XtWindow((Widget)tw) ; + GC bggc = tw->tabs.backgroundGC ; + XRectangle rects[3] ; + x -= TABDELTA ; + y -= TABDELTA ; + twid += TABDELTA*2 ; + thgt += TABDELTA ; + AddRect(0, x,y+1,twid,TABDELTA) ; + AddRect(1, x+1,y,TABDELTA,thgt) ; + AddRect(2, x+twid-TABDELTA-1,y,TABDELTA,thgt) ; + XFillRectangles(dpy,win,bggc, rects, 3) ; + } + + DrawTrim(tw, x,y,twid,thgt+1, child == tw->tabs.topWidget, undraw) ; +} + + +/* Draw highlight around tab that has focus */ + +static void +DrawHighlight(TabsWidget tw, Widget child, Bool undraw) +{ + TabsConstraints tab = (TabsConstraints)child->core.constraints; + Display *dpy = XtDisplay((Widget)tw) ; + Window win = XtWindow((Widget)tw) ; + GC gc ; + Position x = tab->tabs.x ; + Position y = tab->tabs.y ; + Dimension wid = tab->tabs.width ; + Dimension hgt = tw->tabs.tab_height ; + XPoint points[6] ; + + /* top tab does not have a highlight */ + + if( child == tw->tabs.topWidget ) + return ; + + if( undraw ) + gc = tw->tabs.backgroundGC ; + + else if( XtIsSensitive(child) ) + { + gc = tw->tabs.foregroundGC ; + XSetForeground(dpy, gc, tab->tabs.foreground) ; + } + else + { + gc = tw->tabs.greyGC ; + XSetForeground(dpy, gc, tab->tabs.grey) ; + } + + points[0].x = x+1 ; points[0].y = y+hgt-1 ; + points[1].x = x+1 ; points[1].y = y+2 ; + points[2].x = x+2 ; points[2].y = y+1 ; + points[3].x = x+wid-4 ; points[3].y = y+1 ; + points[4].x = x+wid-3 ; points[4].y = y+2 ; + points[5].x = x+wid-3 ; points[5].y = y+hgt-1 ; + + XDrawLines(dpy,win,gc, points,6, CoordModeOrigin) ; +} + + +/* Undraw one tab interior */ + +static void +UndrawTab(TabsWidget tw, Widget child) +{ + TabsConstraints tab = (TabsConstraints)child->core.constraints; + Position x = tab->tabs.x ; + Position y = tab->tabs.y ; + Dimension twid = tab->tabs.width ; + Dimension thgt = tw->tabs.tab_height ; + Display *dpy = XtDisplay((Widget)tw) ; + Window win = XtWindow((Widget)tw) ; + GC bggc = tw->tabs.backgroundGC ; + + XFillRectangle(dpy,win,bggc, x,y, twid,thgt) ; +} + + + + + + /* GEOMETRY UTILITIES */ + + /* Overview: + * + * MaxChild(): ask all children (except possibly one) their + * preferred sizes, set max_cw, max_ch accordingly. + * + * GetPreferredSizes(): ask all children their preferred sizes, + * set max_cw, max_ch accordingly. + * + * PreferredSize(): given max_cw, max_ch, return tabs widget + * preferred size. Iterate with other widths in order to get + * a reasonable aspect ratio. + * + * PreferredSize2(): Given child dimensions, return Tabs + * widget dimensions. + * + * PreferredSize3(): Same, except given child dimensions plus + * shadow. + */ + + + /* Compute the width of one child's tab. Positions will be computed + * elsewhere. + * + * height: font height + vertical_space*2 + shadowWid*2 + * width: string width + horizontal_space*2 + shadowWid*2 + * + * All tabs are the same height, so that is computed elsewhere. + */ + +static void +TabWidth(Widget w) +{ + TabsConstraints tab = (TabsConstraints) w->core.constraints ; + TabsWidget tw = (TabsWidget)XtParent(w) ; + String lbl = tab->tabs.label != NULL ? + tab->tabs.label : XtName(w) ; + XFontStruct *font = tw->tabs.font ; + int iw = tw->tabs.internalWidth ; + + tab->tabs.width = iw + SHADWID*2 ; + tab->tabs.l_x = tab->tabs.lbm_x = SHADWID + iw ; + + if( tab->tabs.left_bitmap != None ) + { + tab->tabs.width += tab->tabs.lbm_width + iw ; + tab->tabs.l_x += tab->tabs.lbm_width + iw ; + tab->tabs.lbm_y = (tw->tabs.tab_height - tab->tabs.lbm_height)/2 ; + } + + if( lbl != NULL && font != NULL ) + { + tab->tabs.width += XTextWidth( font, lbl, (int)strlen(lbl) ) + iw ; + tab->tabs.l_y = (tw->tabs.tab_height + + tw->tabs.font->max_bounds.ascent - + tw->tabs.font->max_bounds.descent)/2 ; + } +} + + + + /* Lay out tabs to fit in given width. Compute x,y position and + * row number for each tab. Return number of rows and total height + * required by all tabs. If there is only one row, add TABDELTA + * height to the total. Rows are assigned bottom to top. + * + * Tabs are indented from the edges by INDENT. + * + * TODO: if they require more than two rows and the total height:width + * ratio is more than 2:1, then try something else. + */ + +static int +TabLayout(TabsWidget tw, int wid, int hgt, Dimension *reply_height, Bool query_only) +{ + int i, row ; + int num_children = tw->composite.num_children ; + Widget *childP ; + Dimension w ; + Position x,y ; + TabsConstraints tab ; + + if (!query_only) + tw->tabs.displayChildren = 0; + + /* Algorithm: loop through children, assign X positions. If a tab + * would extend beyond the right edge, start a new row. After all + * rows are assigned, make a second pass and assign Y positions. + */ + + if( num_children > 0 ) + { + /* Loop through the tabs and see how much space they need. */ + + row = 0 ; + x = INDENT ; + y = 0 ; + wid -= INDENT ; + for(i=num_children, childP=tw->composite.children; --i >= 0; ++childP) + if( XtIsManaged(*childP) ) + { + tab = (TabsConstraints) (*childP)->core.constraints ; + w = tab->tabs.width ; + if( x + w > wid ) { /* new row */ + if (y + tw->tabs.tab_height > hgt) + break; + ++row ; + x = INDENT ; + y += tw->tabs.tab_height ; + } + if( !query_only ) { + tab->tabs.x = x ; + tab->tabs.y = y ; + tab->tabs.row = row ; + } + x += w + SPACING ; + if (!query_only) + tw->tabs.displayChildren++; + } + /* If there was only one row, increse the height by TABDELTA */ + if( ++row == 1 ) + { + y = TABDELTA ; + if( !query_only ) + for(i=num_children, childP=tw->composite.children; + --i >= 0 ; ++childP) + if( XtIsManaged(*childP) ) + { + tab = (TabsConstraints) (*childP)->core.constraints ; + tab->tabs.y = y ; + } + } + y += tw->tabs.tab_height ; + } + else + row = y = 0 ; + + if( !query_only ) { + tw->tabs.tab_total = y ; + tw->tabs.numRows = row ; + } + + if( reply_height != NULL ) + *reply_height = y ; + + return row ; +} + + + + /* Find max preferred child size. Returned sizes include child + * border widths. + */ + +static void +GetPreferredSizes(TabsWidget tw) +{ + MaxChild(tw, NULL, 0,0) ; +} + + + + /* Find max preferred child size. Returned sizes include child + * border widths. If except is non-null, don't ask that one. + */ + +static void +MaxChild(TabsWidget tw, Widget except, Dimension cw, Dimension ch) +{ + int i ; + Widget *childP = tw->composite.children ; + XtWidgetGeometry preferred ; + + for(i=tw->composite.num_children; --i >=0; ++childP) + if( XtIsManaged(*childP) && *childP != except ) + { + (void) XtQueryGeometry(*childP, NULL, &preferred) ; + cw = Max(cw, preferred.width + preferred.border_width * 2 ) ; + ch = Max(ch, preferred.height + preferred.border_width * 2 ) ; + } + + tw->tabs.max_cw = cw ; + tw->tabs.max_ch = ch ; +} + + + + /* rotate row numbers to bring current widget to bottom row, + * compute y positions for all tabs + */ + +static void +TabsShuffleRows(TabsWidget tw) +{ + TabsConstraints tab ; + int move ; + int nrows ; + Widget *childP ; + Dimension th = tw->tabs.tab_height ; + Position bottom ; + int i ; + + /* There must be a top widget. If not, assign one. */ + if( tw->tabs.topWidget == NULL && tw->composite.children != NULL ) + for(i=tw->composite.num_children, childP=tw->composite.children; + --i >= 0; + ++childP) + if( XtIsManaged(*childP) ) { + tw->tabs.topWidget = *childP ; + break ; + } + + if( tw->tabs.topWidget != NULL ) + { + nrows = tw->tabs.numRows ; + assert( nrows > 0 ) ; + + if( nrows > 1 ) + { + tab = (TabsConstraints) tw->tabs.topWidget->core.constraints ; + assert( tab != NULL ) ; + + /* how far to move top row */ + move = nrows - tab->tabs.row ; + bottom = tw->tabs.tab_total - th ; + + for(i=tw->tabs.displayChildren, childP=tw->composite.children; + --i >= 0; + ++childP) + if( XtIsManaged(*childP) ) + { + tab = (TabsConstraints) (*childP)->core.constraints ; + tab->tabs.row = (tab->tabs.row + move) % nrows ; + tab->tabs.y = bottom - tab->tabs.row * th ; + } + } + } +} + + + /* Find preferred size. Ask children, find size of largest, + * add room for tabs & return. This can get a little involved, + * as we don't want to have too many rows of tabs; we may widen + * the widget to reduce # of rows. + * + * This function requires that max_cw, max_ch already be set. + */ + +static int +PreferredSize( + TabsWidget tw, + Dimension *reply_width, /* total widget size */ + Dimension *reply_height, + Dimension *reply_cw, /* child widget size */ + Dimension *reply_ch) +{ + Dimension cw,ch ; /* child width, height */ + Dimension wid,hgt ; + Dimension rwid,rhgt ; + int nrow ; + + wid = cw = tw->tabs.max_cw ; + hgt = ch = tw->tabs.max_ch ; + + nrow = PreferredSize2(tw, wid,hgt, &rwid, &rhgt) ; + + /* Check for absurd results (more than 2 rows, high aspect + * ratio). Try wider size if needed. + * TODO: make sure this terminates. + */ + + if( nrow > 2 && rhgt > rwid ) + { + Dimension w0, w1 ; + int maxloop = 20 ; + + /* step 1: start doubling size until it's too big */ + do { + w0 = wid ; + wid = Max(wid*2, wid+20) ; + nrow = PreferredSize2(tw, wid,hgt, &rwid,&rhgt) ; + } while( nrow > 2 && rhgt > rwid ) ; + w1 = wid ; + + /* step 2: use Newton's method to find ideal size. Stop within + * 8 pixels. + */ + while( --maxloop > 0 && w1 > w0 + 8 ) + { + wid = (w0+w1)/2 ; + nrow = PreferredSize2(tw, wid,hgt, &rwid,&rhgt) ; + if( nrow > 2 && rhgt > rwid ) + w0 = wid ; + else + w1 = wid ; + } + wid = w1 ; + } + + *reply_width = rwid ; + *reply_height = rhgt ; + if( reply_cw != NULL ) *reply_cw = cw ; + if( reply_ch != NULL ) *reply_ch = ch ; + return nrow ; +} + + + /* Find preferred size, given size of children. */ + +static int +PreferredSize2( + TabsWidget tw, + int cw, /* child width, height */ + int ch, + Dimension *reply_width, /* total widget size */ + Dimension *reply_height) +{ + Dimension s = SHADWID ; + + /* make room for shadow frame */ + cw += s*2 ; + ch += s*2 ; + + return PreferredSize3(tw, cw, ch, reply_width, reply_height) ; +} + + + /* Find preferred size, given size of children+shadow. */ + +static int +PreferredSize3( + TabsWidget tw, + int wid, /* child width, height */ + int hgt, + Dimension *reply_width, /* total widget size */ + Dimension *reply_height) +{ + Dimension th ; /* space used by tabs */ + int nrows ; + + if( tw->composite.num_children > 0 ) + nrows = TabLayout(tw, wid, hgt, &th, True) ; + else { + th = 0 ; + nrows = 0 ; + } + + *reply_width = Max(wid, MIN_WID) ; + *reply_height = Max(th+hgt, MIN_HGT) ; + + return nrows ; +} + + +static void +MakeSizeRequest(TabsWidget tw) +{ + Widget w = (Widget)tw ; + XtWidgetGeometry request, reply ; + XtGeometryResult result ; + Dimension cw,ch ; + + request.request_mode = CWWidth | CWHeight ; + PreferredSize(tw, &request.width, &request.height, &cw, &ch) ; + + if( request.width == tw->core.width && + request.height == tw->core.height ) + return ; + + result = XtMakeGeometryRequest(w, &request, &reply) ; + + if( result == XtGeometryAlmost ) + { + /* Bugger. Didn't get what we want, but were offered a + * compromise. If the width was too small, recompute + * based on the too-small width and try again. + * If the height was too small, make a wild-ass guess + * at a wider width and try again. + */ + + if( reply.width < request.width && reply.height >= request.height ) + { + Dimension s = SHADWID ; + ch += s*2 ; + PreferredSize3(tw, reply.width,ch, &request.width, &request.height); + result = XtMakeGeometryRequest(w, &request, &reply) ; + if( result == XtGeometryAlmost ) + (void) XtMakeGeometryRequest(w, &reply, NULL) ; + } + + else + (void) XtMakeGeometryRequest(w, &reply, NULL) ; + } +} + + +static void +getBitmapInfo(TabsWidget tw, TabsConstraints tab) +{ + Window root ; + int x,y ; + unsigned int bw ; + + if( tab->tabs.left_bitmap == None || + !XGetGeometry(XtDisplay(tw), tab->tabs.left_bitmap, &root, &x, &y, + &tab->tabs.lbm_width, &tab->tabs.lbm_height, + &bw, &tab->tabs.lbm_depth) ) + tab->tabs.lbm_width = tab->tabs.lbm_height = 0 ; +} + + + + + /* Code copied & modified from Gcs.c. This version has dynamic + * foreground. + */ + +static void +TabsAllocFgGC(TabsWidget tw) +{ + Widget w = (Widget) tw; + XGCValues values ; + + values.background = tw->core.background_pixel ; + values.font = tw->tabs.font->fid ; + values.line_style = LineOnOffDash ; + values.line_style = LineSolid ; + + tw->tabs.foregroundGC = + XtAllocateGC(w, w->core.depth, + GCBackground|GCFont|GCLineStyle, &values, + GCForeground, + GCSubwindowMode|GCGraphicsExposures|GCDashOffset| + GCDashList|GCArcMode) ; +} + +static void +TabsAllocGreyGC(TabsWidget tw) +{ + Widget w = (Widget) tw; + XGCValues values ; + + values.background = tw->core.background_pixel ; + values.font = tw->tabs.font->fid ; +#ifdef HAVE_XMU + if( tw->tabs.be_nice_to_cmap || w->core.depth == 1) + { + values.fill_style = FillStippled ; + tw->tabs.grey50 = + values.stipple = XmuCreateStippledPixmap(XtScreen(w), 1L, 0L, 1) ; + + tw->tabs.greyGC = + XtAllocateGC(w, w->core.depth, + GCBackground|GCFont|GCStipple|GCFillStyle, &values, + GCForeground, + GCSubwindowMode|GCGraphicsExposures|GCDashOffset| + GCDashList|GCArcMode) ; + } + else +#endif + { + tw->tabs.greyGC = + XtAllocateGC(w, w->core.depth, + GCFont, &values, + GCForeground, + GCBackground|GCSubwindowMode|GCGraphicsExposures|GCDashOffset| + GCDashList|GCArcMode) ; + } +} diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/xlwtabs.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lwlib/xlwtabs.h Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,205 @@ +/* Tabs Widget for XEmacs. + Copyright (C) 1999 Edward A. Falk + + This file is part of XEmacs. + + XEmacs is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by the + Free Software Foundation; either version 2, or (at your option) any + later version. + + XEmacs is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + for more details. + + You should have received a copy of the GNU General Public License + along with XEmacs; see the file COPYING. If not, write to + the Free Software Foundation, Inc., 59 Temple Place - Suite 330, + Boston, MA 02111-1307, USA. */ + +/* + * This widget manages one or more child widgets, exactly one of which is + * visible. Above the child widgets is a graphic that looks like index + * tabs from file folders. Each tab corresponds to one of the child widgets. + * By clicking on a tab, the user can bring the corresponding widget to + * the top of the stack. + */ + + +#ifndef _Tabs_h +#define _Tabs_h + +#include <X11/Constraint.h> + + +/*********************************************************************** + * + * Tabs Widget (subclass of CompositeClass) + * + ***********************************************************************/ + +/* Parameters: + + Name Class RepType Default Value + ---- ----- ------- ------------- + font Font XFontStruct* XtDefaultFont + internalWidth Width Dimension 4 *1 + internalHeight Height Dimension 2 *1 + topWidget TopWidget Widget *2 + callback Callback XtCallbackList NULL *3 + popdownCallback Callback XtCallbackList NULL *4 + selectInsensitive SelectInsensitive Boolean True *5 + beNiceToColormap BeNiceToColormap Boolean False *6 + topShadowContrast TopShadowContrast int 20 + bottomShadowContrast BottomShadowContrast int 40 + insensitiveContrast InsensitiveContrast int 33 *7 + + background Background Pixel XtDefaultBackground + border BorderColor Pixel XtDefaultForeground + borderWidth BorderWidth Dimension 1 + destroyCallback Callback Pointer NULL + hSpace HSpace Dimension 4 + height Height Dimension 0 + mappedWhenManaged MappedWhenManaged Boolean True + orientation Orientation XtOrientation vertical + vSpace VSpace Dimension 4 + width Width Dimension 0 + x Position Position 0 + y Position Position 0 + + Notes: + + 1 internalWidth, internalHeight specify the margins around the text + in the tabs. + 2 topWidget identifies the widget which is currently visible. + 3 callbacks are called whenever the user selects a tab. Call_data is + the new top widget. + 4 popdownCallbacks are called whenever the user selects a tab. Call_data is + the old (no longer visible) top widget. Note that popdownCallbacks + are called before callbacks. + 5 SelectInsensitive determines whether or not insensitive children may + be selected anyway. + 6 BeNiceToColormap causes the Tabs widget to use fewer colors. + 7 InsensitiveContrast sets the contrast used for labels of insensitive widgets. + +*/ + +/* Constraint parameters: + Name Class RepType Default Value + ---- ----- ------- ------------- + tabLabel Label String widget name + tabLeftBitmap LeftBitmap Pixmap None + tabForeground Foreground Pixel XtDefaultForeground + resizable Resizable Boolean False +*/ + +/* New fields */ + +#ifndef XtNtabLabel +#define XtNtabLabel "tabLabel" +#define XtNtabForeground "tabForeground" +#endif + +#ifndef XtNtabLeftBitmap +#define XtNtabLeftBitmap "tabLeftBitmap" +#endif + +#ifndef XtCLeftBitmap +#define XtCLeftBitmap "LeftBitmap" +#endif + +#ifndef XtCResizable +#define XtCResizable "Resizable" +#endif + +#ifndef XtNselectInsensitive +#define XtNselectInsensitive "selectInsensitive" +#define XtCSelectInsensitive "SelectInsensitive" +#endif + +#ifndef XtNnlabels +#define XtNnlabels "nlabels" +#define XtCNLabels "NLabels" +#endif +#ifndef XtNlabels +#define XtNlabels "labels" +#define XtCLabels "Labels" +#endif + +#ifndef XtNtopWidget +#define XtNtopWidget "topWidget" +#define XtCTopWidget "TopWidget" +#endif + +#ifndef XtNhSpace +#define XtNhSpace "hSpace" +#define XtCHSpace "HSpace" +#define XtNvSpace "vSpace" +#define XtCVSpace "VSpace" +#endif + +#ifndef XtNresizable +#define XtNresizable "resizable" +#endif + +#ifndef XtNinsensitiveContrast +#define XtNinsensitiveContrast "insensitiveContrast" +#define XtCInsensitiveContrast "InsensitiveContrast" +#endif + +#ifndef XtNshadowWidth +#define XtNshadowWidth "shadowWidth" +#define XtCShadowWidth "ShadowWidth" +#define XtNtopShadowPixel "topShadowPixel" +#define XtCTopShadowPixel "TopShadowPixel" +#define XtNbottomShadowPixel "bottomShadowPixel" +#define XtCBottomShadowPixel "BottomShadowPixel" +#define XtNtopShadowContrast "topShadowContrast" +#define XtCTopShadowContrast "TopShadowContrast" +#define XtNbottomShadowContrast "bottomShadowContrast" +#define XtCBottomShadowContrast "BottomShadowContrast" +#endif + +#ifndef XtNtopShadowPixmap +#define XtNtopShadowPixmap "topShadowPixmap" +#define XtCTopShadowPixmap "TopShadowPixmap" +#define XtNbottomShadowPixmap "bottomShadowPixmap" +#define XtCBottomShadowPixmap "BottomShadowPixmap" +#endif + +#ifndef XtNbeNiceToColormap +#define XtNbeNiceToColormap "beNiceToColormap" +#define XtCBeNiceToColormap "BeNiceToColormap" +#define XtNbeNiceToColourmap "beNiceToColormap" +#define XtCBeNiceToColourmap "BeNiceToColormap" +#endif + +/* Class record constants */ + +extern WidgetClass tabsWidgetClass; + +typedef struct _TabsClassRec *TabsWidgetClass; +typedef struct _TabsRec *TabsWidget; + +_XFUNCPROTOBEGIN + +extern void +XawTabsSetTop( +#if NeedFunctionPrototypes + Widget w, + Bool callCallbacks +#endif +) ; + +extern void +XawTabsSetHighlight( +#if NeedFunctionPrototypes + Widget tabs, + Widget w +#endif +) ; + +_XFUNCPROTOEND + +#endif /* _Tabs_h */ diff -r f4aeb21a5bad -r 74fd4e045ea6 lwlib/xlwtabsP.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lwlib/xlwtabsP.h Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,148 @@ +/* Tabs Widget for XEmacs. + Copyright (C) 1999 Edward A. Falk + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: TabsP.h 1.8 */ + +/* + * TabsP.h - Private definitions for Index Tabs widget + */ + +#ifndef _TabsP_h +#define _TabsP_h + +/*********************************************************************** + * + * Tabs Widget Private Data + * + ***********************************************************************/ + +#include <X11/IntrinsicP.h> + +#ifdef NEED_MOTIF +#include <Xm/XmP.h> +#include <Xm/ManagerP.h> +#endif + +#include "xlwtabs.h" + +/* New fields for the Tabs widget class record */ +typedef struct {XtPointer extension;} TabsClassPart; + +/* Full class record declaration */ +typedef struct _TabsClassRec { + CoreClassPart core_class; + CompositeClassPart composite_class; + ConstraintClassPart constraint_class; +#ifdef NEED_MOTIF + XmManagerClassPart manager_class; +#endif + TabsClassPart tabs_class; +} TabsClassRec; + +extern TabsClassRec tabsClassRec; + + + +/**************************************************************** + * + * instance record declaration + * + ****************************************************************/ + +/* New fields for the Tabs widget record */ +typedef struct { + /* resources */ + XFontStruct *font ; + Dimension internalHeight, internalWidth ; + Widget topWidget ; + XtCallbackList callbacks ; + XtCallbackList popdownCallbacks ; + Boolean selectInsensitive ; + Boolean be_nice_to_cmap ; + int top_shadow_contrast ; + int bot_shadow_contrast ; + int insensitive_contrast ; + + /* private state */ + Widget hilight ; + GC foregroundGC ; + GC backgroundGC ; + GC greyGC ; + GC topGC ; + GC botGC ; + Dimension tab_height ; /* height of tabs (all the same) */ + /* Note: includes top shadow only */ + Dimension tab_total ; /* total height of all tabs */ + Dimension child_width, child_height; /* child size, including borders */ + Dimension max_cw, max_ch ; /* max child preferred size */ + Cardinal numRows ; + Cardinal displayChildren ; + XtGeometryMask last_query_mode; + Boolean needs_layout ; + Pixmap grey50 ; /* TODO: cache this elsewhere */ +} TabsPart; + + +typedef struct _TabsRec { + CorePart core; + CompositePart composite; + ConstraintPart constraint; +#ifdef NEED_MOTIF + XmManagerPart manager; +#endif + TabsPart tabs; +} TabsRec; + + + + +/**************************************************************** + * + * constraint record declaration + * + ****************************************************************/ + +typedef struct _TabsConstraintsPart { + /* resources */ + String label ; + Pixmap left_bitmap ; + Pixel foreground ; + Boolean resizable ; + + /* private state */ + Pixel grey ; + Boolean greyAlloc ; + Dimension width ; /* tab width */ + Position x,y ; /* tab base position */ + short row ; /* tab row */ + Position l_x, l_y ; /* label position */ + Position lbm_x, lbm_y ; /* bitmap position */ + unsigned int lbm_width, lbm_height, lbm_depth ; +} TabsConstraintsPart ; + +typedef struct _TabsConstraintsRec { +#ifdef NEED_MOTIF + XmManagerConstraintPart manager; +#endif + TabsConstraintsPart tabs ; +} TabsConstraintsRec, *TabsConstraints ; + + +#endif /* _TabsP_h */ diff -r f4aeb21a5bad -r 74fd4e045ea6 man/ChangeLog --- a/man/ChangeLog Mon Aug 13 11:12:06 2007 +0200 +++ b/man/ChangeLog Mon Aug 13 11:13:30 2007 +0200 @@ -1,3 +1,431 @@ +2000-02-16 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.29 is released. + +2000-02-16 Martin Buchholz <martin@xemacs.org> + + * internals/internals.texi: Integrate Olivier's portable dumping docs. + +2000-02-09 Martin Buchholz <martin@xemacs.org> + + * lispref/symbols.texi (Object Plists): + Document `object-plist'. + Document `remprop'. + Rework all plist frobbing docs for accuracy. + +2000-02-07 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.28 is released. + +2000-02-07 Martin Buchholz <martin@xemacs.org> + + * cl.texi: Remove (or replace by `get') references to `get*'. + +2000-01-25 Yoshiki Hayashi <yoshiki@xemacs.org> + + * widget.texi: + * internals/internals.texi: + * lispref/commands.texi: + * lispref/consoles-devices.texi: + * lispref/customize.texi: + * lispref/dialog.texi: + * lispref/extents.texi: + * lispref/faces.texi: + * lispref/glyphs.texi: + * lispref/keymaps.texi: + * lispref/lists.texi: + * lispref/markers.texi: + * lispref/menus.texi: + * lispref/mule.texi: + * lispref/objects.texi: + * lispref/specifiers.texi: + * lispref/toolbar.texi: + * lispref/tooltalk.texi: + * lispref/x-windows.texi: + * new-users-guide/custom2.texi: + * new-users-guide/help.texi: + * new-users-guide/modes.texi: + * xemacs/abbrevs.texi: + * xemacs/buffers.texi: + * xemacs/custom.texi: + * xemacs/help.texi: + * xemacs/keystrokes.texi: + * xemacs/mini.texi: + * xemacs/new.texi: + * xemacs/packages.texi: + * xemacs/programs.texi: + * xemacs/sending.texi: + Change ' -- ' to '---' since Texinfo formats --- to --. + Untabify. TeX doesn't like TAB. + +2000-01-27 Sandra Wambold <wambold@xemacs.org> + + * xemacs-faq.texi (Q6.2.2): updated font instructions to include + 21.2.* + +2000-01-25 Yoshiki Hayashi <yoshiki@xemacs.org> + + * xemacs-faq.texi: Untabify. + +2000-01-22 Martin Buchholz <martin@xemacs.org> + + * internals/internals.texi (General Coding Rules): Document why we + #include <config.h> + +2000-01-21 Yoshiki Hayashi <yoshiki@xemacs.org> + + * xemacs-faq.texi: Change ' -- ' to '---'. + +2000-01-19 Yoshiki Hayashi <yoshiki@xemacs.org> + + * lispref/faces.texi (Face Properties): Document + remove-face-property. + +2000-01-18 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.27 is released. + +2000-01-17 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp> + + * xemacs/regs.texi: Synch with FSF 20.5. + +2000-01-14 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp> + + * info.texi: Change cross reference from emacs to xemacs. + +2000-01-14 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp> + + * xemacs/mini.texi: Synch with FSF 20.5. Update. + +2000-01-16 Martin Buchholz <martin@xemacs.org> + + * xemacs-faq.texi (Q2.1.15): Fix up @table formatting. + +2000-01-14 Martin Buchholz <martin@xemacs.org> + + * xemacs-faq.texi (Q2.1.15): Update dbx/gdb debugging info. + +2000-01-14 Sandra Wambold <wambold@xemacs.org> + + * xemacs-faq.texi: removed out-of-date XEmacs 19 questions. + +2000-01-14 Sandra Wambold <wambold@xemacs.org> + + * xemacs-faq.texi: Updated Macintosh information, + updated OS/2 info, changed turn-on-pending-delete answer. + +2000-01-08 Martin Buchholz <martin@xemacs.org> + + * xemacs-faq.texi (Q2.1.15): Make debugging info current. + +2000-01-08 Hrvoje Niksic <hniksic@iskon.hr> + + * lispref/control.texi (Signaling Errors): Document that `signal' + is continuable. + (Signaling Errors): Document `cerror', `signal-error', and + `check-argument-type'. + (Handling Errors): Mention `debug-on-signal'. + (Error Symbols): Document `define-error'. + (Processing of Errors): Document `display-error' and + `error-message-string'. + +2000-01-05 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp> + + * internals/internals.texi: Remove latin-1 char. + +2000-01-05 Didier Verna <didier@xemacs.org> + + * xemacs/custom.texi (Key bindings using strings): add missing + whitespace. + + * xemacs/xemacs.texi (Top): + * new-users-guide/new-users-guide.texi (Top): add missing `@top' + node. + +1999-12-24 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp> + + * lispref/minibuf.texi (Reading a Password): New section. + +1999-12-21 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp> + + * lispref/minibuf.texi: Remove documentation about + minibuffer-local-ns-map, read-no-blanks-input. + +1999-12-21 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp> + + * lispref/minibuf.texi: Partial Synch with FSF manual. + Add description about DEFAULT argument of reading functions. + +1999-12-31 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.26 is released. + +1999-12-26 Karl M. Hegbloom <karlheg@inetarena.com> + + * internals/internals.texi (garbage_collect_1): Xemacs -> XEmacs + +1999-12-24 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.25 is released. + +1999-12-21 Martin Buchholz <martin@xemacs.org> + + * lispref/text.texi (Near Point): Document `char-before'. + +1999-12-20 Adrian Aichner <adrian@xemacs.org> + + * widget.texi: Fix typos and possessive singular errors. Break + long sentences for readability. Remove some redundant commas. + +1999-12-18 Martin Buchholz <martin@xemacs.org> + + * lispref/functions.texi (Mapping Functions): + Warn about mapping functions modifying their sequences. + +1999-12-15 Sandra Wambold <wambold@xemacs.org> + + * xemacs-faq.texi: link to matlab.el added; misc. address changes + +1999-12-14 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.24 is released. + +1999-12-07 Gunnar Evermann <ge204@eng.cam.ac.uk> + + * xemacs/startup.texi (Startup Paths): fix typo: EMACSPACKAGEPATH + instead of PACKAGEPATH + From Marcus Harnisch <harnisch@mikrom.de> + +1999-12-07 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.23 is released. + +1999-12-06 Sandra Wambold <wambold@pobox.com> + + * xemacs-faq.texi: Added MS-Windows questions; some other changes + +1999-11-29 Martin Buchholz <martin@xemacs.org> + + * info.texi (Top): + Remove @ifnottex, which gives old makeinfos indigestion. + * texinfo.texi (Top): + Revert to pre-texinfo-4.0 version, plus small changes to make + texinfo-3.12, texinfo-3.12f, texinfo-4.0, and TeX happy. + +1999-11-30 Sandra Wambold <wambold@cygnus.com> + + * xemacs-faq.texi: fixed and commented out bad URL links + +1999-11-29 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.22 is released + +1999-11-28 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.21 is released. + +1999-11-26 Martin Buchholz <martin@xemacs.org> + + * internals.texi (Lstream Functions): + * internals.texi (Lstream Methods): + Types have changed to size_t and ssize_t. Document them. + +1999-08-12 Gunnar Evermann <ge204@eng.cam.ac.uk> + + * xemacs-faq.texi (Q4.4.2): added FAQ about Sun Workshop on + XEmacs 21 + +1999-11-15 Martin Buchholz <martin@xemacs.org> + + * xemacs/programs.texi: Upgrade to etags Version 13.32 + + * Makefile: + - Make sure the default target is `info' instead of cl.info. + - Use $(INFODIR) consistently where appropriate. + - Remove makeinfo-1.68 warning. (Usually only maintainer rebuilds info). + - Comment out unused macros: EMACS EMACSFLAGS + - Replace `-rm -f' with `rm -f', XPG4 guarantees exit code == 0. + - Get dependencies up to date. + + * internals/Makefile: + * xemacs/Makefile: + * lispref/Makefile: + * new-users-guide/Makefile: + * lispref/index.perm: + * lispref/index.unperm: + * lispref/permute-index: + * internals/index.perm: + * internals/index.unperm: + Remove these Makefiles. + Include all functionality in man/Makefile. + Support only non-permuted indexes for simplicity. + + * emodules.texi: + - TeX doesn't tolerate `_' in variable names; use `-' instead. + + * lispref/commands.texi: + * lispref/display.texi: + * lispref/faces.texi: + * lispref/functions.texi: + * lispref/keymaps.texi: + * lispref/lists.texi: + * lispref/modes.texi: + * lispref/objects.texi: + * lispref/os.texi: + * lispref/sequences.texi: + * lispref/strings.texi: + * lispref/text.texi: + * new-users-guide/custom1.texi: + * xemacs/custom.texi: + * xemacs/menus.texi: + - Make sources compatible with makeinfo 4.0 *and* 3.12. + - Replace @sc{ASCII} with @sc{ascii}, etc... + - Replace @var{(foo)} with (@var{foo}), etc... + + * info-stnd.texi: Remove. Who cares about the standalone info reader? + + * texinfo.tex: + * texinfo.texi: + * info.texi: + * standards.texi: + * make-stds.texi: + Import FSF-maintained files from texinfo-4.0. + +1999-11-10 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.20 is released + +1999-08-30 Robert Pluim <rpluim@bigfoot.com> + + * xemacs/packages.texi (Using Packages): Added description of + package-get-package-provider. + +1999-07-27 Charles G Waldman <cgw@fnal.gov> + + * xemacs-faq.texi (Q5.0.6): Describe `shell-multiple-shells' + +1999-08-01 Adrian Aichner <adrian@xemacs.org> + + * xemacs/programs.texi (Balanced Editing): Remove broken + line-break. + + * xemacs-faq.texi (Q1.0.6): Provide correct location in XEmacs + menus. + (Q1.4.1): ditto. + (Q1.4.3): ditto. + (Q2.0.5): Hyphenate words. + + * info.texi (Add): Fix one typo. + +1999-08-23 Stephane Epardaud <stephane@lunatech.com> + + * internals/internals.texi (Garbage Collection - Step by Step): + just added some dots to shut up compile warnings. + +1999-08-19 Matthias Neubauer <neubauer@informatik.uni-tuebingen.de> + + * internals/internals.texi (Garbage Collection - Step by Step): + new section in chapter Allocation of Objects in XEmacs Lisp. + +1999-07-28 Andy Piper <andy@xemacs.org> + + * internals.texi (Glyphs): add some glyph documentation. + +1999-07-30 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.19 is released + +1999-07-10 Adrian Aichner <adrian@xemacs.org> + + * emodules.texi: Use @set emacs and @value{emacs} instead of + @macro (unsupported by texinfo package). Remove stray @code. + * custom.texi: Add info extension to @setfilename. + * texinfo.texi: Ditto. + * widget.texi: Ditto. + * packages.texi: Reword a sentence, fixing @item Decide where to + install ... + +1999-07-19 Didier Verna <verna@inf.enst.fr> + + * custom.texi (Wishlist): removed the Custom Comments wishlist + entry. They are implemented. + +1999-07-13 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.18 is released + +1999-06-22 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.17 is released + +1999-06-11 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.16 is released + +1999-06-04 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.15 is released + +1999-05-30 Albert Chin-A-Young <china@thewrittenword.com> + + * custom.texi, external-widget.texi: Minor + fix to get info DIR entry correct. + +1999-05-22 Vin Shelton <acs@xemacs.org> + + * xemacs/cmdargs.texi: + Document -private. + +1999-05-16 Mike McEwan <mike@lotusland.demon.co.uk> + + * Makefile: Added `emodules.info' to info targets. + +1999-05-20 Karl M. Hegbloom <karlheg@debian.org> + + * internals/internals.texi (The XEmacs Object System + (Abstractly Speaking)): typo. + +1999-05-16 Hrvoje Niksic <hniksic@srce.hr> + + * lispref/text.texi (Substitution): Document improvements in + `translate-region'. + +1999-05-14 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.14 is released + +1999-05-11 Albert Chin-A-Young <china@thewrittenword.com> + + * man/internals/internals.texi: + * man/lispref/lispref.texi: + * man/new-users-guide/new-users-guide.texi: + * man/xemacs/xemacs.texi: + * man/cl.texi: + * man/custom.texi: + * man/term.texi: + * man/termcap.texi: + * man/widget.texi: + * man/xemacs-faq.texi: + * man/external-widget.texi: + Added info dir entries so install-info will add them to + the common `dir' file. + +1999-04-28 Stephen J. Turnbull <turnbull@sk.tsukuba.ac.jp> + + * man/lispref/mule.texi: Document CCL + - add sections: syntax, statements, expressions, and examples. + - fix naming and description errors. + - update links in neighboring nodes. + +1999-04-24 Gunnar Evermann <ge204@eng.cam.ac.uk> + + * lispref/eval.texi (Eval): default for max-lisp-eval-depth is 500. + +1999-04-23 Gunnar Evermann <ge204@eng.cam.ac.uk> + + * xemacs-faq.texi (Q3.0.7): refer to correct menu (Option->Frame + Appearance) + 1999-03-12 XEmacs Build Bot <builds@cvs.xemacs.org> * XEmacs 21.2.13 is released @@ -18,7 +446,7 @@ * XEmacs 21.2.9 is released -1999-01-14 Adrian Aichner <aichner@ecf.teradyne.com> +1999-01-14 Adrian Aichner <adrian@xemacs.org> * internals\internals.texi (Techniques for XEmacs Developers): Fixing documentation. @@ -145,7 +573,7 @@ 1998-09-03 Darryl Okahata <darrylo@sr.hp.com> * xemacs/packages.texi: Correct and update package documentation. - Updated the package installation section to mention the visual + Updated the package installation section to mention the visual package browser/installer. 1998-08-31 Hrvoje Niksic <hniksic@srce.hr> @@ -157,7 +585,7 @@ * lispref/files.texi (User Name Completion): new section. -1998-07-23 Adrian Aichner <aichner@ecf.teradyne.com> +1998-07-23 Adrian Aichner <adrian@xemacs.org> * xemacs/packages.texi (Packages): Changing @itemize @emph to @itemize @bullet (this is what all other files included in @@ -167,7 +595,7 @@ * xemacs/startup.texi: Small fixes, suggested by Hrvoje. - * xemacs/xemacs.texi: + * xemacs/xemacs.texi: * xemacs/packages.texi: More packages documentation. 1998-07-19 SL Baur <steve@altair.xemacs.org> @@ -206,7 +634,7 @@ * standards.texi (Preface): Revert previous change to @node because it doesn't pass makeinfo. -1998-06-27 Adrian Aichner <aichner@ecf.teradyne.com> +1998-06-27 Adrian Aichner <adrian@xemacs.org> * cl.texi: See ALL. * info-stnd.texi: Fixed @setfilename. @@ -234,18 +662,18 @@ 1998-06-20 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de> - * xemacs/abbrevs.texi: - * xemacs/basic.texi: - * xemacs/buildings.texi: - * xemacs/cmdargs.texi: - * xemacs/files.texi: + * xemacs/abbrevs.texi: + * xemacs/basic.texi: + * xemacs/buildings.texi: + * xemacs/cmdargs.texi: + * xemacs/files.texi: * xemacs/adjustments.texi: Adjustments to integrate startup.texi and packages.texi stuff. - * xemacs/startup.texi: + * xemacs/startup.texi: * xemacs/packages.texi: Created. -1998-06-10 Adrian Aichner <aichner@ecf.teradyne.com> +1998-06-10 Adrian Aichner <adrian@xemacs.org> * texinfo.texi: added ../info/ to @setfilename, broke line after @noindent. Changed @var{arg-not-used-by-@TeX{}} to @@ -258,12 +686,12 @@ 1998-06-13 Greg Klanderman <greg@alphatech.com> - * lispref/windows.texi (Resizing Windows): document third optional + * lispref/windows.texi (Resizing Windows): document third optional WINDOW argument to enlarge-window and shrink-window. (Selecting Windows): document select-window optional norecord - argument. + argument. (Size of Window): document window-text-area-pixel-height and - window-text-area-pixel-width. + window-text-area-pixel-width. (Size of Window): document window-displayed-text-pixel-height. (Position of Window): document window-text-area-pixel-edges. @@ -305,7 +733,7 @@ * lispref/dragndrop.texi: naming changed to Drag and Drop added some docu about the drop procedure -1998-06-09 Adrian Aichner <aichner@ecf.teradyne.com> +1998-06-09 Adrian Aichner <adrian@xemacs.org> * info-stnd.texi: added ../info/ to @setfilename. * info.texi: added ../info/ to @setfilename. @@ -354,7 +782,7 @@ 1998-05-13 Greg Klanderman <greg@alphatech.com> * lispref/frames.texi (Input Focus): cleanup select-frame - documentation. + documentation. 1998-05-10 Oliver Graf <ograf@fga.de> @@ -370,7 +798,7 @@ 1998-05-04 Martin Buchholz <martin@xemacs.org> - * internals.texi (Techniques for XEmacs Developers): Add some more + * internals.texi (Techniques for XEmacs Developers): Add some more comments on adding new files, inspired by Olivier Galibert. 1998-05-02 Hrvoje Niksic <hniksic@srce.hr> @@ -378,7 +806,7 @@ * lispref/windows.texi (Vertical Scrolling): Fixup docstring for scroll-conservatively. - * lispref/loading.texi (Named Features): Document advanced args to + * lispref/loading.texi (Named Features): Document advanced args to `feature'. * lispref/files.texi (File Name Expansion): Document that @@ -394,7 +822,7 @@ * lispref/os.texi (Time Conversion): Document that TIME may be omitted from format-time-string. - * lispref/strings.texi (String Conversion): Document BASE argument + * lispref/strings.texi (String Conversion): Document BASE argument to `string-to-number'. * lispref/searching.texi (Syntax of Regexps): Fix up Perl @@ -410,7 +838,7 @@ stuff, including `display-message', `lmessage', `clear-message', (Warnings): Document warning stuff. - * lispref/commands.texi (Working With Events): Update `make-event' + * lispref/commands.texi (Working With Events): Update `make-event' for misc-user events. (Using Interactive): Document `function-interactive'. @@ -424,7 +852,7 @@ 1998-05-02 Hrvoje Niksic <hniksic@srce.hr> - * lispref/numbers.texi (Comparison of Numbers): Document multi-arg + * lispref/numbers.texi (Comparison of Numbers): Document multi-arg comparison functions. 1998-04-30 Greg Klanderman <greg@alphatech.com> @@ -470,7 +898,7 @@ setting of x-emacs-application-class. * lispref/x-windows.texi (Resources): update doc for - x-emacs-application-class. + x-emacs-application-class. 1998-02-20 Karl M. Hegbloom <karlheg@bittersweet.inetarena.com> @@ -496,7 +924,7 @@ * xemacs/custom.texi (Init Syntax): document #b, #o, and #x reader syntax for integers. - From Adrian Aichner <aichner@ecf.teradyne.com> + From Adrian Aichner <adrian@xemacs.org> * cl.texi (Porting Common Lisp): ' ' * lispref/numbers.texi (Numbers): ' ' @@ -839,4 +1267,3 @@ * emacs.tex: Update information for obtaining TeX distribution from the University of Washington. - diff -r f4aeb21a5bad -r 74fd4e045ea6 man/Makefile --- a/man/Makefile Mon Aug 13 11:12:06 2007 +0200 +++ b/man/Makefile Mon Aug 13 11:13:30 2007 +0200 @@ -19,15 +19,7 @@ # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. -# Avoid trouble on systems where the "SHELL" variable might be -# inherited from the environment. -SHELL = /bin/sh - -EMACS = ../src/xemacs -EMACSFLAGS = -batch -q -no-site-file - -# NOTE: You *must* have makeinfo-1.68 or later to rebuild the -# info tree. +SHELL = /bin/sh MAKEINFO = makeinfo TEXI2DVI = texi2dvi @@ -36,6 +28,8 @@ RECURSIVE_MAKE = $(MAKE) $(MFLAGS) MAKEINFO='$(MAKEINFO)' TEXI2DVI='$(TEXI2DVI)' +all : info + # Ughhh! The things we do to have portable makefiles... INFODIR = ../info @@ -43,114 +37,264 @@ info_files = \ $(INFODIR)/cl.info \ $(INFODIR)/custom.info \ + $(INFODIR)/emodules.info \ $(INFODIR)/external-widget.info \ $(INFODIR)/info.info \ + $(INFODIR)/lispref.info \ + $(INFODIR)/internals.info \ + $(INFODIR)/new-users-guide.info \ $(INFODIR)/standards.info \ $(INFODIR)/term.info \ $(INFODIR)/termcap.info \ $(INFODIR)/texinfo.info \ $(INFODIR)/widget.info \ + $(INFODIR)/xemacs.info \ $(INFODIR)/xemacs-faq.info dvi_files = \ cl.dvi \ custom.dvi \ + emodules.dvi \ external-widget.dvi \ info.dvi \ + lispref.dvi \ + internals.dvi \ + new-users-guide.dvi \ standards.dvi \ term.dvi \ termcap.dvi \ texinfo.dvi \ widget.dvi \ + xemacs.dvi \ xemacs-faq.dvi -../info/cl.info : cl.texi - -$(MAKEINFO) cl.texi -o ../info/cl.info - -../info/custom.info : custom.texi - -$(MAKEINFO) custom.texi -o ../info/custom.info - -../info/external-widget.info : external-widget.texi - -$(MAKEINFO) external-widget.texi -o ../info/external-widget.info - -../info/info.info : info.texi - -$(MAKEINFO) info.texi -o ../info/info.info - -../info/standards.info : standards.texi - -$(MAKEINFO) standards.texi -o ../info/standards.info - -../info/term.info : term.texi - -$(MAKEINFO) term.texi -o ../info/term.info +xemacs-srcs = \ + xemacs/abbrevs.texi \ + xemacs/basic.texi \ + xemacs/buffers.texi \ + xemacs/building.texi \ + xemacs/calendar.texi \ + xemacs/cmdargs.texi \ + xemacs/custom.texi \ + xemacs/display.texi \ + xemacs/entering.texi \ + xemacs/files.texi \ + xemacs/fixit.texi \ + xemacs/frame.texi \ + xemacs/glossary.texi \ + xemacs/gnu.texi \ + xemacs/help.texi \ + xemacs/indent.texi \ + xemacs/keystrokes.texi \ + xemacs/killing.texi \ + xemacs/m-x.texi \ + xemacs/major.texi \ + xemacs/mark.texi \ + xemacs/menus.texi \ + xemacs/mini.texi \ + xemacs/misc.texi \ + xemacs/mouse.texi \ + xemacs/mule.texi \ + xemacs/new.texi \ + xemacs/packages.texi \ + xemacs/picture.texi \ + xemacs/programs.texi \ + xemacs/reading.texi \ + xemacs/regs.texi \ + xemacs/search.texi \ + xemacs/sending.texi \ + xemacs/startup.texi \ + xemacs/text.texi \ + xemacs/trouble.texi \ + xemacs/undo.texi \ + xemacs/windows.texi \ + xemacs/xemacs.texi -../info/termcap.info : termcap.texi - -$(MAKEINFO) termcap.texi -o ../info/termcap.info - -../info/texinfo.info : texinfo.texi - -$(MAKEINFO) texinfo.texi -o ../info/texinfo.info - -../info/widget.info : widget.texi - -$(MAKEINFO) widget.texi -o ../info/widget.info +lispref-srcs = \ + lispref/abbrevs.texi \ + lispref/annotations.texi \ + lispref/back.texi \ + lispref/backups.texi \ + lispref/buffers.texi \ + lispref/building.texi \ + lispref/commands.texi \ + lispref/compile.texi \ + lispref/consoles-devices.texi \ + lispref/control.texi \ + lispref/customize.texi \ + lispref/databases.texi \ + lispref/debugging.texi \ + lispref/dialog.texi \ + lispref/display.texi \ + lispref/dragndrop.texi \ + lispref/edebug-inc.texi \ + lispref/edebug.texi \ + lispref/errors.texi \ + lispref/eval.texi \ + lispref/extents.texi \ + lispref/faces.texi \ + lispref/files.texi \ + lispref/frames.texi \ + lispref/functions.texi \ + lispref/glyphs.texi \ + lispref/hash-tables.texi \ + lispref/help.texi \ + lispref/hooks.texi \ + lispref/index.texi \ + lispref/internationalization.texi \ + lispref/intro.texi \ + lispref/keymaps.texi \ + lispref/ldap.texi \ + lispref/lispref.texi \ + lispref/lists.texi \ + lispref/loading.texi \ + lispref/locals.texi \ + lispref/macros.texi \ + lispref/maps.texi \ + lispref/markers.texi \ + lispref/menus.texi \ + lispref/minibuf.texi \ + lispref/modes.texi \ + lispref/mouse.texi \ + lispref/mule.texi \ + lispref/numbers.texi \ + lispref/objects.texi \ + lispref/os.texi \ + lispref/positions.texi \ + lispref/processes.texi \ + lispref/range-tables.texi \ + lispref/scrollbars.texi \ + lispref/searching.texi \ + lispref/sequences.texi \ + lispref/specifiers.texi \ + lispref/streams.texi \ + lispref/strings.texi \ + lispref/symbols.texi \ + lispref/syntax.texi \ + lispref/text.texi \ + lispref/tips.texi \ + lispref/toolbar.texi \ + lispref/tooltalk.texi \ + lispref/variables.texi \ + lispref/windows.texi \ + lispref/x-windows.texi -../info/xemacs-faq.info : xemacs-faq.texi - -$(MAKEINFO) xemacs-faq.texi -o ../info/xemacs-faq.info +internals-srcs = \ + internals/internals.texi + +new-users-guide-srcs = \ + new-users-guide/custom1.texi \ + new-users-guide/custom2.texi \ + new-users-guide/edit.texi \ + new-users-guide/enter.texi \ + new-users-guide/files.texi \ + new-users-guide/help.texi \ + new-users-guide/modes.texi \ + new-users-guide/new-users-guide.texi \ + new-users-guide/region.texi \ + new-users-guide/search.texi \ + new-users-guide/xmenu.texi +$(INFODIR)/cl.info : cl.texi + $(MAKEINFO) -o $(INFODIR)/cl.info cl.texi + +$(INFODIR)/custom.info : custom.texi + $(MAKEINFO) -o $(INFODIR)/custom.info custom.texi + +$(INFODIR)/emodules.info : emodules.texi + $(MAKEINFO) -o $(INFODIR)/emodules.info emodules.texi + +$(INFODIR)/external-widget.info : external-widget.texi + $(MAKEINFO) -o $(INFODIR)/external-widget.info external-widget.texi + +$(INFODIR)/info.info : info.texi + $(MAKEINFO) -o $(INFODIR)/info.info info.texi + +$(INFODIR)/standards.info : standards.texi + $(MAKEINFO) -o $(INFODIR)/standards.info standards.texi -# ../info/w3.info : w3.texi -# -$(MAKEINFO) w3.texi -o ../info/w3.info +$(INFODIR)/term.info : term.texi + $(MAKEINFO) -o $(INFODIR)/term.info term.texi + +$(INFODIR)/termcap.info : termcap.texi + $(MAKEINFO) -o $(INFODIR)/termcap.info termcap.texi + +$(INFODIR)/texinfo.info : texinfo.texi + $(MAKEINFO) -o $(INFODIR)/texinfo.info texinfo.texi + +$(INFODIR)/widget.info : widget.texi + $(MAKEINFO) -o $(INFODIR)/widget.info widget.texi + +$(INFODIR)/xemacs-faq.info : xemacs-faq.texi + $(MAKEINFO) -o $(INFODIR)/xemacs-faq.info xemacs-faq.texi -# ../info/vm.info : vm.texi +# Manuals with their own subdirectory +$(INFODIR)/xemacs.info : $(xemacs-srcs) + $(MAKEINFO) -P xemacs -o $(INFODIR)/xemacs.info xemacs/xemacs.texi + +$(INFODIR)/lispref.info : $(lispref-srcs) + $(MAKEINFO) -P lispref -o $(INFODIR)/lispref.info lispref/lispref.texi + +$(INFODIR)/internals.info : $(internals-srcs) + $(MAKEINFO) -P internals -o $(INFODIR)/internals.info internals/internals.texi + +$(INFODIR)/new-users-guide.info : $(new-users-guide-srcs) + $(MAKEINFO) -P new-users-guide -o $(INFODIR)/new-users-guide.info new-users-guide/new-users-guide.texi + +# $(INFODIR)/w3.info : w3.texi +# $(MAKEINFO) -o $(INFODIR)/w3.info w3.texi + +# EMACS = ../src/xemacs +# EMACSFLAGS = -batch -q -no-site-file + +# $(INFODIR)/vm.info : vm.texi # -$(EMACS) $(EMACSFLAGS) -insert vm.texi -l texinfmt \ # -f texinfo-format-buffer -f save-buffer -# -mv vm.info* ../info +# -mv vm.info* $(INFODIR)/. -# special = # ../info/w3.info ../info/vm.info ../info/texinfo.info +# special = # $(INFODIR)/vm.info $(INFODIR)/texinfo.info -all: info +xemacs : $(INFODIR)/xemacs.info +lispref : $(INFODIR)/lispref.info +internals : $(INFODIR)/internals.info +new-users-guide.info : $(INFODIR)/new-users-guide.info -# Subdirectories to make recursively. -SUBDIR = xemacs lispref new-users-guide internals -.PHONY: $(SUBDIR) +.PHONY : xemacs lispref internals new-users-guide info dvi info : $(info_files) - -for d in $(SUBDIR) ; do (cd ./$$d && $(RECURSIVE_MAKE) $@) ; done + +# tm: FRC.tm +# cd ./tm && $(RECURSIVE_MAKE) +# gnats: FRC.gnats +# cd ./gnats && $(RECURSIVE_MAKE) +# FRC.xemacs FRC.lispref FRC.new-users-guide FRC.internals FRC.tm FRC.gnats: .PHONY: info dvi -xemacs: FRC.xemacs - -cd ./$@ && $(RECURSIVE_MAKE) -lispref: FRC.lispref - -cd ./$@ && $(RECURSIVE_MAKE) -new-users-guide: FRC.new-users-guide - -cd ./$@ && $(RECURSIVE_MAKE) -internals: FRC.internals - -cd ./$@ && $(RECURSIVE_MAKE) -# tm: FRC.tm -# -cd ./$@ && $(RECURSIVE_MAKE) -# gnats: FRC.gnats -# -cd ./$@ && $(RECURSIVE_MAKE) -# FRC.xemacs FRC.lispref FRC.new-users-guide FRC.internals FRC.tm FRC.gnats: -FRC.info FRC.dvi FRC.xemacs FRC.lispref FRC.new-users-guide FRC.internals: +.texi.dvi: + -$(TEXI2DVI) $< + +xemacs.dvi : $(xemacs-srcs) + $(TEXI2DVI) -I xemacs xemacs/xemacs.texi +lispref.dvi : $(lispref-srcs) + $(TEXI2DVI) -I lispref lispref/lispref.texi -.texi.dvi: - $(TEXI2DVI) $< +internals.dvi : $(internals-srcs) + $(TEXI2DVI) -I internals internals/internals.texi + +new-users-guide.dvi : $(new-users-guide-srcs) + $(TEXI2DVI) -I new-users-guide new-users-guide/new-users-guide.texi dvi : $(dvi_files) - -for d in $(SUBDIR) ; do (cd ./$${d} && $(RECURSIVE_MAKE) $@) ; done - .PHONY: mostlyclean clean distclean realclean extraclean mostlyclean: - -for d in $(SUBDIR) ; do (cd ./$${d} && $(RECURSIVE_MAKE) $@) ; done - rm -f *.toc *.aux *.log *.op \ - *.cp *.cps *.fn *.fns *.ky *.kys *.pg *.pgs *.vr *.vrs *.tp *.tps + rm -f *.toc *.aux *.log *.op *.cp *.cps *.fn *.fns + rm -f *.ky *.kys *.pg *.pgs *.tp *.tps *.vr *.vrs clean: mostlyclean - -for d in $(SUBDIR) ; do (cd ./$${d} && $(RECURSIVE_MAKE) $@) ; done - rm -f *.o core *.dvi + rm -f core *.dvi distclean: clean - -for d in $(SUBDIR) ; do (cd ./$${d} && $(RECURSIVE_MAKE) $@) ; done realclean: distclean - -for d in $(SUBDIR) ; do (cd ./$${d} && $(RECURSIVE_MAKE) $@) ; done extraclean: distclean - -for d in $(SUBDIR) ; do (cd ./$${d} && $(RECURSIVE_MAKE) $@) ; done - -rm -f *~ \#* + rm -f *~ \#* */*~ */\#* diff -r f4aeb21a5bad -r 74fd4e045ea6 man/cl.texi --- a/man/cl.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/cl.texi Mon Aug 13 11:13:30 2007 +0200 @@ -7,6 +7,11 @@ @end iftex @ifinfo +@dircategory XEmacs Editor +@direntry +* Common Lisp: (cl). GNU Emacs Common Lisp emulation package. +@end direntry + This file documents the GNU Emacs Common Lisp emulation package. Copyright (C) 1993 Free Software Foundation, Inc. @@ -290,10 +295,10 @@ @example defun* defsubst* defmacro* function* -member* assoc* rassoc* get* -remove* delete* mapcar* sort* -floor* ceiling* truncate* round* -mod* rem* random* +member* assoc* rassoc* remove* +delete* mapcar* sort* floor* +ceiling* truncate* round* mod* +rem* random* @end example Internal function and variable names in the package are prefixed @@ -1079,8 +1084,8 @@ nth rest first .. tenth aref elt nthcdr symbol-function symbol-value symbol-plist -get get* getf -gethash subseq +get getf gethash +subseq @end smallexample @noindent @@ -3292,7 +3297,7 @@ missing from Emacs Lisp. @menu -* Property Lists:: `get*', `remprop', `getf', `remf' +* Property Lists:: `getf', `remf' * Creating Symbols:: `gensym', `gentemp' @end menu @@ -3301,31 +3306,9 @@ @noindent These functions augment the standard Emacs Lisp functions @code{get} -and @code{put} for operating on properties attached to symbols. +and @code{put} for operating on properties attached to objects. There are also functions for working with property lists as -first-class data structures not attached to particular symbols. - -@defun get* symbol property &optional default -This function is like @code{get}, except that if the property is -not found, the @var{default} argument provides the return value. -(The Emacs Lisp @code{get} function always uses @code{nil} as -the default; this package's @code{get*} is equivalent to Common -Lisp's @code{get}.) - -The @code{get*} function is @code{setf}-able; when used in this -fashion, the @var{default} argument is allowed but ignored. -@end defun - -@defun remprop symbol property -This function removes the entry for @var{property} from the property -list of @var{symbol}. It returns a true value if the property was -indeed found and removed, or @code{nil} if there was no such property. -(This function was probably omitted from Emacs originally because, -since @code{get} did not allow a @var{default}, it was very difficult -to distinguish between a missing property and a property whose value -was @code{nil}; thus, setting a property to @code{nil} was close -enough to @code{remprop} for most purposes.) -@end defun +first-class data structures not attached to particular objects. @defun getf place property &optional default This function scans the list @var{place} as if it were a property @@ -3352,11 +3335,11 @@ (put sym prop val) @equiv{} (setf (getf (symbol-plist sym) prop) val) @end example -The @code{get} and @code{get*} functions are also @code{setf}-able. -The fact that @code{default} is ignored can sometimes be useful: +The @code{get} function is also @code{setf}-able. The fact that +@code{default} is ignored can sometimes be useful: @example -(incf (get* 'foo 'usage-count 0)) +(incf (get 'foo 'usage-count 0)) @end example Here, symbol @code{foo}'s @code{usage-count} property is incremented @@ -4648,7 +4631,7 @@ does not already exist, a new entry is added to the table and the table is reallocated to a larger size if necessary. The @var{default} argument is allowed but ignored in this case. The situation is -exactly analogous to that of @code{get*}; @pxref{Property Lists}. +exactly analogous to that of @code{get}; @pxref{Property Lists}. @end defun @defun remhash key table diff -r f4aeb21a5bad -r 74fd4e045ea6 man/custom.texi --- a/man/custom.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/custom.texi Mon Aug 13 11:13:30 2007 +0200 @@ -1,7 +1,7 @@ \input texinfo.tex @c %**start of header -@setfilename ../info/custom +@setfilename ../info/custom.info @settitle The Customization Library @iftex @afourpaper @@ -9,6 +9,13 @@ @end iftex @c %**end of header +@ifinfo +@dircategory XEmacs Editor +@direntry +* Customizations: (custom). Customization Library. +@end direntry +@end ifinfo + @node Top, Declaring Groups, (dir), (dir) @comment node-name, next, previous, up @top The Customization Library @@ -18,13 +25,13 @@ @file{cus-edit.el} which contains many declarations you can learn from. @menu -* Declaring Groups:: -* Declaring Variables:: -* Declaring Faces:: -* Usage for Package Authors:: -* Utilities:: -* The Init File:: -* Wishlist:: +* Declaring Groups:: +* Declaring Variables:: +* Declaring Faces:: +* Usage for Package Authors:: +* Utilities:: +* The Init File:: +* Wishlist:: @end menu All the customization declarations can be changes by keyword arguments. @@ -32,19 +39,19 @@ @table @code @item :group -@var{value} should be a customization group. -Add @var{symbol} to that group. +@var{value} should be a customization group. +Add @var{symbol} to that group. @item :link -@var{value} should be a widget type. +@var{value} should be a widget type. Add @var{value} to the external links for this customization option. Useful widget types include @code{custom-manual}, @code{info-link}, and -@code{url-link}. +@code{url-link}. @item :load Add @var{value} to the files that should be loaded before displaying this customization option. The value should be either a string, which should be a string which will be loaded with @code{load-library} unless present in @code{load-history}, or a symbol which will be loaded with -@code{require}. +@code{require}. @item :tag @var{Value} should be a short string used for identifying the option in customization menus and buffers. By default the tag will be @@ -55,10 +62,10 @@ @comment node-name, next, previous, up @section Declaring Groups -Use @code{defgroup} to declare new customization groups. +Use @code{defgroup} to declare new customization groups. @defun defgroup symbol members doc [keyword value]... -Declare @var{symbol} as a customization group containing @var{members}. +Declare @var{symbol} as a customization group containing @var{members}. @var{symbol} does not need to be quoted. @var{doc} is the group documentation. @@ -71,7 +78,7 @@ Internally, custom uses the symbol property @code{custom-group} to keep track of the group members, and @code{group-documentation} for the -documentation string. +documentation string. The following additional @var{keyword}'s are defined: @@ -99,7 +106,7 @@ The following additional @var{keyword}'s are defined: @table @code -@item :type +@item :type @var{value} should be a widget type. @item :options @@ -115,7 +122,7 @@ @item custom-initialize-set Use the @code{:set} method to initialize the variable. Do not initialize it if already bound. This is the default @code{:initialize} -method. +method. @item custom-initialize-default Always use @code{set-default} to initialize the variable, even if a @@ -128,10 +135,10 @@ @item custom-initialize-changed Like @code{custom-initialize-reset}, but use @code{set-default} to initialize the variable if it is not bound and has not been set -already. +already. @end table -@item :set +@item :set @var{value} should be a function to set the value of the symbol. It takes two arguments, the symbol to set and the value to give it. The default is @code{set-default}. @@ -144,7 +151,7 @@ @item :require @var{value} should be a feature symbol. Each feature will be required when the `defcustom' is evaluated, or when Emacs is started if the user -has saved this option. +has saved this option. @end table @@ -173,7 +180,7 @@ Faces are declared with @code{defface}. -@defun defface face spec doc [keyword value]... +@defun defface face spec doc [keyword value]... Declare @var{face} as a customizable face that defaults to @var{spec}. @var{face} does not need to be quoted. @@ -211,7 +218,7 @@ (what color is used for the background text)@* Should be one of @code{light} or @code{dark}. @end table - + Internally, custom uses the symbol property @code{face-defface-spec} for the program specified default face properties, @code{saved-face} for properties saved by the user, and @code{face-documentation} for the @@ -233,13 +240,13 @@ more of the standard customization groups. There exists a group for each @emph{finder} keyword. Press @kbd{C-h p} to see a list of finder keywords, and add you group to each of them, using the @code{:group} -keyword. +keyword. @node Utilities, The Init File, Usage for Package Authors, Top @comment node-name, next, previous, up @section Utilities -These utilities can come in handy when adding customization support. +These utilities can come in handy when adding customization support. @deffn Widget custom-manual Widget type for specifying the info manual entry for a customization @@ -262,7 +269,7 @@ @defun customize-menu-create symbol &optional name Create menu for customization group @var{symbol}. -If optional @var{name} is given, use that as the name of the menu. +If optional @var{name} is given, use that as the name of the menu. Otherwise the menu will be named `Customize'. The menu is in a format applicable to @code{easy-menu-define}. @end defun @@ -283,7 +290,7 @@ @section Wishlist @itemize @bullet -@item +@item Better support for keyboard operations in the customize buffer. @item @@ -294,7 +301,7 @@ @item Add an `examples' section, with explained examples of custom type -definitions. +definitions. @item Support selectable color themes. I.e., change many faces by setting one @@ -309,13 +316,13 @@ @item Ask whether set or modified variables should be saved in -@code{kill-buffer-hook}. +@code{kill-buffer-hook}. Ditto for @code{kill-emacs-query-functions}. @item Command to check if there are any customization options that -does not belong to an existing group. +does not belong to an existing group. @item Optionally disable the point-cursor and instead highlight the selected @@ -328,13 +335,9 @@ values. @item -Make it possible to include a comment/remark/annotation when saving an -option. - -@item Add some direct support for meta variables, i.e. make it possible to specify that this variable should be reset when that variable is -changed. +changed. @item Add tutorial. @@ -375,7 +378,7 @@ @item See if it is feasible to scan files for customization information -instead of loading them, +instead of loading them, @item Add hint message when user push a non-pushable tag. @@ -389,11 +392,11 @@ @item Add option to hide @samp{[hide]} for short options. Default, on. -@item +@item Add option to hide @samp{[state]} for options with their standard settings. -@item +@item There should be a way to specify site defaults for user options. @item diff -r f4aeb21a5bad -r 74fd4e045ea6 man/emodules.texi --- a/man/emodules.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/emodules.texi Mon Aug 13 11:13:30 2007 +0200 @@ -11,30 +11,24 @@ @c @ifset XEMACS -@macro emacs -XEmacs -@end macro +@set emacs XEmacs @clear EMACS -@set HAVE_EMACS +@set HAVE-EMACS @end ifset @ifset EMACS -@macro emacs -Emacs -@end macro +@set emacs Emacs @clear XEMACS -@set HAVE_EMACS +@set HAVE-EMACS @end ifset -@ifclear HAVE_EMACS +@ifclear HAVE-EMACS @set XEMACS -@macro emacs -XEmacs -@end macro +@set emacs XEmacs @end ifclear @ifinfo -This file documents the module loading technology of @emacs{}. +This file documents the module loading technology of @value{emacs}. Copyright @copyright{} 1998 J. Kean Johnston. @@ -84,7 +78,7 @@ @finalout @titlepage -@title Extending @emacs{} using C and C++ +@title Extending @value{emacs} using C and C++ @subtitle Version 1.0, September 1998 @author J. Kean Johnston @@ -119,7 +113,7 @@ @ifinfo @node Top, Introduction, (dir), (dir) -This Info file contains v1.0 of the @emacs{} dynamic loadable module +This Info file contains v1.0 of the @value{emacs} dynamic loadable module support documentation. @menu * Introduction:: Introducing Emacs Modules @@ -157,16 +151,16 @@ @node Introduction, Annatomy of a Module, Top, Top @chapter Introduction - @emacs{} is a powerful, extensible editor. The traditional way of -extending the functionality of @emacs{} is to use its built-in Lisp + @value{emacs} is a powerful, extensible editor. The traditional way of +extending the functionality of @value{emacs} is to use its built-in Lisp language (called Emacs Lisp, or Elisp for short). However, while Elisp -is a full programming language and capable of extending @emacs{} in more +is a full programming language and capable of extending @value{emacs} in more ways than you can imagine, it does have its short-comings. Firstly, Elisp is an interpreted language, and this has serious speed implications. Like all other interpreted languages (like Java), Elisp is often suitable only for certain types of application or extension. -So although Elisp is a general purpose language, and very ligh level, +So although Elisp is a general purpose language, and very high level, there are times when it is desirable to descend to a lower level compiled language for speed purposes. @@ -180,16 +174,16 @@ @cindex DLL @cindex DSO @cindex shared object - This manual describes a new way of extending @emacs{}, by using dynamic + This manual describes a new way of extending @value{emacs}, by using dynamic loadable modules (also knows as dynamicaly loadable libraries (DLLs), dynamic shared objects (DSOs) or just simply shared objectcs), which can -be written in C or C++ and loaded into @emacs{} at any time. I sometimes +be written in C or C++ and loaded into @value{emacs} at any time. I sometimes refer to this technology as @dfn{CEmacs}, which is short for @dfn{C Extensible Emacs}. - @emacs{} modules are configured into and installed with @emacs{} by + @value{emacs} modules are configured into and installed with @value{emacs} by default on all systems that support loading of shared objects. From a -users perspective, the internals of @emacs{} modules are irrelevant. +users perspective, the internals of @value{emacs} modules are irrelevant. All a user will ever need to know about shared objects is the name of the shared object when they want to load a given module. From a developers perspective though, a lot more is provided. @@ -206,28 +200,28 @@ and accepts all common C compiler flags. @code{ellcc} also sets up the correct environment for compiling modules by enabling any special compiler modes (such as PIC mode), setting the correct include paths for -the location of @emacs{} internal header files etc. The program will also +the location of @value{emacs} internal header files etc. The program will also invoke the linker correctly to created the final shared object which is -loaded into @emacs{}. +loaded into @value{emacs}. @item @cindex header files - CEmacs also makes all of the relevant @emacs{} internal header files + CEmacs also makes all of the relevant @value{emacs} internal header files availible for module authors to use. This is often required to get data structure definitions and external variable declarations. The header files installed include the module specific header file @file{emodules.h}. Due to the nature of dynamic modules, most of the -internals of @emacs{} are exposed. -@xref{Top,,,internals,@emacs{} Internals Manual}, for a -more complete discussion on how to extend and understand @emacs{}. All of +internals of @value{emacs} are exposed. +@xref{Top,,,internals,@value{emacs} Internals Manual}, for a +more complete discussion on how to extend and understand @value{emacs}. All of the rules for C modules are discussed there. @item @cindex samples - Part of the @emacs{} distribution is a set of sample modules. These are -not installed when @emacs{} is, but remain in the @emacs{} source tree. + Part of the @value{emacs} distribution is a set of sample modules. These are +not installed when @value{emacs} is, but remain in the @value{emacs} source tree. These modules live in the directory @file{modules}, which is a -sub-directory of the main @emacs{} source code directory. Please look at +sub-directory of the main @value{emacs} source code directory. Please look at the samples carefully, and maybe even use them as a basis for making your own modules. Most of the concepts required for writing extension modules are covered in the samples. @@ -236,19 +230,19 @@ @cindex documentation @cindex help Last, but not least is this manual. This can be viewed from within -@emacs{}, and it can be printed out as well. It is the intention of this +@value{emacs}, and it can be printed out as well. It is the intention of this document that it will describe everything you need to know about -extending @emacs{} in C. If you do not find this to be the case, please +extending @value{emacs} in C. If you do not find this to be the case, please contact the author(s). @end itemize The rest of this document will discuss the actual mechanics of -@emacs{} modules and work through several of the samples. Please be -sure that you have read the @emacs{} Internals Manual and understand +@value{emacs} modules and work through several of the samples. Please be +sure that you have read the @value{emacs} Internals Manual and understand everything in it. The concepts there apply to all modules. This document may have some overlap, but it is the internals manual which should be considered the final authority. It will also help a great -deal to look at the actual @emacs{} source code to see how things are +deal to look at the actual @value{emacs} source code to see how things are done. @node Annatomy of a Module, Using ellcc, Introduction, Top @@ -259,12 +253,12 @@ @cindex module format @cindex format, module - Each dynamically loadable @emacs{} extension (hereafter refered to as a + Each dynamically loadable @value{emacs} extension (hereafter refered to as a module) has a certain compulsory format, and must contain several pieces of information and several mandatory functions. This chapter describes the basic layout of a module, and provides a very simple sample. The source for this sample can be found in the file -@file{modules/simple/sample.c} in the main @emacs{} source code tree. +@file{modules/simple/sample.c} in the main @value{emacs} source code tree. @menu * Required Header File:: Always include <emodules.h> @@ -281,7 +275,7 @@ @cindex emodules.h @cindex config.h Every module must include the file @file{<emodules.h>}. This -will include several other @emacs{} internal header files, and will set up +will include several other @value{emacs} internal header files, and will set up certain vital macros. One of the most important files included by @file{emodules.h} is the generated @file{config.h} file, which contains all of the required system abstraction macros and definitions. Most @@ -290,9 +284,9 @@ familiarize yourself with the macros defined there. Depending on exactly what your module will be doing, you will probably -need to include one or more of the @emacs{} internal header files. When +need to include one or more of the @value{emacs} internal header files. When you @code{#include <emodules.h>}, you will get a few of the most important -@emacs{} header files included automatically for you. The files included +@value{emacs} header files included automatically for you. The files included are: @table @file @@ -308,7 +302,7 @@ @item window.h This header file defines the window structures and Lisp types, and -provides functions and macros for manipulating multiple @emacs{} windows. +provides functions and macros for manipulating multiple @value{emacs} windows. @item buffer.h All macros and function declarations for manipulating internal and user @@ -320,7 +314,7 @@ @item frame.h Provides the required structure, macro and function definitions for -manipulating @emacs{} frames. +manipulating @value{emacs} frames. @end table @node Required Functions, Required Variables, Required Header File, Annatomy of a Module @@ -332,8 +326,8 @@ Every module requires several initialization functions. It is the responsibility of these functions to load in any dependant modules, and to declare all variables and functions which are to be made visibile to the -@emacs{} Lisp reader. Each of these functions performs a very specific -task, and they are executed in the correct order by @emacs{}. All of +@value{emacs} Lisp reader. Each of these functions performs a very specific +task, and they are executed in the correct order by @value{emacs}. All of these functions are @code{void} functions which take no arguments. Here, briefly, are the required module functions. Note that the actual function names do not end with the string @code{_module}, but rather @@ -356,12 +350,12 @@ @code{DEFVAR_LISP()}, @code{DEFVAR_BOOL()} etc, and its purpose is to declare and initialize all and any variables that your module defines. They syntax for declaring variables is identical to the syntax used for -all internal @emacs{} source code. +all internal @value{emacs} source code. @item modules_of_module @findex modules_of_module This optional function should be used to load in any modules which your -module depends on. The @emacs{} module loading code makes sure that the +module depends on. The @value{emacs} module loading code makes sure that the same module is not loaded twice, so several modules can safely call the module load function for the same module. Only one copy of each module (at a given version) will ever be loaded. @@ -391,14 +385,14 @@ @table @code @item emodules_compiler This is a variable of type @code{long}, and is used to indicate the -version of the @emacs{} loading technology that was used to produce the +version of the @value{emacs} loading technology that was used to produce the module being loaded. This version number is completely unrelated to -the @emacs{} version number, as a given module may quite well work -regardless of the version of @emacs{} that was installed at the time the +the @value{emacs} version number, as a given module may quite well work +regardless of the version of @value{emacs} that was installed at the time the module was created. -The @emacs{} modules version is used to differentiate between major -changes in the module loading technology, not versions of @emacs{}. +The @value{emacs} modules version is used to differentiate between major +changes in the module loading technology, not versions of @value{emacs}. @item emodules_name This is a short (typically 10 characters or less) name for the module, @@ -442,11 +436,11 @@ However, if it does have dependnacies, it must call @code{emodules_load}: -@example @code +@example @cartouche -int emodules_load (CONST char *module, - CONST char *modname, - CONST char *modver) +int emodules_load (const char *module, + const char *modname, + const char *modver) @end cartouche @end example @@ -484,12 +478,12 @@ Before discussing the anatomy of a module in greater detail, you should be aware of the steps required in order to correctly compile and link a -module for use within @emacs{}. There is little difference between +module for use within @value{emacs}. There is little difference between compiling normal C code and compiling a module. In fact, all that changes is the command used to compile the module, and a few extra arguments to the compiler. -@emacs{} now ships with a new user utility, called @code{ellcc}. This +@value{emacs} now ships with a new user utility, called @code{ellcc}. This is the @dfn{Emacs Loadable Library C Compiler}. This is a wrapper program that will invoke the real C compiler with the correct arguments to compile and link your module. With the exception of a few command @@ -525,7 +519,7 @@ to @code{ellcc}. In this mode, @code{ellcc} is simply a front-end to the same C compiler -that was used to create the @emacs{} binary itself. All @code{ellcc} +that was used to create the @value{emacs} binary itself. All @code{ellcc} does in this mode is insert a few extra command line arguments before the arguments you specify to @code{ellcc} itself. @code{ellcc} will then invoke the C compiler to compile your module, and will return the @@ -535,7 +529,7 @@ @file{Makefile} as you would for a normal program, and simply insert, at some appropriate place something similar to: -@example @code +@example @cartouche CC=ellcc --mode=compile @@ -555,18 +549,18 @@ @cindex initialization @cindex documentation -@emacs{} uses a rather bizarre way of documenting variables and +@value{emacs} uses a rather bizarre way of documenting variables and functions. Rather than have the documentation for compiled functions and variables passed as static strings in the source code, the documentation is included as a C comment. A special program, called @file{make-docfile}, is used to scan the source code files and extract -the documentation from these comments, producing the @emacs{} @file{DOC} +the documentation from these comments, producing the @value{emacs} @file{DOC} file, which the internal help engine scans when the documentation for a function or variable is requested. Due to the internal construction of Lisp objects, subrs and other such things, adding documentation for a compiled function or variable in a -compiled module, at any time after @emacs{} has been @dfn{dumped} is +compiled module, at any time after @value{emacs} has been @dfn{dumped} is somewhat problematic. Fortunately, as a module writer you are insulated from the difficulties thanks to your friend @code{ellcc} and some internal trickery in the module loading code. This is all done using @@ -613,7 +607,7 @@ to populate the @code{docs_of_module} function. Below is a sample @file{Makefile} fragment which indicates how all of this is used. -@example @code +@example @cartouche CC=ellcc --mode=compile LD=ellcc --mode=link @@ -651,11 +645,11 @@ The above @file{Makefile} is, in fact, complete, and would compile the sample module, and optionally install it. The @code{--mod-location} argument to @code{ellcc} will produce, on the standard output, the base -location of the @emacs{} module directory. Each sub-directory of that +location of the @value{emacs} module directory. Each sub-directory of that directory is automatically searched for for modules when they are loaded with @code{load-module}. An alternative location would be @file{/usr/local/lib/xemacs/site-modules}. That path can change -depending on the options the person who compiled @emacs{} chose, so you +depending on the options the person who compiled @value{emacs} chose, so you can always determine the correct site location using the @code{--mod-site-location} option. This directory is treated the same way as the main module directory. Each sub-directory within it is @@ -678,7 +672,7 @@ loadable module. The module has complete access to all symbols that were present in the -dumped @emacs{}, so you do not need to link against libraries that were +dumped @value{emacs}, so you do not need to link against libraries that were linked in with the main executable. If your library uses some other extra libraries, you will need to link with those. There is nothing particularly complicated about link mode. All you need to do is make @@ -744,10 +738,10 @@ @item --mod-archdir Prints the name of the root of the architecture-dependant directory that -@emacs{} searches for architecture-dependant files. +@value{emacs} searches for architecture-dependant files. @item --mod-config -Prints the name of the configuration for which @emacs{} and @code{ellcc} +Prints the name of the configuration for which @value{emacs} and @code{ellcc} were compiled. @end table @@ -756,7 +750,7 @@ @cindex environment variables During its normal operation, @code{ellcc} uses the compiler and linker -flags that were determined at the time @emacs{} was configured. In +flags that were determined at the time @value{emacs} was configured. In certain rare circumstances you may wish to over-ride the flags passed to the compiler or linker, and you can do so using environment variables. The table below lists all of the environment variables that @code{ellcc} @@ -798,8 +792,8 @@ @cindex @code{ELLMAKEDOC} Sets the name of the @file{make-docfile} program to use. Usually @code{ellcc} will use the version that was compiled and installed with -@emacs{}, but this option allows you to specify an alternative path. -Used during the compile phase of @emacs{} itself. +@value{emacs}, but this option allows you to specify an alternative path. +Used during the compile phase of @value{emacs} itself. @end table @node Defining Functions, Defining Variables, Using ellcc, Top @@ -813,7 +807,7 @@ function and the way it appears to Lisp, which is a @dfn{subroutine}, or simply a @dfn{subr}. A Lisp subr is also known as a Lisp primitive, but that term applies less to dynamic modules. @xref{Writing Lisp -Primitives,,,internals,@emacs{} Internals Manual}, for details on how to +Primitives,,,internals,@value{emacs} Internals Manual}, for details on how to declare functions. You should familiarize yourself with the instructions there. The format of the function declaration is identical in modules. @@ -822,14 +816,14 @@ the documentation as a C comment. During the build process, a program called @file{make-docfile} is run, which will extract all of these comments, build up a single large documentation file, and will store -pointers to the start of each documentation entry in the dumped @emacs{}. +pointers to the start of each documentation entry in the dumped @value{emacs}. This, of course, will not work for dynamic modules, as they are loaded -long after @emacs{} has been dumped. For this reason, we require a +long after @value{emacs} has been dumped. For this reason, we require a special means for adding documentation for new subrs. This is what the macro @code{CDOCSUBR} is used for, and this is used extensively during @code{ellcc} initialization mode. - When using @code{DEFUN} in normal @emacs{} C code, the sixth + When using @code{DEFUN} in normal @value{emacs} C code, the sixth ``parameter'' is a C comment which documents the function. For a dynamic module, we of course need to convert the C comment to a usable string, and we need to set the documentation pointer of the subr to this @@ -850,12 +844,12 @@ @cindex functions, defining Although the full syntax of a function declaration is discussed in the -@emacs{} internals manual in greater depth, what follows is a brief +@value{emacs} internals manual in greater depth, what follows is a brief description of how to define and implement a new Lisp primitive in a module. This is done using the @code{DEFUN} macro. Here is a small example: -@example @code +@example @cartouche DEFUN ("my-function", Fmy_function, 1, 1, "FFile name: ", /* Sample Emacs primitive function. @@ -886,7 +880,7 @@ arguments are passed to the function. Next is the @code{interactive} definition. If this function is meant to be run by a user interactively, then you need to specify the argument types and prompts -in this string. Please consult the @emacs{} Lisp manual for more +in this string. Please consult the @value{emacs} Lisp manual for more details. Next comes a C comment that is the documentation for this function. This comment @strong{must} exist. Last comes the list of function argument names, if any. @@ -908,13 +902,13 @@ @code{DEFUN}. Using the example function above, you would insert the following code in the @code{syms_of_module} function: -@example @code +@example @cartouche DEFSUBR(Fmy_function); @end cartouche @end example -This call will instruct @emacs{} to make the function visible to the Lisp +This call will instruct @value{emacs} to make the function visible to the Lisp reader and will prepare for the insertion of the documentation into the right place. Once this is done, the user can call the Lisp function @code{my-function}, if it was defined as an interactive @@ -922,7 +916,7 @@ Thats all there is to defining and announcing new functions. The rules for what goes inside the functions, and how to write good modules, is -beyond the scope of this document. Please consult the @emacs{} +beyond the scope of this document. Please consult the @value{emacs} internals manual for more details. @node Defining Variables, Index, Defining Functions, Top @@ -941,7 +935,7 @@ common to also provide variables which can be used to control the behaviour of the function, or store the results of the function being executed. The actual C variable types are the same for modules -and internal @emacs{} primitives, and the declaration of the variables +and internal @value{emacs} primitives, and the declaration of the variables is identical. @xref{Adding Global Lisp Variables,,,internals,XEmacs Internals Manual}, @@ -949,27 +943,27 @@ Once your variables are defined, you need to initialize them and make the Lisp reader aware of them. This is done in the -@code{vars_of_module} initialization function using special @emacs{} +@code{vars_of_module} initialization function using special @value{emacs} macros such as @code{DEFVAR_LISP}, @code{DEFVAR_BOOL}, @code{DEFVAR_INT} etc. The best way to see how to use these macros is to look at existing source code, or read the internals manual. - One @emph{very} important difference between @emacs{} variables and + One @emph{very} important difference between @value{emacs} variables and module variables is how you use pure space. Simply put, you -@strong{never} use pure space in @emacs{} modules. The pure space +@strong{never} use pure space in @value{emacs} modules. The pure space storage is of a limited size, and is initialized propperly during the -dumping of @emacs{}. Because variables are being added dynamically to -an already running @emacs{} when you load a module, you cannot use pure +dumping of @value{emacs}. Because variables are being added dynamically to +an already running @value{emacs} when you load a module, you cannot use pure space. Be warned: @strong{do not use pure space in modules. Repeat, do not use pure space in modules.} Once again, to remove all doubts: @strong{DO NOT USE PURE SPACE IN MODULES!!!} Below is a small example which declares and initializes two variables. You will note that this code takes into account the fact -that this module may very well be compiled into @emacs{} itself. This +that this module may very well be compiled into @value{emacs} itself. This is a prudent thing to do. -@example @code +@example @cartouche Lisp_Object Vsample_string; int sample_boolean; diff -r f4aeb21a5bad -r 74fd4e045ea6 man/external-widget.texi --- a/man/external-widget.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/external-widget.texi Mon Aug 13 11:13:30 2007 +0200 @@ -1,6 +1,13 @@ \input texinfo @c -*-texinfo-*- @setfilename ../info/external-widget.info +@ifinfo +@dircategory XEmacs Editor +@direntry +* External Widget: (external-widget) External Client Widget. +@end direntry +@end ifinfo + @node Top, Using an External Client Widget,, (dir) An @dfn{external client widget} is a widget that is part of another program diff -r f4aeb21a5bad -r 74fd4e045ea6 man/info-stnd.texi --- a/man/info-stnd.texi Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1373 +0,0 @@ -\input texinfo @c -*-texinfo-*- -@comment %**start of header -@setfilename ../info/info-stnd.info -@settitle GNU Info -@set InfoProgVer 2.11 -@paragraphindent none -@footnotestyle end -@synindex vr cp -@synindex fn cp -@synindex ky cp -@comment %**end of header -@comment $Id: info-stnd.texi,v 1.3 1998/06/30 06:35:28 steve Exp $ - -@dircategory Texinfo documentation system -@direntry -* info program: (info-stnd). Standalone Info-reading program. -@end direntry - -@ifinfo -This file documents GNU Info, a program for viewing the on-line formatted -versions of Texinfo files. This documentation is different from the -documentation for the Info reader that is part of GNU Emacs. If you do -not know how to use Info, but have a working Info reader, you should -read that documentation first. - -Copyright @copyright{} 1992, 93, 96, 97 Free Software Foundation, Inc. - -Permission is granted to make and distribute verbatim copies of this -manual provided the copyright notice and this permission notice are -preserved on all copies. - -@ignore -Permission is granted to process this file through TeX and print the -results, provided the printed document carries a copying permission -notice identical to this one except for the removal of this paragraph -(this paragraph not being relevant to the printed manual). -@end ignore - -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided also that the -sections entitled ``Copying'' and ``GNU General Public License'' are -included exactly as in the original, and provided that the entire -resulting derived work is distributed under the terms of a permission -notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that this permission notice may be stated in a translation -approved by the Free Software Foundation. -@end ifinfo - -@titlepage -@title GNU Info User's Guide -@subtitle For GNU Info version @value{InfoProgVer} -@author Brian J. Fox (bfox@@ai.mit.edu) -@page -@vskip 0pt plus 1filll -Copyright @copyright{} 1992, 1993, 1997 Free Software Foundation - -Permission is granted to make and distribute verbatim copies of this -manual provided the copyright notice and this permission notice are -preserved on all copies. - -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided also that the -sections entitled ``Copying'' and ``GNU General Public License'' are -included exactly as in the original, and provided that the entire -resulting derived work is distributed under the terms of a permission -notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that this permission notice may be stated in a translation -approved by the Free Software Foundation. -@end titlepage - -@ifinfo -@node Top, What is Info, , (dir) -@top The GNU Info Program - -This file documents GNU Info, a program for viewing the on-line -formatted versions of Texinfo files, version @value{InfoProgVer}. This -documentation is different from the documentation for the Info reader -that is part of GNU Emacs. -@end ifinfo - -@menu -* What is Info:: -* Options:: Options you can pass on the command line. -* Cursor Commands:: Commands which move the cursor within a node. -* Scrolling Commands:: Commands for moving the node around - in a window. -* Node Commands:: Commands for selecting a new node. -* Searching Commands:: Commands for searching an Info file. -* Xref Commands:: Commands for selecting cross references. -* Window Commands:: Commands which manipulate multiple windows. -* Printing Nodes:: How to print out the contents of a node. -* Miscellaneous Commands:: A few commands that defy categories. -* Variables:: How to change the default behavior of Info. -* GNU Info Global Index:: Global index containing keystrokes, - command names, variable names, - and general concepts. -@end menu - -@node What is Info, Options, Top, Top -@chapter What is Info? - -@iftex -This file documents GNU Info, a program for viewing the on-line formatted -versions of Texinfo files, version @value{InfoProgVer}. -@end iftex - -@dfn{Info} is a program which is used to view Info files on an ASCII -terminal. @dfn{Info files} are the result of processing Texinfo files -with the program @code{makeinfo} or with one of the Emacs commands, such -as @code{M-x texinfo-format-buffer}. Texinfo itself is a documentation -system that uses a single source file to produce both on-line -information and printed output. You can typeset and print the -files that you read in Info.@refill - -@node Options, Cursor Commands, What is Info, Top -@chapter Command Line Options -@cindex command line options -@cindex arguments, command line - -GNU Info accepts several options to control the initial node being -viewed, and to specify which directories to search for Info files. Here -is a template showing an invocation of GNU Info from the shell: - -@example -info [--@var{option-name} @var{option-value}] @var{menu-item}@dots{} -@end example - -The following @var{option-names} are available when invoking Info from -the shell: - -@table @code -@cindex directory path -@item --directory @var{directory-path} -@itemx -d @var{directory-path} -Add @var{directory-path} to the list of directory paths searched when -Info needs to find a file. You may issue @code{--directory} multiple -times; once for each directory which contains Info files. -Alternatively, you may specify a value for the environment variable -@code{INFOPATH}; if @code{--directory} is not given, the value of -@code{INFOPATH} is used. The value of @code{INFOPATH} is a colon -separated list of directory names. If you do not supply @code{INFOPATH} -or @code{--directory-path}, Info uses a default path. - -@item --file @var{filename} -@itemx -f @var{filename} -@cindex Info file, selecting -Specify a particular Info file to visit. By default, Info visits -the file @code{dir}; if you use this option, Info will start with -@code{(@var{filename})Top} as the first file and node. - -@item --index-search @var{string} -@cindex index search, selecting -@cindex online help, using Info as -Go to the index entry @var{string} in the Info file specified with -@samp{--file}. If no such entry, print @samp{no entries found} and exit -with nonzero status. This can used from another program as a way to -provide online help. - -@item --node @var{nodename} -@itemx -n @var{nodename} -@cindex node, selecting -Specify a particular node to visit in the initial file that Info -loads. This is especially useful in conjunction with -@code{--file}@footnote{Of course, you can specify both the file and node -in a @code{--node} command; but don't forget to escape the open and -close parentheses from the shell as in: @code{info --node -"(emacs)Buffers"}}. You may specify @code{--node} multiple times; for -an interactive Info, each @var{nodename} is visited in its own window, -for a non-interactive Info (such as when @code{--output} is given) each -@var{nodename} is processed sequentially. - -@item --output @var{filename} -@itemx -o @var{filename} -@cindex file, outputting to -@cindex outputting to a file -Specify @var{filename} as the name of a file to which to direct output. -Each node that Info visits will be output to @var{filename} instead of -interactively viewed. A value of @code{-} for @var{filename} specifies -the standard output. - -@item --subnodes -@cindex @code{--subnodes}, command line option -This option only has meaning when given in conjunction with -@code{--output}. It means to recursively output the nodes appearing in -the menus of each node being output. Menu items which resolve to -external Info files are not output, and neither are menu items which are -members of an index. Each node is only output once. - -@item --help -@itemx -h -Produces a relatively brief description of the available Info options. - -@item --version -@cindex version information -Prints the version information of Info and exits. - -@item @var{menu-item} -@cindex menu, following -Info treats its remaining arguments as the names of menu items. The -first argument is a menu item in the initial node visited, while -the second argument is a menu item in the first argument's node. -You can easily move to the node of your choice by specifying the menu -names which describe the path to that node. For example, - -@example -info emacs buffers -@end example - -@noindent -first selects the menu item @samp{Emacs} in the node @samp{(dir)Top}, -and then selects the menu item @samp{Buffers} in the node -@samp{(emacs)Top}. -@end table - -@node Cursor Commands, Scrolling Commands, Options, Top -@chapter Moving the Cursor -@cindex cursor, moving - -Many people find that reading screens of text page by page is made -easier when one is able to indicate particular pieces of text with some -kind of pointing device. Since this is the case, GNU Info (both the -Emacs and standalone versions) have several commands which allow you to -move the cursor about the screen. The notation used in this manual to -describe keystrokes is identical to the notation used within the Emacs -manual, and the GNU Readline manual. @xref{Characters, , Character -Conventions, emacs, the GNU Emacs Manual}, if you are unfamiliar with the -notation. - -The following table lists the basic cursor movement commands in Info. -Each entry consists of the key sequence you should type to execute the -cursor movement, the @code{M-x}@footnote{@code{M-x} is also a command; it -invokes @code{execute-extended-command}. @xref{M-x, , Executing an -extended command, emacs, the GNU Emacs Manual}, for more detailed -information.} command name (displayed in parentheses), and a short -description of what the command does. All of the cursor motion commands -can take an @dfn{numeric} argument (@pxref{Miscellaneous Commands, -@code{universal-argument}}), to find out how to supply them. With a -numeric argument, the motion commands are simply executed that -many times; for example, a numeric argument of 4 given to -@code{next-line} causes the cursor to move down 4 lines. With a -negative numeric argument, the motion is reversed; an argument of -4 -given to the @code{next-line} command would cause the cursor to move -@emph{up} 4 lines. - -@table @asis -@item @code{C-n} (@code{next-line}) -@kindex C-n -@findex next-line -Move the cursor down to the next line. - -@item @code{C-p} (@code{prev-line}) -@kindex C-p -@findex prev-line -Move the cursor up to the previous line. - -@item @code{C-a} (@code{beginning-of-line}) -@kindex C-a, in Info windows -@findex beginning-of-line -Move the cursor to the start of the current line. - -@item @code{C-e} (@code{end-of-line}) -@kindex C-e, in Info windows -@findex end-of-line -Move the cursor to the end of the current line. - -@item @code{C-f} (@code{forward-char}) -@kindex C-f, in Info windows -@findex forward-char -Move the cursor forward a character. - -@item @code{C-b} (@code{backward-char}) -@kindex C-b, in Info windows -@findex backward-char -Move the cursor backward a character. - -@item @code{M-f} (@code{forward-word}) -@kindex M-f, in Info windows -@findex forward-word -Move the cursor forward a word. - -@item @code{M-b} (@code{backward-word}) -@kindex M-b, in Info windows -@findex backward-word -Move the cursor backward a word. - -@item @code{M-<} (@code{beginning-of-node}) -@itemx @code{b} -@kindex b, in Info windows -@kindex M-< -@findex beginning-of-node -Move the cursor to the start of the current node. - -@item @code{M->} (@code{end-of-node}) -@kindex M-> -@findex end-of-node -Move the cursor to the end of the current node. - -@item @code{M-r} (@code{move-to-window-line}) -@kindex M-r -@findex move-to-window-line -Move the cursor to a specific line of the window. Without a numeric -argument, @code{M-r} moves the cursor to the start of the line in the -center of the window. With a numeric argument of @var{n}, @code{M-r} -moves the cursor to the start of the @var{n}th line in the window. -@end table - -@node Scrolling Commands, Node Commands, Cursor Commands, Top -@chapter Moving Text Within a Window -@cindex scrolling - -Sometimes you are looking at a screenful of text, and only part of the -current paragraph you are reading is visible on the screen. The -commands detailed in this section are used to shift which part of the -current node is visible on the screen. - -@table @asis -@item @code{SPC} (@code{scroll-forward}) -@itemx @code{C-v} -@kindex SPC, in Info windows -@kindex C-v -@findex scroll-forward -Shift the text in this window up. That is, show more of the node which -is currently below the bottom of the window. With a numeric argument, -show that many more lines at the bottom of the window; a numeric -argument of 4 would shift all of the text in the window up 4 lines -(discarding the top 4 lines), and show you four new lines at the bottom -of the window. Without a numeric argument, @key{SPC} takes the bottom -two lines of the window and places them at the top of the window, -redisplaying almost a completely new screenful of lines. - -@item @code{DEL} (@code{scroll-backward}) -@itemx @code{M-v} -@kindex DEL, in Info windows -@kindex M-v -@findex scroll-backward -Shift the text in this window down. The inverse of -@code{scroll-forward}. -@end table - -@cindex scrolling through node structure -The @code{scroll-forward} and @code{scroll-backward} commands can also -move forward and backward through the node structure of the file. If -you press @key{SPC} while viewing the end of a node, or @key{DEL} while -viewing the beginning of a node, what happens is controlled by the -variable @code{scroll-behavior}. @xref{Variables, -@code{scroll-behavior}}, for more information. - -@table @asis -@item @code{C-l} (@code{redraw-display}) -@kindex C-l -@findex redraw-display -Redraw the display from scratch, or shift the line containing the cursor -to a specified location. With no numeric argument, @samp{C-l} clears -the screen, and then redraws its entire contents. Given a numeric -argument of @var{n}, the line containing the cursor is shifted so that -it is on the @var{n}th line of the window. - -@item @code{C-x w} (@code{toggle-wrap}) -@kindex C-w -@findex toggle-wrap -Toggles the state of line wrapping in the current window. Normally, -lines which are longer than the screen width @dfn{wrap}, i.e., they are -continued on the next line. Lines which wrap have a @samp{\} appearing -in the rightmost column of the screen. You can cause such lines to be -terminated at the rightmost column by changing the state of line -wrapping in the window with @code{C-x w}. When a line which needs more -space than one screen width to display is displayed, a @samp{$} appears -in the rightmost column of the screen, and the remainder of the line is -invisible. -@end table - -@node Node Commands, Searching Commands, Scrolling Commands, Top -@chapter Selecting a New Node -@cindex nodes, selection of - -This section details the numerous Info commands which select a new node -to view in the current window. - -The most basic node commands are @samp{n}, @samp{p}, @samp{u}, and -@samp{l}. - -When you are viewing a node, the top line of the node contains some Info -@dfn{pointers} which describe where the next, previous, and up nodes -are. Info uses this line to move about the node structure of the file -when you use the following commands: - -@table @asis -@item @code{n} (@code{next-node}) -@kindex n -@findex next-node -Select the `Next' node. - -@item @code{p} (@code{prev-node}) -@kindex p -@findex prev-node -Select the `Prev' node. - -@item @code{u} (@code{up-node}) -@kindex u -@findex up-node -Select the `Up' node. -@end table - -You can easily select a node that you have already viewed in this window -by using the @samp{l} command -- this name stands for "last", and -actually moves through the list of already visited nodes for this -window. @samp{l} with a negative numeric argument moves forward through -the history of nodes for this window, so you can quickly step between -two adjacent (in viewing history) nodes. - -@table @asis -@item @code{l} (@code{history-node}) -@kindex l -@findex history-node -Select the most recently selected node in this window. -@end table - -Two additional commands make it easy to select the most commonly -selected nodes; they are @samp{t} and @samp{d}. - -@table @asis -@item @code{t} (@code{top-node}) -@kindex t -@findex top-node -Select the node @samp{Top} in the current Info file. - -@item @code{d} (@code{dir-node}) -@kindex d -@findex dir-node -Select the directory node (i.e., the node @samp{(dir)}). -@end table - -Here are some other commands which immediately result in the selection -of a different node in the current window: - -@table @asis -@item @code{<} (@code{first-node}) -@kindex < -@findex first-node -Selects the first node which appears in this file. This node is most -often @samp{Top}, but it does not have to be. - -@item @code{>} (@code{last-node}) -@kindex > -@findex last-node -Select the last node which appears in this file. - -@item @code{]} (@code{global-next-node}) -@kindex ] -@findex global-next-node -Move forward or down through node structure. If the node that you are -currently viewing has a @samp{Next} pointer, that node is selected. -Otherwise, if this node has a menu, the first menu item is selected. If -there is no @samp{Next} and no menu, the same process is tried with the -@samp{Up} node of this node. - -@item @code{[} (@code{global-prev-node}) -@kindex [ -@findex global-prev-node -Move backward or up through node structure. If the node that you are -currently viewing has a @samp{Prev} pointer, that node is selected. -Otherwise, if the node has an @samp{Up} pointer, that node is selected, -and if it has a menu, the last item in the menu is selected. -@end table - -You can get the same behavior as @code{global-next-node} and -@code{global-prev-node} while simply scrolling through the file with -@key{SPC} and @key{DEL}; @xref{Variables, @code{scroll-behavior}}, for -more information. - -@table @asis -@item @code{g} (@code{goto-node}) -@kindex g -@findex goto-node -Read the name of a node and select it. No completion is done while -reading the node name, since the desired node may reside in a separate -file. The node must be typed exactly as it appears in the Info file. A -file name may be included as with any node specification, for example - -@example -@code{g(emacs)Buffers} -@end example - -finds the node @samp{Buffers} in the Info file @file{emacs}. - -@item @code{C-x k} (@code{kill-node}) -@kindex C-x k -@findex kill-node -Kill a node. The node name is prompted for in the echo area, with a -default of the current node. @dfn{Killing} a node means that Info tries -hard to forget about it, removing it from the list of history nodes kept -for the window where that node is found. Another node is selected in -the window which contained the killed node. - -@item @code{C-x C-f} (@code{view-file}) -@kindex C-x C-f -@findex view-file -Read the name of a file and selects the entire file. The command -@example -@code{C-x C-f @var{filename}} -@end example -is equivalent to typing -@example -@code{g(@var{filename})*} -@end example - -@item @code{C-x C-b} (@code{list-visited-nodes}) -@kindex C-x C-b -@findex list-visited-nodes -Make a window containing a menu of all of the currently visited nodes. -This window becomes the selected window, and you may use the standard -Info commands within it. - -@item @code{C-x b} (@code{select-visited-node}) -@kindex C-x b -@findex select-visited-node -Select a node which has been previously visited in a visible window. -This is similar to @samp{C-x C-b} followed by @samp{m}, but no window is -created. -@end table - -@node Searching Commands, Xref Commands, Node Commands, Top -@chapter Searching an Info File -@cindex searching - -GNU Info allows you to search for a sequence of characters throughout an -entire Info file, search through the indices of an Info file, or find -areas within an Info file which discuss a particular topic. - -@table @asis -@item @code{s} (@code{search}) -@kindex s -@findex search -Read a string in the echo area and search for it. - -@item @code{C-s} (@code{isearch-forward}) -@kindex C-s -@findex isearch-forward -Interactively search forward through the Info file for a string as you -type it. - -@item @code{C-r} (@code{isearch-backward}) -@kindex C-r -@findex isearch-backward -Interactively search backward through the Info file for a string as -you type it. - -@item @code{i} (@code{index-search}) -@kindex i -@findex index-search -Look up a string in the indices for this Info file, and select a node -where the found index entry points to. - -@item @code{,} (@code{next-index-match}) -@kindex , -@findex next-index-match -Move to the node containing the next matching index item from the last -@samp{i} command. -@end table - -The most basic searching command is @samp{s} (@code{search}). The -@samp{s} command prompts you for a string in the echo area, and then -searches the remainder of the Info file for an occurrence of that string. -If the string is found, the node containing it is selected, and the -cursor is left positioned at the start of the found string. Subsequent -@samp{s} commands show you the default search string within @samp{[} and -@samp{]}; pressing @key{RET} instead of typing a new string will use the -default search string. - -@dfn{Incremental searching} is similar to basic searching, but the -string is looked up while you are typing it, instead of waiting until -the entire search string has been specified. - -@node Xref Commands, Window Commands, Searching Commands, Top -@chapter Selecting Cross References - -We have already discussed the @samp{Next}, @samp{Prev}, and @samp{Up} -pointers which appear at the top of a node. In addition to these -pointers, a node may contain other pointers which refer you to a -different node, perhaps in another Info file. Such pointers are called -@dfn{cross references}, or @dfn{xrefs} for short. - -@menu -* Parts of an Xref:: What a cross reference is made of. -* Selecting Xrefs:: Commands for selecting menu or note items. -@end menu - -@node Parts of an Xref, Selecting Xrefs, , Xref Commands -@section Parts of an Xref - -Cross references have two major parts: the first part is called the -@dfn{label}; it is the name that you can use to refer to the cross -reference, and the second is the @dfn{target}; it is the full name of -the node that the cross reference points to. - -The target is separated from the label by a colon @samp{:}; first the -label appears, and then the target. For example, in the sample menu -cross reference below, the single colon separates the label from the -target. - -@example -* Foo Label: Foo Target. More information about Foo. -@end example - -Note the @samp{.} which ends the name of the target. The @samp{.} is -not part of the target; it serves only to let Info know where the target -name ends. - -A shorthand way of specifying references allows two adjacent colons to -stand for a target name which is the same as the label name: - -@example -* Foo Commands:: Commands pertaining to Foo. -@end example - -In the above example, the name of the target is the same as the name of -the label, in this case @code{Foo Commands}. - -You will normally see two types of cross reference while viewing nodes: -@dfn{menu} references, and @dfn{note} references. Menu references -appear within a node's menu; they begin with a @samp{*} at the beginning -of a line, and continue with a label, a target, and a comment which -describes what the contents of the node pointed to contains. - -Note references appear within the body of the node text; they begin with -@code{*Note}, and continue with a label and a target. - -Like @samp{Next}, @samp{Prev}, and @samp{Up} pointers, cross references -can point to any valid node. They are used to refer you to a place -where more detailed information can be found on a particular subject. -Here is a cross reference which points to a node within the Texinfo -documentation: @xref{xref, , Writing an Xref, texinfo, the Texinfo -Manual}, for more information on creating your own texinfo cross -references. - -@node Selecting Xrefs, , Parts of an Xref, Xref Commands -@section Selecting Xrefs - -The following table lists the Info commands which operate on menu items. - -@table @asis -@item @code{1} (@code{menu-digit}) -@itemx @code{2} @dots{} @code{9} -@cindex 1 @dots{} 9, in Info windows -@kindex 1 @dots{} 9, in Info windows -@findex menu-digit -Within an Info window, pressing a single digit, (such as @samp{1}), -selects that menu item, and places its node in the current window. -For convenience, there is one exception; pressing @samp{0} selects the -@emph{last} item in the node's menu. - -@item @code{0} (@code{last-menu-item}) -@kindex 0, in Info windows -@findex last-menu-item -Select the last item in the current node's menu. - -@item @code{m} (@code{menu-item}) -@kindex m -@findex menu-item -Reads the name of a menu item in the echo area and selects its node. -Completion is available while reading the menu label. - -@item @code{M-x find-menu} -@findex find-menu -Move the cursor to the start of this node's menu. -@end table - -This table lists the Info commands which operate on note cross references. - -@table @asis -@item @code{f} (@code{xref-item}) -@itemx @code{r} -@kindex f -@kindex r -@findex xref-item -Reads the name of a note cross reference in the echo area and selects -its node. Completion is available while reading the cross reference -label. -@end table - -Finally, the next few commands operate on menu or note references alike: - -@table @asis -@item @code{TAB} (@code{move-to-next-xref}) -@kindex TAB, in Info windows -@findex move-to-next-xref -Move the cursor to the start of the next nearest menu item or note -reference in this node. You can then use @key{RET} -(@code{select-reference-this-line}) to select the menu or note reference. - -@item @code{M-TAB} (@code{move-to-prev-xref}) -@kindex M-TAB, in Info windows -@findex move-to-prev-xref -Move the cursor the start of the nearest previous menu item or note -reference in this node. - -@item @code{RET} (@code{select-reference-this-line}) -@kindex RET, in Info windows -@findex select-reference-this-line -Select the menu item or note reference appearing on this line. -@end table - -@node Window Commands, Printing Nodes, Xref Commands, Top -@chapter Manipulating Multiple Windows -@cindex windows, manipulating - -A @dfn{window} is a place to show the text of a node. Windows have a -view area where the text of the node is displayed, and an associated -@dfn{mode line}, which briefly describes the node being viewed. - -GNU Info supports multiple windows appearing in a single screen; each -window is separated from the next by its modeline. At any time, there -is only one @dfn{active} window, that is, the window in which the cursor -appears. There are commands available for creating windows, changing -the size of windows, selecting which window is active, and for deleting -windows. - -@menu -* The Mode Line:: What appears in the mode line? -* Basic Windows:: Manipulating windows in Info. -* The Echo Area:: Used for displaying errors and reading input. -@end menu - -@node The Mode Line, Basic Windows, , Window Commands -@section The Mode Line - -A @dfn{mode line} is a line of inverse video which appears at the bottom -of an Info window. It describes the contents of the window just above -it; this information includes the name of the file and node appearing in -that window, the number of screen lines it takes to display the node, -and the percentage of text that is above the top of the window. It can -also tell you if the indirect tags table for this Info file needs to be -updated, and whether or not the Info file was compressed when stored on -disk. - -Here is a sample mode line for a window containing an uncompressed file -named @file{dir}, showing the node @samp{Top}. - -@example -@group ------Info: (dir)Top, 40 lines --Top--------------------------------------- - ^^ ^ ^^^ ^^ - (file)Node #lines where -@end group -@end example - -When a node comes from a file which is compressed on disk, this is -indicated in the mode line with two small @samp{z}'s. In addition, if -the Info file containing the node has been split into subfiles, the name -of the subfile containing the node appears in the modeline as well: - -@example ---zz-Info: (emacs)Top, 291 lines --Top-- Subfile: emacs-1.Z--------------- -@end example - -When Info makes a node internally, such that there is no corresponding -info file on disk, the name of the node is surrounded by asterisks -(@samp{*}). The name itself tells you what the contents of the window -are; the sample mode line below shows an internally constructed node -showing possible completions: - -@example ------Info: *Completions*, 7 lines --All----------------------------------- -@end example - -@node Basic Windows, The Echo Area, The Mode Line, Window Commands -@section Window Commands - -It can be convenient to view more than one node at a time. To allow -this, Info can display more than one @dfn{window}. Each window has its -own mode line (@pxref{The Mode Line}) and history of nodes viewed in that -window (@pxref{Node Commands, , @code{history-node}}). - -@table @asis -@item @code{C-x o} (@code{next-window}) -@cindex windows, selecting -@kindex C-x o -@findex next-window -Select the next window on the screen. Note that the echo area can only be -selected if it is already in use, and you have left it temporarily. -Normally, @samp{C-x o} simply moves the cursor into the next window on -the screen, or if you are already within the last window, into the first -window on the screen. Given a numeric argument, @samp{C-x o} moves over -that many windows. A negative argument causes @samp{C-x o} to select -the previous window on the screen. - -@item @code{M-x prev-window} -@findex prev-window -Select the previous window on the screen. This is identical to -@samp{C-x o} with a negative argument. - -@item @code{C-x 2} (@code{split-window}) -@cindex windows, creating -@kindex C-x 2 -@findex split-window -Split the current window into two windows, both showing the same node. -Each window is one half the size of the original window, and the cursor -remains in the original window. The variable @code{automatic-tiling} -can cause all of the windows on the screen to be resized for you -automatically, please @pxref{Variables, , automatic-tiling} for more -information. - -@item @code{C-x 0} (@code{delete-window}) -@cindex windows, deleting -@kindex C-x 0 -@findex delete-window -Delete the current window from the screen. If you have made too many -windows and your screen appears cluttered, this is the way to get rid of -some of them. - -@item @code{C-x 1} (@code{keep-one-window}) -@kindex C-x 1 -@findex keep-one-window -Delete all of the windows excepting the current one. - -@item @code{ESC C-v} (@code{scroll-other-window}) -@kindex ESC C-v, in Info windows -@findex scroll-other-window -Scroll the other window, in the same fashion that @samp{C-v} might -scroll the current window. Given a negative argument, scroll the -"other" window backward. - -@item @code{C-x ^} (@code{grow-window}) -@kindex C-x ^ -@findex grow-window -Grow (or shrink) the current window. Given a numeric argument, grow -the current window that many lines; with a negative numeric argument, -shrink the window instead. - -@item @code{C-x t} (@code{tile-windows}) -@cindex tiling -@kindex C-x t -@findex tile-windows -Divide the available screen space among all of the visible windows. -Each window is given an equal portion of the screen in which to display -its contents. The variable @code{automatic-tiling} can cause -@code{tile-windows} to be called when a window is created or deleted. -@xref{Variables, , @code{automatic-tiling}}. -@end table - -@node The Echo Area, , Basic Windows, Window Commands -@section The Echo Area -@cindex echo area - -The @dfn{echo area} is a one line window which appears at the bottom of -the screen. It is used to display informative or error messages, and to -read lines of input from you when that is necessary. Almost all of the -commands available in the echo area are identical to their Emacs -counterparts, so please refer to that documentation for greater depth of -discussion on the concepts of editing a line of text. The following -table briefly lists the commands that are available while input is being -read in the echo area: - -@table @asis -@item @code{C-f} (@code{echo-area-forward}) -@kindex C-f, in the echo area -@findex echo-area-forward -Move forward a character. - -@item @code{C-b} (@code{echo-area-backward}) -@kindex C-b, in the echo area -@findex echo-area-backward -Move backward a character. - -@item @code{C-a} (@code{echo-area-beg-of-line}) -@kindex C-a, in the echo area -@findex echo-area-beg-of-line -Move to the start of the input line. - -@item @code{C-e} (@code{echo-area-end-of-line}) -@kindex C-e, in the echo area -@findex echo-area-end-of-line -Move to the end of the input line. - -@item @code{M-f} (@code{echo-area-forward-word}) -@kindex M-f, in the echo area -@findex echo-area-forward-word -Move forward a word. - -@item @code{M-b} (@code{echo-area-backward-word}) -@kindex M-b, in the echo area -@findex echo-area-backward-word -Move backward a word. - -@item @code{C-d} (@code{echo-area-delete}) -@kindex C-d, in the echo area -@findex echo-area-delete -Delete the character under the cursor. - -@item @code{DEL} (@code{echo-area-rubout}) -@kindex DEL, in the echo area -@findex echo-area-rubout -Delete the character behind the cursor. - -@item @code{C-g} (@code{echo-area-abort}) -@kindex C-g, in the echo area -@findex echo-area-abort -Cancel or quit the current operation. If completion is being read, -@samp{C-g} discards the text of the input line which does not match any -completion. If the input line is empty, @samp{C-g} aborts the calling -function. - -@item @code{RET} (@code{echo-area-newline}) -@kindex RET, in the echo area -@findex echo-area-newline -Accept (or forces completion of) the current input line. - -@item @code{C-q} (@code{echo-area-quoted-insert}) -@kindex C-q, in the echo area -@findex echo-area-quoted-insert -Insert the next character verbatim. This is how you can insert control -characters into a search string, for example. - -@item @var{printing character} (@code{echo-area-insert}) -@kindex printing characters, in the echo area -@findex echo-area-insert -Insert the character. - -@item @code{M-TAB} (@code{echo-area-tab-insert}) -@kindex M-TAB, in the echo area -@findex echo-area-tab-insert -Insert a TAB character. - -@item @code{C-t} (@code{echo-area-transpose-chars}) -@kindex C-t, in the echo area -@findex echo-area-transpose-chars -Transpose the characters at the cursor. -@end table - -The next group of commands deal with @dfn{killing}, and @dfn{yanking} -text. For an in depth discussion of killing and yanking, -@pxref{Killing, , Killing and Deleting, emacs, the GNU Emacs Manual} - -@table @asis -@item @code{M-d} (@code{echo-area-kill-word}) -@kindex M-d, in the echo area -@findex echo-area-kill-word -Kill the word following the cursor. - -@item @code{M-DEL} (@code{echo-area-backward-kill-word}) -@kindex M-DEL, in the echo area -@findex echo-area-backward-kill-word -Kill the word preceding the cursor. - -@item @code{C-k} (@code{echo-area-kill-line}) -@kindex C-k, in the echo area -@findex echo-area-kill-line -Kill the text from the cursor to the end of the line. - -@item @code{C-x DEL} (@code{echo-area-backward-kill-line}) -@kindex C-x DEL, in the echo area -@findex echo-area-backward-kill-line -Kill the text from the cursor to the beginning of the line. - -@item @code{C-y} (@code{echo-area-yank}) -@kindex C-y, in the echo area -@findex echo-area-yank -Yank back the contents of the last kill. - -@item @code{M-y} (@code{echo-area-yank-pop}) -@kindex M-y, in the echo area -@findex echo-area-yank-pop -Yank back a previous kill, removing the last yanked text first. -@end table - -Sometimes when reading input in the echo area, the command that needed -input will only accept one of a list of several choices. The choices -represent the @dfn{possible completions}, and you must respond with one -of them. Since there are a limited number of responses you can make, -Info allows you to abbreviate what you type, only typing as much of the -response as is necessary to uniquely identify it. In addition, you can -request Info to fill in as much of the response as is possible; this -is called @dfn{completion}. - -The following commands are available when completing in the echo area: - -@table @asis -@item @code{TAB} (@code{echo-area-complete}) -@itemx @code{SPC} -@kindex TAB, in the echo area -@kindex SPC, in the echo area -@findex echo-area-complete -Insert as much of a completion as is possible. - -@item @code{?} (@code{echo-area-possible-completions}) -@kindex ?, in the echo area -@findex echo-area-possible-completions -Display a window containing a list of the possible completions of what -you have typed so far. For example, if the available choices are: - -@example -@group -bar -foliate -food -forget -@end group -@end example - -@noindent -and you have typed an @samp{f}, followed by @samp{?}, the possible -completions would contain: - -@example -@group -foliate -food -forget -@end group -@end example - -@noindent -i.e., all of the choices which begin with @samp{f}. Pressing @key{SPC} -or @key{TAB} would result in @samp{fo} appearing in the echo area, since -all of the choices which begin with @samp{f} continue with @samp{o}. -Now, typing @samp{l} followed by @samp{TAB} results in @samp{foliate} -appearing in the echo area, since that is the only choice which begins -with @samp{fol}. - -@item @code{ESC C-v} (@code{echo-area-scroll-completions-window}) -@kindex ESC C-v, in the echo area -@findex echo-area-scroll-completions-window -Scroll the completions window, if that is visible, or the "other" -window if not. -@end table - -@node Printing Nodes, Miscellaneous Commands, Window Commands, Top -@chapter Printing Out Nodes -@cindex printing - -You may wish to print out the contents of a node as a quick reference -document for later use. Info provides you with a command for doing -this. In general, we recommend that you use @TeX{} to format the -document and print sections of it, by running @code{tex} on the Texinfo -source file. - -@table @asis -@item @code{M-x print-node} -@findex print-node -@cindex INFO_PRINT_COMMAND, environment variable -Pipe the contents of the current node through the command in the -environment variable @code{INFO_PRINT_COMMAND}. If the variable does not -exist, the node is simply piped to @code{lpr}. -@end table - -@node Miscellaneous Commands, Variables, Printing Nodes, Top -@chapter Miscellaneous Commands - -GNU Info contains several commands which self-document GNU Info: - -@table @asis -@item @code{M-x describe-command} -@cindex functions, describing -@cindex commands, describing -@findex describe-command -Read the name of an Info command in the echo area and then display a -brief description of what that command does. - -@item @code{M-x describe-key} -@cindex keys, describing -@findex describe-key -Read a key sequence in the echo area, and then display the name and -documentation of the Info command that the key sequence invokes. - -@item @code{M-x describe-variable} -Read the name of a variable in the echo area and then display a brief -description of what the variable affects. - -@item @code{M-x where-is} -@findex where-is -Read the name of an Info command in the echo area, and then display -a key sequence which can be typed in order to invoke that command. - -@item @code{C-h} (@code{get-help-window}) -@itemx @code{?} -@kindex C-h -@kindex ?, in Info windows -@findex get-help-window -Create (or Move into) the window displaying @code{*Help*}, and place -a node containing a quick reference card into it. This window displays -the most concise information about GNU Info available. - -@item @code{h} (@code{get-info-help-node}) -@kindex h -@findex get-info-help-node -Try hard to visit the node @code{(info)Help}. The Info file -@file{info.texi} distributed with GNU Info contains this node. Of -course, the file must first be processed with @code{makeinfo}, and then -placed into the location of your Info directory. -@end table - -Here are the commands for creating a numeric argument: - -@table @asis -@item @code{C-u} (@code{universal-argument}) -@cindex numeric arguments -@kindex C-u -@findex universal-argument -Start (or multiply by 4) the current numeric argument. @samp{C-u} is -a good way to give a small numeric argument to cursor movement or -scrolling commands; @samp{C-u C-v} scrolls the screen 4 lines, while -@samp{C-u C-u C-n} moves the cursor down 16 lines. - -@item @code{M-1} (@code{add-digit-to-numeric-arg}) -@itemx @code{M-2} @dots{} @code{M-9} -@kindex M-1 @dots{} M-9 -@findex add-digit-to-numeric-arg -Add the digit value of the invoking key to the current numeric -argument. Once Info is reading a numeric argument, you may just type -the digits of the argument, without the Meta prefix. For example, you -might give @samp{C-l} a numeric argument of 32 by typing: - -@example -@kbd{C-u 3 2 C-l} -@end example - -@noindent -or - -@example -@kbd{M-3 2 C-l} -@end example -@end table - -@samp{C-g} is used to abort the reading of a multi-character key -sequence, to cancel lengthy operations (such as multi-file searches) and -to cancel reading input in the echo area. - -@table @asis -@item @code{C-g} (@code{abort-key}) -@cindex cancelling typeahead -@cindex cancelling the current operation -@kindex C-g, in Info windows -@findex abort-key -Cancel current operation. -@end table - -The @samp{q} command of Info simply quits running Info. - -@table @asis -@item @code{q} (@code{quit}) -@cindex quitting -@kindex q -@findex quit -Exit GNU Info. -@end table - -If the operating system tells GNU Info that the screen is 60 lines tall, -and it is actually only 40 lines tall, here is a way to tell Info that -the operating system is correct. - -@table @asis -@item @code{M-x set-screen-height} -@findex set-screen-height -@cindex screen, changing the height of -Read a height value in the echo area and set the height of the -displayed screen to that value. -@end table - -Finally, Info provides a convenient way to display footnotes which might -be associated with the current node that you are viewing: - -@table @asis -@item @code{ESC C-f} (@code{show-footnotes}) -@kindex ESC C-f -@findex show-footnotes -@cindex footnotes, displaying -Show the footnotes (if any) associated with the current node in another -window. You can have Info automatically display the footnotes -associated with a node when the node is selected by setting the variable -@code{automatic-footnotes}. @xref{Variables, , @code{automatic-footnotes}}. -@end table - -@node Variables, GNU Info Global Index, Miscellaneous Commands, Top -@chapter Manipulating Variables - -GNU Info contains several @dfn{variables} whose values are looked at by -various Info commands. You can change the values of these variables, -and thus change the behavior of Info to more closely match your -environment and Info file reading manner. - -@table @asis -@item @code{M-x set-variable} -@cindex variables, setting -@findex set-variable -Read the name of a variable, and the value for it, in the echo area and -then set the variable to that value. Completion is available when -reading the variable name; often, completion is available when reading -the value to give to the variable, but that depends on the variable -itself. If a variable does @emph{not} supply multiple choices to -complete over, it expects a numeric value. - -@item @code{M-x describe-variable} -@cindex variables, describing -@findex describe-variable -Read the name of a variable in the echo area and then display a brief -description of what the variable affects. -@end table - -Here is a list of the variables that you can set in Info. - -@table @code -@item automatic-footnotes -@vindex automatic-footnotes -When set to @code{On}, footnotes appear and disappear automatically. -This variable is @code{On} by default. When a node is selected, a -window containing the footnotes which appear in that node is created, -and the footnotes are displayed within the new window. The window that -Info creates to contain the footnotes is called @samp{*Footnotes*}. If -a node is selected which contains no footnotes, and a @samp{*Footnotes*} -window is on the screen, the @samp{*Footnotes*} window is deleted. -Footnote windows created in this fashion are not automatically tiled so -that they can use as little of the display as is possible. - -@item automatic-tiling -@vindex automatic-tiling -When set to @code{On}, creating or deleting a window resizes other -windows. This variable is @code{Off} by default. Normally, typing -@samp{C-x 2} divides the current window into two equal parts. When -@code{automatic-tiling} is set to @code{On}, all of the windows are -resized automatically, keeping an equal number of lines visible in each -window. There are exceptions to the automatic tiling; specifically, the -windows @samp{*Completions*} and @samp{*Footnotes*} are @emph{not} -resized through automatic tiling; they remain their original size. - -@item visible-bell -@vindex visible-bell -When set to @code{On}, GNU Info attempts to flash the screen instead of -ringing the bell. This variable is @code{Off} by default. Of course, -Info can only flash the screen if the terminal allows it; in the case -that the terminal does not allow it, the setting of this variable has no -effect. However, you can make Info perform quietly by setting the -@code{errors-ring-bell} variable to @code{Off}. - -@item errors-ring-bell -@vindex errors-ring-bell -When set to @code{On}, errors cause the bell to ring. The default -setting of this variable is @code{On}. - -@item gc-compressed-files -@vindex gc-compressed-files -When set to @code{On}, Info garbage collects files which had to be -uncompressed. The default value of this variable is @code{Off}. -Whenever a node is visited in Info, the Info file containing that node -is read into core, and Info reads information about the tags and nodes -contained in that file. Once the tags information is read by Info, it -is never forgotten. However, the actual text of the nodes does not need -to remain in core unless a particular Info window needs it. For -non-compressed files, the text of the nodes does not remain in core when -it is no longer in use. But de-compressing a file can be a time -consuming operation, and so Info tries hard not to do it twice. -@code{gc-compressed-files} tells Info it is okay to garbage collect the -text of the nodes of a file which was compressed on disk. - -@item show-index-match -@vindex show-index-match -When set to @code{On}, the portion of the matched search string is -highlighted in the message which explains where the matched search -string was found. The default value of this variable is @code{On}. -When Info displays the location where an index match was found, -(@pxref{Searching Commands, , @code{next-index-match}}), the portion of the -string that you had typed is highlighted by displaying it in the inverse -case from its surrounding characters. - -@item scroll-behavior -@vindex scroll-behavior -Control what happens when forward scrolling is requested at the end of -a node, or when backward scrolling is requested at the beginning of a -node. The default value for this variable is @code{Continuous}. There -are three possible values for this variable: - -@table @code -@item Continuous -Try to get the first item in this node's menu, or failing that, the -@samp{Next} node, or failing that, the @samp{Next} of the @samp{Up}. -This behavior is identical to using the @samp{]} -(@code{global-next-node}) and @samp{[} (@code{global-prev-node}) -commands. - -@item Next Only -Only try to get the @samp{Next} node. - -@item Page Only -Simply give up, changing nothing. If @code{scroll-behavior} is -@code{Page Only}, no scrolling command can change the node that is being -viewed. -@end table - -@item scroll-step -@vindex scroll-step -The number of lines to scroll when the cursor moves out of the window. -Scrolling happens automatically if the cursor has moved out of the -visible portion of the node text when it is time to display. Usually -the scrolling is done so as to put the cursor on the center line of the -current window. However, if the variable @code{scroll-step} has a -nonzero value, Info attempts to scroll the node text by that many lines; -if that is enough to bring the cursor back into the window, that is what -is done. The default value of this variable is 0, thus placing the -cursor (and the text it is attached to) in the center of the window. -Setting this variable to 1 causes a kind of "smooth scrolling" which -some people prefer. - -@item ISO-Latin -@cindex ISO Latin characters -@vindex ISO-Latin -When set to @code{On}, Info accepts and displays ISO Latin characters. -By default, Info assumes an ASCII character set. @code{ISO-Latin} tells -Info that it is running in an environment where the European standard -character set is in use, and allows you to input such characters to -Info, as well as display them. -@end table - - - -@c the following is incomplete -@ignore -@c node Info for Sys Admins -@c chapter Info for System Administrators - -This text describes some common ways of setting up an Info hierarchy -from scratch, and details the various options that are available when -installing Info. This text is designed for the person who is installing -GNU Info on the system; although users may find the information present -in this section interesting, none of it is vital to understanding how to -use GNU Info. - -@menu -* Setting the INFOPATH:: Where are my Info files kept? -* Editing the DIR node:: What goes in `DIR', and why? -* Storing Info files:: Alternate formats allow flexibility in setups. -* Using `localdir':: Building DIR on the fly. -* Example setups:: Some common ways to organize Info files. -@end menu - -@c node Setting the INFOPATH -@c section Setting the INFOPATH - -Where are my Info files kept? - -@c node Editing the DIR node -@c section Editing the DIR node - -What goes in `DIR', and why? - -@c node Storing Info files -@c section Storing Info files - -Alternate formats allow flexibility in setups. - -@c node Using `localdir' -@c section Using `localdir' - -Building DIR on the fly. - -@c node Example setups -@c section Example setups - -Some common ways to organize Info files. -@end ignore - -@node GNU Info Global Index, , Variables, Top -@appendix Global Index - -@printindex cp - -@contents -@bye diff -r f4aeb21a5bad -r 74fd4e045ea6 man/info.texi --- a/man/info.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/info.texi Mon Aug 13 11:13:30 2007 +0200 @@ -1,9 +1,9 @@ \input texinfo @c -*-texinfo-*- -@comment %**start of header +@comment %**start of header @setfilename ../info/info.info -@settitle Info 1.0 -@comment %**end of header -@comment $Id: info.texi,v 1.4 1998/06/30 06:35:28 steve Exp $ +@settitle Info +@comment %**end of header +@comment $Id: info.texi,v 1.4.2.4 2000/01/18 07:27:42 yoshiki Exp $ @dircategory Texinfo documentation system @direntry @@ -11,10 +11,10 @@ @end direntry @ifinfo -This file describes how to use Info, -the on-line, menu-driven GNU documentation system. +This file describes how to use Info, the on-line, menu-driven GNU +documentation system. -Copyright (C) 1989, 92, 96, 97 Free Software Foundation, Inc. +Copyright (C) 1989, 92, 96, 97, 98, 99 Free Software Foundation, Inc. Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice @@ -44,10 +44,9 @@ @author Brian Fox @page @vskip 0pt plus 1filll -Copyright @copyright{} 1989, 1992, 1993, 1996, 1997 Free Software +Copyright @copyright{} 1989, 92, 93, 96, 97, 98, 99 Free Software Foundation, Inc. @sp 2 - Published by the Free Software Foundation @* 59 Temple Place - Suite 330 @* Boston, MA 02111-1307, USA. @@ -67,31 +66,19 @@ by the Free Software Foundation. @end titlepage -@ifinfo -@node Top, Getting Started, , (dir) +@node Top @top Info: An Introduction -Info is a program for reading documentation, which you are using now. - -To learn how to use Info, type the command @kbd{h}. It brings you -to a programmed instruction sequence. +Info is a program for reading documentation, which you might be using +now to read this. -@c Need to make sure that `Info-help' goes to the right node, -@c which is the first node of the first chapter. (It should.) -@c (Info-find-node "info" -@c (if (< (window-height) 23) -@c "Help-Small-Screen" -@c "Help"))) - -To learn advanced Info commands, type @kbd{n} twice. This brings you to -@cite{Info for Experts}, skipping over the `Getting Started' chapter. -@end ifinfo +To learn how to use Info, type the command @kbd{h} while using the Info +program. It brings you to a programmed instruction sequence. @menu * Getting Started:: Getting started using an Info reader. * Advanced Info:: Advanced commands within Info. -* Create an Info File:: How to make your own Info file. -* The Standalone Info Program: (info-stnd.info). +* Creating an Info File:: How to make your own Info file. @end menu @node Getting Started, Advanced Info, Top, Top @@ -101,7 +88,7 @@ This first part of the Info manual describes how to get around inside of Info. The second part of the manual describes various advanced Info commands, and how to write an Info as distinct from a Texinfo -file. The third part is about how to generate Info files from +file. The third part is about how to generate Info files from Texinfo files. @iftex @@ -110,7 +97,7 @@ effective, since you must take it on faith that the commands described really do what the manual says. By all means go through this manual now that you have it; but please try going through the on-line version as -well. +well. There are two ways of looking at the online version of this manual: @@ -340,7 +327,7 @@ by a line which starts with @samp{* Menu:}. A node contains a menu if and only if it has a line in it which starts that way. The only menu you can use at any moment is the one in the node you are in. To use a -menu in any other node, you must move to that node first. +menu in any other node, you must move to that node first. After the start of the menu, each line that starts with a @samp{*} identifies one subtopic. The line usually contains a brief name @@ -427,16 +414,14 @@ not need to type the argument: you just type a Return, and it stands for the subtopic of the line you are on. -Here is a menu to give you a chance to practice. - -* Menu: The menu starts here. +Here is a menu to give you a chance to practice. This menu gives you +three ways of going to one place, Help-FOO: -This menu gives you three ways of going to one place, Help-FOO. - -* Foo: Help-FOO. A node you can visit for fun.@* -* Bar: Help-FOO. Strange! two ways to get to the same place.@* -* Help-FOO:: And yet another!@* - +@menu +* Foo: Help-FOO. A node you can visit for fun. +* Bar: Help-FOO. Strange! two ways to get to the same place. +* Help-FOO:: And yet another! +@end menu >> Now type just an @kbd{m} and see what happens: @@ -559,17 +544,16 @@ @c It is an accident of the menu updating command. @node Help-Cross, , , Help-Adv -@comment node-name, next, previous, up -@unnumberedsubsec The node reached by the cross reference in Info +@subsection The node reached by the cross reference in Info This is the node reached by the cross reference named @samp{Cross}. While this node is specifically intended to be reached by a cross -reference, most cross references lead to nodes that ``belong'' -someplace else far away in the structure of Info. So you cannot expect -the footnote to have a @samp{Next}, @samp{Previous} or @samp{Up} pointing back to -where you came from. In general, the @kbd{l} (el) command is the only -way to get back there. +reference, most cross references lead to nodes that ``belong'' someplace +else far away in the structure of Info. So you cannot expect the +footnote to have a @samp{Next}, @samp{Previous} or @samp{Up} pointing +back to where you came from. In general, the @kbd{l} (el) command is +the only way to get back there. >> Type @kbd{l} to return to the node where the cross reference was. @@ -590,15 +574,15 @@ @samp{mInfo} and Return, to get to the node about Info and see what other help is available. -@node Advanced Info, Create an Info File, Getting Started, Top -@comment node-name, next, previous, up + +@node Advanced Info @chapter Info for Experts This chapter describes various advanced Info commands, and how to write an Info as distinct from a Texinfo file. (However, in most cases, writing a Texinfo file is better, since you can use it @emph{both} to generate an Info file and to make a printed manual. @xref{Top,, Overview of -Texinfo, texinfo, Texinfo: The GNU Documentation Format}.) +Texinfo, texinfo, Texinfo}.) @menu * Expert:: Advanced Info commands: g, s, e, and 1 - 5. @@ -639,12 +623,12 @@ @key{RET}. To search for the same string again, just @kbd{s} followed by @key{RET} will do. The file's nodes are scanned in the order they are in in the file, which has no necessary relationship to the -order that they may be in in the tree structure of menus and @samp{next} pointers. -But normally the two orders are not very different. In any case, -you can always do a @kbd{b} to find out what node you have reached, if -the header is not visible (this can happen, because @kbd{s} puts your -cursor at the occurrence of the string, not at the beginning of the -node). +order that they may be in in the tree structure of menus and @samp{next} +pointers. But normally the two orders are not very different. In any +case, you can always do a @kbd{b} to find out what node you have +reached, if the header is not visible (this can happen, because @kbd{s} +puts your cursor at the occurrence of the string, not at the beginning +of the node). If you grudge the system each character of type-in it requires, you might like to use the commands @kbd{1}, @kbd{2}, @kbd{3}, @kbd{4}, ... @@ -652,9 +636,9 @@ argument. @kbd{1} goes through the first item in the current node's menu; @kbd{2} goes through the second item, etc. -If you display supports multiple fonts, and you are using Emacs' Info +If your display supports multiple fonts, and you are using Emacs' Info mode to read Info files, the @samp{*} for the fifth menu item is -underlines, and so is the @samp{*} for the ninth item; these underlines +underlined, and so is the @samp{*} for the ninth item; these underlines make it easy to see at a glance which number to use for an item. On ordinary terminals, you won't have underlining. If you need to @@ -678,12 +662,12 @@ Put that topic in the menu in the directory. @xref{Menus, Menu}. @end enumerate -Usually, the way to create the nodes is with Texinfo @pxref{Top,, Overview of -Texinfo, texinfo, Texinfo: The GNU Documentation Format}); this has the -advantage that you can also make a printed manual from them. However, -if hyou want to edit an Info file, here is how. +Usually, the way to create the nodes is with Texinfo (@pxref{Top,, +Overview of Texinfo, texinfo, Texinfo}); this has the advantage that you +can also make a printed manual from them. However, if you want to edit +an Info file, here is how. - The new node can live in an existing documentation file, or in a new +The new node can live in an existing documentation file, or in a new one. It must have a @key{^_} character before it (invisible to the user; this node has one but you cannot see it), and it ends with either a @key{^_}, a @key{^L}, or the end of file. Note: If you put in a @@ -693,12 +677,12 @@ is to put a @key{^L} @emph{right after} the @key{^_}. The @key{^_} starting a node must be followed by a newline or a -@key{^L} newline, after which comes the node's header line. The -header line must give the node's name (by which Info finds it), -and state the names of the @samp{Next}, @samp{Previous}, and @samp{Up} nodes (if -there are any). As you can see, this node's @samp{Up} node is the node -@samp{Top}, which points at all the documentation for Info. The @samp{Next} -node is @samp{Menus}. +@key{^L} newline, after which comes the node's header line. The header +line must give the node's name (by which Info finds it), and state the +names of the @samp{Next}, @samp{Previous}, and @samp{Up} nodes (if there +are any). As you can see, this node's @samp{Up} node is the node +@samp{Top}, which points at all the documentation for Info. The +@samp{Next} node is @samp{Menus}. The keywords @dfn{Node}, @dfn{Previous}, @dfn{Up}, and @dfn{Next}, may appear in any order, anywhere in the header line, but the @@ -728,10 +712,10 @@ unstructured files into nodes of the tree. The @samp{Node:} name, in which a node states its own name, must not -contain a filename, since Info when searching for a node does not -expect one to be there. The @samp{Next}, @samp{Previous} and @samp{Up} names may -contain them. In this node, since the @samp{Up} node is in the same file, -it was not necessary to use one. +contain a filename, since Info when searching for a node does not expect +one to be there. The @samp{Next}, @samp{Previous} and @samp{Up} names +may contain them. In this node, since the @samp{Up} node is in the same +file, it was not necessary to use one. Note that the nodes in this file have a file name in the header line. The file names are ignored by Info, but they serve as comments @@ -741,7 +725,7 @@ @comment node-name, next, previous, up @section How to Create Menus - Any node in the Info hierarchy may have a @dfn{menu}---a list of subnodes. + Any node in the Info hierarchy may have a @dfn{menu}---a list of subnodes. The @kbd{m} command searches the current node's menu for the topic which it reads from the terminal. @@ -766,11 +750,11 @@ the beginning of each item name which is the minimum acceptable abbreviation for it (a long menu is more than 5 or so entries). - The nodes listed in a node's menu are called its ``subnodes'', and -it is their ``superior''. They should each have an @samp{Up:} pointing at -the superior. It is often useful to arrange all or most of the -subnodes in a sequence of @samp{Next} and @samp{Previous} pointers so that someone who -wants to see them all need not keep revisiting the Menu. + The nodes listed in a node's menu are called its ``subnodes'', and it +is their ``superior''. They should each have an @samp{Up:} pointing at +the superior. It is often useful to arrange all or most of the subnodes +in a sequence of @samp{Next} and @samp{Previous} pointers so that +someone who wants to see them all need not keep revisiting the Menu. The Info Directory is simply the menu of the node @samp{(dir)Top}---that is, node @samp{Top} in file @file{.../info/dir}. You can put new entries @@ -816,7 +800,7 @@ You can speed up the access to nodes of a large Info file by giving it a tag table. Unlike the tag table for a program, the tag table for -an Info file lives inside the file itself and is used +an Info file lives inside the file itself and is used automatically whenever Info reads in the file. To make a tag table, go to a node in the file using Emacs Info mode and type @@ -847,33 +831,34 @@ a Delete character, and the character position in the file of the beginning of the node. + @node Checking, Emacs Info Variables, Tags, Advanced Info -@comment node-name, next, previous, up @section Checking an Info File - When creating an Info file, it is easy to forget the name of a node -when you are making a pointer to it from another node. If you put in -the wrong name for a node, this is not detected until someone -tries to go through the pointer using Info. Verification of the Info -file is an automatic process which checks all pointers to nodes and -reports any pointers which are invalid. Every @samp{Next}, @samp{Previous}, and +When creating an Info file, it is easy to forget the name of a node when +you are making a pointer to it from another node. If you put in the +wrong name for a node, this is not detected until someone tries to go +through the pointer using Info. Verification of the Info file is an +automatic process which checks all pointers to nodes and reports any +pointers which are invalid. Every @samp{Next}, @samp{Previous}, and @samp{Up} is checked, as is every menu item and every cross reference. In -addition, any @samp{Next} which does not have a @samp{Previous} pointing back is -reported. Only pointers within the file are checked, because checking -pointers to other files would be terribly slow. But those are usually -few. +addition, any @samp{Next} which does not have a @samp{Previous} pointing +back is reported. Only pointers within the file are checked, because +checking pointers to other files would be terribly slow. But those are +usually few. - To check an Info file, do @kbd{M-x Info-validate} while looking at -any node of the file with Emacs Info mode. +To check an Info file, do @kbd{M-x Info-validate} while looking at any +node of the file with Emacs Info mode. @node Emacs Info Variables, , Checking, Advanced Info @section Emacs Info-mode Variables The following variables may modify the behaviour of Info-mode in Emacs; you may wish to set one or several of these variables interactively, or -in your @file{~/.emacs} init file. @xref{Examining, Examining and Setting -Variables, Examining and Setting Variables, emacs, The GNU Emacs -Manual}. +in your @file{~/.emacs} init file. @xref{Examining, Examining and +Setting Variables, Examining and Setting Variables, xemacs, XEmacs +User's Manual}. + @vtable @code @item Info-enable-edit @@ -894,18 +879,17 @@ function @code{Info-directory} is called. @end vtable -@node Create an Info File, , Advanced Info, Top -@comment node-name, next, previous, up -@chapter Creating an Info File from a Makeinfo file + +@node Creating an Info File +@chapter Creating an Info File -@code{makeinfo} is a utility that converts a Texinfo file into an Info -file; @code{texinfo-format-region} and @code{texinfo-format-buffer} are -GNU Emacs functions that do the same. +@xref{Top,, Overview of Texinfo, texinfo, Texinfo}, to learn how to +write a Texinfo file. -@xref{Create an Info File, , Creating an Info File, texinfo, the Texinfo -Manual}, to learn how to create an Info file from a Texinfo file. +@xref{Creating an Info File,,, texinfo, Texinfo}, to learn how to create +an Info file from a Texinfo file. -@xref{Top,, Overview of Texinfo, texinfo, Texinfo: The GNU Documentation -Format}, to learn how to write a Texinfo file. +@xref{Installing an Info File,,, texinfo, Texinfo}, to learn how to +install an Info file after you have created one. @bye diff -r f4aeb21a5bad -r 74fd4e045ea6 man/internals/Makefile --- a/man/internals/Makefile Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,70 +0,0 @@ -# Makefile for the XEmacs Internals Manual. - -# This file is part of XEmacs. - -# XEmacs is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any -# later version. - -# XEmacs is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. - -# You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. - -VERSION=1.0 -NAME=internals -manual = xemacs-internals-manual-19-$(VERSION) - -TEXI2DVI = texi2dvi -MAKEINFO = makeinfo - -# Uncomment this line for permuted index. -# permuted_index = 1 - -# List of all the texinfo files in the manual: - -srcs = internals.texi index.unperm index.perm - -all : info -info : ../../info/$(NAME).info - -../../info/$(NAME).info: $(srcs) index.texi - @echo "Expect a coredump if you are not using makeinfo 1.68 (or later)" - $(MAKEINFO) $(NAME).texi - @rm -f core - -dvi : $(NAME).dvi - -$(NAME).dvi: $(srcs) index.texi - # Avoid losing old contents of aux file entirely. - -mv $(NAME).aux $(NAME).oaux - # First shot to define xrefs: - $(TEX) $(NAME).texi - if [ a${permuted_index} != a ]; \ - then ./permute-index && mv permuted.fns $(NAME).fns; \ - else texindex $(NAME).??; \ - fi - $(TEX) $(NAME).texi - -index.texi: - if [ a${permuted_index} != a ]; \ - then ln -s index.perm index.texi; \ - else ln -s index.unperm index.texi; \ - fi - -.PHONY: mostlyclean clean distclean realclean extraclean -mostlyclean: - rm -f *.toc *.aux *.log *.cp *.cps *.fn *.fns *.tp *.tps \ - *.vr *.vrs *.pg *.pgs *.ky *.kys -clean: mostlyclean - rm -f *.dvi *.ps make.out core index.texi -distclean: clean -realclean: clean -extraclean: clean - -rm -f *~ \#* diff -r f4aeb21a5bad -r 74fd4e045ea6 man/internals/index.perm --- a/man/internals/index.perm Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -@c -*-texinfo-*- -@setfilename ../../info/index.info - -@c Indexing guidelines - -@c I assume that all indexes will be combined. -@c Therefore, if a generated findex and permutations -@c cover the ways an index user would look up the entry, -@c then no cindex is added. -@c Concept index (cindex) entries will also be permuted. Therefore, they -@c have no commas and few irrelevant connectives in them. - -@c I tried to include words in a cindex that give the context of the entry, -@c particularly if there is more than one entry for the same concept. -@c For example, "nil in keymap" -@c Similarly for explicit findex and vindex entries, e.g. "print example". - -@c Error codes are given cindex entries, e.g. "end-of-file error". - -@c pindex is used for .el files and Unix programs - -@node Index, , Interface to X Windows, Top -@unnumbered Index - - -All variables, functions, keys, programs, files, and concepts are -in this one index. - -All names and concepts are permuted, so they appear several times, one -for each permutation of the parts of the name. For example, -@code{function-name} would appear as @b{function-name} and @b{name, -function-}. Key entries are not permuted, however. - - -@c Print the indices - -@printindex fn diff -r f4aeb21a5bad -r 74fd4e045ea6 man/internals/index.texi --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/man/internals/index.texi Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,37 @@ +@c -*-texinfo-*- +@setfilename ../../info/index.info + +@c Indexing guidelines + +@c I assume that all indexes will be combined. +@c Therefore, if a generated findex and permutations +@c cover the ways an index user would look up the entry, +@c then no cindex is added. +@c Concept index (cindex) entries will also be permuted. Therefore, they +@c have no commas and few irrelevant connectives in them. + +@c I tried to include words in a cindex that give the context of the entry, +@c particularly if there is more than one entry for the same concept. +@c For example, "nil in keymap" +@c Similarly for explicit findex and vindex entries, e.g. "print example". + +@c Error codes are given cindex entries, e.g. "end-of-file error". + +@c pindex is used for .el files and Unix programs + +@node Index, , Interface to X Windows, Top +@unnumbered Index + +@ignore +All variables, functions, keys, programs, files, and concepts are +in this one index. + +All names and concepts are permuted, so they appear several times, one +for each permutation of the parts of the name. For example, +@code{function-name} would appear as @b{function-name} and @b{name, +function-}. Key entries are not permuted, however. +@end ignore + +@c Print the indices + +@printindex fn diff -r f4aeb21a5bad -r 74fd4e045ea6 man/internals/index.unperm --- a/man/internals/index.unperm Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -@c -*-texinfo-*- -@setfilename ../../info/index.info - -@c Indexing guidelines - -@c I assume that all indexes will be combined. -@c Therefore, if a generated findex and permutations -@c cover the ways an index user would look up the entry, -@c then no cindex is added. -@c Concept index (cindex) entries will also be permuted. Therefore, they -@c have no commas and few irrelevant connectives in them. - -@c I tried to include words in a cindex that give the context of the entry, -@c particularly if there is more than one entry for the same concept. -@c For example, "nil in keymap" -@c Similarly for explicit findex and vindex entries, e.g. "print example". - -@c Error codes are given cindex entries, e.g. "end-of-file error". - -@c pindex is used for .el files and Unix programs - -@node Index, , Interface to X Windows, Top -@unnumbered Index - -@ignore -All variables, functions, keys, programs, files, and concepts are -in this one index. - -All names and concepts are permuted, so they appear several times, one -for each permutation of the parts of the name. For example, -@code{function-name} would appear as @b{function-name} and @b{name, -function-}. Key entries are not permuted, however. -@end ignore - -@c Print the indices - -@printindex fn diff -r f4aeb21a5bad -r 74fd4e045ea6 man/internals/internals.texi --- a/man/internals/internals.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/internals/internals.texi Mon Aug 13 11:13:30 2007 +0200 @@ -5,6 +5,10 @@ @c %**end of header @ifinfo +@dircategory XEmacs Editor +@direntry +* Internals: (internals). XEmacs Internals Manual. +@end direntry Copyright @copyright{} 1992 - 1996 Ben Wing. Copyright @copyright{} 1996, 1997 Sun Microsystems. @@ -59,11 +63,13 @@ @titlepage @title XEmacs Internals Manual -@subtitle Version 1.2, October 1998 +@subtitle Version 1.3, August 1999 @author Ben Wing @author Martin Buchholz @author Hrvoje Niksic +@author Matthias Neubauer +@author Olivier Galibert @page @vskip 0pt plus 1fill @@ -74,8 +80,8 @@ Copyright @copyright{} 1994, 1995 Board of Trustees, University of Illinois. @sp 2 -Version 1.2 @* -October 1998.@* +Version 1.3 @* +August 1999.@* Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice are @@ -113,6 +119,7 @@ * Rules When Writing New C Code:: * A Summary of the Various XEmacs Modules:: * Allocation of Objects in XEmacs Lisp:: +* Dumping:: * Events and the Event Loop:: * Evaluation; Stack Frames; Bindings:: * Symbols and Variables:: @@ -123,24 +130,22 @@ * Consoles; Devices; Frames; Windows:: * The Redisplay Mechanism:: * Extents:: -* Faces and Glyphs:: +* Faces:: +* Glyphs:: * Specifiers:: * Menus:: * Subprocesses:: * Interface to X Windows:: -* Index:: Index including concepts, functions, variables, - and other terms. - - --- The Detailed Node Listing --- - -Here are other nodes that are inferiors of those already listed, -mentioned here so you can get to them in one step: +* Index:: + +@detailmenu --- The Detailed Node Listing --- A History of Emacs * Through Version 18:: Unification prevails. * Lucid Emacs:: One version 19 Emacs. * GNU Emacs 19:: The other version 19 Emacs. +* GNU Emacs 20:: The other version 20 Emacs. * XEmacs:: The continuation of Lucid Emacs. Rules When Writing New C Code @@ -148,8 +153,17 @@ * General Coding Rules:: * Writing Lisp Primitives:: * Adding Global Lisp Variables:: +* Coding for Mule:: * Techniques for XEmacs Developers:: +Coding for Mule + +* Character-Related Data Types:: +* Working With Character and Byte Positions:: +* Conversion to and from External Data:: +* General Guidelines for Writing Mule-Aware Code:: +* An Example of Mule-Aware Code:: + A Summary of the Various XEmacs Modules * Low-Level Modules:: @@ -170,6 +184,7 @@ * Introduction to Allocation:: * Garbage Collection:: * GCPROing:: +* Garbage Collection - Step by Step:: * Integers and Characters:: * Allocation from Frob Blocks:: * lrecords:: @@ -183,6 +198,32 @@ * String:: * Compiled Function:: +Garbage Collection - Step by Step + +* Invocation:: +* garbage_collect_1:: +* mark_object:: +* gc_sweep:: +* sweep_lcrecords_1:: +* compact_string_chars:: +* sweep_strings:: +* sweep_bit_vectors_1:: + +Dumping + +* Overview:: +* Data descriptions:: +* Dumping phase:: +* Reloading phase:: + +Dumping phase + +* Object inventory:: +* Address allocation:: +* The header:: +* Data dumping:: +* Pointers dumping:: + Events and the Event Loop * Introduction to Events:: @@ -221,6 +262,7 @@ * Character Sets:: * Encodings:: * Internal Mule Encodings:: +* CCL:: Encodings @@ -232,20 +274,25 @@ * Internal String Encoding:: * Internal Character Encoding:: -The Lisp Reader and Compiler - Lstreams +* Creating an Lstream:: Creating an lstream object. +* Lstream Types:: Different sorts of things that are streamed. +* Lstream Functions:: Functions for working with lstreams. +* Lstream Methods:: Creating new lstream types. + Consoles; Devices; Frames; Windows * Introduction to Consoles; Devices; Frames; Windows:: * Point:: * Window Hierarchy:: +* The Window Object:: The Redisplay Mechanism * Critical Redisplay Sections:: * Line Start Cache:: +* Redisplay Piece by Piece:: Extents @@ -253,19 +300,10 @@ * Extent Ordering:: How extents are ordered internally. * Format of the Extent Info:: The extent information in a buffer or string. * Zero-Length Extents:: A weird special case. -* Mathematics of Extent Ordering:: A rigorous foundation. +* Mathematics of Extent Ordering:: A rigorous foundation. * Extent Fragments:: Cached information useful for redisplay. -Faces and Glyphs - -Specifiers - -Menus - -Subprocesses - -Interface to X Windows - +@end detailmenu @end menu @node A History of Emacs, XEmacs From the Outside, Top, Top @@ -306,7 +344,7 @@ * XEmacs:: The continuation of Lucid Emacs. @end menu -@node Through Version 18 +@node Through Version 18, Lucid Emacs, A History of Emacs, A History of Emacs @section Through Version 18 @cindex Gosling, James @cindex Great Usenet Renaming @@ -419,7 +457,7 @@ version 18.59 released October 31, 1992. @end itemize -@node Lucid Emacs +@node Lucid Emacs, GNU Emacs 19, Through Version 18, A History of Emacs @section Lucid Emacs @cindex Lucid Emacs @cindex Lucid Inc. @@ -507,7 +545,7 @@ version 20.4 released February 28, 1998. @end itemize -@node GNU Emacs 19 +@node GNU Emacs 19, GNU Emacs 20, Lucid Emacs, A History of Emacs @section GNU Emacs 19 @cindex GNU Emacs 19 @cindex FSF Emacs @@ -584,7 +622,7 @@ working on and using GNU Emacs for a long time (back as far as version 16 or 17). -@node GNU Emacs 20 +@node GNU Emacs 20, XEmacs, GNU Emacs 19, A History of Emacs @section GNU Emacs 20 @cindex GNU Emacs 20 @cindex FSF Emacs @@ -603,7 +641,7 @@ version 20.3 released August 19, 1998. @end itemize -@node XEmacs +@node XEmacs, , GNU Emacs 20, A History of Emacs @section XEmacs @cindex XEmacs @@ -691,7 +729,7 @@ displayable representations, and XEmacs provides a function @code{redisplay()} that ensures that the display of all such objects matches their internal state. Most of the time, a standard Lisp -environment is in a @dfn{read-eval-print} loop -- i.e. ``read some Lisp +environment is in a @dfn{read-eval-print} loop---i.e. ``read some Lisp code, execute it, and print the results''. XEmacs has a similar loop: @itemize @bullet @@ -866,7 +904,7 @@ executed; this prints out the error and continues.) Routines can also specify cleanup code (called an @dfn{unwind-protect}) that will be called when control exits from a block of code, no matter how that exit -occurs -- i.e. even if a function deeply nested below it causes a +occurs---i.e. even if a function deeply nested below it causes a non-local exit back to the top level. Note that this facility has appeared in some recent vintages of C, in @@ -880,7 +918,7 @@ you declared. This is actually considered a bug in Emacs Lisp and in all other early dialects of Lisp, and was corrected in Common Lisp. (In Common Lisp, you can still declare dynamically scoped variables if you -want to -- they are sometimes useful -- but variables by default are +want to---they are sometimes useful---but variables by default are @dfn{lexically scoped} as in C.) @end enumerate @@ -1238,9 +1276,9 @@ An object representing a single character of text; chars behave like integers in many ways but are logically considered text rather than numbers and have a different read syntax. (the read syntax for a char -contains the char itself or some textual encoding of it -- for example, +contains the char itself or some textual encoding of it---for example, a Japanese Kanji character might be encoded as @samp{^[$(B#&^[(B} using the -ISO-2022 encoding standard -- rather than the numerical representation +ISO-2022 encoding standard---rather than the numerical representation of the char; this way, if the mapping between chars and integers changes, which is quite possible for Kanji characters and other extended characters, the same character will still be created. Note that some @@ -1458,7 +1496,7 @@ 1.983e-4 @end example -converts to a float whose value is 1983.23e-4, or .0001983. +converts to a float whose value is 1.983e-4, or .0001983. @example ?b @@ -1592,10 +1630,10 @@ others, the lower 28 bits contain a pointer. The mark bit is used during garbage-collection, and is always 0 when garbage collection is not happening. (The way that garbage collection works, basically, is that it -loops over all places where Lisp objects could exist -- this includes +loops over all places where Lisp objects could exist---this includes all global variables in C that contain Lisp objects [including @code{Vobarray}, the C equivalent of @code{obarray}; through this, all -Lisp variables will get marked], plus various other places -- and +Lisp variables will get marked], plus various other places---and recursively scans through the Lisp objects, marking each object it finds by setting the mark bit. Then it goes through the lists of all objects allocated, freeing the ones that are not marked and turning off the mark @@ -1709,10 +1747,10 @@ @code{EXPLICIT_SIGN_EXTEND}. Note that when @code{ERROR_CHECK_TYPECHECK} is defined, the extractor -macros become more complicated -- they check the tag bits and/or the +macros become more complicated---they check the tag bits and/or the type field in the first four bytes of a record type to ensure that the object is really of the correct type. This is great for catching places -where an incorrect type is being dereferenced -- this typically results +where an incorrect type is being dereferenced---this typically results in a pointer being dereferenced as the wrong type of structure, with unpredictable (and sometimes not easily traceable) results. @@ -1756,7 +1794,7 @@ * Techniques for XEmacs Developers:: @end menu -@node General Coding Rules +@node General Coding Rules, Writing Lisp Primitives, Rules When Writing New C Code, Rules When Writing New C Code @section General Coding Rules The C code is actually written in a dialect of C called @dfn{Clean C}, @@ -1789,6 +1827,15 @@ system header files) to ensure that certain tricks played by various @file{s/} and @file{m/} files work out correctly. +When including header files, always use angle brackets, not double +quotes, except when the file to be included is in the same directory as +the including file. If either file is a generated file, then that is +not likely to be the case. In order to understand why we have this +rule, imagine what happens when you do a build in the source directory +using @samp{./configure} and another build in another directory using +@samp{../work/configure}. There will be two different @file{config.h} +files. Which one will be used if you @samp{#include "config.h"}? + @strong{All global and static variables that are to be modifiable must be declared uninitialized.} This means that you may not use the ``declare with initializer'' form for these variables, such as @code{int @@ -1798,7 +1845,7 @@ segment in the dumped executable. This allows this memory to be shared among multiple running XEmacs processes. XEmacs is careful to place as much constant data as possible into initialized variables (in -particular, into what's called the @dfn{pure space} -- see below) during +particular, into what's called the @dfn{pure space}---see below) during the @file{temacs} phase. @cindex copy-on-write @@ -1833,10 +1880,10 @@ macro style is: @example -#define FOO(var, value) do @{ \ - Lisp_Object FOO_value = (value); \ - ... /* compute using FOO_value */ \ - (var) = bar; \ +#define FOO(var, value) do @{ \ + Lisp_Object FOO_value = (value); \ + ... /* compute using FOO_value */ \ + (var) = bar; \ @} while (0) @end example @@ -1862,7 +1909,7 @@ @code{LIST_LOOP_DELETE_IF} delete elements from a lisp list satisfying some predicate. -@node Writing Lisp Primitives +@node Writing Lisp Primitives, Adding Global Lisp Variables, General Coding Rules, Rules When Writing New C Code @section Writing Lisp Primitives Lisp primitives are Lisp functions implemented in C. The details of @@ -2106,7 +2153,7 @@ @file{lisp.h} contains the definitions for important macros and functions. -@node Adding Global Lisp Variables +@node Adding Global Lisp Variables, Coding for Mule, Writing Lisp Primitives, Rules When Writing New C Code @section Adding Global Lisp Variables Global variables whose names begin with @samp{Q} are constants whose @@ -2168,7 +2215,7 @@ Lisp object, and you will be the one who's unhappy when you can't figure out how your variable got overwritten. -@node Coding for Mule +@node Coding for Mule, Techniques for XEmacs Developers, Adding Global Lisp Variables, Rules When Writing New C Code @section Coding for Mule @cindex Coding for Mule @@ -2191,7 +2238,7 @@ * An Example of Mule-Aware Code:: @end menu -@node Character-Related Data Types +@node Character-Related Data Types, Working With Character and Byte Positions, Coding for Mule, Coding for Mule @subsection Character-Related Data Types First, let's review the basic character-related datatypes used by @@ -2265,7 +2312,7 @@ and Extcounts are not all that frequent in XEmacs code. @end table -@node Working With Character and Byte Positions +@node Working With Character and Byte Positions, Conversion to and from External Data, Character-Related Data Types, Coding for Mule @subsection Working With Character and Byte Positions Now that we have defined the basic character-related types, we can look @@ -2389,7 +2436,7 @@ @end example @end table -@node Conversion to and from External Data +@node Conversion to and from External Data, General Guidelines for Writing Mule-Aware Code, Working With Character and Byte Positions, Coding for Mule @subsection Conversion to and from External Data When an external function, such as a C library function, returns a @@ -2503,7 +2550,7 @@ the macro. @end table -@node General Guidelines for Writing Mule-Aware Code +@node General Guidelines for Writing Mule-Aware Code, An Example of Mule-Aware Code, Conversion to and from External Data, Coding for Mule @subsection General Guidelines for Writing Mule-Aware Code This section contains some general guidance on how to write Mule-aware @@ -2542,7 +2589,7 @@ passed around in internal format. @end table -@node An Example of Mule-Aware Code +@node An Example of Mule-Aware Code, , General Guidelines for Writing Mule-Aware Code, Coding for Mule @subsection An Example of Mule-Aware Code As an example of Mule-aware code, we shall will analyze the @@ -2593,7 +2640,7 @@ understood this section of the manual and studied the examples, you can proceed writing new Mule-aware code. -@node Techniques for XEmacs Developers +@node Techniques for XEmacs Developers, , Coding for Mule, Rules When Writing New C Code @section Techniques for XEmacs Developers To make a quantified XEmacs, do: @code{make quantmacs}. @@ -2641,8 +2688,8 @@ calls in elisp are especially expensive. Iterating over a long list is going to be 30 times faster implemented in C than in Elisp. -To get started debugging XEmacs, take a look at the @file{gdbinit} and -@file{dbxrc} files in the @file{src} directory. +To get started debugging XEmacs, take a look at the @file{.gdbinit} and +@file{.dbxrc} files in the @file{src} directory. @xref{Q2.1.15 - How to Debug an XEmacs problem with a debugger,,, xemacs-faq, XEmacs FAQ}. @@ -2715,7 +2762,7 @@ * Modules for Internationalization:: @end menu -@node Low-Level Modules +@node Low-Level Modules, Basic Lisp Modules, A Summary of the Various XEmacs Modules, A Summary of the Various XEmacs Modules @section Low-Level Modules @example @@ -2939,7 +2986,7 @@ -@node Basic Lisp Modules +@node Basic Lisp Modules, Modules for Standard Editing Operations, Low-Level Modules, A Summary of the Various XEmacs Modules @section Basic Lisp Modules @example @@ -2974,7 +3021,7 @@ typedefs section as necessary. @file{lrecord.h} contains the basic structures and macros that implement -all record-type Lisp objects -- i.e. all objects whose type is a field +all record-type Lisp objects---i.e. all objects whose type is a field in their C structure, which includes all objects except the few most basic ones. @@ -3010,7 +3057,7 @@ type-specific methods. This scheme is a fundamental principle of object-oriented programming and is heavily used throughout XEmacs. The great advantage of this is that it allows for a clean separation of -functionality into different modules -- new classes of Lisp objects, new +functionality into different modules---new classes of Lisp objects, new event interfaces, new device types, new stream interfaces, etc. can be added transparently without affecting code anywhere else in XEmacs. Because the different subsystems are divided into general and specific @@ -3101,7 +3148,7 @@ @file{symbols.c} implements the handling of symbols, obarrays, and retrieving the values of symbols. Much of the code is devoted to handling the special @dfn{symbol-value-magic} objects that define -special types of variables -- this includes buffer-local variables, +special types of variables---this includes buffer-local variables, variable aliases, variables that forward into C variables, etc. This module is initialized extremely early (right after @file{alloc.c}), because it is here that the basic symbols @code{t} and @code{nil} are @@ -3145,7 +3192,7 @@ -@node Modules for Standard Editing Operations +@node Modules for Standard Editing Operations, Editor-Level Control Flow Modules, Basic Lisp Modules, A Summary of the Various XEmacs Modules @section Modules for Standard Editing Operations @example @@ -3315,7 +3362,7 @@ -@node Editor-Level Control Flow Modules +@node Editor-Level Control Flow Modules, Modules for the Basic Displayable Lisp Objects, Modules for Standard Editing Operations, A Summary of the Various XEmacs Modules @section Editor-Level Control Flow Modules @example @@ -3380,7 +3427,7 @@ @end example @file{keyboard.c} contains functions that implement the actual editor -command loop -- i.e. the event loop that cyclically retrieves and +command loop---i.e. the event loop that cyclically retrieves and dispatches events. This code is also rather tricky, just like @file{event-stream.c}. @@ -3413,7 +3460,7 @@ -@node Modules for the Basic Displayable Lisp Objects +@node Modules for the Basic Displayable Lisp Objects, Modules for other Display-Related Lisp Objects, Editor-Level Control Flow Modules, A Summary of the Various XEmacs Modules @section Modules for the Basic Displayable Lisp Objects @example @@ -3487,7 +3534,7 @@ -@node Modules for other Display-Related Lisp Objects +@node Modules for other Display-Related Lisp Objects, Modules for the Redisplay Mechanism, Modules for the Basic Displayable Lisp Objects, A Summary of the Various XEmacs Modules @section Modules for other Display-Related Lisp Objects @example @@ -3548,7 +3595,7 @@ font-lock.c @end example -This file provides C support for syntax highlighting -- i.e. +This file provides C support for syntax highlighting---i.e. highlighting different syntactic constructs of a source file in different colors, for easy reading. The C support is provided so that this is fast. @@ -3566,7 +3613,7 @@ -@node Modules for the Redisplay Mechanism +@node Modules for the Redisplay Mechanism, Modules for Interfacing with the File System, Modules for other Display-Related Lisp Objects, A Summary of the Various XEmacs Modules @section Modules for the Redisplay Mechanism @example @@ -3638,7 +3685,7 @@ -@node Modules for Interfacing with the File System +@node Modules for Interfacing with the File System, Modules for Other Aspects of the Lisp Interpreter and Object System, Modules for the Redisplay Mechanism, A Summary of the Various XEmacs Modules @section Modules for Interfacing with the File System @example @@ -3739,7 +3786,7 @@ -@node Modules for Other Aspects of the Lisp Interpreter and Object System +@node Modules for Other Aspects of the Lisp Interpreter and Object System, Modules for Interfacing with the Operating System, Modules for Interfacing with the File System, A Summary of the Various XEmacs Modules @section Modules for Other Aspects of the Lisp Interpreter and Object System @example @@ -3853,7 +3900,7 @@ with them, in case the block of memory contains other Lisp objects that need to be marked for garbage-collection purposes. (If you need other object methods, such as a finalize method, you should just go ahead and -create a new Lisp object type -- it's not hard.) +create a new Lisp object type---it's not hard.) @@ -3901,7 +3948,7 @@ -@node Modules for Interfacing with the Operating System +@node Modules for Interfacing with the Operating System, Modules for Interfacing with X Windows, Modules for Other Aspects of the Lisp Interpreter and Object System, A Summary of the Various XEmacs Modules @section Modules for Interfacing with the Operating System @example @@ -4140,7 +4187,7 @@ -@node Modules for Interfacing with X Windows +@node Modules for Interfacing with X Windows, Modules for Internationalization, Modules for Interfacing with the Operating System, A Summary of the Various XEmacs Modules @section Modules for Interfacing with X Windows @example @@ -4282,7 +4329,7 @@ -@node Modules for Internationalization +@node Modules for Internationalization, , Modules for Interfacing with X Windows, A Summary of the Various XEmacs Modules @section Modules for Internationalization @example @@ -4359,13 +4406,14 @@ -@node Allocation of Objects in XEmacs Lisp, Events and the Event Loop, A Summary of the Various XEmacs Modules, Top +@node Allocation of Objects in XEmacs Lisp, Dumping, A Summary of the Various XEmacs Modules, Top @chapter Allocation of Objects in XEmacs Lisp @menu * Introduction to Allocation:: * Garbage Collection:: * GCPROing:: +* Garbage Collection - Step by Step:: * Integers and Characters:: * Allocation from Frob Blocks:: * lrecords:: @@ -4380,7 +4428,7 @@ * Compiled Function:: @end menu -@node Introduction to Allocation +@node Introduction to Allocation, Garbage Collection, Allocation of Objects in XEmacs Lisp, Allocation of Objects in XEmacs Lisp @section Introduction to Allocation Emacs Lisp, like all Lisps, has garbage collection. This means that @@ -4429,7 +4477,7 @@ @dfn{frob blocks}, i.e. large blocks of memory that are subdivided into individual objects. This saves a lot on malloc overhead, since there are typically quite a lot of these objects around, and the objects are -small. (A cons, for example, occupies 8 bytes on 32-bit machines -- 4 +small. (A cons, for example, occupies 8 bytes on 32-bit machines---4 bytes for each of the two objects it contains.) Vectors are individually @code{malloc()}ed since they are of variable size. (It would be possible, and desirable, to allocate vectors of certain small sizes out @@ -4483,7 +4531,7 @@ (d) @code{Lisp_Vectorlike}, with separate tags for each, although @code{Lisp_Vectorlike} is also used for vectors.) -@node Garbage Collection +@node Garbage Collection, GCPROing, Introduction to Allocation, Allocation of Objects in XEmacs Lisp @section Garbage Collection @cindex garbage collection @@ -4557,7 +4605,7 @@ by @code{eval}, once a certain amount of memory has been allocated since the last garbage collection (according to @code{gc-cons-threshold}). -@node GCPROing +@node GCPROing, Garbage Collection - Step by Step, Garbage Collection, Allocation of Objects in XEmacs Lisp @section @code{GCPRO}ing @code{GCPRO}ing is one of the ugliest and trickiest parts of Emacs @@ -4619,7 +4667,7 @@ in the next enclosing stack frame. Each @code{GCPRO}ed thing is an lvalue, and the @code{struct gcpro} local variable contains a pointer to this lvalue. This is why things will mess up badly if you don't pair up -the @code{GCPRO}s and @code{UNGCPRO}s -- you will end up with +the @code{GCPRO}s and @code{UNGCPRO}s---you will end up with @code{gcprolist}s containing pointers to @code{struct gcpro}s or local @code{Lisp_Object} variables in no-longer-active stack frames. @@ -4710,7 +4758,503 @@ it obviates the need for @code{GCPRO}ing, and allows garbage collection to happen at any point at all, such as during object allocation. -@node Integers and Characters +@node Garbage Collection - Step by Step, Integers and Characters, GCPROing, Allocation of Objects in XEmacs Lisp +@section Garbage Collection - Step by Step +@cindex garbage collection step by step + +@menu +* Invocation:: +* garbage_collect_1:: +* mark_object:: +* gc_sweep:: +* sweep_lcrecords_1:: +* compact_string_chars:: +* sweep_strings:: +* sweep_bit_vectors_1:: +@end menu + +@node Invocation, garbage_collect_1, Garbage Collection - Step by Step, Garbage Collection - Step by Step +@subsection Invocation +@cindex garbage collection, invocation + +The first thing that anyone should know about garbage collection is: +when and how the garbage collector is invoked. One might think that this +could happen every time new memory is allocated, e.g. new objects are +created, but this is @emph{not} the case. Instead, we have the following +situation: + +The entry point of any process of garbage collection is an invocation +of the function @code{garbage_collect_1} in file @code{alloc.c}. The +invocation can occur @emph{explicitly} by calling the function +@code{Fgarbage_collect} (in addition this function provides information +about the freed memory), or can occur @emph{implicitly} in four different +situations: +@enumerate +@item +In function @code{main_1} in file @code{emacs.c}. This function is called +at each startup of xemacs. The garbage collection is invoked after all +initial creations are completed, but only if a special internal error +checking-constant @code{ERROR_CHECK_GC} is defined. +@item +In function @code{disksave_object_finalization} in file +@code{alloc.c}. The only purpose of this function is to clear the +objects from memory which need not be stored with xemacs when we dump out +an executable. This is only done by @code{Fdump_emacs} or by +@code{Fdump_emacs_data} respectively (both in @code{emacs.c}). The +actual clearing is accomplished by making these objects unreachable and +starting a garbage collection. The function is only used while building +xemacs. +@item +In function @code{Feval / eval} in file @code{eval.c}. Each time the +well known and often used function eval is called to evaluate a form, +one of the first things that could happen, is a potential call of +@code{garbage_collect_1}. There exist three global variables, +@code{consing_since_gc} (counts the created cons-cells since the last +garbage collection), @code{gc_cons_threshold} (a specified threshold +after which a garbage collection occurs) and @code{always_gc}. If +@code{always_gc} is set or if the threshold is exceeded, the garbage +collection will start. +@item +In function @code{Ffuncall / funcall} in file @code{eval.c}. This +function evaluates calls of elisp functions and works according to +@code{Feval}. +@end enumerate + +The upshot is that garbage collection can basically occur everywhere +@code{Feval}, respectively @code{Ffuncall}, is used - either directly or +through another function. Since calls to these two functions are +hidden in various other functions, many calls to +@code{garabge_collect_1} are not obviously foreseeable, and therefore +unexpected. Instances where they are used that are worth remembering are +various elisp commands, as for example @code{or}, +@code{and}, @code{if}, @code{cond}, @code{while}, @code{setq}, etc., +miscellaneous @code{gui_item_...} functions, everything related to +@code{eval} (@code{Feval_buffer}, @code{call0}, ...) and inside +@code{Fsignal}. The latter is used to handle signals, as for example the +ones raised by every @code{QUITE}-macro triggered after pressing Ctrl-g. + +@node garbage_collect_1, mark_object, Invocation, Garbage Collection - Step by Step +@subsection @code{garbage_collect_1} +@cindex @code{garbage_collect_1} + +We can now describe exactly what happens after the invocation takes +place. +@enumerate +@item +There are several cases in which the garbage collector is left immediately: +when we are already garbage collecting (@code{gc_in_progress}), when +the garbage collection is somehow forbidden +(@code{gc_currently_forbidden}), when we are currently displaying something +(@code{in_display}) or when we are preparing for the armageddon of the +whole system (@code{preparing_for_armageddon}). +@item +Next the correct frame in which to put +all the output occurring during garbage collecting is determined. In +order to be able to restore the old display's state after displaying the +message, some data about the current cursor position has to be +saved. The variables @code{pre_gc_curser} and @code{cursor_changed} take +care of that. +@item +The state of @code{gc_currently_forbidden} must be restored after +the garbage collection, no matter what happens during the process. We +accomplish this by @code{record_unwind_protect}ing the suitable function +@code{restore_gc_inhibit} together with the current value of +@code{gc_currently_forbidden}. +@item +If we are concurrently running an interactive xemacs session, the next step +is simply to show the garbage collector's cursor/message. +@item +The following steps are the intrinsic steps of the garbage collector, +therefore @code{gc_in_progress} is set. +@item +For debugging purposes, it is possible to copy the current C stack +frame. However, this seems to be a currently unused feature. +@item +Before actually starting to go over all live objects, references to +objects that are no longer used are pruned. We only have to do this for events +(@code{clear_event_resource}) and for specifiers +(@code{cleanup_specifiers}). +@item +Now the mark phase begins and marks all accessible elements. In order to +start from +all slots that serve as roots of accessibility, the function +@code{mark_object} is called for each root individually to go out from +there to mark all reachable objects. All roots that are traversed are +shown in their processed order: +@itemize @bullet +@item +all constant symbols and static variables that are registered via +@code{staticpro}@ in the array @code{staticvec}. +@xref{Adding Global Lisp Variables}. +@item +all Lisp objects that are created in C functions and that must be +protected from freeing them. They are registered in the global +list @code{gcprolist}. +@xref{GCPROing}. +@item +all local variables (i.e. their name fields @code{symbol} and old +values @code{old_values}) that are bound during the evaluation by the Lisp +engine. They are stored in @code{specbinding} structs pushed on a stack +called @code{specpdl}. +@xref{Dynamic Binding; The specbinding Stack; Unwind-Protects}. +@item +all catch blocks that the Lisp engine encounters during the evaluation +cause the creation of structs @code{catchtag} inserted in the list +@code{catchlist}. Their tag (@code{tag}) and value (@code{val} fields +are freshly created objects and therefore have to be marked. +@xref{Catch and Throw}. +@item +every function application pushes new structs @code{backtrace} +on the call stack of the Lisp engine (@code{backtrace_list}). The unique +parts that have to be marked are the fields for each function +(@code{function}) and all their arguments (@code{args}). +@xref{Evaluation}. +@item +all objects that are used by the redisplay engine that must not be freed +are marked by a special function called @code{mark_redisplay} (in +@code{redisplay.c}). +@item +all objects created for profiling purposes are allocated by C functions +instead of using the lisp allocation mechanisms. In order to receive the +right ones during the sweep phase, they also have to be marked +manually. That is done by the function @code{mark_profiling_info} +@end itemize +@item +Hash tables in XEmacs belong to a kind of special objects that +make use of a concept often called 'weak pointers'. +To make a long story short, these kind of pointers are not followed +during the estimation of the live objects during garbage collection. +Any object referenced only by weak pointers is collected +anyway, and the reference to it is cleared. In hash tables there are +different usage patterns of them, manifesting in different types of hash +tables, namely 'non-weak', 'weak', 'key-weak' and 'value-weak' +(internally also 'key-car-weak' and 'value-car-weak') hash tables, each +clearing entries depending on different conditions. More information can +be found in the documentation to the function @code{make-hash-table}. + +Because there are complicated dependency rules about when and what to +mark while processing weak hash tables, the standard @code{marker} +method is only active if it is marking non-weak hash tables. As soon as +a weak component is in the table, the hash table entries are ignored +while marking. Instead their marking is done each separately by the +function @code{finish_marking_weak_hash_tables}. This function iterates +over each hash table entry @code{hentries} for each weak hash table in +@code{Vall_weak_hash_tables}. Depending on the type of a table, the +appropriate action is performed. +If a table is acting as @code{HASH_TABLE_KEY_WEAK}, and a key already marked, +everything reachable from the @code{value} component is marked. If it is +acting as a @code{HASH_TABLE_VALUE_WEAK} and the value component is +already marked, the marking starts beginning only from the +@code{key} component. +If it is a @code{HASH_TABLE_KEY_CAR_WEAK} and the car +of the key entry is already marked, we mark both the @code{key} and +@code{value} components. +Finally, if the table is of the type @code{HASH_TABLE_VALUE_CAR_WEAK} +and the car of the value components is already marked, again both the +@code{key} and the @code{value} components get marked. + +Again, there are lists with comparable properties called weak +lists. There exist different peculiarities of their types called +@code{simple}, @code{assoc}, @code{key-assoc} and +@code{value-assoc}. You can find further details about them in the +description to the function @code{make-weak-list}. The scheme of their +marking is similar: all weak lists are listed in @code{Qall_weak_lists}, +therefore we iterate over them. The marking is advanced until we hit an +already marked pair. Then we know that during a former run all +the rest has been marked completely. Again, depending on the special +type of the weak list, our jobs differ. If it is a @code{WEAK_LIST_SIMPLE} +and the elem is marked, we mark the @code{cons} part. If it is a +@code{WEAK_LIST_ASSOC} and not a pair or a pair with both marked car and +cdr, we mark the @code{cons} and the @code{elem}. If it is a +@code{WEAK_LIST_KEY_ASSOC} and not a pair or a pair with a marked car of +the elem, we mark the @code{cons} and the @code{elem}. Finally, if it is +a @code{WEAK_LIST_VALUE_ASSOC} and not a pair or a pair with a marked +cdr of the elem, we mark both the @code{cons} and the @code{elem}. + +Since, by marking objects in reach from weak hash tables and weak lists, +other objects could get marked, this perhaps implies further marking of +other weak objects, both finishing functions are redone as long as +yet unmarked objects get freshly marked. + +@item +After completing the special marking for the weak hash tables and for the weak +lists, all entries that point to objects that are going to be swept in +the further process are useless, and therefore have to be removed from +the table or the list. + +The function @code{prune_weak_hash_tables} does the job for weak hash +tables. Totally unmarked hash tables are removed from the list +@code{Vall_weak_hash_tables}. The other ones are treated more carefully +by scanning over all entries and removing one as soon as one of +the components @code{key} and @code{value} is unmarked. + +The same idea applies to the weak lists. It is accomplished by +@code{prune_weak_lists}: An unmarked list is pruned from +@code{Vall_weak_lists} immediately. A marked list is treated more +carefully by going over it and removing just the unmarked pairs. + +@item +The function @code{prune_specifiers} checks all listed specifiers held +in @code{Vall_speficiers} and removes the ones from the lists that are +unmarked. + +@item +All syntax tables are stored in a list called +@code{Vall_syntax_tables}. The function @code{prune_syntax_tables} walks +through it and unlinks the tables that are unmarked. + +@item +Next, we will attack the complete sweeping - the function +@code{gc_sweep} which holds the predominance. +@item +First, all the variables with respect to garbage collection are +reset. @code{consing_since_gc} - the counter of the created cells since +the last garbage collection - is set back to 0, and +@code{gc_in_progress} is not @code{true} anymore. +@item +In case the session is interactive, the displayed cursor and message are +removed again. +@item +The state of @code{gc_inhibit} is restored to the former value by +unwinding the stack. +@item +A small memory reserve is always held back that can be reached by +@code{breathing_space}. If nothing more is left, we create a new reserve +and exit. +@end enumerate + +@node mark_object, gc_sweep, garbage_collect_1, Garbage Collection - Step by Step +@subsection @code{mark_object} +@cindex @code{mark_object} + +The first thing that is checked while marking an object is whether the +object is a real Lisp object @code{Lisp_Type_Record} or just an integer +or a character. Integers and characters are the only two types that are +stored directly - without another level of indirection, and therefore they +don't have to be marked and collected. +@xref{How Lisp Objects Are Represented in C}. + +The second case is the one we have to handle. It is the one when we are +dealing with a pointer to a Lisp object. But, there exist also three +possibilities, that prevent us from doing anything while marking: The +object is read only which prevents it from being garbage collected, +i.e. marked (@code{C_READONLY_RECORD_HEADER}). The object in question is +already marked, and need not be marked for the second time (checked by +@code{MARKED_RECORD_HEADER_P}). If it is a special, unmarkable object +(@code{UNMARKABLE_RECORD_HEADER_P}, apparently, these are objects that +sit in some const space, and can therefore not be marked, see +@code{this_one_is_unmarkable} in @code{alloc.c}). + +Now, the actual marking is feasible. We do so by once using the macro +@code{MARK_RECORD_HEADER} to mark the object itself (actually the +special flag in the lrecord header), and calling its special marker +"method" @code{marker} if available. The marker method marks every +other object that is in reach from our current object. Note, that these +marker methods should not call @code{mark_object} recursively, but +instead should return the next object from where further marking has to +be performed. + +In case another object was returned, as mentioned before, we reiterate +the whole @code{mark_object} process beginning with this next object. + +@node gc_sweep, sweep_lcrecords_1, mark_object, Garbage Collection - Step by Step +@subsection @code{gc_sweep} +@cindex @code{gc_sweep} + +The job of this function is to free all unmarked records from memory. As +we know, there are different types of objects implemented and managed, and +consequently different ways to free them from memory. +@xref{Introduction to Allocation}. + +We start with all objects stored through @code{lcrecords}. All +bulkier objects are allocated and handled using that scheme of +@code{lcrecords}. Each object is @code{malloc}ed separately +instead of placing it in one of the contiguous frob blocks. All types +that are currently stored +using @code{lcrecords}'s @code{alloc_lcrecord} and +@code{make_lcrecord_list} are the types: vectors, buffers, +char-table, char-table-entry, console, weak-list, database, device, +ldap, hash-table, command-builder, extent-auxiliary, extent-info, face, +coding-system, frame, image-instance, glyph, popup-data, gui-item, +keymap, charset, color_instance, font_instance, opaque, opaque-list, +process, range-table, specifier, symbol-value-buffer-local, +symbol-value-lisp-magic, symbol-value-varalias, toolbar-button, +tooltalk-message, tooltalk-pattern, window, and window-configuration. We +take care of them in the fist place +in order to be able to handle and to finalize items stored in them more +easily. The function @code{sweep_lcrecords_1} as described below is +doing the whole job for us. +For a description about the internals: @xref{lrecords}. + +Our next candidates are the other objects that behave quite differently +than everything else: the strings. They consists of two parts, a +fixed-size portion (@code{struct Lisp_string}) holding the string's +length, its property list and a pointer to the second part, and the +actual string data, which is stored in string-chars blocks comparable to +frob blocks. In this block, the data is not only freed, but also a +compression of holes is made, i.e. all strings are relocated together. +@xref{String}. This compacting phase is performed by the function +@code{compact_string_chars}, the actual sweeping by the function +@code{sweep_strings} is described below. + +After that, the other types are swept step by step using functions +@code{sweep_conses}, @code{sweep_bit_vectors_1}, +@code{sweep_compiled_functions}, @code{sweep_floats}, +@code{sweep_symbols}, @code{sweep_extents}, @code{sweep_markers} and +@code{sweep_extents}. They are the fixed-size types cons, floats, +compiled-functions, symbol, marker, extent, and event stored in +so-called "frob blocks", and therefore we can basically do the same on +every type objects, using the same macros, especially defined only to +handle everything with respect to fixed-size blocks. The only fixed-size +type that is not handled here are the fixed-size portion of strings, +because we took special care of them earlier. + +The only big exceptions are bit vectors stored differently and +therefore treated differently by the function @code{sweep_bit_vectors_1} +described later. + +At first, we need some brief information about how +these fixed-size types are managed in general, in order to understand +how the sweeping is done. They have all a fixed size, and are therefore +stored in big blocks of memory - allocated at once - that can hold a +certain amount of objects of one type. The macro +@code{DECLARE_FIXED_TYPE_ALLOC} creates the suitable structures for +every type. More precisely, we have the block struct +(holding a pointer to the previous block @code{prev} and the +objects in @code{block[]}), a pointer to current block +(@code{current_..._block)}) and its last index +(@code{current_..._block_index}), and a pointer to the free list that +will be created. Also a macro @code{FIXED_TYPE_FROM_BLOCK} plus some +related macros exists that are used to obtain a new object, either from +the free list @code{ALLOCATE_FIXED_TYPE_1} if there is an unused object +of that type stored or by allocating a completely new block using +@code{ALLOCATE_FIXED_TYPE_FROM_BLOCK}. + +The rest works as follows: all of them define a +macro @code{UNMARK_...} that is used to unmark the object. They define a +macro @code{ADDITIONAL_FREE_...} that defines additional work that has +to be done when converting an object from in use to not in use (so far, +only markers use it in order to unchain them). Then, they all call +the macro @code{SWEEP_FIXED_TYPE_BLOCK} instantiated with their type name +and their struct name. + +This call in particular does the following: we go over all blocks +starting with the current moving towards the oldest. +For each block, we look at every object in it. If the object already +freed (checked with @code{FREE_STRUCT_P} using the first pointer of the +object), or if it is +set to read only (@code{C_READONLY_RECORD_HEADER_P}, nothing must be +done. If it is unmarked (checked with @code{MARKED_RECORD_HEADER_P}), it +is put in the free list and set free (using the macro +@code{FREE_FIXED_TYPE}, otherwise it stays in the block, but is unmarked +(by @code{UNMARK_...}). While going through one block, we note if the +whole block is empty. If so, the whole block is freed (using +@code{xfree}) and the free list state is set to the state it had before +handling this block. + +@node sweep_lcrecords_1, compact_string_chars, gc_sweep, Garbage Collection - Step by Step +@subsection @code{sweep_lcrecords_1} +@cindex @code{sweep_lcrecords_1} + +After nullifying the complete lcrecord statistics, we go over all +lcrecords two separate times. They are all chained together in a list with +a head called @code{all_lcrecords}. + +The first loop calls for each object its @code{finalizer} method, but only +in the case that it is not read only +(@code{C_READONLY_RECORD_HEADER_P)}, it is not already marked +(@code{MARKED_RECORD_HEADER_P}), it is not already in a free list (list of +freed objects, field @code{free}) and finally it owns a finalizer +method. + +The second loop actually frees the appropriate objects again by iterating +through the whole list. In case an object is read only or marked, it +has to persist, otherwise it is manually freed by calling +@code{xfree}. During this loop, the lcrecord statistics are kept up to +date by calling @code{tick_lcrecord_stats} with the right arguments, + +@node compact_string_chars, sweep_strings, sweep_lcrecords_1, Garbage Collection - Step by Step +@subsection @code{compact_string_chars} +@cindex @code{compact_string_chars} + +The purpose of this function is to compact all the data parts of the +strings that are held in so-called @code{string_chars_block}, i.e. the +strings that do not exceed a certain maximal length. + +The procedure with which this is done is as follows. We are keeping two +positions in the @code{string_chars_block}s using two pointer/integer +pairs, namely @code{from_sb}/@code{from_pos} and +@code{to_sb}/@code{to_pos}. They stand for the actual positions, from +where to where, to copy the actually handled string. + +While going over all chained @code{string_char_block}s and their held +strings, staring at @code{first_string_chars_block}, both pointers +are advanced and eventually a string is copied from @code{from_sb} to +@code{to_sb}, depending on the status of the pointed at strings. + +More precisely, we can distinguish between the following actions. +@itemize @bullet +@item +The string at @code{from_sb}'s position could be marked as free, which +is indicated by an invalid pointer to the pointer that should point back +to the fixed size string object, and which is checked by +@code{FREE_STRUCT_P}. In this case, the @code{from_sb}/@code{from_pos} +is advanced to the next string, and nothing has to be copied. +@item +Also, if a string object itself is unmarked, nothing has to be +copied. We likewise advance the @code{from_sb}/@code{from_pos} +pair as described above. +@item +In all other cases, we have a marked string at hand. The string data +must be moved from the from-position to the to-position. In case +there is not enough space in the actual @code{to_sb}-block, we advance +this pointer to the beginning of the next block before copying. In case the +from and to positions are different, we perform the +actual copying using the library function @code{memmove}. +@end itemize + +After compacting, the pointer to the current +@code{string_chars_block}, sitting in @code{current_string_chars_block}, +is reset on the last block to which we moved a string, +i.e. @code{to_block}, and all remaining blocks (we know that they just +carry garbage) are explicitly @code{xfree}d. + +@node sweep_strings, sweep_bit_vectors_1, compact_string_chars, Garbage Collection - Step by Step +@subsection @code{sweep_strings} +@cindex @code{sweep_strings} + +The sweeping for the fixed sized string objects is essentially exactly +the same as it is for all other fixed size types. As before, the freeing +into the suitable free list is done by using the macro +@code{SWEEP_FIXED_SIZE_BLOCK} after defining the right macros +@code{UNMARK_string} and @code{ADDITIONAL_FREE_string}. These two +definitions are a little bit special compared to the ones used +for the other fixed size types. + +@code{UNMARK_string} is defined the same way except some additional code +used for updating the bookkeeping information. + +For strings, @code{ADDITIONAL_FREE_string} has to do something in +addition: in case, the string was not allocated in a +@code{string_chars_block} because it exceeded the maximal length, and +therefore it was @code{malloc}ed separately, we know also @code{xfree} +it explicitly. + +@node sweep_bit_vectors_1, , sweep_strings, Garbage Collection - Step by Step +@subsection @code{sweep_bit_vectors_1} +@cindex @code{sweep_bit_vectors_1} + +Bit vectors are also one of the rare types that are @code{malloc}ed +individually. Consequently, while sweeping, all further needless +bit vectors must be freed by hand. This is done, as one might imagine, +the expected way: since they are all registered in a list called +@code{all_bit_vectors}, all elements of that list are traversed, +all unmarked bit vectors are unlinked by calling @code{xfree} and all of +them become unmarked. +In addition, the bookkeeping information used for garbage +collector's output purposes is updated. + +@node Integers and Characters, Allocation from Frob Blocks, Garbage Collection - Step by Step, Allocation of Objects in XEmacs Lisp @section Integers and Characters Integer and character Lisp objects are created from integers using the @@ -4724,7 +5268,7 @@ are too big; i.e. you won't get the value you expected but the tag bits will at least be correct. -@node Allocation from Frob Blocks +@node Allocation from Frob Blocks, lrecords, Integers and Characters, Allocation of Objects in XEmacs Lisp @section Allocation from Frob Blocks The uninitialized memory required by a @code{Lisp_Object} of a particular type @@ -4751,7 +5295,7 @@ none. (There are actually two versions of these macros, one of which is more defensive but less efficient and is used for error-checking.) -@node lrecords +@node lrecords, Low-level allocation, Allocation from Frob Blocks, Allocation of Objects in XEmacs Lisp @section lrecords [see @file{lrecord.h}] @@ -4990,7 +5534,7 @@ For an example, see the methods for window configurations and opaques. @end enumerate -@node Low-level allocation +@node Low-level allocation, Pure Space, lrecords, Allocation of Objects in XEmacs Lisp @section Low-level allocation Memory that you want to allocate directly should be allocated using @@ -5062,12 +5606,12 @@ allocated, so that garbage-collection can be invoked when the threshold is reached. -@node Pure Space +@node Pure Space, Cons, Low-level allocation, Allocation of Objects in XEmacs Lisp @section Pure Space Not yet documented. -@node Cons +@node Cons, Vector, Pure Space, Allocation of Objects in XEmacs Lisp @section Cons Conses are allocated in standard frob blocks. The only thing to @@ -5081,7 +5625,7 @@ If you mess this up, you will get BADLY BURNED, and it has happened before. -@node Vector +@node Vector, Bit Vector, Cons, Allocation of Objects in XEmacs Lisp @section Vector As mentioned above, each vector is @code{malloc()}ed individually, and @@ -5092,7 +5636,7 @@ is actually @code{malloc()}ed with the right size, however, and access to any element through the @code{contents} array works fine. -@node Bit Vector +@node Bit Vector, Symbol, Vector, Allocation of Objects in XEmacs Lisp @section Bit Vector Bit vectors work exactly like vectors, except for more complicated @@ -5102,7 +5646,7 @@ tag field in bit vector Lisp words is ``lrecord'' rather than ``vector''.) -@node Symbol +@node Symbol, Marker, Bit Vector, Allocation of Objects in XEmacs Lisp @section Symbol Symbols are also allocated in frob blocks. Note that the code @@ -5116,7 +5660,7 @@ Remember that @code{intern} looks up a symbol in an obarray, creating one if necessary. -@node Marker +@node Marker, String, Symbol, Allocation of Objects in XEmacs Lisp @section Marker Markers are allocated in frob blocks, as usual. They are kept @@ -5127,7 +5671,7 @@ markers from a buffer.) Markers are removed from a buffer in the finalize stage, in @code{ADDITIONAL_FREE_marker()}. -@node String +@node String, Compiled Function, Marker, Allocation of Objects in XEmacs Lisp @section String As mentioned above, strings are a special case. A string is logically @@ -5161,8 +5705,8 @@ strings}, are all @code{malloc()}ed as their own block. (#### Although it would make more sense for the threshold for big strings to be somewhat lower, e.g. 1/2 or 1/4 the size of a string-chars block. It seems that -this was indeed the case formerly -- indeed, the threshold was set at -1/8 -- but Mly forgot about this when rewriting things for 19.8.) +this was indeed the case formerly---indeed, the threshold was set at +1/8---but Mly forgot about this when rewriting things for 19.8.) Note also that the string data in string-chars blocks is padded as necessary so that proper alignment constraints on the @code{struct @@ -5188,12 +5732,374 @@ The string compactor recognizes this special 0xFFFFFFFF marker and handles it correctly. -@node Compiled Function +@node Compiled Function, , String, Allocation of Objects in XEmacs Lisp @section Compiled Function Not yet documented. -@node Events and the Event Loop, Evaluation; Stack Frames; Bindings, Allocation of Objects in XEmacs Lisp, Top + +@node Dumping, Events and the Event Loop, Allocation of Objects in XEmacs Lisp, Top +@chapter Dumping + +@section What is dumping and its justification + +The C code of XEmacs is just a Lisp engine with a lot of built-in +primitives useful for writing an editor. The editor itself is written +mostly in Lisp, and represents around 100K lines of code. Loading and +executing the initialization of all this code takes a bit a time (five +to ten times the usual startup time of current xemacs) and requires +having all the lisp source files around. Having to reload them each +time the editor is started would not be acceptable. + +The traditional solution to this problem is called dumping: the build +process first creates the lisp engine under the name @file{temacs}, then +runs it until it has finished loading and initializing all the lisp +code, and eventually creates a new executable called @file{xemacs} +including both the object code in @file{temacs} and all the contents of +the memory after the initialization. + +This solution, while working, has a huge problem: the creation of the +new executable from the actual contents of memory is an extremely +system-specific process, quite error-prone, and which interferes with a +lot of system libraries (like malloc). It is even getting worse +nowadays with libraries using constructors which are automatically +called when the program is started (even before main()) which tend to +crash when they are called multiple times, once before dumping and once +after (IRIX 6.x libz.so pulls in some C++ image libraries thru +dependencies which have this problem). Writing the dumper is also one +of the most difficult parts of porting XEmacs to a new operating system. +Basically, `dumping' is an operation that is just not officially +supported on many operating systems. + +The aim of the portable dumper is to solve the same problem as the +system-specific dumper, that is to be able to reload quickly, using only +a small number of files, the fully initialized lisp part of the editor, +without any system-specific hacks. + +@menu +* Overview:: +* Data descriptions:: +* Dumping phase:: +* Reloading phase:: +* Remaining issues:: +@end menu + +@node Overview, Data descriptions, Dumping, Dumping +@section Overview + +The portable dumping system has to: + +@enumerate +@item +At dump time, write all initialized, non-quickly-rebuildable data to a +file [Note: currently named @file{xemacs.dmp}, but the name will +change], along with all informations needed for the reloading. + +@item +When starting xemacs, reload the dump file, relocate it to its new +starting address if needed, and reinitialize all pointers to this +data. Also, rebuild all the quickly rebuildable data. +@end enumerate + +@node Data descriptions, Dumping phase, Overview, Dumping +@section Data descriptions + +The more complex task of the dumper is to be able to write lisp objects +(lrecords) and C structs to disk and reload them at a different address, +updating all the pointers they include in the process. This is done by +using external data descriptions that give information about the layout +of the structures in memory. + +The specification of these descriptions is in lrecord.h. A description +of an lrecord is an array of struct lrecord_description. Each of these +structs include a type, an offset in the structure and some optional +parameters depending on the type. For instance, here is the string +description: + +@example +static const struct lrecord_description string_description[] = @{ + @{ XD_BYTECOUNT, offsetof (Lisp_String, size) @}, + @{ XD_OPAQUE_DATA_PTR, offsetof (Lisp_String, data), XD_INDIRECT(0, 1) @}, + @{ XD_LISP_OBJECT, offsetof (Lisp_String, plist) @}, + @{ XD_END @} +@}; +@end example + +The first line indicates a member of type Bytecount, which is used by +the next, indirect directive. The second means "there is a pointer to +some opaque data in the field @code{data}". The length of said data is +given by the expression @code{XD_INDIRECT(0, 1)}, which means "the value +in the 0th line of the description (welcome to C) plus one". The third +line means "there is a Lisp_Object member @code{plist} in the Lisp_String +structure". @code{XD_END} then ends the description. + +This gives us all the information we need to move around what is pointed +to by a structure (C or lrecord) and, by transitivity, everything that +it points to. The only missing information for dumping is the size of +the structure. For lrecords, this is part of the +lrecord_implementation, so we don't need to duplicate it. For C +structures we use a struct struct_description, which includes a size +field and a pointer to an associated array of lrecord_description. + +@node Dumping phase, Reloading phase, Data descriptions, Dumping +@section Dumping phase + +Dumping is done by calling the function pdump() (in alloc.c) which is +invoked from Fdump_emacs (in emacs.c). This function performs a number +of tasks. + +@menu +* Object inventory:: +* Address allocation:: +* The header:: +* Data dumping:: +* Pointers dumping:: +@end menu + +@node Object inventory, Address allocation, Dumping phase, Dumping phase +@subsection Object inventory + +The first task is to build the list of the objects to dump. This +includes: + +@itemize @bullet +@item lisp objects +@item C structures +@end itemize + +We end up with one @code{pdump_entry_list_elmt} per object group (arrays +of C structs are kept together) which includes a pointer to the first +object of the group, the per-object size and the count of objects in the +group, along with some other information which is initialized later. + +These entries are linked together in @code{pdump_entry_list} structures +and can be enumerated thru either: + +@enumerate +@item +the @code{pdump_object_table}, an array of @code{pdump_entry_list}, one +per lrecord type, indexed by type number. + +@item +the @code{pdump_opaque_data_list}, used for the opaque data which does +not include pointers, and hence does not need descriptions. + +@item +the @code{pdump_struct_table}, which is a vector of +@code{struct_description}/@code{pdump_entry_list} pairs, used for +non-opaque C structures. +@end enumerate + +This uses a marking strategy similar to the garbage collector. Some +differences though: + +@enumerate +@item +We do not use the mark bit (which does not exist for C structures +anyway), we use a big hash table instead. + +@item +We do not use the mark function of lrecords but instead rely on the +external descriptions. This happens essentially because we need to +follow pointers to C structures and opaque data in addition to +Lisp_Object members. +@end enumerate + +This is done by @code{pdump_register_object}, which handles Lisp_Object +variables, and pdump_register_struct which handles C structures, which +both delegate the description management to pdump_register_sub. + +The hash table doubles as a map object to pdump_entry_list_elmt (i.e. +allows us to look up a pdump_entry_list_elmt with the object it points +to). Entries are added with @code{pdump_add_entry()} and looked up with +@code{pdump_get_entry()}. There is no need for entry removal. The hash +value is computed quite basically from the object pointer by +@code{pdump_make_hash()}. + +The roots for the marking are: + +@enumerate +@item +the @code{staticpro}'ed variables (there is a special @code{staticpro_nodump()} +call for protected variables we do not want to dump). + +@item +the @code{pdump_wire}'d variables (@code{staticpro} is equivalent to +@code{staticpro_nodump()} + @code{pdump_wire()}). + +@item +the @code{dumpstruct}'ed variables, which points to C structures. +@end enumerate + +This does not include the GCPRO'ed variables, the specbinds, the +catchtags, the backlist, the redisplay or the profiling info, since we +do not want to rebuild the actual chain of lisp calls which end up to +the dump-emacs call, only the global variables. + +Weak lists and weak hash tables are dumped as if they were their +non-weak equivalent (without changing their type, of course). This has +not yet been a problem. + +@node Address allocation, The header, Object inventory, Dumping phase +@subsection Address allocation + + +The next step is to allocate the offsets of each of the objects in the +final dump file. This is done by @code{pdump_allocate_offset()} which +is called indirectly by @code{pdump_scan_by_alignment()}. + +The strategy to deal with alignment problems uses these facts: + +@enumerate +@item +real world alignment requirements are powers of two. + +@item +the C compiler is required to adjust the size of a struct so that you +can have an array of them next to each other. This means you can have a +upper bound of the alignment requirements of a given structure by +looking at which power of two its size is a multiple. + +@item +the non-variant part of variable size lrecords has an alignment +requirement of 4. +@end enumerate + +Hence, for each lrecord type, C struct type or opaque data block the +alignment requirement is computed as a power of two, with a minimum of +2^2 for lrecords. @code{pdump_scan_by_alignment()} then scans all the +@code{pdump_entry_list_elmt}'s, the ones with the highest requirements +first. This ensures the best packing. + +The maximum alignment requirement we take into account is 2^8. + +@code{pdump_allocate_offset()} only has to do a linear allocation, +starting at offset 256 (this leaves room for the header and keep the +alignments happy). + +@node The header, Data dumping, Address allocation, Dumping phase +@subsection The header + +The next step creates the file and writes a header with a signature and +some random informations in it (number of staticpro, number of assigned +lrecord types, etc...). The reloc_address field, which indicates at +which address the file should be loaded if we want to avoid post-reload +relocation, is set to 0. It then seeks to offset 256 (base offset for +the objects). + +@node Data dumping, Pointers dumping, The header, Dumping phase +@subsection Data dumping + +The data is dumped in the same order as the addresses were allocated by +@code{pdump_dump_data()}, called from @code{pdump_scan_by_alignment()}. +This function copies the data to a temporary buffer, relocates all +pointers in the object to the addresses allocated in step Address +Allocation, and writes it to the file. Using the same order means that, +if we are careful with lrecords whose size is not a multiple of 4, we +are ensured that the object is always written at the offset in the file +allocated in step Address Allocation. + +@node Pointers dumping, , Data dumping, Dumping phase +@subsection Pointers dumping + +A bunch of tables needed to reassign properly the global pointers are +then written. They are: + +@enumerate +@item the staticpro array +@item the dumpstruct array +@item the lrecord_implementation_table array +@item a vector of all the offsets to the objects in the file that include a +description (for faster relocation at reload time) +@item the pdump_wired and pdump_wired_list arrays +@end enumerate + +For each of the arrays we write both the pointer to the variables and +the relocated offset of the object they point to. Since these variables +are global, the pointers are still valid when restarting the program and +are used to regenerate the global pointers. + +The @code{pdump_wired_list} array is a special case. The variables it +points to are the head of weak linked lists of lisp objects of the same +type. Not all objects of this list are dumped so the relocated pointer +we associate with them points to the first dumped object of the list, or +Qnil if none is available. This is also the reason why they are not +used as roots for the purpose of object enumeration. + +This is the end of the dumping part. + +@node Reloading phase, Remaining issues, Dumping phase, Dumping +@section Reloading phase + +@subsection File loading + +The file is mmap'ed in memory (which ensures a PAGESIZE alignment, at +least 4096), or if mmap is unavailable or fails, a 256-bytes aligned +malloc is done and the file is loaded. + +Some variables are reinitialized from the values found in the header. + +The difference between the actual loading address and the reloc_address +is computed and will be used for all the relocations. + + +@subsection Putting back the staticvec + +The staticvec array is memcpy'd from the file and the variables it +points to are reset to the relocated objects addresses. + + +@subsection Putting back the dumpstructed variables + +The variables pointed to by dumpstruct in the dump phase are reset to +the right relocated object addresses. + + +@subsection lrecord_implementations_table + +The lrecord_implementations_table is reset to its dump time state and +the right lrecord_type_index values are put in. + + +@subsection Object relocation + +All the objects are relocated using their description and their offset +by @code{pdump_reloc_one}. This step is unnecessary if the +reloc_address is equal to the file loading address. + + +@subsection Putting back the pdump_wire and pdump_wire_list variables + +Same as Putting back the dumpstructed variables. + + +@subsection Reorganize the hash tables + +Since some of the hash values in the lisp hash tables are +address-dependent, their layout is now wrong. So we go through each of +them and have them resorted by calling @code{pdump_reorganize_hash_table}. + +@node Remaining issues, , Reloading phase, Dumping +@section Remaining issues + +The build process will have to start a post-dump xemacs, ask it the +loading address (which will, hopefully, be always the same between +different xemacs invocations) and relocate the file to the new address. +This way the object relocation phase will not have to be done, which +means no writes in the objects and that, because of the use of mmap, the +dumped data will be shared between all the xemacs running on the +computer. + +Some executable signature will be necessary to ensure that a given dump +file is really associated with a given executable, or random crashes +will occur. Maybe a random number set at compile or configure time thru +a define. This will also allow for having differently-compiled xemacsen +on the same system (mule and no-mule comes to mind). + +The DOC file contents should probably end up in the dump file. + + +@node Events and the Event Loop, Evaluation; Stack Frames; Bindings, Dumping, Top @chapter Events and the Event Loop @menu @@ -5207,7 +6113,7 @@ * Dispatching Events; The Command Builder:: @end menu -@node Introduction to Events +@node Introduction to Events, Main Loop, Events and the Event Loop, Events and the Event Loop @section Introduction to Events An event is an object that encapsulates information about an @@ -5241,12 +6147,12 @@ nature of the most basic events that are received. Part of the complex nature of the XEmacs event collection process involves converting from the operating-system events into the proper -Emacs events -- there may not be a one-to-one correspondence. +Emacs events---there may not be a one-to-one correspondence. Emacs events are documented in @file{events.h}; I'll discuss them later. -@node Main Loop +@node Main Loop, Specifics of the Event Gathering Mechanism, Introduction to Events, Events and the Event Loop @section Main Loop The @dfn{command loop} is the top-level loop that the editor is always @@ -5266,7 +6172,7 @@ This is documented elsewhere. The guts of the command loop are in @code{command_loop_1()}. This -function doesn't catch errors, though -- that's the job of +function doesn't catch errors, though---that's the job of @code{command_loop_2()}, which is a condition-case (i.e. error-trapping) wrapper around @code{command_loop_1()}. @code{command_loop_1()} never returns, but may get thrown out of. @@ -5313,7 +6219,7 @@ invoking @code{top_level_1()}, just like when it invokes @code{command_loop_2()}. -@node Specifics of the Event Gathering Mechanism +@node Specifics of the Event Gathering Mechanism, Specifics About the Emacs Event, Main Loop, Events and the Event Loop @section Specifics of the Event Gathering Mechanism Here is an approximate diagram of the collection processes @@ -5552,13 +6458,13 @@ using `dispatch-event' @end example -@node Specifics About the Emacs Event +@node Specifics About the Emacs Event, The Event Stream Callback Routines, Specifics of the Event Gathering Mechanism, Events and the Event Loop @section Specifics About the Emacs Event -@node The Event Stream Callback Routines +@node The Event Stream Callback Routines, Other Event Loop Functions, Specifics About the Emacs Event, Events and the Event Loop @section The Event Stream Callback Routines -@node Other Event Loop Functions +@node Other Event Loop Functions, Converting Events, The Event Stream Callback Routines, Events and the Event Loop @section Other Event Loop Functions @code{detect_input_pending()} and @code{input-pending-p} look for @@ -5580,7 +6486,7 @@ the right kind of input method support, it is possible for (read-char) to return a Kanji character. -@node Converting Events +@node Converting Events, Dispatching Events; The Command Builder, Other Event Loop Functions, Events and the Event Loop @section Converting Events @code{character_to_event()}, @code{event_to_character()}, @@ -5591,7 +6497,7 @@ between character representation and the split-up event representation (keysym plus mod keys). -@node Dispatching Events; The Command Builder +@node Dispatching Events; The Command Builder, , Converting Events, Events and the Event Loop @section Dispatching Events; The Command Builder Not yet documented. @@ -5606,7 +6512,7 @@ * Catch and Throw:: @end menu -@node Evaluation +@node Evaluation, Dynamic Binding; The specbinding Stack; Unwind-Protects, Evaluation; Stack Frames; Bindings, Evaluation; Stack Frames; Bindings @section Evaluation @code{Feval()} evaluates the form (a Lisp object) that is passed to @@ -5736,7 +6642,7 @@ an array). @code{apply1()} uses @code{Fapply()} while the others use @code{Ffuncall()} to do the real work. -@node Dynamic Binding; The specbinding Stack; Unwind-Protects +@node Dynamic Binding; The specbinding Stack; Unwind-Protects, Simple Special Forms, Evaluation, Evaluation; Stack Frames; Bindings @section Dynamic Binding; The specbinding Stack; Unwind-Protects @example @@ -5790,7 +6696,7 @@ the symbol's value). @end enumerate -@node Simple Special Forms +@node Simple Special Forms, Catch and Throw, Dynamic Binding; The specbinding Stack; Unwind-Protects, Evaluation; Stack Frames; Bindings @section Simple Special Forms @code{or}, @code{and}, @code{if}, @code{cond}, @code{progn}, @@ -5807,7 +6713,7 @@ compiler knows how to convert calls to these functions directly into byte code. -@node Catch and Throw +@node Catch and Throw, , Simple Special Forms, Evaluation; Stack Frames; Bindings @section Catch and Throw @example @@ -5875,7 +6781,7 @@ * Symbol Values:: @end menu -@node Introduction to Symbols +@node Introduction to Symbols, Obarrays, Symbols and Variables, Symbols and Variables @section Introduction to Symbols A symbol is basically just an object with four fields: a name (a @@ -5892,7 +6798,7 @@ additional values with particular names, and once again the namespace is independent of the function and variable namespaces. -@node Obarrays +@node Obarrays, Symbol Values, Introduction to Symbols, Symbols and Variables @section Obarrays The identity of symbols with their names is accomplished through a @@ -5959,7 +6865,7 @@ into any obarray.) Finally, @code{mapatoms} maps over all of the symbols in an obarray. -@node Symbol Values +@node Symbol Values, , Obarrays, Symbols and Variables @section Symbol Values The value field of a symbol normally contains a Lisp object. However, @@ -6014,7 +6920,7 @@ * The Buffer Object:: The Lisp object corresponding to a buffer. @end menu -@node Introduction to Buffers +@node Introduction to Buffers, The Text in a Buffer, Buffers and Textual Representation, Buffers and Textual Representation @section Introduction to Buffers A buffer is logically just a Lisp object that holds some text. @@ -6067,7 +6973,7 @@ window. (This latter distinction is explained in detail in the section on windows.) -@node The Text in a Buffer +@node The Text in a Buffer, Buffer Lists, Introduction to Buffers, Buffers and Textual Representation @section The Text in a Buffer The text in a buffer consists of a sequence of zero or more @@ -6207,7 +7113,7 @@ number of possible alternative representations (e.g. EUC-encoded text, etc.). -@node Buffer Lists +@node Buffer Lists, Markers and Extents, The Text in a Buffer, Buffers and Textual Representation @section Buffer Lists Recall earlier that buffers are @dfn{permanent} objects, i.e. that @@ -6243,7 +7149,7 @@ a unique name from this by appending a number, and then creates the buffer. This is basically like the symbol operation @code{gensym}. -@node Markers and Extents +@node Markers and Extents, Bufbytes and Emchars, Buffer Lists, Buffers and Textual Representation @section Markers and Extents Among the things associated with a buffer are things that are @@ -6283,12 +7189,12 @@ (which could happen as a result of text being deleted) or the buffer is deleted, and primitives do exist to enumerate the extents in a buffer. -@node Bufbytes and Emchars +@node Bufbytes and Emchars, The Buffer Object, Markers and Extents, Buffers and Textual Representation @section Bufbytes and Emchars Not yet documented. -@node The Buffer Object +@node The Buffer Object, , Bufbytes and Emchars, Buffers and Textual Representation @section The Buffer Object Buffers contain fields not directly accessible by the Lisp programmer. @@ -6407,7 +7313,7 @@ * CCL:: @end menu -@node Character Sets +@node Character Sets, Encodings, MULE Character Sets and Encodings, MULE Character Sets and Encodings @section Character Sets A character set (or @dfn{charset}) is an ordered set of characters. A @@ -6488,7 +7394,7 @@ This is a bit ad-hoc but gets the job done. -@node Encodings +@node Encodings, Internal Mule Encodings, Character Sets, MULE Character Sets and Encodings @section Encodings An @dfn{encoding} is a way of numerically representing characters from @@ -6515,7 +7421,7 @@ * JIS7:: @end menu -@node Japanese EUC (Extended Unix Code) +@node Japanese EUC (Extended Unix Code), JIS7, Encodings, Encodings @subsection Japanese EUC (Extended Unix Code) This encompasses the character sets Printing-ASCII, Japanese-JISX0201, @@ -6537,7 +7443,7 @@ @end example -@node JIS7 +@node JIS7, , Japanese EUC (Extended Unix Code), Encodings @subsection JIS7 This encompasses the character sets Printing-ASCII, @@ -6572,7 +7478,7 @@ Initially, Printing-ASCII is invoked. -@node Internal Mule Encodings +@node Internal Mule Encodings, CCL, Encodings, MULE Character Sets and Encodings @section Internal Mule Encodings In XEmacs/Mule, each character set is assigned a unique number, called a @@ -6618,7 +7524,7 @@ * Internal Character Encoding:: @end menu -@node Internal String Encoding +@node Internal String Encoding, Internal Character Encoding, Internal Mule Encodings, Internal Mule Encodings @subsection Internal String Encoding ASCII characters are encoded using their position code directly. Other @@ -6668,7 +7574,7 @@ Shift-JIS and Big5 (not yet described) satisfy only (2). (All non-modal encodings must satisfy (2), in order to be unambiguous.) -@node Internal Character Encoding +@node Internal Character Encoding, , Internal String Encoding, Internal Mule Encodings @subsection Internal Character Encoding One 19-bit word represents a single character. The word is @@ -6703,7 +7609,7 @@ Note that character codes 0 - 255 are the same as the ``binary encoding'' described above. -@node CCL +@node CCL, , Internal Mule Encodings, MULE Character Sets and Encodings @section CCL @example @@ -6894,7 +7800,7 @@ * Lstream Methods:: Creating new lstream types. @end menu -@node Creating an Lstream +@node Creating an Lstream, Lstream Types, Lstreams, Lstreams @section Creating an Lstream Lstreams come in different types, depending on what is being interfaced @@ -6925,7 +7831,7 @@ Open for writing, but never writes partial MULE characters. @end table -@node Lstream Types +@node Lstream Types, Lstream Functions, Creating an Lstream, Lstreams @section Lstream Types @table @asis @@ -6950,10 +7856,10 @@ @item encoding @end table -@node Lstream Functions +@node Lstream Functions, Lstream Methods, Lstream Types, Lstreams @section Lstream Functions -@deftypefun {Lstream *} Lstream_new (Lstream_implementation *@var{imp}, CONST char *@var{mode}) +@deftypefun {Lstream *} Lstream_new (Lstream_implementation *@var{imp}, const char *@var{mode}) Allocate and return a new Lstream. This function is not really meant to be called directly; rather, each stream type should provide its own stream creation function, which creates the stream and does any other @@ -6986,8 +7892,8 @@ @deftypefn Macro void Lstream_ungetc (Lstream *@var{stream}, int @var{c}) Push one byte back onto the input queue. This will be the next byte read from the stream. Any number of bytes can be pushed back and will -be read in the reverse order they were pushed back -- most recent -first. (This is necessary for consistency -- if there are a number of +be read in the reverse order they were pushed back---most recent +first. (This is necessary for consistency---if there are a number of bytes that have been unread and I read and unread a byte, it needs to be the first to be read again.) This is a macro and so it is very efficient. The @var{c} argument is only evaluated once but the @var{stream} @@ -7000,18 +7906,18 @@ Function equivalents of the above macros. @end deftypefun -@deftypefun int Lstream_read (Lstream *@var{stream}, void *@var{data}, int @var{size}) +@deftypefun ssize_t Lstream_read (Lstream *@var{stream}, void *@var{data}, size_t @var{size}) Read @var{size} bytes of @var{data} from the stream. Return the number of bytes read. 0 means EOF. -1 means an error occurred and no bytes were read. @end deftypefun -@deftypefun int Lstream_write (Lstream *@var{stream}, void *@var{data}, int @var{size}) +@deftypefun ssize_t Lstream_write (Lstream *@var{stream}, void *@var{data}, size_t @var{size}) Write @var{size} bytes of @var{data} to the stream. Return the number of bytes written. -1 means an error occurred and no bytes were written. @end deftypefun -@deftypefun void Lstream_unread (Lstream *@var{stream}, void *@var{data}, int @var{size}) +@deftypefun void Lstream_unread (Lstream *@var{stream}, void *@var{data}, size_t @var{size}) Push back @var{size} bytes of @var{data} onto the input queue. The next call to @code{Lstream_read()} with the same size will read the same bytes back. Note that this will be the case even if there is other @@ -7025,7 +7931,7 @@ @deftypefun void Lstream_reopen (Lstream *@var{stream}) Reopen a closed stream. This enables I/O on it again. This is not meant to be called except from a wrapper routine that reinitializes -variables and such -- the close routine may well have freed some +variables and such---the close routine may well have freed some necessary storage structures, for example. @end deftypefun @@ -7033,10 +7939,10 @@ Rewind the stream to the beginning. @end deftypefun -@node Lstream Methods +@node Lstream Methods, , Lstream Functions, Lstreams @section Lstream Methods -@deftypefn {Lstream Method} int reader (Lstream *@var{stream}, unsigned char *@var{data}, int @var{size}) +@deftypefn {Lstream Method} ssize_t reader (Lstream *@var{stream}, unsigned char *@var{data}, size_t @var{size}) Read some data from the stream's end and store it into @var{data}, which can hold @var{size} bytes. Return the number of bytes read. A return value of 0 means no bytes can be read at this time. This may be because @@ -7053,7 +7959,7 @@ This function can be @code{NULL} if the stream is output-only. @end deftypefn -@deftypefn {Lstream Method} int writer (Lstream *@var{stream}, CONST unsigned char *@var{data}, int @var{size}) +@deftypefn {Lstream Method} ssize_t writer (Lstream *@var{stream}, const unsigned char *@var{data}, size_t @var{size}) Send some data to the stream's end. Data to be sent is in @var{data} and is @var{size} bytes. Return the number of bytes sent. This function can send and return fewer bytes than is passed in; in that @@ -7071,7 +7977,7 @@ @end deftypefn @deftypefn {Lstream Method} int seekable_p (Lstream *@var{stream}) -Indicate whether this stream is seekable -- i.e. it can be rewound. +Indicate whether this stream is seekable---i.e. it can be rewound. This method is ignored if the stream does not have a rewind method. If this method is not present, the result is determined by whether a rewind method is present. @@ -7108,7 +8014,7 @@ * The Window Object:: @end menu -@node Introduction to Consoles; Devices; Frames; Windows +@node Introduction to Consoles; Devices; Frames; Windows, Point, Consoles; Devices; Frames; Windows, Consoles; Devices; Frames; Windows @section Introduction to Consoles; Devices; Frames; Windows A window-system window that you see on the screen is called a @@ -7150,7 +8056,7 @@ within it to become the selected window. Similar relationships apply for consoles to devices and devices to frames. -@node Point +@node Point, Window Hierarchy, Introduction to Consoles; Devices; Frames; Windows, Consoles; Devices; Frames; Windows @section Point Recall that every buffer has a current insertion position, called @@ -7171,7 +8077,7 @@ buffer's point instead. This is related to why @code{save-window-excursion} does not save the selected window's value of @code{point}. -@node Window Hierarchy +@node Window Hierarchy, The Window Object, Point, Consoles; Devices; Frames; Windows @section Window Hierarchy @cindex window hierarchy @cindex hierarchy of windows @@ -7240,7 +8146,7 @@ @item Leaf windows also have markers in their @code{start} (the first buffer position displayed in the window) and @code{pointm} -(the window's stashed value of @code{point} -- see above) fields, +(the window's stashed value of @code{point}---see above) fields, while combination windows have nil in these fields. @item @@ -7256,7 +8162,7 @@ GC purposes. @item -Most frames actually have two top-level windows -- one for the +Most frames actually have two top-level windows---one for the minibuffer and one (the @dfn{root}) for everything else. The modeline (if present) separates these two. The @code{next} field of the root points to the minibuffer, and the @code{prev} field of the minibuffer @@ -7269,7 +8175,7 @@ artifact that should be fixed.) @end enumerate -@node The Window Object +@node The Window Object, , Window Hierarchy, Consoles; Devices; Frames; Windows @section The Window Object Windows have the following accessible fields: @@ -7398,9 +8304,10 @@ @menu * Critical Redisplay Sections:: * Line Start Cache:: +* Redisplay Piece by Piece:: @end menu -@node Critical Redisplay Sections +@node Critical Redisplay Sections, Line Start Cache, The Redisplay Mechanism, The Redisplay Mechanism @section Critical Redisplay Sections @cindex critical redisplay sections @@ -7432,7 +8339,7 @@ #### If a frame-size change does occur we should probably actually be preempting redisplay. -@node Line Start Cache +@node Line Start Cache, Redisplay Piece by Piece, Critical Redisplay Sections, The Redisplay Mechanism @section Line Start Cache @cindex line start cache @@ -7476,7 +8383,7 @@ is sufficient to always provide the needed information. The second thing we can do is be smart about invalidating the cache. - TODO -- Be smart about invalidating the cache. Potential places: + TODO---Be smart about invalidating the cache. Potential places: @itemize @bullet @item @@ -7493,7 +8400,58 @@ In case you're wondering, the Second Golden Rule of Redisplay is not applicable. -@node Extents, Faces and Glyphs, The Redisplay Mechanism, Top +@node Redisplay Piece by Piece, , Line Start Cache, The Redisplay Mechanism +@section Redisplay Piece by Piece +@cindex Redisplay Piece by Piece + +As you can begin to see redisplay is complex and also not well +documented. Chuck no longer works on XEmacs so this section is my take +on the workings of redisplay. + +Redisplay happens in three phases: + +@enumerate +@item +Determine desired display in area that needs redisplay. +Implemented by @code{redisplay.c} +@item +Compare desired display with current display +Implemented by @code{redisplay-output.c} +@item +Output changes Implemented by @code{redisplay-output.c}, +@code{redisplay-x.c}, @code{redisplay-msw.c} and @code{redisplay-tty.c} +@end enumerate + +Steps 1 and 2 are device-independant and relatively complex. Step 3 is +mostly device-dependent. + +Determining the desired display + +Display attributes are stored in @code{display_line} structures. Each +@code{display_line} consists of a set of @code{display_block}'s and each +@code{display_block} contains a number of @code{rune}'s. Generally +dynarr's of @code{display_line}'s are held by each window representing +the current display and the desired display. + +The @code{display_line} structures are tighly tied to buffers which +presents a problem for redisplay as this connection is bogus for the +modeline. Hence the @code{display_line} generation routines are +duplicated for generating the modeline. This means that the modeline +display code has many bugs that the standard redisplay code does not. + +The guts of @code{display_line} generation are in +@code{create_text_block}, which creates a single display line for the +desired locale. This incrementally parses the characters on the current +line and generates redisplay structures for each. + +Gutter redisplay is different. Because the data to display is stored in +a string we cannot use @code{create_text_block}. Instead we use +@code{create_text_string_block} which performs the same function as +@code{create_text_block} but for strings. Many of the complexities of +@code{create_text_block} to do with cursor handling and selective +display have been removed. + +@node Extents, Faces, The Redisplay Mechanism, Top @chapter Extents @menu @@ -7501,11 +8459,11 @@ * Extent Ordering:: How extents are ordered internally. * Format of the Extent Info:: The extent information in a buffer or string. * Zero-Length Extents:: A weird special case. -* Mathematics of Extent Ordering:: A rigorous foundation. +* Mathematics of Extent Ordering:: A rigorous foundation. * Extent Fragments:: Cached information useful for redisplay. @end menu -@node Introduction to Extents +@node Introduction to Extents, Extent Ordering, Extents, Extents @section Introduction to Extents Extents are regions over a buffer, with a start and an end position @@ -7527,7 +8485,7 @@ however, and just ended up complexifying and buggifying all the rest of the code.) -@node Extent Ordering +@node Extent Ordering, Format of the Extent Info, Introduction to Extents, Extents @section Extent Ordering Extents are compared using memory indices. There are two orderings @@ -7561,13 +8519,13 @@ all occurrences of ``display order'' and ``e-order'', ``less than'' and ``greater than'', and ``extent start'' and ``extent end''. -@node Format of the Extent Info +@node Format of the Extent Info, Zero-Length Extents, Extent Ordering, Extents @section Format of the Extent Info An extent-info structure consists of a list of the buffer or string's extents and a @dfn{stack of extents} that lists all of the extents over a particular position. The stack-of-extents info is used for -optimization purposes -- it basically caches some info that might +optimization purposes---it basically caches some info that might be expensive to compute. Certain otherwise hard computations are easy given the stack of extents over a particular position, and if the stack of extents over a nearby position is known (because it was @@ -7595,7 +8553,7 @@ array, except for the fact that positions are integers (this should be generalized to handle integers and linked list equally well). -@node Zero-Length Extents +@node Zero-Length Extents, Mathematics of Extent Ordering, Format of the Extent Info, Extents @section Zero-Length Extents Extents can be zero-length, and will end up that way if their endpoints @@ -7624,7 +8582,7 @@ exactly like markers and that open-closed, non-detachable zero-length extents behave like the ``point-type'' marker in Mule. -@node Mathematics of Extent Ordering +@node Mathematics of Extent Ordering, Extent Fragments, Zero-Length Extents, Extents @section Mathematics of Extent Ordering @cindex extent mathematics @cindex mathematics of extents @@ -7759,7 +8717,7 @@ @math{S}, including @math{F}. Otherwise, @math{F2} includes @math{I} and thus is in @math{S}, and thus @math{F2 >= F}. -@node Extent Fragments +@node Extent Fragments, , Mathematics of Extent Ordering, Extents @section Extent Fragments @cindex extent fragment @@ -7769,7 +8727,7 @@ An extent fragment is a structure that holds data about the run that contains a particular buffer position (if the buffer position is at the -junction of two runs, the run after the position is used) -- the +junction of two runs, the run after the position is used)---the beginning and end of the run, a list of all of the extents in that run, the @dfn{merged face} that results from merging all of the faces corresponding to those extents, the begin and end glyphs at the @@ -7781,12 +8739,74 @@ stack-of-extents code, which does the heavy-duty algorithmic work of determining which extents overly a particular position. -@node Faces and Glyphs, Specifiers, Extents, Top -@chapter Faces and Glyphs +@node Faces, Glyphs, Extents, Top +@chapter Faces Not yet documented. -@node Specifiers, Menus, Faces and Glyphs, Top +@node Glyphs, Specifiers, Faces, Top +@chapter Glyphs + +Glyphs are graphical elements that can be displayed in XEmacs buffers or +gutters. We use the term graphical element here in the broadest possible +sense since glyphs can be as mundane as text to as arcane as a native +tab widget. + +In XEmacs, glyphs represent the uninstantiated state of graphical +elements, i.e. they hold all the information necessary to produce an +image on-screen but the image does not exist at this stage. + +Glyphs are lazily instantiated by calling one of the glyph +functions. This usually occurs within redisplay when +@code{Fglyph_height} is called. Instantiation causes an image-instance +to be created and cached. This cache is on a device basis for all glyphs +except glyph-widgets, and on a window basis for glyph widgets. The +caching is done by @code{image_instantiate} and is necessary because it +is generally possible to display an image-instance in multiple +domains. For instance if we create a Pixmap, we can actually display +this on multiple windows - even though we only need a single Pixmap +instance to do this. If caching wasn't done then it would be necessary +to create image-instances for every displayable occurrance of a glyph - +and every usage - and this would be extremely memory and cpu intensive. + +Widget-glyphs (a.k.a native widgets) are not cached in this way. This is +because widget-glyph image-instances on screen are toolkit windows, and +thus cannot be reused in multiple XEmacs domains. Thus widget-glyphs are +cached on a window basis. + +Any action on a glyph first consults the cache before actually +instantiating a widget. + +@section Widget-Glyphs in the MS-Windows Environment + +To Do + +@section Widget-Glyphs in the X Environment + +Widget-glyphs under X make heavy use of lwlib for manipulating the +native toolkit objects. This is primarily so that different toolkits can +be supported for widget-glyphs, just as they are supported for features +such as menubars etc. + +Lwlib is extremely poorly documented and quite hairy so here is my +understanding of what goes on. + +Lwlib maintains a set of widget_instances which mirror the hierarchical +state of Xt widgets. I think this is so that widgets can be updated and +manipulated generically by the lwlib library. For instance +update_one_widget_instance can cope with multiple types of widget and +multiple types of toolkit. Each element in the widget hierarchy is updated +from its corresponding widget_instance by walking the widget_instance +tree recursively. + +This has desirable properties such as lw_modify_all_widgets which is +called from glyphs-x.c and updates all the properties of a widget +without having to know what the widget is or what toolkit it is from. +Unfortunately this also has hairy properrties such as making the lwlib +code quite complex. And of course lwlib has to know at some level what +the widget is and how to set its properties. + +@node Specifiers, Menus, Glyphs, Top @chapter Specifiers Not yet documented. @@ -7916,7 +8936,7 @@ or @code{nil} if it is using pipes. @end table -@node Interface to X Windows, Index, Subprocesses, Top +@node Interface to X Windows, Index , Subprocesses, Top @chapter Interface to X Windows Not yet documented. diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/Makefile --- a/man/lispref/Makefile Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,80 +0,0 @@ -# Makefile for the XEmacs Lisp Programmer's Manual. - -# This file is part of XEmacs. - -# XEmacs is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any -# later version. - -# XEmacs is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. - -# You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. - -VERSION=2.4 -NAME=lispref -manual = elisp-manual-19-$(VERSION) - -TEXI2DVI = texi2dvi -MAKEINFO = makeinfo - -# Uncomment this line for permuted index. -# permuted_index = 1 - -# List of all the texinfo files in the manual: - -srcs = abbrevs.texi annotations.texi back.texi backups.texi buffers.texi \ - building.texi commands.texi compile.texi consoles-devices.texi control.texi \ - databases.texi debugging.texi dialog.texi display.texi edebug-inc.texi \ - edebug.texi errors.texi eval.texi extents.texi faces.texi files.texi \ - frames.texi functions.texi glyphs.texi hash-tables.texi help.texi \ - hooks.texi index.texi internationalization.texi intro.texi \ - keymaps.texi ldap.texi lispref.texi lists.texi loading.texi locals.texi \ - macros.texi maps.texi markers.texi menus.texi minibuf.texi modes.texi \ - mouse.texi mule.texi numbers.texi objects.texi os.texi positions.texi \ - processes.texi range-tables.texi scrollbars.texi searching.texi \ - sequences.texi specifiers.texi streams.texi strings.texi symbols.texi \ - syntax.texi text.texi tips.texi toolbar.texi tooltalk.texi variables.texi \ - windows.texi x-windows.texi index.unperm index.perm - -all : info -info : ../../info/$(NAME).info - -../../info/$(NAME).info: $(srcs) index.texi - $(MAKEINFO) -o $@ $(NAME).texi - -dvi: $(NAME).dvi - -$(NAME).dvi: $(srcs) index.texi - # Avoid losing old contents of aux file entirely. - -mv $(NAME).aux $(NAME).oaux - # First shot to define xrefs: - $(TEX) $(NAME).texi - if [ a${permuted_index} != a ]; \ - then ./permute-index && mv permuted.fns $(NAME).fns; \ - else texindex $(NAME).??; \ - fi - $(TEX) $(NAME).texi - -index.texi: - if [ a${permuted_index} != a ]; \ - then ln -s index.perm index.texi; \ - else ln -s index.unperm index.texi; \ - fi - -.PHONY: mostlyclean clean distclean realclean extraclean -mostlyclean: - rm -f *.toc *.aux *.log *.cp *.cps *.fn *.fns *.tp *.tps \ - *.vr *.vrs *.pg *.pgs *.ky *.kys -clean: mostlyclean - rm -f *.dvi *.ps make.out core index.texi -distclean: clean -realclean: distclean -extraclean: distclean - -rm -f *~ \#* diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/commands.texi --- a/man/lispref/commands.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/commands.texi Mon Aug 13 11:13:30 2007 +0200 @@ -874,7 +874,7 @@ @item channel @item timestamp @item key - Which key was pressed. This is an integer (in the printing @sc{ASCII} + Which key was pressed. This is an integer (in the printing @sc{ascii} range: >32 and <127) or a symbol such as @code{left} or @code{right}. Note that many physical keys are actually treated as two separate keys, depending on whether the shift key is pressed; for example, the ``a'' @@ -1252,7 +1252,7 @@ @defun event-key event This function returns the Keysym of the given key-press event. -This will be the @sc{ASCII} code of a printing character, or a symbol. +This will be the @sc{ascii} code of a printing character, or a symbol. @end defun @defun event-button event @@ -1450,13 +1450,13 @@ XEmacs provides some auxiliary functions for converting between events and other ways of representing keys. These are useful when working with -@sc{ASCII} strings and with keymaps. +@sc{ascii} strings and with keymaps. @defun character-to-event ch &optional event device -This function converts a numeric @sc{ASCII} value to an event structure, +This function converts a numeric @sc{ascii} value to an event structure, replete with modifier bits. @var{ch} is the character to convert, and @var{event} is the event object to fill in. This function contains -knowledge about what the codes ``mean'' -- for example, the number 9 is +knowledge about what the codes ``mean''---for example, the number 9 is converted to the character @key{Tab}, not the distinct character @key{Control-I}. @@ -1474,19 +1474,19 @@ Beware that @code{character-to-event} and @code{event-to-character} are not strictly inverse functions, since events contain much more -information than the @sc{ASCII} character set can encode. +information than the @sc{ascii} character set can encode. @end defun @defun event-to-character event &optional allow-extra-modifiers allow-meta allow-non-ascii -This function returns the closest @sc{ASCII} approximation to +This function returns the closest @sc{ascii} approximation to @var{event}. If the event isn't a keypress, this returns @code{nil}. If @var{allow-extra-modifiers} is non-@code{nil}, then this is lenient in its translation; it will ignore modifier keys other than @key{control} and @key{meta}, and will ignore the @key{shift} modifier -on those characters which have no shifted @sc{ASCII} equivalent +on those characters which have no shifted @sc{ascii} equivalent (@key{Control-Shift-A} for example, will be mapped to the same -@sc{ASCII} code as @key{Control-A}). +@sc{ascii} code as @key{Control-A}). If @var{allow-meta} is non-@code{nil}, then the @key{Meta} modifier will be represented by turning on the high bit of the byte returned; @@ -1497,7 +1497,7 @@ present in the prevailing character set (@pxref{Keymaps, variable @code{character-set-property}}) will be returned as their code in that character set, instead of the return value being restricted to -@sc{ASCII}. +@sc{ascii}. Note that specifying both @var{allow-meta} and @var{allow-non-ascii} is ambiguous, as both use the high bit; @key{M-x} and @key{oslash} will be @@ -1506,7 +1506,7 @@ @defun events-to-keys events &optional no-mice Given a vector of event objects, this function returns a vector of key -descriptors, or a string (if they all fit in the @sc{ASCII} range). +descriptors, or a string (if they all fit in the @sc{ascii} range). Optional arg @var{no-mice} means that button events are not allowed. @end defun @@ -1632,13 +1632,13 @@ @lisp @group - (while (progn - (next-event event) - (not (or (key-press-event-p event) - (button-press-event-p event) - (button-release-event-p event) - (menu-event-p event)))) - (dispatch-event event)) + (while (progn + (next-event event) + (not (or (key-press-event-p event) + (button-press-event-p event) + (button-release-event-p event) + (menu-event-p event)))) + (dispatch-event event)) @end group @end lisp @@ -1656,7 +1656,7 @@ @defun read-char This function reads and returns a character of command input. If a mouse click is detected, an error is signalled. The character typed is -returned as an @sc{ASCII} value. This function is retained for +returned as an @sc{ascii} value. This function is retained for compatibility with Emacs 18, and is most likely the wrong thing for you to be using: consider using @code{next-command-event} instead. @end defun @@ -1803,8 +1803,8 @@ @defvar last-input-char If the value of @code{last-input-event} is a keyboard event, then this -is the nearest @sc{ASCII} equivalent to it. Remember that there is -@emph{not} a 1:1 mapping between keyboard events and @sc{ASCII} +is the nearest @sc{ascii} equivalent to it. Remember that there is +@emph{not} a 1:1 mapping between keyboard events and @sc{ascii} characters: the set of keyboard events is much larger, so writing code that examines this variable to determine what key has been typed is bad practice, unless you are certain that it will be one of a small set of diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/consoles-devices.texi --- a/man/lispref/consoles-devices.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/consoles-devices.texi Mon Aug 13 11:13:30 2007 +0200 @@ -11,7 +11,7 @@ A @dfn{console} is an object representing a single input connection to XEmacs, such as an X display or a TTY connection. It is possible for XEmacs to have frames on multiple consoles at once (even on -heterogeneous types -- you can simultaneously have a frame on an +heterogeneous types---you can simultaneously have a frame on an X display and a TTY connection). Normally, there is only one console in existence. diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/control.texi --- a/man/lispref/control.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/control.texi Mon Aug 13 11:13:30 2007 +0200 @@ -662,7 +662,7 @@ which you call for other purposes, such as if you try to take the @sc{car} of an integer or move forward a character at the end of the buffer; you can also signal errors explicitly with the functions -@code{error} and @code{signal}. +@code{error}, @code{signal}, and others. Quitting, which happens when the user types @kbd{C-g}, is not considered an error, but it is handled almost like an error. @@ -673,6 +673,11 @@ applying @code{format} (@pxref{String Conversion}) to @var{format-string} and @var{args}. +This error is not continuable: you cannot continue execution after the +error using the debugger @kbd{r} or @kbd{c} commands. If you wish the +user to be able to continue execution, use @code{cerror} or +@code{signal} instead. + These examples show typical uses of @code{error}: @example @@ -691,7 +696,8 @@ @code{error} works by calling @code{signal} with two arguments: the error symbol @code{error}, and a list containing the string returned by -@code{format}. +@code{format}. This is repeated in an endless loop, to ensure that +@code{error} never returns. If you want to use your own string as an error message verbatim, don't just write @code{(error @var{string})}. If @var{string} contains @@ -699,10 +705,16 @@ results. Instead, use @code{(error "%s" @var{string})}. @end defun +@defun cerror format-string &rest args +This function behaves like @code{error}, except that the error it +signals is continuable. That means that debugger commands @kbd{c} and +@kbd{r} can resume execution. +@end defun + @defun signal error-symbol data -This function signals an error named by @var{error-symbol}. The -argument @var{data} is a list of additional Lisp objects relevant to the -circumstances of the error. +This function signals a continuable error named by @var{error-symbol}. +The argument @var{data} is a list of additional Lisp objects relevant to +the circumstances of the error. The argument @var{error-symbol} must be an @dfn{error symbol}---a symbol bearing a property @code{error-conditions} whose value is a list of @@ -710,9 +722,9 @@ errors. The number and significance of the objects in @var{data} depends on -@var{error-symbol}. For example, with a @code{wrong-type-arg} error, -there are two objects in the list: a predicate that describes the type -that was expected, and the object that failed to fit that type. +@var{error-symbol}. For example, with a @code{wrong-type-argument} +error, there are two objects in the list: a predicate that describes the +type that was expected, and the object that failed to fit that type. @xref{Error Symbols}, for a description of error symbols. Both @var{error-symbol} and @var{data} are available to any error @@ -721,8 +733,10 @@ @var{data})} (@pxref{Handling Errors}). If the error is not handled, these two values are used in printing the error message. -The function @code{signal} never returns (though in older Emacs versions -it could sometimes return). +The function @code{signal} can return, if the debugger is invoked and +the user invokes the ``return from signal'' option. If you want the +error not to be continuable, use @code{signal-error} instead. Note that +in FSF Emacs @code{signal} never returns. @smallexample @group @@ -731,17 +745,42 @@ @end group @group -(signal 'no-such-error '("My unknown error condition.")) - @error{} peculiar error: "My unknown error condition." +(signal 'no-such-error '("My unknown error condition")) + @error{} Peculiar error (no-such-error "My unknown error condition") @end group @end smallexample @end defun -@cindex CL note---no continuable errors -@quotation -@b{Common Lisp note:} XEmacs Lisp has nothing like the Common Lisp -concept of continuable errors. -@end quotation +@defun signal-error error-symbol data +This function behaves like @code{signal}, except that the error it +signals is not continuable. +@end defun + +@defmac check-argument-type predicate argument +This macro checks that @var{argument} satisfies @var{predicate}. If +that is not the case, it signals a continuable +@code{wrong-type-argument} error until the returned value satisfies +@var{predicate}, and assigns the returned value to @var{argument}. In +other words, execution of the program will not continue until +@var{predicate} is met. + +@var{argument} is not evaluated, and should be a symbol. +@var{predicate} is evaluated, and should name a function. + +As shown in the following example, @code{check-argument-type} is useful +in low-level code that attempts to ensure the sanity of its data before +proceeding. + +@example +@group +(defun cache-object-internal (object wlist) + ;; @r{Before doing anything, make sure that @var{wlist} is indeed} + ;; @r{a weak list, which is what we expect.} + (check-argument-type 'weak-list-p wlist) + @dots{}) +@end group +@end example +@end defmac @node Processing of Errors @subsubsection How XEmacs Processes Errors @@ -761,6 +800,27 @@ command loop's handler uses the error symbol and associated data to print an error message. +Errors in command loop are processed using the @code{command-error} +function, which takes care of some necessary cleanup, and prints a +formatted error message to the echo area. The functions that do the +formatting are explained below. + +@defun display-error error-object stream +This function displays @var{error-object} on @var{stream}. +@var{error-object} is a cons of error type, a symbol, and error +arguments, a list. If the error type symbol of one of its error +condition superclasses has an @code{display-error} property, that +function is invoked for printing the actual error message. Otherwise, +the error is printed as @samp{Error: arg1, arg2, ...}. +@end defun + +@defun error-message-string error-object +This function converts @var{error-object} to an error message string, +and returns it. The message is equivalent to the one that would be +printed by @code{display-error}, except that it is conveniently returned +in string form. +@end defun + @cindex @code{debug-on-error} use An error that has no explicit handler may call the Lisp debugger. The debugger is enabled if the variable @code{debug-on-error} (@pxref{Error @@ -834,6 +894,13 @@ totally unpredictable, such as when the program evaluates an expression read from the user. +@cindex @code{debug-on-signal} use + Even when an error is handled, the debugger may still be called if the +variable @code{debug-on-signal} (@pxref{Error Debugging}) is +non-@code{nil}. Note that this may yield unpredictable results with +code that traps expected errors as normal part of its operation. Do not +set @code{debug-on-signal} unless you know what you are doing. + Error signaling and handling have some resemblance to @code{throw} and @code{catch}, but they are entirely separate facilities. An error cannot be caught by a @code{catch}, and a @code{throw} cannot be handled @@ -917,7 +984,9 @@ @end smallexample @noindent -The handler specifies condition name @code{arith-error} so that it will handle only division-by-zero errors. Other kinds of errors will not be handled, at least not by this @code{condition-case}. Thus, +The handler specifies condition name @code{arith-error} so that it will +handle only division-by-zero errors. Other kinds of errors will not be +handled, at least not by this @code{condition-case}. Thus, @smallexample @group @@ -972,43 +1041,49 @@ is distinct from @code{error}, and perhaps some intermediate classifications. - In order for a symbol to be an error symbol, it must have an -@code{error-conditions} property which gives a list of condition names. -This list defines the conditions that this kind of error belongs to. -(The error symbol itself, and the symbol @code{error}, should always be -members of this list.) Thus, the hierarchy of condition names is -defined by the @code{error-conditions} properties of the error symbols. + In other words, each error condition @dfn{inherits} from another error +condition, with @code{error} sitting at the top of the inheritance +hierarchy. + +@defun define-error error-symbol error-message &optional inherits-from + This function defines a new error, denoted by @var{error-symbol}. +@var{error-message} is an informative message explaining the error, and +will be printed out when an unhandled error occurs. @var{error-symbol} +is a sub-error of @var{inherits-from} (which defaults to @code{error}). - In addition to the @code{error-conditions} list, the error symbol -should have an @code{error-message} property whose value is a string to -be printed when that error is signaled but not handled. If the -@code{error-message} property exists, but is not a string, the error -message @samp{peculiar error} is used. -@cindex peculiar error + @code{define-error} internally works by putting on @var{error-symbol} +an @code{error-message} property whose value is @var{error-message}, and +an @code{error-conditions} property that is a list of @var{error-symbol} +followed by each of its super-errors, up to and including @code{error}. +You will sometimes see code that sets this up directly rather than +calling @code{define-error}, but you should @emph{not} do this yourself, +unless you wish to maintain compatibility with FSF Emacs, which does not +provide @code{define-error}. +@end defun - Here is how we define a new error symbol, @code{new-error}: + Here is how we define a new error symbol, @code{new-error}, that +belongs to a range of errors called @code{my-own-errors}: @example @group -(put 'new-error - 'error-conditions - '(error my-own-errors new-error)) -@result{} (error my-own-errors new-error) -@end group -@group -(put 'new-error 'error-message "A new error") -@result{} "A new error" +(define-error 'my-own-errors "A whole range of errors" 'error) +(define-error 'new-error "A new error" 'my-own-errors) @end group @end example @noindent -This error has three condition names: @code{new-error}, the narrowest -classification; @code{my-own-errors}, which we imagine is a wider -classification; and @code{error}, which is the widest of all. +@code{new-error} has three condition names: @code{new-error}, the +narrowest classification; @code{my-own-errors}, which we imagine is a +wider classification; and @code{error}, which is the widest of all. + + Note that it is not legal to try to define an error unless its +super-error is also defined. For instance, attempting to define +@code{new-error} before @code{my-own-errors} are defined will signal an +error. The error string should start with a capital letter but it should not end with a period. This is for consistency with the rest of Emacs. - + Naturally, XEmacs will never signal @code{new-error} on its own; only an explicit call to @code{signal} (@pxref{Signaling Errors}) in your code can do this: @@ -1044,6 +1119,8 @@ when you write an error handler. Using error symbols alone would eliminate all but the narrowest level of classification. + + @xref{Standard Errors}, for a list of all the standard error symbols and their conditions. diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/customize.texi --- a/man/lispref/customize.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/customize.texi Mon Aug 13 11:13:30 2007 +0200 @@ -262,7 +262,7 @@ (defcustom show-paren-mode nil "Toggle Show Paren mode@enddots{}" :set (lambda (symbol value) - (show-paren-mode (or value 0))) + (show-paren-mode (or value 0))) :initialize 'custom-initialize-default :type 'boolean :group 'paren-showing diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/debugging.texi --- a/man/lispref/debugging.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/debugging.texi Mon Aug 13 11:13:30 2007 +0200 @@ -95,6 +95,12 @@ errors also can invoke the debugger. @xref{Processes}. @end defopt +@defopt debug-on-signal +This variable is similar to @code{debug-on-error} but breaks +whenever an error is signalled, regardless of whether it would be +handled. +@end defopt + @defopt debug-ignored-errors This variable specifies certain kinds of errors that should not enter the debugger. Its value is a list of error condition symbols and/or @@ -124,12 +130,6 @@ '(lambda () (setq debug-on-error t))) @end example -@defopt debug-on-signal -This variable is similar to @code{debug-on-error} but breaks -whenever an error is signalled, regardless of whether it would be -handled. -@end defopt - @node Infinite Loops @subsection Debugging Infinite Loops @cindex infinite loops diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/dialog.texi --- a/man/lispref/dialog.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/dialog.texi Mon Aug 13 11:13:30 2007 +0200 @@ -44,15 +44,15 @@ The syntax, more precisely: @example - form := <something to pass to `eval'> - command := <a symbol or string, to pass to `call-interactively'> - callback := command | form - active-p := <t, nil, or a form to evaluate to decide whether this - button should be selectable> - name := <string> - partition := 'nil' - button := '[' name callback active-p ']' - dialog := '(' name [ button ]+ [ partition [ button ]+ ] ')' + form := <something to pass to `eval'> + command := <a symbol or string, to pass to `call-interactively'> + callback := command | form + active-p := <t, nil, or a form to evaluate to decide whether this + button should be selectable> + name := <string> + partition := 'nil' + button := '[' name callback active-p ']' + dialog := '(' name [ button ]+ [ partition [ button ]+ ] ')' @end example @node Dialog Box Functions diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/display.texi --- a/man/lispref/display.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/display.texi Mon Aug 13 11:13:30 2007 +0200 @@ -874,13 +874,13 @@ All other codes in the range 0 through 31, and code 127, display in one of two ways according to the value of @code{ctl-arrow}. If it is non-@code{nil}, these codes map to sequences of two glyphs, where the -first glyph is the @sc{ASCII} code for @samp{^}. (A display table can +first glyph is the @sc{ascii} code for @samp{^}. (A display table can specify a glyph to use instead of @samp{^}.) Otherwise, these codes map just like the codes in the range 128 to 255. @item Character codes 128 through 255 map to sequences of four glyphs, where -the first glyph is the @sc{ASCII} code for @samp{\}, and the others are +the first glyph is the @sc{ascii} code for @samp{\}, and the others are digit characters representing the code in octal. (A display table can specify a glyph to use instead of @samp{\}.) @end itemize @@ -921,7 +921,7 @@ @cindex display table You can use the @dfn{display table} feature to control how all 256 possible character codes display on the screen. This is useful for -displaying European languages that have letters not in the @sc{ASCII} +displaying European languages that have letters not in the @sc{ascii} character set. The display table maps each character code into a sequence of @@ -1040,9 +1040,9 @@ @end example If you are editing buffers written in the ISO Latin 1 character set and -your terminal doesn't handle anything but @sc{ASCII}, you can load the +your terminal doesn't handle anything but @sc{ascii}, you can load the file @file{iso-ascii} to set up a display table that displays the other -ISO characters as explanatory sequences of @sc{ASCII} characters. For +ISO characters as explanatory sequences of @sc{ascii} characters. For example, the character ``o with umlaut'' displays as @samp{@{"o@}}. Some European countries have terminals that don't support ISO Latin 1 diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/eval.texi --- a/man/lispref/eval.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/eval.texi Mon Aug 13 11:13:30 2007 +0200 @@ -182,7 +182,7 @@ that Lisp avoids infinite recursion on an ill-defined function. @cindex Lisp nesting error -The default value of this variable is 200. If you set it to a value +The default value of this variable is 500. If you set it to a value less than 100, Lisp will reset it to 100 if the given value is reached. @code{max-specpdl-size} provides another limit on nesting. diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/extents.texi --- a/man/lispref/extents.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/extents.texi Mon Aug 13 11:13:30 2007 +0200 @@ -286,7 +286,7 @@ The following low-level functions are provided for explicitly traversing the extents in a buffer according to the display order. -These functions are mostly intended for debugging -- in normal +These functions are mostly intended for debugging---in normal operation, you should probably use @code{mapcar-extents} or @code{map-extents}, or loop using the @var{before} argument to @code{extent-at}, rather than creating a loop using @code{next-extent}. @@ -778,7 +778,7 @@ It is possible for an extent's parent to itself have a parent, and so on. Through this, a whole tree of extents can be created, all deriving their properties from one root extent. Note, however, -that you cannot create an inheritance loop -- this is explicitly +that you cannot create an inheritance loop---this is explicitly disallowed. Parent extents are used to implement the extents over the modeline. diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/faces.texi --- a/man/lispref/faces.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/faces.texi Mon Aug 13 11:13:30 2007 +0200 @@ -248,6 +248,21 @@ specifier. @end defun +@defun remove-face-property face property &optional local tag-set exact-p +This function removes a property of a @var{face}. + +For built-in properties, this is analogous to @code{remove-specifier}. +For more information, @xref{Other Specification Functions}. + +When @var{property} is not a built-in property, this function will just +remove its value if @var{locale} is @code{nil} or @code{all}. However, +if @var{locale} is other than that, this function will attempt to remove +@var{value} as the instantiator for the given @var{locale} with +@code{remove-specifier}. If the value of the property is not a +specifier, it will be converted into a @code{generic} specifier +automatically. +@end defun + @defun face-property face property &optional locale This function returns @var{face}'s value of the given @var{property}. @@ -672,7 +687,7 @@ @end defun @defun color-rgb-components color &optional domain -This function returns the @sc{RGB} components of the @var{color} in the +This function returns the @sc{rgb} components of the @var{color} in the specified @var{domain}, if any. @var{color} should be a color specifier object and @var{domain} is normally a window and defaults to the selected window if omitted. This is equivalent to using diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/functions.texi --- a/man/lispref/functions.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/functions.texi Mon Aug 13 11:13:30 2007 +0200 @@ -680,18 +680,21 @@ @cindex mapping functions A @dfn{mapping function} applies a given function to each element of a -list or other collection. XEmacs Lisp has three such functions; +list or other collection. XEmacs Lisp has several such functions; @code{mapcar} and @code{mapconcat}, which scan a list, are described -here. For the third mapping function, @code{mapatoms}, see -@ref{Creating Symbols}. +here. @xref{Creating Symbols}, for the function @code{mapatoms} which +maps over the symbols in an obarray. + +Mapping functions should never modify the sequence being mapped over. +The results are unpredictable. @defun mapcar function sequence @code{mapcar} applies @var{function} to each element of @var{sequence} in turn, and returns a list of the results. -The argument @var{sequence} may be a list, a vector, or a string. The -result is always a list. The length of the result is the same as the -length of @var{sequence}. +The argument @var{sequence} can be any kind of sequence; that is, a +list, a vector, a bit vector, or a string. The result is always a list. +The length of the result is the same as the length of @var{sequence}. @smallexample @group @@ -716,7 +719,7 @@ Return the list of results." ;; @r{If no list is exhausted,} (if (not (memq 'nil args)) - ;; @r{apply function to @sc{CAR}s.} + ;; @r{apply function to @sc{car}s.} (cons (apply f (mapcar 'car args)) (apply 'mapcar* f ;; @r{Recurse for rest of elements.} @@ -738,7 +741,8 @@ other suitable punctuation. The argument @var{function} must be a function that can take one -argument and return a string. +argument and return a string. The argument @var{sequence} can be any +kind of sequence; that is, a list, a vector, a bit vector, or a string. @smallexample @group diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/glyphs.texi --- a/man/lispref/glyphs.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/glyphs.texi Mon Aug 13 11:13:30 2007 +0200 @@ -429,7 +429,7 @@ Image instantiators come in many formats: @code{xbm}, @code{xpm}, @code{gif}, @code{jpeg}, etc. This describes the format of the data describing the image. The resulting image instances also come in many -types -- @code{mono-pixmap}, @code{color-pixmap}, @code{text}, +types---@code{mono-pixmap}, @code{color-pixmap}, @code{text}, @code{pointer}, etc. This refers to the behavior of the image and the sorts of places it can appear. (For example, a color-pixmap image has fixed colors specified for it, while a mono-pixmap image comes in two diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/hash-tables.texi --- a/man/lispref/hash-tables.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/hash-tables.texi Mon Aug 13 11:13:30 2007 +0200 @@ -72,19 +72,25 @@ (without the @code{:} character), as well as the additional keyword @code{data}, which specifies the initial hash table contents. -@defun make-hash-table &key @code{:size} @code{:test} @code{:type} @code{:rehash-size} @code{:rehash-threshold} +@defun make-hash-table &key @code{test} @code{size} @code{rehash-size} @code{rehash-threshold} @code{weakness} This function returns a new empty hash table object. -Keyword @code{:size} specifies the number of keys likely to be inserted. -This number of entries can be inserted without enlarging the hash table. - Keyword @code{:test} can be @code{eq}, @code{eql} (default) or @code{equal}. Comparison between keys is done using this function. If speed is important, consider using @code{eq}. When storing strings in the hash table, you will likely need to use @code{equal}. -Keyword @code{:type} can be @code{non-weak} (default), @code{weak}, -@code{key-weak} or @code{value-weak}. +Keyword @code{:size} specifies the number of keys likely to be inserted. +This number of entries can be inserted without enlarging the hash table. + +Keyword @code{:rehash-size} must be a float greater than 1.0, and specifies +the factor by which to increase the size of the hash table when enlarging. + +Keyword @code{:rehash-threshold} must be a float between 0.0 and 1.0, +and specifies the load factor of the hash table which triggers enlarging. + +Keyword @code{:weakness} can be @code{nil} (default), @code{t}, +@code{key} or @code{value}. A weak hash table is one whose pointers do not count as GC referents: for any key-value pair in the hash table, if the only remaining pointer @@ -104,12 +110,6 @@ unmarked outside of weak hash tables. The pair will remain in the hash table if the value is pointed to by something other than a weak hash table, even if the key is not. - -Keyword @code{:rehash-size} must be a float greater than 1.0, and specifies -the factor by which to increase the size of the hash table when enlarging. - -Keyword @code{:rehash-threshold} must be a float between 0.0 and 1.0, -and specifies the load factor of the hash table which triggers enlarging. @end defun @defun copy-hash-table hash-table @@ -122,22 +122,16 @@ This function returns the number of entries in @var{hash-table}. @end defun +@defun hash-table-test hash-table +This function returns the test function of @var{hash-table}. +This can be one of @code{eq}, @code{eql} or @code{equal}. +@end defun + @defun hash-table-size hash-table This function returns the current number of slots in @var{hash-table}, whether occupied or not. @end defun -@defun hash-table-type hash-table -This function returns the type of @var{hash-table}. -This can be one of @code{non-weak}, @code{weak}, @code{key-weak} or -@code{value-weak}. -@end defun - -@defun hash-table-test hash-table -This function returns the test function of @var{hash-table}. -This can be one of @code{eq}, @code{eql} or @code{equal}. -@end defun - @defun hash-table-rehash-size hash-table This function returns the current rehash size of @var{hash-table}. This is a float greater than 1.0; the factor by which @var{hash-table} @@ -150,6 +144,11 @@ @var{hash-table}, beyond which the @var{hash-table} is enlarged by rehashing. @end defun +@defun hash-table-weakness hash-table +This function returns the weakness of @var{hash-table}. +This can be one of @code{nil}, @code{t}, @code{key} or @code{value}. +@end defun + @node Working With Hash Tables @section Working With Hash Tables @@ -181,6 +180,7 @@ processed by @var{function}. @end defun + @node Weak Hash Tables @section Weak Hash Tables @cindex hash table, weak @@ -220,5 +220,5 @@ Also see @ref{Weak Lists}. -Weak hash tables are created by specifying the @code{:type} keyword to +Weak hash tables are created by specifying the @code{:weakness} keyword to @code{make-hash-table}. diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/index.perm --- a/man/lispref/index.perm Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -@c -*-texinfo-*- -@setfilename ../../info/index.info - -@c Indexing guidelines - -@c I assume that all indexes will be combined. -@c Therefore, if a generated findex and permutations -@c cover the ways an index user would look up the entry, -@c then no cindex is added. -@c Concept index (cindex) entries will also be permuted. Therefore, they -@c have no commas and few irrelevant connectives in them. - -@c I tried to include words in a cindex that give the context of the entry, -@c particularly if there is more than one entry for the same concept. -@c For example, "nil in keymap" -@c Similarly for explicit findex and vindex entries, e.g. "print example". - -@c Error codes are given cindex entries, e.g. "end-of-file error". - -@c pindex is used for .el files and Unix programs - -@node Index, , Standard Hooks, Top -@unnumbered Index - - -All variables, functions, keys, programs, files, and concepts are -in this one index. - -All names and concepts are permuted, so they appear several times, one -for each permutation of the parts of the name. For example, -@code{function-name} would appear as @b{function-name} and @b{name, -function-}. Key entries are not permuted, however. - - -@c Print the indices - -@printindex fn diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/index.texi --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/man/lispref/index.texi Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,37 @@ +@c -*-texinfo-*- +@setfilename ../../info/index.info + +@c Indexing guidelines + +@c I assume that all indexes will be combined. +@c Therefore, if a generated findex and permutations +@c cover the ways an index user would look up the entry, +@c then no cindex is added. +@c Concept index (cindex) entries will also be permuted. Therefore, they +@c have no commas and few irrelevant connectives in them. + +@c I tried to include words in a cindex that give the context of the entry, +@c particularly if there is more than one entry for the same concept. +@c For example, "nil in keymap" +@c Similarly for explicit findex and vindex entries, e.g. "print example". + +@c Error codes are given cindex entries, e.g. "end-of-file error". + +@c pindex is used for .el files and Unix programs + +@node Index, , Standard Hooks, Top +@unnumbered Index + +@ignore +All variables, functions, keys, programs, files, and concepts are +in this one index. + +All names and concepts are permuted, so they appear several times, one +for each permutation of the parts of the name. For example, +@code{function-name} would appear as @b{function-name} and @b{name, +function-}. Key entries are not permuted, however. +@end ignore + +@c Print the indices + +@printindex fn diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/index.unperm --- a/man/lispref/index.unperm Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -@c -*-texinfo-*- -@setfilename ../../info/index.info - -@c Indexing guidelines - -@c I assume that all indexes will be combined. -@c Therefore, if a generated findex and permutations -@c cover the ways an index user would look up the entry, -@c then no cindex is added. -@c Concept index (cindex) entries will also be permuted. Therefore, they -@c have no commas and few irrelevant connectives in them. - -@c I tried to include words in a cindex that give the context of the entry, -@c particularly if there is more than one entry for the same concept. -@c For example, "nil in keymap" -@c Similarly for explicit findex and vindex entries, e.g. "print example". - -@c Error codes are given cindex entries, e.g. "end-of-file error". - -@c pindex is used for .el files and Unix programs - -@node Index, , Standard Hooks, Top -@unnumbered Index - -@ignore -All variables, functions, keys, programs, files, and concepts are -in this one index. - -All names and concepts are permuted, so they appear several times, one -for each permutation of the parts of the name. For example, -@code{function-name} would appear as @b{function-name} and @b{name, -function-}. Key entries are not permuted, however. -@end ignore - -@c Print the indices - -@printindex fn diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/intro.texi --- a/man/lispref/intro.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/intro.texi Mon Aug 13 11:13:30 2007 +0200 @@ -471,7 +471,7 @@ @end ifinfo This manual was originally written for FSF Emacs 19 and was updated by -Ben Wing (wing@@666.com) for Lucid Emacs 19.10 and later for XEmacs +Ben Wing (ben@@xemacs.org) for Lucid Emacs 19.10 and later for XEmacs 19.12, 19.13, 19.14, and 20.0. It was further updated by the XEmacs Development Team for 19.15 and 20.1. Please send comments and corrections relating to XEmacs-specific portions of this manual to diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/keymaps.texi --- a/man/lispref/keymaps.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/keymaps.texi Mon Aug 13 11:13:30 2007 +0200 @@ -235,7 +235,7 @@ @section Key Sequences @cindex key sequences - Contrary to popular belief, the world is not @sc{ASCII}. When running + Contrary to popular belief, the world is not @sc{ascii}. When running under a window manager, XEmacs can tell the difference between, for example, the keystrokes @kbd{control-h}, @kbd{control-shift-h}, and @kbd{backspace}. You can, in fact, bind different commands to each of @@ -246,8 +246,8 @@ A @dfn{keysym} is what is printed on the keys on your keyboard. A keysym may be represented by a symbol, or (if and only if it is -equivalent to an @sc{ASCII} character in the range 32 - 255) by a -character or its equivalent @sc{ASCII} code. The @kbd{A} key may be +equivalent to an @sc{ascii} character in the range 32 - 255) by a +character or its equivalent @sc{ascii} code. The @kbd{A} key may be represented by the symbol @code{A}, the character @code{?A}, or by the number 65. The @kbd{break} key may be represented only by the symbol @code{break}. @@ -262,12 +262,12 @@ @code{next-command-event} and @code{read-key-sequence} functions. Note that in this context, the keystroke @kbd{control-b} is @emph{not} -represented by the number 2 (the @sc{ASCII} code for @samp{^B}) or the +represented by the number 2 (the @sc{ascii} code for @samp{^B}) or the character @code{?\^B}. See below. The @key{SHIFT} modifier is somewhat of a special case. You should not (and cannot) use @code{(meta shift a)} to mean @code{(meta A)}, -since for characters that have @sc{ASCII} equivalents, the state of the +since for characters that have @sc{ascii} equivalents, the state of the shift key is implicit in the keysym (@samp{a} vs. @samp{A}). You also cannot say @code{(shift =)} to mean @code{+}, as that sort of thing varies from keyboard to keyboard. The @key{SHIFT} modifier is for use @@ -279,23 +279,23 @@ That is, the @kbd{A} keystroke is represented by all of these forms: @example - A ?A 65 (A) (?A) (65) - [A] [?A] [65] [(A)] [(?A)] [(65)] + A ?A 65 (A) (?A) (65) + [A] [?A] [65] [(A)] [(?A)] [(65)] @end example - + the @kbd{control-a} keystroke is represented by these forms: @example - (control A) (control ?A) (control 65) - [(control A)] [(control ?A)] [(control 65)] + (control A) (control ?A) (control 65) + [(control A)] [(control ?A)] [(control 65)] @end example the key sequence @kbd{control-c control-a} is represented by these forms: @example - [(control c) (control a)] [(control ?c) (control ?a)] - [(control 99) (control 65)] etc. + [(control c) (control a)] [(control ?c) (control ?a)] + [(control 99) (control 65)] etc. @end example Mouse button clicks work just like keypresses: @code{(control @@ -311,38 +311,38 @@ For backward compatibility, a key sequence may also be represented by a string. In this case, it represents the key sequence(s) that would -produce that sequence of @sc{ASCII} characters in a purely @sc{ASCII} -world. For example, a string containing the @sc{ASCII} backspace +produce that sequence of @sc{ascii} characters in a purely @sc{ascii} +world. For example, a string containing the @sc{ascii} backspace character, @code{"\^H"}, would represent two key sequences: @code{(control h)} and @code{backspace}. Binding a command to this will actually bind both of those key sequences. Likewise for the following pairs: @example - control h backspace - control i tab - control m return - control j linefeed - control [ escape - control @@ control space + control h backspace + control i tab + control m return + control j linefeed + control [ escape + control @@ control space @end example After binding a command to two key sequences with a form like @example - (define-key global-map "\^X\^I" 'command-1) + (define-key global-map "\^X\^I" 'command-1) @end example @noindent it is possible to redefine only one of those sequences like so: @example - (define-key global-map [(control x) (control i)] 'command-2) - (define-key global-map [(control x) tab] 'command-3) + (define-key global-map [(control x) (control i)] 'command-2) + (define-key global-map [(control x) tab] 'command-3) @end example Of course, all of this applies only when running under a window -system. If you're talking to XEmacs through a @sc{TTY} connection, you +system. If you're talking to XEmacs through a @sc{tty} connection, you don't get any of these features. @defun event-matches-key-specifier-p event key-specifier @@ -614,22 +614,22 @@ @result{} #<keymap lisp-interaction-mode-map 5 entries 0x558> (describe-bindings-internal (current-local-map)) @result{} ; @r{Inserted into the buffer:} -backspace backward-delete-char-untabify -linefeed eval-print-last-sexp -delete delete-char -C-j eval-print-last-sexp -C-x << Prefix Command >> -M-tab lisp-complete-symbol -M-; lisp-indent-for-comment -M-C-i lisp-complete-symbol -M-C-q indent-sexp -M-C-x eval-defun -Alt-backspace backward-kill-sexp -Alt-delete kill-sexp +backspace backward-delete-char-untabify +linefeed eval-print-last-sexp +delete delete-char +C-j eval-print-last-sexp +C-x << Prefix Command >> +M-tab lisp-complete-symbol +M-; lisp-indent-for-comment +M-C-i lisp-complete-symbol +M-C-q indent-sexp +M-C-x eval-defun +Alt-backspace backward-kill-sexp +Alt-delete kill-sexp @end group @group -C-x x edebug-defun +C-x x edebug-defun @end group @end example @end defun @@ -973,14 +973,14 @@ translating a two-character sequence to a meta character so it can be looked up in a keymap. For useful results, the value should be a prefix event (@pxref{Prefix Keys}). The default value is @code{?\^[} (integer -27), which is the @sc{ASCII} character usually produced by the @key{ESC} +27), which is the @sc{ascii} character usually produced by the @key{ESC} key. As long as the value of @code{meta-prefix-char} remains @code{?\^[}, key lookup translates @kbd{@key{ESC} b} into @kbd{M-b}, which is normally defined as the @code{backward-word} command. However, if you set @code{meta-prefix-char} to @code{?\^X} (i.e. the keystroke -@kbd{C-x}) or its equivalent @sc{ASCII} code @code{24}, then XEmacs will +@kbd{C-x}) or its equivalent @sc{ascii} code @code{24}, then XEmacs will translate @kbd{C-x b} (whose standard binding is the @code{switch-to-buffer} command) into @kbd{M-b}. @@ -1503,7 +1503,7 @@ string representing the first key sequence found, rather than a list of all possible key sequences. If @var{firstonly} is @code{t}, then the value is the first key sequence, except that key sequences consisting -entirely of @sc{ASCII} characters (or meta variants of @sc{ASCII} +entirely of @sc{ascii} characters (or meta variants of @sc{ascii} characters) are preferred to all other key sequences. @end ignore @@ -1546,13 +1546,13 @@ If @var{prefix} is non-@code{nil}, it should be a prefix key; then the listing includes only keys that start with @var{prefix}. -When several characters with consecutive @sc{ASCII} codes have the +When several characters with consecutive @sc{ascii} codes have the same definition, they are shown together, as @samp{@var{firstchar}..@var{lastchar}}. In this instance, you need to -know the @sc{ASCII} codes to understand which characters this means. +know the @sc{ascii} codes to understand which characters this means. For example, in the default global map, the characters @samp{@key{SPC} -..@: ~} are described by a single line. @key{SPC} is @sc{ASCII} 32, -@kbd{~} is @sc{ASCII} 126, and the characters between them include all +..@: ~} are described by a single line. @key{SPC} is @sc{ascii} 32, +@kbd{~} is @sc{ascii} 126, and the characters between them include all the normal printing characters, (e.g., letters, digits, punctuation, etc.@:); all these characters are bound to @code{self-insert-command}. diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/ldap.texi --- a/man/lispref/ldap.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/ldap.texi Mon Aug 13 11:13:30 2007 +0200 @@ -21,10 +21,11 @@ @section Building XEmacs with LDAP support LDAP support must be added to XEmacs at build time since it requires -linking to an external LDAP client library. As of 21.0, XEmacs has been +linking to an external LDAP client library. As of 21.2, XEmacs has been successfully built and tested with @itemize @bullet +@item OpenLDAP 1.0.3 (@url{http://www.openldap.org/}) @item University of Michigan's LDAP 3.3 (@url{http://www.umich.edu/~dirsvcs/ldap/}) @item LDAP SDK 1.0 from Netscape Corp. (@url{http://developer.netscape.com/}) @end itemize @@ -63,7 +64,9 @@ @subsection LDAP Variables @defvar ldap-default-host -The default LDAP server +The default LDAP server hostname. +A TCP port number can be appended to that name using a colon as +a separator. @end defvar @defvar ldap-default-port @@ -81,7 +84,9 @@ @defvar ldap-host-parameters-alist An alist of per host options for LDAP transactions. The list elements look like @code{(HOST PROP1 VAL1 PROP2 VAL2 ...)} -@var{host} is the name of an LDAP server. @var{propn} and @var{valn} are +@var{host} is the name of an LDAP server. A TCP port number can be +appended to that name using a colon as a separator. +@var{propn} and @var{valn} are property/value pairs describing parameters for the server. Valid properties: @table @code diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/lispref.texi --- a/man/lispref/lispref.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/lispref.texi Mon Aug 13 11:13:30 2007 +0200 @@ -1,4 +1,4 @@ -\input ../texinfo @c -*-texinfo-*- +\input texinfo @c -*-texinfo-*- @c %**start of header @setfilename ../../info/lispref.info @c @smallbook @@ -6,6 +6,11 @@ @c %**end of header @ifinfo +@dircategory XEmacs Editor +@direntry +* Lispref: (lispref). XEmacs Lisp Reference Manual. +@end direntry + Edition History: GNU Emacs Lisp Reference Manual Second Edition (v2.01), May 1993 @@ -282,7 +287,7 @@ * Buffer Type:: The basic object of editing. * Window Type:: What makes buffers visible. -* Window Configuration Type::Save what the screen looks like. +* Window Configuration Type:: Save what the screen looks like. * Marker Type:: A position in a buffer. * Process Type:: A process running on the underlying OS. * Stream Type:: Receive or send characters. @@ -303,7 +308,7 @@ Strings and Characters -* Basics: String Basics. Basic properties of strings and characters. +* String Basics:: Basic properties of strings and characters. * Predicates for Strings:: Testing whether an object is a string or char. * Creating Strings:: Functions to allocate new strings. * Predicates for Characters:: Testing whether an object is a character. diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/lists.texi --- a/man/lispref/lists.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/lists.texi Mon Aug 13 11:13:30 2007 +0200 @@ -1448,7 +1448,7 @@ @defun remassoc key alist This function deletes by side effect any associations with key @var{key} -in @var{alist} -- i.e. it removes any elements from @var{alist} whose +in @var{alist}---i.e. it removes any elements from @var{alist} whose @code{car} is @code{equal} to @var{key}. The modified @var{alist} is returned. @@ -1460,7 +1460,7 @@ @defun remassq key alist This function deletes by side effect any associations with key @var{key} -in @var{alist} -- i.e. it removes any elements from @var{alist} whose +in @var{alist}---i.e. it removes any elements from @var{alist} whose @code{car} is @code{eq} to @var{key}. The modified @var{alist} is returned. @@ -1471,7 +1471,7 @@ @defun remrassoc value alist This function deletes by side effect any associations with value @var{value} -in @var{alist} -- i.e. it removes any elements from @var{alist} whose +in @var{alist}---i.e. it removes any elements from @var{alist} whose @code{cdr} is @code{equal} to @var{value}. The modified @var{alist} is returned. @@ -1488,7 +1488,7 @@ @defun remrassq value alist This function deletes by side effect any associations with value @var{value} -in @var{alist} -- i.e. it removes any elements from @var{alist} whose +in @var{alist}---i.e. it removes any elements from @var{alist} whose @code{cdr} is @code{eq} to @var{value}. The modified @var{alist} is returned. @@ -1628,7 +1628,7 @@ In the following functions, if optional arg @var{nil-means-not-present} is non-@code{nil}, then a property with a @code{nil} value is ignored or removed. This feature is a virus that has infected old Lisp -implementations (and thus E-Lisp, due to @sc{RMS}'s enamorment with old +implementations (and thus E-Lisp, due to @sc{rms}'s enamorment with old Lisps), but should not be used except for backward compatibility. @defun plists-eq a b &optional nil-means-not-present @@ -1682,7 +1682,7 @@ In the following functions, if optional arg @var{nil-means-not-present} is non-@code{nil}, then a property with a @code{nil} value is ignored or removed. This feature is a virus that has infected old Lisp -implementations (and thus E-Lisp, due to @sc{RMS}'s enamorment with old +implementations (and thus E-Lisp, due to @sc{rms}'s enamorment with old Lisps), but should not be used except for backward compatibility. @defun lax-plists-eq a b &optional nil-means-not-present @@ -1771,7 +1771,7 @@ done with the elements, they will automatically disappear from the list. Weak lists are used internally, for example, to manage the list holding -the children of an extent -- an extent that is unused but has a parent +the children of an extent---an extent that is unused but has a parent will still be reclaimed, and will automatically be removed from its parent's list of children. diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/markers.texi --- a/man/lispref/markers.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/markers.texi Mon Aug 13 11:13:30 2007 +0200 @@ -667,7 +667,7 @@ When @code{zmacs-regions} is non-@code{nil} (this is the default), the concept of an @dfn{active region} exists. The region is active when the corresponding mark is active. Note that only one active region at a -time can exist -- i.e. only one buffer's region is active at a time. +time can exist---i.e. only one buffer's region is active at a time. @xref{The Mark}, for more information about active regions. @defopt zmacs-regions diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/menus.texi --- a/man/lispref/menus.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/menus.texi Mon Aug 13 11:13:30 2007 +0200 @@ -9,14 +9,14 @@ @cindex menu @menu -* Menu Format:: Format of a menu description. -* Menubar Format:: How to specify a menubar. -* Menubar:: Functions for controlling the menubar. -* Modifying Menus:: Modifying a menu description. -* Pop-Up Menus:: Functions for specifying pop-up menus. -* Menu Filters:: Filter functions for the default menubar. -* Menu Accelerators:: Using and controlling menu accelerator keys -* Buffers Menu:: The menu that displays the list of buffers. +* Menu Format:: Format of a menu description. +* Menubar Format:: How to specify a menubar. +* Menubar:: Functions for controlling the menubar. +* Modifying Menus:: Modifying a menu description. +* Pop-Up Menus:: Functions for specifying pop-up menus. +* Menu Filters:: Filter functions for the default menubar. +* Menu Accelerators:: Using and controlling menu accelerator keys +* Buffers Menu:: The menu that displays the list of buffers. @end menu @node Menu Format @@ -241,9 +241,9 @@ @example ("File" - :filter file-menu-filter ; file-menu-filter is a function that takes - ; one argument (a list of menu items) and - ; returns a list of menu items + :filter file-menu-filter ; file-menu-filter is a function that takes + ; one argument (a list of menu items) and + ; returns a list of menu items [ "Save As..." write-file] [ "Revert Buffer" revert-buffer :active (buffer-modified-p) ] [ "Read Only" toggle-read-only :style toggle :selected buffer-read-only ] @@ -600,10 +600,10 @@ activate that item. @menu -* Creating Menu Accelerators:: How to add accelerator keys to a menu. -* Keyboard Menu Traversal:: How to use and modify the keys which are used - to traverse the menu structure. -* Menu Accelerator Functions:: Functions for working with menu accelerators. +* Creating Menu Accelerators:: How to add accelerator keys to a menu. +* Keyboard Menu Traversal:: How to use and modify the keys which are used + to traverse the menu structure. +* Menu Accelerator Functions:: Functions for working with menu accelerators. @end menu @node Creating Menu Accelerators @@ -620,9 +620,9 @@ @example (add-submenu nil '("%_Test" - ["One" (insert "1") :accelerator ?1 :active t] - ["%_Two" (insert "2")] - ["%_3" (insert "3")])) + ["One" (insert "1") :accelerator ?1 :active t] + ["%_Two" (insert "2")] + ["%_3" (insert "3")])) @end example will add a new menu to the top level menubar. The new menu can be reached @@ -708,9 +708,9 @@ (setq menu-accelerator-modifiers '(meta control)) (setq menu-accelerator-enabled 'menu-force) (add-submenu nil '("%_Test" - ["One" (insert "1") :accelerator ?1 :active t] - ["%_Two" (insert "2")] - ["%_3" (insert "3")])) + ["One" (insert "1") :accelerator ?1 :active t] + ["%_Two" (insert "2")] + ["%_3" (insert "3")])) @end example will add the menu "Test" to the top level menubar. Pressing C-x followed by diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/minibuf.texi --- a/man/lispref/minibuf.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/minibuf.texi Mon Aug 13 11:13:30 2007 +0200 @@ -25,6 +25,7 @@ * Completion:: How to invoke and customize completion. * Yes-or-No Queries:: Asking a question with a simple answer. * Multiple Queries:: Asking a series of similar questions. +* Reading a Password:: Reading a password from the terminal. * Minibuffer Misc:: Various customization hooks and variables. @end menu @@ -37,7 +38,7 @@ to minibuffers. The name of a minibuffer always has the form @w{@samp{ *Minibuf-@var{number}}}, and it cannot be changed. Minibuffers are displayed only in special windows used only for minibuffers; these -windows always appear at the bottom of a frame. (Sometime frames have +windows always appear at the bottom of a frame. (Sometimes frames have no minibuffer window, and sometimes a special kind of frame contains nothing but a minibuffer window; see @ref{Minibuffers and Frames}.) @@ -67,10 +68,6 @@ @code{minibuffer-local-map} is for ordinary input (no completion). @item -@code{minibuffer-local-ns-map} is similar, except that @key{SPC} exits -just like @key{RET}. This is used mainly for Mocklisp compatibility. - -@item @code{minibuffer-local-completion-map} is for permissive completion. @item @@ -91,7 +88,7 @@ reading the arguments for a command, in the @code{interactive} spec. @xref{Defining Commands}. -@defun read-from-minibuffer prompt-string &optional initial-contents keymap read hist +@defun read-from-minibuffer prompt-string &optional initial-contents keymap read hist abbrev-table default This function is the most general way to get input through the minibuffer. By default, it accepts arbitrary text and returns it as a string; however, if @var{read} is non-@code{nil}, then it uses @@ -112,12 +109,25 @@ @var{string} in the minibuffer but put point @var{position} characters from the beginning, rather than at the end. +When the user types a command to exit the minibuffer, +@code{read-from-minibuffer} constructs the return value from the text in +the minibuffer. Normally it returns a string containing that text. +However, if @var{read} is non-@code{nil}, @code{read-from-minibuffer} +reads the text and returns the resulting Lisp object, unevaluated. +(@xref{Input Functions}, for information about reading.) + +The argument @var{default} specifies a default value to make available +through the history commands. It should be a string, or @code{nil}. + If @var{keymap} is non-@code{nil}, that keymap is the local keymap to use in the minibuffer. If @var{keymap} is omitted or @code{nil}, the value of @code{minibuffer-local-map} is used as the keymap. Specifying a keymap is the most important way to customize the minibuffer for various applications such as completion. +The argument @var{abbrev-table} specifies @code{local-abbrev-table} in +the minibuffer (@pxref{Standard Abbrev Tables}). + The argument @var{hist} specifies which history list variable to use for saving the input and for history commands used in the minibuffer. It defaults to @code{minibuffer-history}. @xref{Minibuffer History}. @@ -129,15 +139,27 @@ @code{read-from-minibuffer} reads the text and returns the resulting Lisp object, unevaluated. (@xref{Input Functions}, for information about reading.) + +@strong{Usage note:} The @var{initial-contents} argument and the +@var{default} argument are two alternative features for more or less the +same job. It does not make sense to use both features in a single call +to @code{read-from-minibuffer}. In general, we recommend using +@var{default}, since this permits the user to insert the default value +when it is wanted, but does not burden the user with deleting it from +the minibuffer on other occasions. However, if user is supposed to edit +default value, @var{initial-contents} may be preferred. @end defun -@defun read-string prompt &optional initial +@defun read-string prompt &optional initial history This function reads a string from the minibuffer and returns it. The arguments @var{prompt} and @var{initial} are used as in @code{read-from-minibuffer}. The keymap used is @code{minibuffer-local-map}. -This is a simplified interface to the +The optional argument @var{history}, if non-nil, specifies a history +list and optionally the initial position in the list. + +This function is a simplified interface to the @code{read-from-minibuffer} function: @smallexample @@ -154,7 +176,7 @@ default, it makes the following bindings: @table @asis -@item @key{LFD} +@item @kbd{C-j} @code{exit-minibuffer} @item @key{RET} @@ -177,49 +199,6 @@ @end table @end defvar -@c In version 18, initial is required -@c Emacs 19 feature -@defun read-no-blanks-input prompt &optional initial -This function reads a string from the minibuffer, but does not allow -whitespace characters as part of the input: instead, those characters -terminate the input. The arguments @var{prompt} and @var{initial} are -used as in @code{read-from-minibuffer}. - -This is a simplified interface to the @code{read-from-minibuffer} -function, and passes the value of the @code{minibuffer-local-ns-map} -keymap as the @var{keymap} argument for that function. Since the keymap -@code{minibuffer-local-ns-map} does not rebind @kbd{C-q}, it @emph{is} -possible to put a space into the string, by quoting it. - -@smallexample -@group -(read-no-blanks-input @var{prompt} @var{initial}) -@equiv{} -(read-from-minibuffer @var{prompt} @var{initial} minibuffer-local-ns-map) -@end group -@end smallexample -@end defun - -@defvar minibuffer-local-ns-map -This built-in variable is the keymap used as the minibuffer local keymap -in the function @code{read-no-blanks-input}. By default, it makes the -following bindings, in addition to those of @code{minibuffer-local-map}: - -@table @asis -@item @key{SPC} -@cindex @key{SPC} in minibuffer -@code{exit-minibuffer} - -@item @key{TAB} -@cindex @key{TAB} in minibuffer -@code{exit-minibuffer} - -@item @kbd{?} -@cindex @kbd{?} in minibuffer -@code{self-insert-and-exit} -@end table -@end defvar - @node Object from Minibuffer @section Reading Lisp Objects with the Minibuffer @@ -227,7 +206,7 @@ minibuffer. @defun read-minibuffer prompt &optional initial -This function reads a Lisp object in the minibuffer and returns it, +This function reads a Lisp object using the minibuffer, and returns it without evaluating it. The arguments @var{prompt} and @var{initial} are used as in @code{read-from-minibuffer}. @@ -266,9 +245,9 @@ @end defun @defun eval-minibuffer prompt &optional initial -This function reads a Lisp expression in the minibuffer, evaluates it, -then returns the result. The arguments @var{prompt} and @var{initial} -are used as in @code{read-from-minibuffer}. +This function reads a Lisp expression using the minibuffer, evaluates +it, then returns the result. The arguments @var{prompt} and +@var{initial} are used as in @code{read-from-minibuffer}. This function simply evaluates the result of a call to @code{read-minibuffer}: @@ -293,7 +272,7 @@ The first thing @code{edit-and-eval-command} does is to activate the minibuffer with @var{prompt} as the prompt. Then it inserts the printed -representation of @var{form} in the minibuffer, and lets the user edit. +representation of @var{form} in the minibuffer, and lets the user edit it. When the user exits the minibuffer, the edited text is read with @code{read} and then evaluated. The resulting value becomes the value of @code{edit-and-eval-command}. @@ -366,6 +345,8 @@ name to the input functions when you wish. But it is safe to modify the list by hand when the minibuffer input functions are not using it. + Here are some of the standard minibuffer history list variables: + @defvar minibuffer-history The default history list for minibuffer history input. @end defvar @@ -551,7 +532,7 @@ @defun all-completions string collection &optional predicate nospace This function returns a list of all possible completions of -@var{string}. The parameters to this function are the same as to +@var{string}. The arguments to this function are the same as those of @code{try-completion}. If @var{collection} is a function, it is called with three arguments: @@ -592,7 +573,7 @@ This section describes the basic interface for reading from the minibuffer with completion. -@defun completing-read prompt collection &optional predicate require-match initial hist +@defun completing-read prompt collection &optional predicate require-match initial hist default This function reads a string in the minibuffer, assisting the user by providing completion. It activates the minibuffer with prompt @var{prompt}, which must be a string. If @var{initial} is @@ -611,11 +592,17 @@ @var{collection}. If @var{require-match} is @code{nil}, the exit commands work regardless of the input in the minibuffer. +However, empty input is always permitted, regardless of the value of +@var{require-match}; in that case, @code{completing-read} returns +@var{default}. The value of @var{default} (if non-@code{nil}) is also +available to the user through the history commands. + The user can exit with null input by typing @key{RET} with an empty -minibuffer. Then @code{completing-read} returns @code{nil}. This is -how the user requests whatever default the command uses for the value -being read. The user can return using @key{RET} in this way regardless -of the value of @var{require-match}. +minibuffer. Then @code{completing-read} returns @code{""}. This is how +the user requests whatever default the command uses for the value being +read. The user can return using @key{RET} in this way regardless of the +value of @var{require-match}, and regardless of whether the empty string +is included in @var{collection}. The function @code{completing-read} works by calling @code{read-minibuffer}. It uses @code{minibuffer-local-completion-map} @@ -707,7 +694,7 @@ @item @key{TAB} @code{minibuffer-complete} -@item @key{LFD} +@item @kbd{C-j} @code{minibuffer-complete-and-exit} @item @key{RET} @@ -745,7 +732,7 @@ @deffn Command minibuffer-complete-and-exit This function completes the minibuffer contents, and exits if confirmation is not required, i.e., if -@code{minibuffer-completion-confirm} is non-@code{nil}. If confirmation +@code{minibuffer-completion-confirm} is @code{nil}. If confirmation @emph{is} required, it is given by repeating this command immediately---the command is programmed to work without confirmation when run twice in succession. @@ -956,7 +943,7 @@ @c Emacs 19 feature If you specify @var{initial}, that is an initial file name to insert in -the buffer (after with @var{directory}, if that is inserted). In this +the buffer (after @var{directory}, if that is inserted). In this case, point goes at the beginning of @var{initial}. The default for @var{initial} is @code{nil}---don't insert any file name. To see what @var{initial} does, try the command @kbd{C-x C-v}. @@ -1071,8 +1058,12 @@ @item @code{nil} specifies @code{try-completion}. The completion function should return the completion of the specified string, or @code{t} if the -string is an exact match already, or @code{nil} if the string matches no -possibility. +string is a unique and exact match already, or @code{nil} if the string +matches no possibility. + +If the string is an exact match for one possibility, but also matches +other longer possibilities, the function should return the string, not +@code{t}. @item @code{t} specifies @code{all-completions}. The completion function @@ -1343,6 +1334,40 @@ The return value of @code{map-y-or-n-p} is the number of objects acted on. @end defun +@node Reading a Password +@section Reading a Password +@cindex passwords, reading + + To read a password to pass to another program, you can use the +function @code{read-passwd}. + +@defun read-passwd prompt &optional confirm default +This function reads a password, prompting with @var{prompt}. It does +not echo the password as the user types it; instead, it echoes @samp{.} +for each character in the password. + +The optional argument @var{confirm}, if non-@code{nil}, says to read the +password twice and insist it must be the same both times. If it isn't +the same, the user has to type it over and over until the last two +times match. + +The optional argument @var{default} specifies the default password to +return if the user enters empty input. It is translated to @samp{.} +and inserted in the minibuffer. If @var{default} is @code{nil}, then +@code{read-passwd} returns the null string in that case. +@end defun + +@defopt passwd-invert-frame-when-keyboard-grabbed +If non-nil swap the foreground and background colors of all faces while +reading a password. Default values is @code{t} unless feature +@code{infodock} is provided. +@end defopt + +@defopt passwd-echo +This specifies the character echoed when typing a password. When nil, +nothing is echoed. +@end defopt + @node Minibuffer Misc @section Minibuffer Miscellany @@ -1452,8 +1477,8 @@ @defopt enable-recursive-minibuffers If this variable is non-@code{nil}, you can invoke commands (such as -@code{find-file}) that use minibuffers even while in the minibuffer -window. Such invocation produces a recursive editing level for a new +@code{find-file}) that use minibuffers even while the minibuffer window +is active. Such invocation produces a recursive editing level for a new minibuffer. The outer-level minibuffer is invisible while you are editing the inner one. @@ -1476,4 +1501,4 @@ in this fashion, just use an evaluated interactive spec and bind @code{enable-recursive-minibuffers} while reading from the minibuffer. See the definition of @code{next-matching-history-element} in -@file{lisp/prim/minibuf.el}. +@file{lisp/minibuf.el}. diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/modes.texi --- a/man/lispref/modes.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/modes.texi Mon Aug 13 11:13:30 2007 +0200 @@ -330,7 +330,7 @@ @group ;; @r{Set syntax of chars up to 0 to class of chars that are} ;; @r{part of symbol names but not words.} - ;; @r{(The number 0 is @code{48} in the @sc{ASCII} character set.)} + ;; @r{(The number 0 is @code{48} in the @sc{ascii} character set.)} (while (< i ?0) (modify-syntax-entry i "_ " emacs-lisp-mode-syntax-table) (setq i (1+ i))) diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/mule.texi --- a/man/lispref/mule.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/mule.texi Mon Aug 13 11:13:30 2007 +0200 @@ -43,7 +43,7 @@ In some cases, the differences will be significant enough that it is actually possible to identify two or more distinct shapes that both represent the same character. For example, the lowercase letters -@samp{a} and @samp{g} each have two distinct possible shapes -- the +@samp{a} and @samp{g} each have two distinct possible shapes---the @samp{a} can optionally have a curved tail projecting off the top, and the @samp{g} can be formed either of two loops, or of one loop and a tail hanging off the bottom. Such distinct possible shapes of a @@ -51,7 +51,7 @@ glyphs making up the same character is that the choice between one or the other is purely stylistic and has no linguistic effect on a word (this is the reason why a capital @samp{A} and lowercase @samp{a} -are different characters rather than different glyphs -- e.g. +are different characters rather than different glyphs---e.g. @samp{Aspen} is a city while @samp{aspen} is a kind of tree). Note that @dfn{character} and @dfn{glyph} are used differently @@ -74,7 +74,7 @@ numbers before letters, etc. Note that for many of the Asian character sets, there is no natural ordering of the characters. The actual orderings are based on one or more salient characteristic, of which -there are many to choose from -- e.g. number of strokes, common +there are many to choose from---e.g. number of strokes, common radicals, phonetic ordering, etc. The set of numbers assigned to any particular character are called @@ -105,11 +105,11 @@ not understand the difference between a character set and an encoding.) This is not possible, however, if more than one character set is to be used in the encoding. For example, printed Japanese text typically -requires characters from multiple character sets -- ASCII, JISX0208, and +requires characters from multiple character sets---ASCII, JISX0208, and JISX0212, to be specific. Each of these is indexed using one or more position codes in the range 33 through 126, so the position codes could not be used directly or there would be no way to tell which character -was meant. Different Japanese encodings handle this differently -- JIS +was meant. Different Japanese encodings handle this differently---JIS uses special escape characters to denote different character sets; EUC sets the high bit of the position codes for JISX0208 and JISX0212, and puts a special extra byte before each JISX0212 character; etc. (JIS, @@ -366,7 +366,7 @@ @end defun @defun charset-direction charset -This function returns the display direction of @var{charset} -- either +This function returns the display direction of @var{charset}---either @code{l2r} or @code{r2l}. @end defun @@ -555,10 +555,10 @@ @example @group - C0: 0x00 - 0x1F - GL: 0x20 - 0x7F - C1: 0x80 - 0x9F - GR: 0xA0 - 0xFF + C0: 0x00 - 0x1F + GL: 0x20 - 0x7F + C1: 0x80 - 0x9F + GR: 0xA0 - 0xFF @end group @end example @@ -571,7 +571,7 @@ Charset designation is done by escape sequences of the form: @example - ESC [@var{I}] @var{I} @var{F} + ESC [@var{I}] @var{I} @var{F} @end example where @var{I} is an intermediate character in the range 0x20 - 0x2F, and @@ -581,32 +581,32 @@ @example @group - $ [0x24]: indicate charset of dimension 2 (94x94 or 96x96). - ( [0x28]: designate to G0 a 94-charset whose final byte is @var{F}. - ) [0x29]: designate to G1 a 94-charset whose final byte is @var{F}. - * [0x2A]: designate to G2 a 94-charset whose final byte is @var{F}. - + [0x2B]: designate to G3 a 94-charset whose final byte is @var{F}. - - [0x2D]: designate to G1 a 96-charset whose final byte is @var{F}. - . [0x2E]: designate to G2 a 96-charset whose final byte is @var{F}. - / [0x2F]: designate to G3 a 96-charset whose final byte is @var{F}. + $ [0x24]: indicate charset of dimension 2 (94x94 or 96x96). + ( [0x28]: designate to G0 a 94-charset whose final byte is @var{F}. + ) [0x29]: designate to G1 a 94-charset whose final byte is @var{F}. + * [0x2A]: designate to G2 a 94-charset whose final byte is @var{F}. + + [0x2B]: designate to G3 a 94-charset whose final byte is @var{F}. + - [0x2D]: designate to G1 a 96-charset whose final byte is @var{F}. + . [0x2E]: designate to G2 a 96-charset whose final byte is @var{F}. + / [0x2F]: designate to G3 a 96-charset whose final byte is @var{F}. @end group @end example The following rule is not allowed in ISO 2022 but can be used in Mule. @example - , [0x2C]: designate to G0 a 96-charset whose final byte is @var{F}. + , [0x2C]: designate to G0 a 96-charset whose final byte is @var{F}. @end example Here are examples of designations: @example @group - ESC ( B : designate to G0 ASCII - ESC - A : designate to G1 Latin-1 - ESC $ ( A or ESC $ A : designate to G0 GB2312 - ESC $ ( B or ESC $ B : designate to G0 JISX0208 - ESC $ ) C : designate to G1 KSC5601 + ESC ( B : designate to G0 ASCII + ESC - A : designate to G1 Latin-1 + ESC $ ( A or ESC $ A : designate to G0 GB2312 + ESC $ ( B or ESC $ B : designate to G0 JISX0208 + ESC $ ) C : designate to G1 KSC5601 @end group @end example @@ -618,21 +618,21 @@ Locking Shift is done as follows: @example - LS0 or SI (0x0F): invoke G0 into GL - LS1 or SO (0x0E): invoke G1 into GL - LS2: invoke G2 into GL - LS3: invoke G3 into GL - LS1R: invoke G1 into GR - LS2R: invoke G2 into GR - LS3R: invoke G3 into GR + LS0 or SI (0x0F): invoke G0 into GL + LS1 or SO (0x0E): invoke G1 into GL + LS2: invoke G2 into GL + LS3: invoke G3 into GL + LS1R: invoke G1 into GR + LS2R: invoke G2 into GR + LS3R: invoke G3 into GR @end example Single Shift is done as follows: @example @group - SS2 or ESC N: invoke G2 into GL - SS3 or ESC O: invoke G3 into GL + SS2 or ESC N: invoke G2 into GL + SS3 or ESC O: invoke G3 into GL @end group @end example @@ -678,51 +678,51 @@ @example @group junet -- Coding system used in JUNET. - 1. G0 <- ASCII, G1..3 <- never used - 2. Yes. - 3. Yes. - 4. Yes. - 5. 7-bit environment - 6. No. - 7. Use ASCII - 8. Use JISX0208-1983 + 1. G0 <- ASCII, G1..3 <- never used + 2. Yes. + 3. Yes. + 4. Yes. + 5. 7-bit environment + 6. No. + 7. Use ASCII + 8. Use JISX0208-1983 @end group @group ctext -- Compound Text - 1. G0 <- ASCII, G1 <- Latin-1, G2,3 <- never used - 2. No. - 3. No. - 4. Yes. - 5. 8-bit environment - 6. No. - 7. Use ASCII - 8. Use JISX0208-1983 + 1. G0 <- ASCII, G1 <- Latin-1, G2,3 <- never used + 2. No. + 3. No. + 4. Yes. + 5. 8-bit environment + 6. No. + 7. Use ASCII + 8. Use JISX0208-1983 @end group @group euc-china -- Chinese EUC. Although many people call this as "GB encoding", the name may cause misunderstanding. - 1. G0 <- ASCII, G1 <- GB2312, G2,3 <- never used - 2. No. - 3. Yes. - 4. Yes. - 5. 8-bit environment - 6. No. - 7. Use ASCII - 8. Use JISX0208-1983 + 1. G0 <- ASCII, G1 <- GB2312, G2,3 <- never used + 2. No. + 3. Yes. + 4. Yes. + 5. 8-bit environment + 6. No. + 7. Use ASCII + 8. Use JISX0208-1983 @end group @group korean-mail -- Coding system used in Korean network. - 1. G0 <- ASCII, G1 <- KSC5601, G2,3 <- never used - 2. No. - 3. Yes. - 4. Yes. - 5. 7-bit environment - 6. Yes. - 7. No. - 8. No. + 1. G0 <- ASCII, G1 <- KSC5601, G2,3 <- never used + 2. No. + 3. Yes. + 4. Yes. + 5. 7-bit environment + 6. Yes. + 7. No. + 8. No. @end group @end example @@ -740,7 +740,7 @@ For example, many ISO-2022-compliant coding systems (such as Compound Text, which is used for inter-client data under the X Window System) use -escape sequences to switch between different charsets -- Japanese Kanji, +escape sequences to switch between different charsets---Japanese Kanji, for example, is invoked with @samp{ESC $ ( B}; ASCII is invoked with @samp{ESC ( B}; and Cyrillic is invoked with @samp{ESC - L}. See @code{make-coding-system} for more information. @@ -1093,54 +1093,361 @@ coding-system. The corresponding character code in Big5 is returned. @end defun -@node CCL +@node CCL, Category Tables, Coding Systems, MULE @section CCL -@defun execute-ccl-program ccl-program status -This function executes @var{ccl-program} with registers initialized by +CCL (Code Conversion Language) is a simple structured programming +language designed for character coding conversions. A CCL program is +compiled to CCL code (represented by a vector of integers) and executed +by the CCL interpreter embedded in Emacs. The CCL interpreter +implements a virtual machine with 8 registers called @code{r0}, ..., +@code{r7}, a number of control structures, and some I/O operators. Take +care when using registers @code{r0} (used in implicit @dfn{set} +statements) and especially @code{r7} (used internally by several +statements and operations, especially for multiple return values and I/O +operations). + +CCL is used for code conversion during process I/O and file I/O for +non-ISO2022 coding systems. (It is the only way for a user to specify a +code conversion function.) It is also used for calculating the code +point of an X11 font from a character code. However, since CCL is +designed as a powerful programming language, it can be used for more +generic calculation where efficiency is demanded. A combination of +three or more arithmetic operations can be calculated faster by CCL than +by Emacs Lisp. + +@strong{Warning:} The code in @file{src/mule-ccl.c} and +@file{$packages/lisp/mule-base/mule-ccl.el} is the definitive +description of CCL's semantics. The previous version of this section +contained several typos and obsolete names left from earlier versions of +MULE, and many may remain. (I am not an experienced CCL programmer; the +few who know CCL well find writing English painful.) + +A CCL program transforms an input data stream into an output data +stream. The input stream, held in a buffer of constant bytes, is left +unchanged. The buffer may be filled by an external input operation, +taken from an Emacs buffer, or taken from a Lisp string. The output +buffer is a dynamic array of bytes, which can be written by an external +output operation, inserted into an Emacs buffer, or returned as a Lisp +string. + +A CCL program is a (Lisp) list containing two or three members. The +first member is the @dfn{buffer magnification}, which indicates the +required minimum size of the output buffer as a multiple of the input +buffer. It is followed by the @dfn{main block} which executes while +there is input remaining, and an optional @dfn{EOF block} which is +executed when the input is exhausted. Both the main block and the EOF +block are CCL blocks. + +A @dfn{CCL block} is either a CCL statement or list of CCL statements. +A @dfn{CCL statement} is either a @dfn{set statement} (either an integer +or an @dfn{assignment}, which is a list of a register to receive the +assignment, an assignment operator, and an expression) or a @dfn{control +statement} (a list starting with a keyword, whose allowable syntax +depends on the keyword). + +@menu +* CCL Syntax:: CCL program syntax in BNF notation. +* CCL Statements:: Semantics of CCL statements. +* CCL Expressions:: Operators and expressions in CCL. +* Calling CCL:: Running CCL programs. +* CCL Examples:: The encoding functions for Big5 and KOI-8. +@end menu + +@node CCL Syntax, CCL Statements, CCL, CCL +@comment Node, Next, Previous, Up +@subsection CCL Syntax + +The full syntax of a CCL program in BNF notation: + +@format +CCL_PROGRAM := + (BUFFER_MAGNIFICATION + CCL_MAIN_BLOCK + [ CCL_EOF_BLOCK ]) + +BUFFER_MAGNIFICATION := integer +CCL_MAIN_BLOCK := CCL_BLOCK +CCL_EOF_BLOCK := CCL_BLOCK + +CCL_BLOCK := + STATEMENT | (STATEMENT [STATEMENT ...]) +STATEMENT := + SET | IF | BRANCH | LOOP | REPEAT | BREAK | READ | WRITE + | CALL | END + +SET := + (REG = EXPRESSION) + | (REG ASSIGNMENT_OPERATOR EXPRESSION) + | integer + +EXPRESSION := ARG | (EXPRESSION OPERATOR ARG) + +IF := (if EXPRESSION CCL_BLOCK [CCL_BLOCK]) +BRANCH := (branch EXPRESSION CCL_BLOCK [CCL_BLOCK ...]) +LOOP := (loop STATEMENT [STATEMENT ...]) +BREAK := (break) +REPEAT := + (repeat) + | (write-repeat [REG | integer | string]) + | (write-read-repeat REG [integer | ARRAY]) +READ := + (read REG ...) + | (read-if (REG OPERATOR ARG) CCL_BLOCK CCL_BLOCK) + | (read-branch REG CCL_BLOCK [CCL_BLOCK ...]) +WRITE := + (write REG ...) + | (write EXPRESSION) + | (write integer) | (write string) | (write REG ARRAY) + | string +CALL := (call ccl-program-name) +END := (end) + +REG := r0 | r1 | r2 | r3 | r4 | r5 | r6 | r7 +ARG := REG | integer +OPERATOR := + + | - | * | / | % | & | '|' | ^ | << | >> | <8 | >8 | // + | < | > | == | <= | >= | != | de-sjis | en-sjis +ASSIGNMENT_OPERATOR := + += | -= | *= | /= | %= | &= | '|=' | ^= | <<= | >>= +ARRAY := '[' integer ... ']' +@end format + +@node CCL Statements, CCL Expressions, CCL Syntax, CCL +@comment Node, Next, Previous, Up +@subsection CCL Statements + +The Emacs Code Conversion Language provides the following statement +types: @dfn{set}, @dfn{if}, @dfn{branch}, @dfn{loop}, @dfn{repeat}, +@dfn{break}, @dfn{read}, @dfn{write}, @dfn{call}, and @dfn{end}. + +@heading Set statement: + +The @dfn{set} statement has three variants with the syntaxes +@samp{(@var{reg} = @var{expression})}, +@samp{(@var{reg} @var{assignment_operator} @var{expression})}, and +@samp{@var{integer}}. The assignment operator variation of the +@dfn{set} statement works the same way as the corresponding C expression +statement does. The assignment operators are @code{+=}, @code{-=}, +@code{*=}, @code{/=}, @code{%=}, @code{&=}, @code{|=}, @code{^=}, +@code{<<=}, and @code{>>=}, and they have the same meanings as in C. A +"naked integer" @var{integer} is equivalent to a @var{set} statement of +the form @code{(r0 = @var{integer})}. + +@heading I/O statements: + +The @dfn{read} statement takes one or more registers as arguments. It +reads one byte (a C char) from the input into each register in turn. + +The @dfn{write} takes several forms. In the form @samp{(write @var{reg} +...)} it takes one or more registers as arguments and writes each in +turn to the output. The integer in a register (interpreted as an +Emchar) is encoded to multibyte form (ie, Bufbytes) and written to the +current output buffer. If it is less than 256, it is written as is. +The forms @samp{(write @var{expression})} and @samp{(write +@var{integer})} are treated analogously. The form @samp{(write +@var{string})} writes the constant string to the output. A +"naked string" @samp{@var{string}} is equivalent to the statement @samp{(write +@var{string})}. The form @samp{(write @var{reg} @var{array})} writes +the @var{reg}th element of the @var{array} to the output. + +@heading Conditional statements: + +The @dfn{if} statement takes an @var{expression}, a @var{CCL block}, and +an optional @var{second CCL block} as arguments. If the +@var{expression} evaluates to non-zero, the first @var{CCL block} is +executed. Otherwise, if there is a @var{second CCL block}, it is +executed. + +The @dfn{read-if} variant of the @dfn{if} statement takes an +@var{expression}, a @var{CCL block}, and an optional @var{second CCL +block} as arguments. The @var{expression} must have the form +@code{(@var{reg} @var{operator} @var{operand})} (where @var{operand} is +a register or an integer). The @code{read-if} statement first reads +from the input into the first register operand in the @var{expression}, +then conditionally executes a CCL block just as the @code{if} statement +does. + +The @dfn{branch} statement takes an @var{expression} and one or more CCL +blocks as arguments. The CCL blocks are treated as a zero-indexed +array, and the @code{branch} statement uses the @var{expression} as the +index of the CCL block to execute. Null CCL blocks may be used as +no-ops, continuing execution with the statement following the +@code{branch} statement in the containing CCL block. Out-of-range +values for the @var{EXPRESSION} are also treated as no-ops. + +The @dfn{read-branch} variant of the @dfn{branch} statement takes an +@var{register}, a @var{CCL block}, and an optional @var{second CCL +block} as arguments. The @code{read-branch} statement first reads from +the input into the @var{register}, then conditionally executes a CCL +block just as the @code{branch} statement does. + +@heading Loop control statements: + +The @dfn{loop} statement creates a block with an implied jump from the +end of the block back to its head. The loop is exited on a @code{break} +statement, and continued without executing the tail by a @code{repeat} +statement. + +The @dfn{break} statement, written @samp{(break)}, terminates the +current loop and continues with the next statement in the current +block. + +The @dfn{repeat} statement has three variants, @code{repeat}, +@code{write-repeat}, and @code{write-read-repeat}. Each continues the +current loop from its head, possibly after performing I/O. +@code{repeat} takes no arguments and does no I/O before jumping. +@code{write-repeat} takes a single argument (a register, an +integer, or a string), writes it to the output, then jumps. +@code{write-read-repeat} takes one or two arguments. The first must +be a register. The second may be an integer or an array; if absent, it +is implicitly set to the first (register) argument. +@code{write-read-repeat} writes its second argument to the output, then +reads from the input into the register, and finally jumps. See the +@code{write} and @code{read} statements for the semantics of the I/O +operations for each type of argument. + +@heading Other control statements: + +The @dfn{call} statement, written @samp{(call @var{ccl-program-name})}, +executes a CCL program as a subroutine. It does not return a value to +the caller, but can modify the register status. + +The @dfn{end} statement, written @samp{(end)}, terminates the CCL +program successfully, and returns to caller (which may be a CCL +program). It does not alter the status of the registers. + +@node CCL Expressions, Calling CCL, CCL Statements, CCL +@comment Node, Next, Previous, Up +@subsection CCL Expressions + +CCL, unlike Lisp, uses infix expressions. The simplest CCL expressions +consist of a single @var{operand}, either a register (one of @code{r0}, +..., @code{r0}) or an integer. Complex expressions are lists of the +form @code{( @var{expression} @var{operator} @var{operand} )}. Unlike +C, assignments are not expressions. + +In the following table, @var{X} is the target resister for a @dfn{set}. +In subexpressions, this is implicitly @code{r7}. This means that +@code{>8}, @code{//}, @code{de-sjis}, and @code{en-sjis} cannot be used +freely in subexpressions, since they return parts of their values in +@code{r7}. @var{Y} may be an expression, register, or integer, while +@var{Z} must be a register or an integer. + +@multitable @columnfractions .22 .14 .09 .55 +@item Name @tab Operator @tab Code @tab C-like Description +@item CCL_PLUS @tab @code{+} @tab 0x00 @tab X = Y + Z +@item CCL_MINUS @tab @code{-} @tab 0x01 @tab X = Y - Z +@item CCL_MUL @tab @code{*} @tab 0x02 @tab X = Y * Z +@item CCL_DIV @tab @code{/} @tab 0x03 @tab X = Y / Z +@item CCL_MOD @tab @code{%} @tab 0x04 @tab X = Y % Z +@item CCL_AND @tab @code{&} @tab 0x05 @tab X = Y & Z +@item CCL_OR @tab @code{|} @tab 0x06 @tab X = Y | Z +@item CCL_XOR @tab @code{^} @tab 0x07 @tab X = Y ^ Z +@item CCL_LSH @tab @code{<<} @tab 0x08 @tab X = Y << Z +@item CCL_RSH @tab @code{>>} @tab 0x09 @tab X = Y >> Z +@item CCL_LSH8 @tab @code{<8} @tab 0x0A @tab X = (Y << 8) | Z +@item CCL_RSH8 @tab @code{>8} @tab 0x0B @tab X = Y >> 8, r[7] = Y & 0xFF +@item CCL_DIVMOD @tab @code{//} @tab 0x0C @tab X = Y / Z, r[7] = Y % Z +@item CCL_LS @tab @code{<} @tab 0x10 @tab X = (X < Y) +@item CCL_GT @tab @code{>} @tab 0x11 @tab X = (X > Y) +@item CCL_EQ @tab @code{==} @tab 0x12 @tab X = (X == Y) +@item CCL_LE @tab @code{<=} @tab 0x13 @tab X = (X <= Y) +@item CCL_GE @tab @code{>=} @tab 0x14 @tab X = (X >= Y) +@item CCL_NE @tab @code{!=} @tab 0x15 @tab X = (X != Y) +@item CCL_ENCODE_SJIS @tab @code{en-sjis} @tab 0x16 @tab X = HIGHER_BYTE (SJIS (Y, Z)) +@item @tab @tab @tab r[7] = LOWER_BYTE (SJIS (Y, Z) +@item CCL_DECODE_SJIS @tab @code{de-sjis} @tab 0x17 @tab X = HIGHER_BYTE (DE-SJIS (Y, Z)) +@item @tab @tab @tab r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) +@end multitable + +The CCL operators are as in C, with the addition of CCL_LSH8, CCL_RSH8, +CCL_DIVMOD, CCL_ENCODE_SJIS, and CCL_DECODE_SJIS. The CCL_ENCODE_SJIS +and CCL_DECODE_SJIS treat their first and second bytes as the high and +low bytes of a two-byte character code. (SJIS stands for Shift JIS, an +encoding of Japanese characters used by Microsoft. CCL_ENCODE_SJIS is a +complicated transformation of the Japanese standard JIS encoding to +Shift JIS. CCL_DECODE_SJIS is its inverse.) It is somewhat odd to +represent the SJIS operations in infix form. + +@node Calling CCL, CCL Examples, CCL Expressions, CCL +@comment Node, Next, Previous, Up +@subsection Calling CCL + +CCL programs are called automatically during Emacs buffer I/O when the +external representation has a coding system type of @code{shift-jis}, +@code{big5}, or @code{ccl}. The program is specified by the coding +system (@pxref{Coding Systems}). You can also call CCL programs from +other CCL programs, and from Lisp using these functions: + +@defun ccl-execute ccl-program status +Execute @var{ccl-program} with registers initialized by @var{status}. @var{ccl-program} is a vector of compiled CCL code -created by @code{ccl-compile}. @var{status} must be a vector of nine +created by @code{ccl-compile}. It is an error for the program to try to +execute a CCL I/O command. @var{status} must be a vector of nine values, specifying the initial value for the R0, R1 .. R7 registers and for the instruction counter IC. A @code{nil} value for a register initializer causes the register to be set to 0. A @code{nil} value for the IC initializer causes execution to start at the beginning of the program. When the program is done, @var{status} is modified (by side-effect) to contain the ending values for the corresponding -registers and IC. +registers and IC. @end defun -@defun execute-ccl-program-string ccl-program status str -This function executes @var{ccl-program} with initial @var{status} on +@defun ccl-execute-on-string ccl-program status str &optional continue +Execute @var{ccl-program} with initial @var{status} on @var{string}. @var{ccl-program} is a vector of compiled CCL code created by @code{ccl-compile}. @var{status} must be a vector of nine values, specifying the initial value for the R0, R1 .. R7 registers and for the instruction counter IC. A @code{nil} value for a register initializer causes the register to be set to 0. A @code{nil} value for the IC initializer causes execution to start at the beginning of the -program. When the program is done, @var{status} is modified (by +program. An optional fourth argument @var{continue}, if non-nil, causes +the IC to +remain on the unsatisfied read operation if the program terminates due +to exhaustion of the input buffer. Otherwise the IC is set to the end +of the program. When the program is done, @var{status} is modified (by side-effect) to contain the ending values for the corresponding registers and IC. Returns the resulting string. @end defun -@defun ccl-reset-elapsed-time -This function resets the internal value which holds the time elapsed by -CCL interpreter. +To call a CCL program from another CCL program, it must first be +registered: + +@defun register-ccl-program name ccl-program +Register @var{name} for CCL program @var{program} in +@code{ccl-program-table}. @var{program} should be the compiled form of +a CCL program, or nil. Return index number of the registered CCL +program. @end defun +Information about the processor time used by the CCL interpreter can be +obtained using these functions: + @defun ccl-elapsed-time -This function returns the time elapsed by CCL interpreter as cons of -user and system time. This measures processor time, not real time. -Both values are floating point numbers measured in seconds. If only one +Returns the elapsed processor time of the CCL interpreter as cons of +user and system time, as +floating point numbers measured in seconds. If only one overall value can be determined, the return value will be a cons of that value and 0. @end defun -@node Category Tables +@defun ccl-reset-elapsed-time +Resets the CCL interpreter's internal elapsed time registers. +@end defun + +@node CCL Examples, , Calling CCL, CCL +@comment Node, Next, Previous, Up +@subsection CCL Examples + +This section is not yet written. + +@node Category Tables, , CCL, MULE @section Category Tables A category table is a type of char table used for keeping track of categories. Categories are used for classifying characters for use in -regexps -- you can refer to a category rather than having to use a +regexps---you can refer to a category rather than having to use a complicated [] expression (and category lookups are significantly faster). diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/objects.texi --- a/man/lispref/objects.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/objects.texi Mon Aug 13 11:13:30 2007 +0200 @@ -343,7 +343,7 @@ @node Character Type @subsection Character Type -@cindex @sc{ASCII} character codes +@cindex @sc{ascii} character codes @cindex char-int confoundance disease In XEmacs version 19, and in all versions of FSF GNU Emacs, a @@ -352,7 +352,7 @@ vintage-1980 Lisps; modern versions of Lisp consider this equivalence a bad idea, and have separate character types. In XEmacs version 20, the modern convention is followed, and characters are their own -primitive types. (This change was necessary in order for @sc{MULE}, +primitive types. (This change was necessary in order for @sc{mule}, i.e. Asian-language, support to be correctly implemented.) Even in XEmacs version 20, remnants of the equivalence between @@ -363,28 +363,28 @@ are integers are the same. Byte code compiled under any version 19 Emacs will have all such functions mapped to their @code{old-} equivalents when the byte code is read into XEmacs 20. This is to preserve -compatibility -- Emacs 19 converts all constant characters to the equivalent +compatibility---Emacs 19 converts all constant characters to the equivalent integer during byte-compilation, and thus there is no other way to preserve byte-code compatibility even if the code has specifically been written with the distinction between characters and integers in mind. Every character has an equivalent integer, called the @dfn{character code}. For example, the character @kbd{A} is represented as the -@w{integer 65}, following the standard @sc{ASCII} representation of -characters. If XEmacs was not compiled with @sc{MULE} support, the -range of this integer will always be 0 to 255 -- eight bits, or one +@w{integer 65}, following the standard @sc{ascii} representation of +characters. If XEmacs was not compiled with @sc{mule} support, the +range of this integer will always be 0 to 255---eight bits, or one byte. (Integers outside this range are accepted but silently truncated; however, you should most decidedly @emph{not} rely on this, because it -will not work under XEmacs with @sc{MULE} support.) When @sc{MULE} +will not work under XEmacs with @sc{mule} support.) When @sc{mule} support is present, the range of character codes is much larger. (Currently, 19 bits are used.) FSF GNU Emacs uses kludgy character codes above 255 to represent -keyboard input of @sc{ASCII} characters in combination with certain +keyboard input of @sc{ascii} characters in combination with certain modifiers. XEmacs does not use this (a more general mechanism is -used that does not distinguish between @sc{ASCII} keys and other +used that does not distinguish between @sc{ascii} keys and other keys), so you will never find character codes above 255 in a -non-@sc{MULE} XEmacs. +non-@sc{mule} XEmacs. Individual characters are not often used in programs. It is far more common to work with @emph{strings}, which are sequences composed of @@ -506,15 +506,15 @@ syntax in your programs. It is a holdover of yet another confoundance disease from earlier Emacsen. (This was used to represent keyboard input with the @key{META} key set, thus the @samp{M}; however, it conflicts -with the legitimate @sc{ISO}-8859-1 interpretation of the character code. +with the legitimate @sc{iso}-8859-1 interpretation of the character code. For example, character code 193 is a lowercase @samp{a} with an acute -accent, in @sc{ISO}-8859-1.) +accent, in @sc{iso}-8859-1.) @ignore @c None of this crap applies to XEmacs. For use in strings and buffers, you are limited to the control -characters that exist in @sc{ASCII}, but for keyboard input purposes, +characters that exist in @sc{ascii}, but for keyboard input purposes, you can turn any character into a control character with @samp{C-}. The -character codes for these non-@sc{ASCII} control characters include the +character codes for these non-@sc{ascii} control characters include the @iftex $2^{26}$ @end iftex @@ -617,9 +617,9 @@ followed by a backslash and the character code in octal (up to three octal digits); thus, @samp{?\101} for the character @kbd{A}, @samp{?\001} for the character @kbd{C-a}, and @code{?\002} for the -character @kbd{C-b}. Although this syntax can represent any @sc{ASCII} +character @kbd{C-b}. Although this syntax can represent any @sc{ascii} character, it is preferred only when the precise octal value is more -important than the @sc{ASCII} representation. +important than the @sc{ascii} representation. @example @group @@ -1521,7 +1521,7 @@ than one if XEmacs is being run on a multi-headed display (e.g. an X server with attached color and mono screens) or if XEmacs is simultaneously driving frames attached to different consoles, e.g. -an X display and a @sc{TTY} connection. +an X display and a @sc{tty} connection. Devices do not have a read syntax. They print in hash notation, giving the device's type, connection name, and a unique number assigned @@ -1544,13 +1544,13 @@ (i.e. displays on which frames exist) are connected. Normally, there is only one console object, but there may be more than one if XEmacs is simultaneously driving frames attached to different X servers and/or -@sc{TTY} connections. (XEmacs is capable of driving multiple X and -@sc{TTY} connections at the same time, and provides a robust mechanism +@sc{tty} connections. (XEmacs is capable of driving multiple X and +@sc{tty} connections at the same time, and provides a robust mechanism for handling the differing display capabilities of such heterogeneous environments. A buffer with embedded glyphs and multiple fonts and colors, for example, will display reasonably if it simultaneously appears on a frame on a color X display, a frame on a mono X display, -and a frame on a @sc{TTY} connection.) +and a frame on a @sc{tty} connection.) Consoles do not have a read syntax. They print in hash notation, giving the console's type, connection name, and a unique number assigned diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/os.texi --- a/man/lispref/os.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/os.texi Mon Aug 13 11:13:30 2007 +0200 @@ -1602,7 +1602,7 @@ @code{C-s} and @kbd{C-q} for flow control. Therefore, the choice of @kbd{C-s} and @kbd{C-q} as command characters was uncontroversial. XEmacs, for economy of keystrokes and portability, used nearly all the -@sc{ASCII} control characters, with mnemonic meanings when possible; +@sc{ascii} control characters, with mnemonic meanings when possible; thus, @kbd{C-s} for search and @kbd{C-q} for quote. Later, some terminals were introduced which required these characters diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/permute-index --- a/man/lispref/permute-index Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,102 +0,0 @@ -#!/bin/csh -f -# Generate a permuted index of all names. -# The result is a file called index.fns. - -# You will need to modify this for your needs. - - -set TEXINDEX=texindex # path to texindex command -#set EMACS=xemacs # your emacs command -#set TEX=tex # your tex command - -set MANUAL=lispref # the base name of the manual - -# goto 3 - -1: -echo "Extract raw index from texinfo fn index." -# Let texindex combine duplicate entries, later. -# But it wants to protect non-alphanumerics thus confusing ptx. -# Also change `\ ' to just a ` ', since texindex will fail. This is produced -# by `@findex two words' in an example environment (no doubt among others). -# delete wrapper parens -# change dots {} to dots{} -# change {-} to char form, so ptx wont ignore it. -# delete leading \entry { -# change '\ ' to ' ' -# change lines with = < > since they mess up field extraction. -# separate into fields delimited by " -cat ${MANUAL}.fn | \ - sed \ - -e 's/(\([^)]*\))/\1/' \ - -e 's/\\dots {}/(\\dots{})/' \ - -e "s/{-}/{{\\tt\\char'055}}/" \ - -e 's,^[^ ]* {,,' \ - -e 's, },},' \ - -e 's,\\ , ,g' \ - -e 's/{\\tt\\char61}/=/' \ - -e 's/{\\tt\\gtr}/>/' \ - -e 's/{\\tt\\less}/</' \ - -e 's/}{/"/g' \ - | awk -F\" '{print $2, $1}' >! permuted.raw - -2: -# Build break file for ptx. -cat <<EOF > permuted.break -- -: -EOF -# Build the ignore file for ptx. -# We would like to ignore "and", "or", and "for", -# but ptx ignores ignore words even if they stand alone. -cat <<EOF > permuted.ignore -the -in -to -as -a -an -of -on -them -how -from -by -EOF - -echo "Make troff permuted index." -ptx -i permuted.ignore -b permuted.break -f -r -w 144 \ - < permuted.raw >! permuted.t - -3: -echo "Extract the desired fields." -awk -F\" '{printf "%s\"%s\"%s\n", $4,$6,$9}' permuted.t >! permuted.fields - -4: -echo "Format for texindex." -# delete lines that start with "and ", "for " -sed < permuted.fields \ - -e 's/=/{\\tt\\char61}/' \ - -e 's/>/{\\tt\\gtr}/' \ - -e 's/</{\\tt\\less}/' \ - -e '/"and /d' \ - -e '/"for /d' \ - | awk -F\" 'NF>0 {if ($1=="") {\ - print "\entry {" $2 "}{" 0+$3 "}{" $2 "}" }\ - else {\ - print "\entry {" $2 ", " $1 "}{" 0+$3 "}{" $2 ", " $1 "}"} }'\ - > permuted.fn - -5: -echo "Sort with texindex." -${TEXINDEX} permuted.fn -#mv permuted.fns ${MANUAL}.fns - -# The resulting permuted.fns will be read when we run TeX -# on the manual the second time. Or you can use permuted.texinfo here. -#${TEX} permuted.texinfo - -6: -echo "Clean up." -rm -f permuted.fields permuted.t permuted.raw -rm -f permuted.break permuted.ignore permuted.fn diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/sequences.texi --- a/man/lispref/sequences.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/sequences.texi Mon Aug 13 11:13:30 2007 +0200 @@ -264,7 +264,7 @@ @item They usually occupy one-fourth the space of a vector of the same elements. (This is one-eighth the space for 64-bit machines such as the -DEC Alpha, and may also be different when @sc{MULE} support is compiled +DEC Alpha, and may also be different when @sc{mule} support is compiled into XEmacs.) @item diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/specifiers.texi --- a/man/lispref/specifiers.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/specifiers.texi Mon Aug 13 11:13:30 2007 +0200 @@ -22,27 +22,27 @@ @end defun @menu -* Introduction to Specifiers:: Specifiers provide a clean way for - display and other properties to vary - (under user control) in a wide variety - of contexts. -* Specifiers In-Depth:: Gory details about specifier innards. -* Specifier Instancing:: Instancing means obtaining the ``value'' of - a specifier in a particular context. -* Specifier Types:: Specifiers come in different flavors. -* Adding Specifications:: Specifications control a specifier's ``value'' - by giving conditions under which a - particular value is valid. -* Retrieving Specifications:: Querying a specifier's specifications. -* Specifier Tag Functions:: Working with specifier tags. +* Introduction to Specifiers:: Specifiers provide a clean way for + display and other properties to vary + (under user control) in a wide variety + of contexts. +* Specifiers In-Depth:: Gory details about specifier innards. +* Specifier Instancing:: Instancing means obtaining the ``value'' of + a specifier in a particular context. +* Specifier Types:: Specifiers come in different flavors. +* Adding Specifications:: Specifications control a specifier's ``value'' + by giving conditions under which a + particular value is valid. +* Retrieving Specifications:: Querying a specifier's specifications. +* Specifier Tag Functions:: Working with specifier tags. * Specifier Instancing Functions:: - Functions to instance a specifier. -* Specifier Example:: Making all this stuff clearer. -* Creating Specifiers:: Creating specifiers for your own use. + Functions to instance a specifier. +* Specifier Example:: Making all this stuff clearer. +* Creating Specifiers:: Creating specifiers for your own use. * Specifier Validation Functions:: - Validating the components of a specifier. + Validating the components of a specifier. * Other Specification Functions:: - Other ways of working with specifications. + Other ways of working with specifications. @end menu @node Introduction to Specifiers @@ -169,7 +169,7 @@ User-defined tags may be defined, with an optional predicate specified. An application can create its own tag, use it to mark all its instantiators, and be fairly confident that it will not interfere with -other applications that modify the same specifier -- Functions that add +other applications that modify the same specifier---Functions that add a specification to a specifier usually only overwrite existing inst-pairs with the same tag set as was given, and a particular tag or tag set can be specified when removing instantiators. @@ -196,7 +196,7 @@ different font names, with possibly different foundries, widths, etc., on different devices), the extra properties of that font on that device, etc. Furthermore, this conversion (called @dfn{instantiation}) -might fail -- a font or color might not exist on a particular device, +might fail---a font or color might not exist on a particular device, for example. @node Specifier Instancing @@ -861,9 +861,9 @@ @result{} ((#<buffer "device.c"> (nil . "forest green")) (#<window on "Makefile" 0x8a2b> (nil . "hot pink")) (#<x-frame "emacs" 0x4ac> (nil . "puke orange") - (nil . "moccasin")) + (nil . "moccasin")) (#<x-frame "VM" 0x4ac> (nil . "magenta")) - (global ((tty) . "cyan") (nil . "white")) + (global ((tty) . "cyan") (nil . "white")) ) @end example @@ -890,7 +890,7 @@ @enumerate @item First, we look for a specification matching the buffer displayed in the -window, i.e. @samp{*scratch}. There are none, so we proceed. +window, i.e. @samp{*scratch*}. There are none, so we proceed. @item Then, we look for a specification matching the window itself. Again, there are none. diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/strings.texi --- a/man/lispref/strings.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/strings.texi Mon Aug 13 11:13:30 2007 +0200 @@ -18,7 +18,7 @@ Lisp programs use strings more often than individual characters. @menu -* Basics: String Basics. Basic properties of strings and characters. +* String Basics:: Basic properties of strings and characters. * Predicates for Strings:: Testing whether an object is a string or char. * Creating Strings:: Functions to allocate new strings. * Predicates for Characters:: Testing whether an object is a character. @@ -45,8 +45,8 @@ The length of a string (like any array) is fixed and independent of the string contents, and cannot be altered. Strings in Lisp are @emph{not} terminated by a distinguished character code. (By contrast, -strings in C are terminated by a character with @sc{ASCII} code 0.) -This means that any character, including the null character (@sc{ASCII} +strings in C are terminated by a character with @sc{ascii} code 0.) +This means that any character, including the null character (@sc{ascii} code 0), is a valid element of a string.@refill Since strings are considered arrays, you can operate on them with the @@ -321,15 +321,15 @@ @item 0 - 31 Control set 0 @item 32 - 127 -@sc{ASCII} +@sc{ascii} @item 128 - 159 Control set 1 @item 160 - 255 Right half of ISO-8859-1 @end table -If support for @sc{MULE} does not exist, these are the only valid -character values. When @sc{MULE} support exists, the values assigned to +If support for @sc{mule} does not exist, these are the only valid +character values. When @sc{mule} support exists, the values assigned to other characters may vary depending on the particular version of XEmacs, the order in which character sets were loaded, etc., and you should not depend on them. @@ -427,9 +427,9 @@ @var{string2}, then @var{string1} is greater, and this function returns @code{nil}. If the two strings match entirely, the value is @code{nil}. -Pairs of characters are compared by their @sc{ASCII} codes. Keep in +Pairs of characters are compared by their @sc{ascii} codes. Keep in mind that lower case letters have higher numeric values in the -@sc{ASCII} character set than their upper case counterparts; numbers and +@sc{ascii} character set than their upper case counterparts; numbers and many punctuation characters have a lower numeric value than upper case letters. @@ -515,7 +515,7 @@ This function returns the first character in @var{string}. If the string is empty, the function returns 0. (Under XEmacs 19, the value is also 0 when the first character of @var{string} is the null character, -@sc{ASCII} code 0.) +@sc{ascii} code 0.) @example (string-to-char "ABC") @@ -610,14 +610,14 @@ @cindex string properties @cindex properties of strings -Similar to symbols, extents, faces, and glyphs, you can attach +Just as with symbols, extents, faces, and glyphs, you can attach additional information to strings in the form of @dfn{string properties}. These differ from text properties, which are logically attached to particular characters in the string. To attach a property to a string, use @code{put}. To retrieve a property from a string, use @code{get}. You can also use @code{remprop} to remove -a property from a string and @code{object-props} to retrieve a list of +a property from a string and @code{object-plist} to retrieve a list of all the properties in a string. @node Formatting Strings @@ -910,7 +910,7 @@ modify the strings that are passed to them as arguments. The examples below use the characters @samp{X} and @samp{x} which have -@sc{ASCII} codes 88 and 120 respectively. +@sc{ascii} codes 88 and 120 respectively. @defun downcase string-or-char This function converts a character or a string to lower case. @@ -995,7 +995,7 @@ case letters. It affects both the string and character case conversion functions (see the previous section) and those that apply to text in the buffer (@pxref{Case Changes}). You need a case table if you are using a -language which has letters other than the standard @sc{ASCII} letters. +language which has letters other than the standard @sc{ascii} letters. A case table is a list of this form: @@ -1022,7 +1022,7 @@ The element @var{equivalences} is a map that cyclicly permutes each equivalence class (of characters with the same canonical equivalent). -(For ordinary @sc{ASCII}, this would map @samp{a} into @samp{A} and +(For ordinary @sc{ascii}, this would map @samp{a} into @samp{A} and @samp{A} into @samp{a}, and likewise for each set of equivalent characters.) @@ -1063,7 +1063,7 @@ @end defun The following three functions are convenient subroutines for packages -that define non-@sc{ASCII} character sets. They modify a string +that define non-@sc{ascii} character sets. They modify a string @var{downcase-table} provided as an argument; this should be a string to be used as the @var{downcase} part of a case table. They also modify the standard syntax table. @xref{Syntax Tables}. @@ -1109,7 +1109,7 @@ this section, exist only in XEmacs 20. In XEmacs 19, char tables are generally implemented using a vector of 256 elements. -When @sc{MULE} support exists, the types of ranges that can be assigned +When @sc{mule} support exists, the types of ranges that can be assigned values are @itemize @bullet @@ -1123,7 +1123,7 @@ a single character @end itemize -When @sc{MULE} support is not present, the types of ranges that can be +When @sc{mule} support is not present, the types of ranges that can be assigned values are @itemize @bullet @@ -1154,7 +1154,7 @@ that a character is in. The valid values are @code{nil} or a bit vector of 95 elements. Higher-level Lisp functions are provided for working with category tables. Currently categories -and category tables only exist when @sc{MULE} support is present. +and category tables only exist when @sc{mule} support is present. @item char A generalized char table, for mapping from one character to another. Used for case tables, syntax matching tables, @@ -1203,10 +1203,10 @@ @item @code{t} (all characters are affected) @item -A charset (only allowed when @sc{MULE} support is present) +A charset (only allowed when @sc{mule} support is present) @item A vector of two elements: a two-octet charset and a row number -(only allowed when @sc{MULE} support is present) +(only allowed when @sc{mule} support is present) @item A single character @end itemize diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/symbols.texi --- a/man/lispref/symbols.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/symbols.texi Mon Aug 13 11:13:30 2007 +0200 @@ -378,14 +378,14 @@ @cindex plist, symbol A @dfn{property list} (@dfn{plist} for short) is a list of paired -elements stored in the property list cell of a symbol. Each of the -pairs associates a property name (usually a symbol) with a property or -value. Property lists are generally used to record information about a -symbol, such as its documentation as a variable, the name of the file +elements, often stored in the property list cell of a symbol. Each of +the pairs associates a property name (usually a symbol) with a property +or value. Property lists are generally used to record information about +a symbol, such as its documentation as a variable, the name of the file where it was defined, or perhaps even the grammatical class of the symbol (representing a word) in a language-understanding system. - Many objects other than symbols can have property lists associated + Some objects which are not symbols also have property lists associated with them, and XEmacs provides a full complement of functions for working with property lists. @xref{Property Lists}. @@ -405,7 +405,7 @@ @menu * Plists and Alists:: Comparison of the advantages of property lists and association lists. -* Symbol Plists:: Functions to access symbols' property lists. +* Object Plists:: Functions to access objects' property lists. * Other Plists:: Accessing property lists stored elsewhere. @end menu @@ -441,13 +441,22 @@ are pushed on the front of the list and later discarded; this is not possible with a property list. -@node Symbol Plists -@subsection Property List Functions for Symbols +@node Object Plists +@subsection Property List Functions for Objects + +Once upon a time, only symbols had property lists. Now, several other +object types, including strings, extents, faces and glyphs also have +property lists. @defun symbol-plist symbol This function returns the property list of @var{symbol}. @end defun +@defun object-plist object +This function returns the property list of @var{object}. If +@var{object} is a symbol, this is identical to @code{symbol-plist}. +@end defun + @defun setplist symbol plist This function sets @var{symbol}'s property list to @var{plist}. Normally, @var{plist} should be a well-formed property list, but this is @@ -463,23 +472,24 @@ For symbols in special obarrays, which are not used for ordinary purposes, it may make sense to use the property list cell in a nonstandard fashion; in fact, the abbrev mechanism does so -(@pxref{Abbrevs}). +(@pxref{Abbrevs}). But generally, its use is discouraged. Use +@code{put} instead. @code{setplist} can only be used with symbols, not +other object types. @end defun -@defun get symbol property +@defun get object property &optional default This function finds the value of the property named @var{property} in -@var{symbol}'s property list. If there is no such property, @code{nil} -is returned. Thus, there is no distinction between a value of -@code{nil} and the absence of the property. +@var{object}'s property list. If there is no such property, +@code{default} (which itself defaults to @code{nil}) is returned. -The name @var{property} is compared with the existing property names -using @code{eq}, so any object is a legitimate property. +@var{property} is compared with the existing properties using @code{eq}, +so any object is a legitimate property. See @code{put} for an example. @end defun -@defun put symbol property value -This function puts @var{value} onto @var{symbol}'s property list under +@defun put object property value +This function puts @var{value} onto @var{object}'s property list under the property name @var{property}, replacing any previous property value. The @code{put} function returns @var{value}. @@ -490,13 +500,24 @@ @result{} (a buzzing little bug) (get 'fly 'verb) @result{} transitive -(symbol-plist 'fly) +(object-plist 'fly) @result{} (verb transitive noun (a buzzing little bug)) @end smallexample @end defun +@defun remprop object property +This function removes the entry for @var{property} from the property +list of @var{object}. It returns @code{t} if the property was +indeed found and removed, or @code{nil} if there was no such property. +(This function was probably omitted from Emacs originally because, +since @code{get} did not allow a @var{default}, it was very difficult +to distinguish between a missing property and a property whose value +was @code{nil}; thus, setting a property to @code{nil} was close +enough to @code{remprop} for most purposes.) +@end defun + @node Other Plists -@subsection Property Lists Outside Symbols +@subsection Property Lists Not Associated with Objects These functions are useful for manipulating property lists that are stored in places other than symbols: diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/text.texi --- a/man/lispref/text.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/text.texi Mon Aug 13 11:13:30 2007 +0200 @@ -70,12 +70,13 @@ and always operated on the current buffer.) -@defun char-after position &optional buffer +@defun char-after &optional position buffer This function returns the character in the buffer at (i.e., immediately after) position @var{position}. If @var{position} is out of range for this purpose, either before the beginning of the buffer, or at -or beyond the end, then the value is @code{nil}. If optional argument -@var{buffer} is @code{nil}, the current buffer is assumed. +or beyond the end, then the value is @code{nil}. The default for +@var{position} is point. If optional argument @var{buffer} is +@code{nil}, the current buffer is assumed. In the following example, assume that the first character in the buffer is @samp{@@}: @@ -88,6 +89,15 @@ @end example @end defun +@defun char-before &optional position buffer +This function returns the character in the current buffer immediately +before position @var{position}. If @var{position} is out of range for +this purpose, either at or before the beginning of the buffer, or beyond +the end, then the value is @code{nil}. The default for +@var{position} is point. If optional argument @var{buffer} is +@code{nil}, the current buffer is assumed. +@end defun + @defun following-char &optional buffer This function returns the character following point in the buffer. This is similar to @code{(char-after (point))}. However, if point is at @@ -1478,7 +1488,7 @@ and so on. If a mismatch is found, it means that the sort keys are unequal; the sort key whose character is less at the point of first mismatch is the lesser sort key. The individual characters are compared -according to their numerical values. Since Emacs uses the @sc{ASCII} +according to their numerical values. Since Emacs uses the @sc{ascii} character set, the ordering in that set determines alphabetical order. @c version 19 change @@ -2464,18 +2474,59 @@ @defun translate-region start end table This function applies a translation table to the characters in the -buffer between positions @var{start} and @var{end}. - -The translation table @var{table} is a string; @code{(aref @var{table} -@var{ochar})} gives the translated character corresponding to -@var{ochar}. If the length of @var{table} is less than 256, any -characters with codes larger than the length of @var{table} are not -altered by the translation. +buffer between positions @var{start} and @var{end}. The translation +table @var{table} can be either a string, a vector, or a char-table. + +If @var{table} is a string, its @var{n}th element is the mapping for the +character with code @var{n}. + +If @var{table} is a vector, its @var{n}th element is the mapping for +character with code @var{n}. Legal mappings are characters, strings, or +@code{nil} (meaning don't replace.) + +If @var{table} is a char-table, its elements describe the mapping +between characters and their replacements. The char-table should be of +type @code{char} or @code{generic}. + +When the @var{table} is a string or vector and its length is less than +the total number of characters (256 without Mule), any characters with +codes larger than the length of @var{table} are not altered by the +translation. The return value of @code{translate-region} is the number of characters that were actually changed by the translation. This does not count characters that were mapped into themselves in the translation table. + +@strong{NOTE}: Prior to XEmacs 21.2, the @var{table} argument was +allowed only to be a string. This is still the case in FSF Emacs. + +The following example creates a char-table that is passed to +@code{translate-region}, which translates character @samp{a} to +@samp{the letter a}, removes character @samp{b}, and translates +character @samp{c} to newline. + +@example +@group +---------- Buffer: foo ---------- +Here is a sentence in the buffer. +---------- Buffer: foo ---------- +@end group + +@group +(let ((table (make-char-table 'generic))) + (put-char-table ?a "the letter a" table) + (put-char-table ?b "" table) + (put-char-table ?c ?\n table) + (translate-region (point-min) (point-max) table)) + @result{} 3 + +---------- Buffer: foo ---------- +Here is the letter a senten +e in the uffer. +---------- Buffer: foo ---------- +@end group +@end example @end defun @node Registers diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/toolbar.texi --- a/man/lispref/toolbar.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/toolbar.texi Mon Aug 13 11:13:30 2007 +0200 @@ -18,7 +18,7 @@ @section Toolbar Intro A @dfn{toolbar} is a bar of icons displayed along one edge of a frame. -You can view a toolbar as a series of menu shortcuts -- the most +You can view a toolbar as a series of menu shortcuts---the most common menu options can be accessed with a single click rather than a series of clicks and/or drags to select the option from a menu. Consistent with this, a help string (called the @dfn{help-echo}) @@ -346,7 +346,7 @@ buffer does not specify a left toolbar or has a nil value specified for @code{left-toolbar-visible-p}), you will find that, when that buffer is displayed in the selected window, the window will have a width of 86 or -87 characters -- the frame is sized for a 68-pixel left toolbar but the +87 characters---the frame is sized for a 68-pixel left toolbar but the selected window specifies that the left toolbar is not visible, so it is expanded to take up the slack. diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/tooltalk.texi --- a/man/lispref/tooltalk.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/tooltalk.texi Mon Aug 13 11:13:30 2007 +0200 @@ -138,7 +138,7 @@ Send a reply to this message. The second argument can be @code{reply}, @code{reject} or @code{fail}; the default is @code{reply}. Before sending a reply, all message arguments whose mode is @code{TT_INOUT} or -@code{TT_OUT} should have been filled in -- see +@code{TT_OUT} should have been filled in---see @code{set-tooltalk-message-attribute}. @refill @end defun diff -r f4aeb21a5bad -r 74fd4e045ea6 man/lispref/x-windows.texi --- a/man/lispref/x-windows.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/lispref/x-windows.texi Mon Aug 13 11:13:30 2007 +0200 @@ -18,9 +18,9 @@ generalize well, and they are covered specially here. @menu -* X Selections:: Transferring text to and from other X clients. -* X Server:: Information about the X server connected to - a particular device. +* X Selections:: Transferring text to and from other X clients. +* X Server:: Information about the X server connected to + a particular device. * X Miscellaneous:: Other X-specific functions and variables. @end menu @@ -86,9 +86,9 @@ the X server XEmacs is using. @menu -* Resources:: Getting resource values from the server. -* Server Data:: Getting info about the X server. -* Grabs:: Restricting access to the server by other apps. +* Resources:: Getting resource values from the server. +* Server Data:: Getting info about the X server. +* Grabs:: Restricting access to the server by other apps. @end menu @node Resources @@ -161,8 +161,8 @@ @example @code{XrmGetResource (db, "xemacs.buffer.@var{buffer-name}.foreground", - "Emacs.EmacsLocaleType.EmacsBuffer.Foreground", - "String");} + "Emacs.EmacsLocaleType.EmacsBuffer.Foreground", + "String");} @end example @item @@ -176,8 +176,8 @@ @example @code{XrmGetResource (db, "xemacs.frame.@var{frame-name}.foreground", - "Emacs.EmacsLocaleType.EmacsFrame.Foreground", - "String");} + "Emacs.EmacsLocaleType.EmacsFrame.Foreground", + "String");} @end example @item @@ -191,8 +191,8 @@ @example @code{XrmGetResource (db, "xemacs.device.@var{device-name}.foreground", - "Emacs.EmacsLocaleType.EmacsDevice.Foreground", - "String");} + "Emacs.EmacsLocaleType.EmacsDevice.Foreground", + "String");} @end example @item @@ -206,8 +206,8 @@ @example @code{XrmGetResource (db, "xemacs.foreground", - "Emacs.Foreground", - "String");} + "Emacs.Foreground", + "String");} @end example @end enumerate @@ -278,7 +278,7 @@ @defun x-grab-keyboard &optional device This function grabs the keyboard on the given device (defaulting to the selected one). So long as the keyboard is grabbed, all keyboard events -will be delivered to XEmacs -- it is not possible for other X clients to +will be delivered to XEmacs---it is not possible for other X clients to eavesdrop on them. Ungrab the keyboard with @code{x-ungrab-keyboard} (use an @code{unwind-protect}). Returns @code{t} if the grab was successful; @code{nil} otherwise. diff -r f4aeb21a5bad -r 74fd4e045ea6 man/make-stds.texi --- a/man/make-stds.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/make-stds.texi Mon Aug 13 11:13:30 2007 +0200 @@ -21,6 +21,8 @@ @end ifclear @end iftex describes conventions for writing the Makefiles for GNU programs. +Using Automake will help you write a Makefile that follows these +conventions. @menu * Makefile Basics:: General Conventions for Makefiles @@ -28,6 +30,8 @@ * Command Variables:: Variables for Specifying Commands * Directory Variables:: Variables for Installation Directories * Standard Targets:: Standard Targets for Users +* Install Command Categories:: Three categories of commands in the `install' + rule: normal, pre-install and post-install. @end menu @node Makefile Basics @@ -65,9 +69,10 @@ of the source code. Without one of these prefixes, the current search path is used. -The distinction between @file{./} and @file{$(srcdir)/} is important -when using the @samp{--srcdir} option to @file{configure}. A rule of -the form: +The distinction between @file{./} (the @dfn{build directory}) and +@file{$(srcdir)/} (the @dfn{source directory}) is important because +users can build in a separate directory using the @samp{--srcdir} option +to @file{configure}. A rule of the form: @smallexample foo.1 : foo.man sedscript @@ -75,9 +80,8 @@ @end smallexample @noindent -will fail when the current directory is not the source directory, -because @file{foo.man} and @file{sedscript} are not in the current -directory. +will fail when the build directory is not the source directory, because +@file{foo.man} and @file{sedscript} are in the the source directory. When using GNU @code{make}, relying on @samp{VPATH} to find the source file will work in the case where there is a single dependency file, @@ -109,6 +113,18 @@ sed -e $(srcdir)/sedscript $(srcdir)/foo.man > $@@ @end smallexample +GNU distributions usually contain some files which are not source +files---for example, Info files, and the output from Autoconf, Automake, +Bison or Flex. Since these files normally appear in the source +directory, they should always appear in the source directory, not in the +build directory. So Makefile rules to update them should put the +updated files in the source directory. + +However, if a file does not appear in the distribution, then the +Makefile should not put it in the source directory, because building a +program in ordinary circumstances should not modify the source directory +in any way. + Try to make the build and installation targets, at least (and all their subtargets) work correctly with a parallel @code{make}. @@ -122,11 +138,17 @@ The @code{configure} script and the Makefile rules for building and installation should not use any utilities directly except these: +@c dd find +@c gunzip gzip md5sum +@c mkfifo mknod tee uname + @example -cat cmp cp echo egrep expr false grep -ln mkdir mv pwd rm rmdir sed test touch true +cat cmp cp diff echo egrep expr false grep install-info +ln ls mkdir mv pwd rm rmdir sed sleep sort tar test touch true @end example +The compression program @code{gzip} can be used in the @code{dist} rule. + Stick to the generally supported options for these programs. For example, don't use @samp{mkdir -p}, convenient as it may be, because most systems don't support it. @@ -140,26 +162,33 @@ mean: @example -ar bison cc flex install ld lex +ar bison cc flex install ld ldconfig lex make makeinfo ranlib texi2dvi yacc @end example -Use the following @code{make} variables: +Use the following @code{make} variables to run those programs: @example -$(AR) $(BISON) $(CC) $(FLEX) $(INSTALL) $(LD) $(LEX) +$(AR) $(BISON) $(CC) $(FLEX) $(INSTALL) $(LD) $(LDCONFIG) $(LEX) $(MAKE) $(MAKEINFO) $(RANLIB) $(TEXI2DVI) $(YACC) @end example -When you use @code{ranlib}, you should make sure nothing bad happens if -the system does not have @code{ranlib}. Arrange to ignore an error -from that command, and print a message before the command to tell the -user that failure of the @code{ranlib} command does not mean a problem. -(The Autoconf @samp{AC_PROG_RANLIB} macro can help with this.) +When you use @code{ranlib} or @code{ldconfig}, you should make sure +nothing bad happens if the system does not have the program in question. +Arrange to ignore an error from that command, and print a message before +the command to tell the user that failure of this command does not mean +a problem. (The Autoconf @samp{AC_PROG_RANLIB} macro can help with +this.) If you use symbolic links, you should implement a fallback for systems that don't have symbolic links. +Additional utilities that can be used via Make variables are: + +@example +chgrp chmod chown mknod +@end example + It is ok to use other utilities in Makefile portions (or scripts) intended only for particular systems where you know those utilities exist. @@ -182,11 +211,12 @@ Each program-name variable should come with an options variable that is used to supply options to the program. Append @samp{FLAGS} to the program-name variable name to get the options variable name---for -example, @code{BISONFLAGS}. (The name @code{CFLAGS} is an exception to -this rule, but we keep it because it is standard.) Use @code{CPPFLAGS} -in any compilation command that runs the preprocessor, and use -@code{LDFLAGS} in any compilation command that does linking as well as -in any direct use of @code{ld}. +example, @code{BISONFLAGS}. (The names @code{CFLAGS} for the C +compiler, @code{YFLAGS} for yacc, and @code{LFLAGS} for lex, are +exceptions to this rule, but we keep them because they are standard.) +Use @code{CPPFLAGS} in any compilation command that runs the +preprocessor, and use @code{LDFLAGS} in any compilation command that +does linking as well as in any direct use of @code{ld}. If there are C compiler options that @emph{must} be used for proper compilation of certain files, do not include them in @code{CFLAGS}. @@ -212,6 +242,9 @@ containing compiler options, so the user can use @code{CFLAGS} to override the others. +@code{CFLAGS} should be used in every invocation of the C compiler, +both those which do compilation and those which do linking. + Every Makefile should define the variable @code{INSTALL}, which is the basic command for installing a file into the system. @@ -226,6 +259,18 @@ $(INSTALL_DATA) libfoo.a $(libdir)/libfoo.a @end example +Optionally, you may prepend the value of @code{DESTDIR} to the target +filename. Doing this allows the installer to create a snapshot of the +installation to be copied onto the real target filesystem later. Do not +set the value of @code{DESTDIR} in your Makefile, and do not include it +in any installed files. With support for @code{DESTDIR}, the above +examples become: + +@example +$(INSTALL_PROGRAM) foo $(DESTDIR)$(bindir)/foo +$(INSTALL_DATA) libfoo.a $(DESTDIR)$(libdir)/libfoo.a +@end example + @noindent Always use a file name, not a directory name, as the second argument of the installation commands. Use a separate command for each file to be @@ -252,6 +297,10 @@ @file{/usr} will be a symbolic link to @file{/}. (If you are using Autoconf, write it as @samp{@@prefix@@}.) +Running @samp{make install} with a different value of @code{prefix} +from the one used to build the program should @var{not} recompile +the program. + @item exec_prefix A prefix used in constructing the default values of some of the variables listed below. The default value of @code{exec_prefix} should @@ -261,6 +310,10 @@ Generally, @code{$(exec_prefix)} is used for directories that contain machine-specific files (such as executables and subroutine libraries), while @code{$(prefix)} is used directly for other directories. + +Running @samp{make install} with a different value of @code{exec_prefix} +from the one used to build the program should @var{not} recompile the +program. @end table Executable programs are installed in one of the following directories. @@ -328,14 +381,11 @@ write it as @file{$(prefix)/etc}. (If you are using Autoconf, write it as @samp{@@sysconfdir@@}.) -@c rewritten to avoid overfull hbox --tower -Do not install executables -@c here -in this directory (they probably -belong in @file{$(libexecdir)} or @file{$(sbindir)}). Also do not -install files that are modified in the normal course of their use -(programs whose purpose is to change the configuration of the system -excluded). Those probably belong in @file{$(localstatedir)}. +Do not install executables here in this directory (they probably belong +in @file{$(libexecdir)} or @file{$(sbindir)}). Also do not install +files that are modified in the normal course of their use (programs +whose purpose is to change the configuration of the system excluded). +Those probably belong in @file{$(localstatedir)}. @item sharedstatedir The directory for installing architecture-independent data files which @@ -366,6 +416,20 @@ as @file{$(prefix)/info}. (If you are using Autoconf, write it as @samp{@@infodir@@}.) +@item lispdir +The directory for installing any Emacs Lisp files in this package. By +default, it should be @file{/usr/local/share/emacs/site-lisp}, but it +should be written as @file{$(prefix)/share/emacs/site-lisp}. + +If you are using Autoconf, write the default as @samp{@@lispdir@@}. +In order to make @samp{@@lispdir@@} work, you need the following lines +in your @file{configure.in} file: + +@example +lispdir='$@{datadir@}/emacs/site-lisp' +AC_SUBST(lispdir) +@end example + @item includedir @c rewritten to avoid overfull hbox --roland The directory for installing header files to be included by user @@ -374,7 +438,7 @@ @file{$(prefix)/include}. (If you are using Autoconf, write it as @samp{@@includedir@@}.) -Most compilers other than GCC do not look for header files in +Most compilers other than GCC do not look for header files in directory @file{/usr/local/include}. So installing the header files this way is only useful with GCC. Sometimes this is not a problem because some libraries are only really intended to work with GCC. But some libraries @@ -526,11 +590,12 @@ @comment This example has been carefully formatted for the Make manual. @comment Please do not reformat it without talking to roland@gnu.ai.mit.edu. @smallexample -$(infodir)/foo.info: foo.info +$(DESTDIR)$(infodir)/foo.info: foo.info + $(POST_INSTALL) # There may be a newer info file in . than in srcdir. -if test -f foo.info; then d=.; \ else d=$(srcdir); fi; \ - $(INSTALL_DATA) $$d/foo.info $@@; \ + $(INSTALL_DATA) $$d/foo.info $(DESTDIR)$@@; \ # Run install-info only if it exists. # Use `if' instead of just prepending `-' to the # line so we notice real errors from install-info. @@ -538,22 +603,29 @@ # fail gracefully when there is an unknown command. if $(SHELL) -c 'install-info --version' \ >/dev/null 2>&1; then \ - install-info --dir-file=$(infodir)/dir \ - $(infodir)/foo.info; \ + install-info --dir-file=$(DESTDIR)$(infodir)/dir \ + $(DESTDIR)$(infodir)/foo.info; \ else true; fi @end smallexample +When writing the @code{install} target, you must classify all the +commands into three categories: normal ones, @dfn{pre-installation} +commands and @dfn{post-installation} commands. @xref{Install Command +Categories}. + @item uninstall -Delete all the installed files that the @samp{install} target would -create (but not the noninstalled files such as @samp{make all} would -create). +Delete all the installed files---the copies that the @samp{install} +target creates. This rule should not modify the directories where compilation is done, only the directories where files are installed. +The uninstallation commands are divided into three categories, just like +the installation commands. @xref{Install Command Categories}. + @item install-strip Like @code{install}, but strip the executable files while installing -them. The definition of this target can be very simple: +them. In many cases, the definition of this target can be very simple: @smallexample install-strip: @@ -638,6 +710,12 @@ run the @code{makeinfo} program, which is part of the Texinfo distribution. +Normally a GNU distribution comes with Info files, and that means the +Info files are present in the source directory. Therefore, the Make +rule for an info file should update it in the source directory. When +users build the package, ordinarily Make will not update the Info files +because they will already be up to date. + @item dvi Generate DVI files for all Texinfo documentation. For example: @@ -669,7 +747,7 @@ named, use @code{ln} or @code{cp} to install the proper files in it, and then @code{tar} that subdirectory. -Compress the tar file with @code{gzip}. For example, the actual +Compress the tar file file with @code{gzip}. For example, the actual distribution file for GCC version 1.40 is called @file{gcc-1.40.tar.gz}. The @code{dist} target should explicitly depend on all non-source files @@ -720,3 +798,119 @@ This rule should not modify the directories where compilation is done. It should do nothing but create installation directories. @end table + +@node Install Command Categories +@section Install Command Categories + +@cindex pre-installation commands +@cindex post-installation commands +When writing the @code{install} target, you must classify all the +commands into three categories: normal ones, @dfn{pre-installation} +commands and @dfn{post-installation} commands. + +Normal commands move files into their proper places, and set their +modes. They may not alter any files except the ones that come entirely +from the package they belong to. + +Pre-installation and post-installation commands may alter other files; +in particular, they can edit global configuration files or data bases. + +Pre-installation commands are typically executed before the normal +commands, and post-installation commands are typically run after the +normal commands. + +The most common use for a post-installation command is to run +@code{install-info}. This cannot be done with a normal command, since +it alters a file (the Info directory) which does not come entirely and +solely from the package being installed. It is a post-installation +command because it needs to be done after the normal command which +installs the package's Info files. + +Most programs don't need any pre-installation commands, but we have the +feature just in case it is needed. + +To classify the commands in the @code{install} rule into these three +categories, insert @dfn{category lines} among them. A category line +specifies the category for the commands that follow. + +A category line consists of a tab and a reference to a special Make +variable, plus an optional comment at the end. There are three +variables you can use, one for each category; the variable name +specifies the category. Category lines are no-ops in ordinary execution +because these three Make variables are normally undefined (and you +@emph{should not} define them in the makefile). + +Here are the three possible category lines, each with a comment that +explains what it means: + +@smallexample + $(PRE_INSTALL) # @r{Pre-install commands follow.} + $(POST_INSTALL) # @r{Post-install commands follow.} + $(NORMAL_INSTALL) # @r{Normal commands follow.} +@end smallexample + +If you don't use a category line at the beginning of the @code{install} +rule, all the commands are classified as normal until the first category +line. If you don't use any category lines, all the commands are +classified as normal. + +These are the category lines for @code{uninstall}: + +@smallexample + $(PRE_UNINSTALL) # @r{Pre-uninstall commands follow.} + $(POST_UNINSTALL) # @r{Post-uninstall commands follow.} + $(NORMAL_UNINSTALL) # @r{Normal commands follow.} +@end smallexample + +Typically, a pre-uninstall command would be used for deleting entries +from the Info directory. + +If the @code{install} or @code{uninstall} target has any dependencies +which act as subroutines of installation, then you should start +@emph{each} dependency's commands with a category line, and start the +main target's commands with a category line also. This way, you can +ensure that each command is placed in the right category regardless of +which of the dependencies actually run. + +Pre-installation and post-installation commands should not run any +programs except for these: + +@example +[ basename bash cat chgrp chmod chown cmp cp dd diff echo +egrep expand expr false fgrep find getopt grep gunzip gzip +hostname install install-info kill ldconfig ln ls md5sum +mkdir mkfifo mknod mv printenv pwd rm rmdir sed sort tee +test touch true uname xargs yes +@end example + +@cindex binary packages +The reason for distinguishing the commands in this way is for the sake +of making binary packages. Typically a binary package contains all the +executables and other files that need to be installed, and has its own +method of installing them---so it does not need to run the normal +installation commands. But installing the binary package does need to +execute the pre-installation and post-installation commands. + +Programs to build binary packages work by extracting the +pre-installation and post-installation commands. Here is one way of +extracting the pre-installation commands: + +@smallexample +make -n install -o all \ + PRE_INSTALL=pre-install \ + POST_INSTALL=post-install \ + NORMAL_INSTALL=normal-install \ + | gawk -f pre-install.awk +@end smallexample + +@noindent +where the file @file{pre-install.awk} could contain this: + +@smallexample +$0 ~ /^\t[ \t]*(normal_install|post_install)[ \t]*$/ @{on = 0@} +on @{print $0@} +$0 ~ /^\t[ \t]*pre_install[ \t]*$/ @{on = 1@} +@end smallexample + +The resulting file of pre-installation commands is executed as a shell +script as part of installing the binary package. diff -r f4aeb21a5bad -r 74fd4e045ea6 man/new-users-guide/Makefile --- a/man/new-users-guide/Makefile Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,51 +0,0 @@ -# Makefile for the XEmacs New Users Guide - -# This file is part of XEmacs. - -# XEmacs is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any -# later version. - -# XEmacs is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. - -# You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. - -NAME=new-users-guide - -SHELL = /bin/sh -TEXI2DVI = texi2dvi -MAKEINFO = makeinfo - -# List of all the texinfo files in the manual: - -srcs = new-users-guide.texi custom1.texi files.texi region.texi \ - custom2.texi help.texi search.texi edit.texi modes.texi \ - xmenu.texi enter.texi - -all : info -info : ../../info/$(NAME).info - -../../info/$(NAME).info: $(srcs) - $(MAKEINFO) -o $@ $(NAME).texi - -dvi : $(NAME).dvi -.texi.dvi : - $(TEXI2DVI) $< - -.PHONY: mostlyclean clean distclean realclean extraclean -mostlyclean: - rm -f *.toc *.aux *.oaux *.log *.cp *.cps *.fn *.fns *.tp *.tps \ - *.vr *.vrs *.pg *.pgs *.ky *.kys -clean: mostlyclean - rm -f *.dvi *.ps make.out core -distclean: clean -realclean: clean -extraclean: clean - -rm -f *~ \#* diff -r f4aeb21a5bad -r 74fd4e045ea6 man/new-users-guide/custom1.texi --- a/man/new-users-guide/custom1.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/new-users-guide/custom1.texi Mon Aug 13 11:13:30 2007 +0200 @@ -168,8 +168,8 @@ @enumerate @item -add-menu-item: @var{(menu-name item-name function enabled-p -&optional before)} +add-menu-item: (@var{menu-name} @var{item-name} @var{function} @var{enabled-p} +&optional @var{before}) This function will add a menu item to a menu, creating the menu first if necessary. If the named item already exists, the menu will remain @@ -260,7 +260,7 @@ @findex delete-menu-item @cindex deleting menu items @item -delete-menu-item: @var{(menu-path)} +delete-menu-item: (@var{menu-path}) This function will remove the menu item defined by @var{menu-name} from the menu hierarchy. Look at the following examples and the comments just above them which specify what the examples do. @@ -286,7 +286,7 @@ @findex disable-menu-item @cindex disabling menu items @item -disable-menu-item: @var{(menu-name)} +disable-menu-item: (@var{menu-name}) Disables the specified menu item. The following example @example @@ -301,7 +301,7 @@ @findex enable-menu-item @cindex enabling menu items @item -enable-menu-item: @var{(menu-name)} +enable-menu-item: (@var{menu-name}) Enables the specified previously disabled menu item. @example @@ -315,7 +315,7 @@ @findex relabel-menu-items @cindex relabelling menu items @item -relabel-menu-item: @var{(menu-name new-name)} +relabel-menu-item: (@var{menu-name} @var{new-name}) Change the string of the menu item specified by @var{menu-name} to @var{new-name}. diff -r f4aeb21a5bad -r 74fd4e045ea6 man/new-users-guide/custom2.texi --- a/man/new-users-guide/custom2.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/new-users-guide/custom2.texi Mon Aug 13 11:13:30 2007 +0200 @@ -46,7 +46,7 @@ (add-hook 'texinfo-mode-hook 'turn-on-font-lock) ;;; enables the font-lock mode in C Mode -(add-hook 'c-mode-hook 'turn-on-font-lock) +(add-hook 'c-mode-hook 'turn-on-font-lock) @end example To turn on the font-lock mode in other Major Modes like emacs-lisp, just diff -r f4aeb21a5bad -r 74fd4e045ea6 man/new-users-guide/help.texi --- a/man/new-users-guide/help.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/new-users-guide/help.texi Mon Aug 13 11:13:30 2007 +0200 @@ -98,13 +98,13 @@ of your list will contain: @example -C-c C-c n texinfo-insert-@@node -C-c C-c o texinfo-insert-@@noindent -C-c C-c s texinfo-insert-@@samp -C-c C-c t texinfo-insert-@@table -C-c C-c v texinfo-insert-@@var -C-c C-c x texinfo-insert-@@example -C-c C-c @{ texinfo-insert-braces +C-c C-c n texinfo-insert-@@node +C-c C-c o texinfo-insert-@@noindent +C-c C-c s texinfo-insert-@@samp +C-c C-c t texinfo-insert-@@table +C-c C-c v texinfo-insert-@@var +C-c C-c x texinfo-insert-@@example +C-c C-c @{ texinfo-insert-braces @end example @noindent These keybindings apply only to "Texinfo" mode. @xref{Modes}, for more diff -r f4aeb21a5bad -r 74fd4e045ea6 man/new-users-guide/modes.texi --- a/man/new-users-guide/modes.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/new-users-guide/modes.texi Mon Aug 13 11:13:30 2007 +0200 @@ -175,7 +175,7 @@ the major mode is c-mode. @example -(add-hook 'c-mode-hook 'turn-on-font-lock) +(add-hook 'c-mode-hook 'turn-on-font-lock) @end example @noindent diff -r f4aeb21a5bad -r 74fd4e045ea6 man/new-users-guide/new-users-guide.texi --- a/man/new-users-guide/new-users-guide.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/new-users-guide/new-users-guide.texi Mon Aug 13 11:13:30 2007 +0200 @@ -1,9 +1,14 @@ -\input ../texinfo @c -*-texinfo-*- +\input texinfo @c -*-texinfo-*- @setfilename ../../info/new-users-guide.info @comment node-name, next, previous, up @ifinfo +@dircategory XEmacs Editor +@direntry +* Intro: (new-users-guide). Introduction to the XEmacs Editor. +@end direntry + This manual serves as an introduction to the XEmacs editor. Copyright (C) 1985, 1986, 1988 Richard M. Stallman. @@ -55,9 +60,8 @@ @page @ifinfo @node Top, Intro, (dir), (dir) +@top The Emacs Editor -The Emacs Editor -**************** Emacs is the extensible, customizable, self-documenting real-time display editor. This Info file will help you get started on using diff -r f4aeb21a5bad -r 74fd4e045ea6 man/standards.texi --- a/man/standards.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/standards.texi Mon Aug 13 11:13:30 2007 +0200 @@ -2,8 +2,8 @@ @c %**start of header @setfilename ../info/standards.info @settitle GNU Coding Standards -@c UPDATE THIS DATE WHENEVER YOU MAKE CHANGES! -@set lastupdate 17 May 1996 +@c This date is automagically updated when you save this file: +@set lastupdate June 24, 1999 @c %**end of header @ifinfo @@ -28,7 +28,7 @@ @ifinfo GNU Coding Standards -Copyright (C) 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. +Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999 Free Software Foundation, Inc. Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice @@ -59,7 +59,7 @@ @page @vskip 0pt plus 1filll -Copyright @copyright{} 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. +Copyright @copyright{} 1992, 1993, 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc. Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice @@ -84,13 +84,14 @@ @end ifinfo @menu -* Preface:: About the GNU Coding Standards -* Intellectual Property:: Keeping Free Software Free -* Design Advice:: General Program Design -* Program Behavior:: Program Behavior for All Programs -* Writing C:: Making The Best Use of C -* Documentation:: Documenting Programs -* Managing Releases:: The Release Process +* Preface:: About the GNU Coding Standards +* Legal Issues:: Keeping Free Software Free +* Design Advice:: General Program Design +* Program Behavior:: Program Behavior for All Programs +* Writing C:: Making The Best Use of C +* Documentation:: Documenting Programs +* Managing Releases:: The Release Process +* References:: References to Non-Free Software or Documentation @end menu @node Preface @@ -104,8 +105,8 @@ even if you write in another programming language. The rules often state reasons for writing in a certain way. -Corrections or suggestions regarding this document should be sent to -@code{gnu@@prep.ai.mit.edu}. If you make a suggestion, please include a +Corrections or suggestions for this document should be sent to +@email{gnu@@gnu.org}. If you make a suggestion, please include a suggested new wording for it; our time is limited. We prefer a context diff to the @file{standards.texi} or @file{make-stds.texi} files, but if you don't have those files, please mail your suggestion anyway. @@ -113,15 +114,15 @@ This release of the GNU Coding Standards was last updated @value{lastupdate}. -@node Intellectual Property +@node Legal Issues @chapter Keeping Free Software Free This @value{CHAPTER} discusses how you can make sure that GNU software remains unencumbered. @menu -* Reading Non-Free Code:: Referring to Proprietary Programs -* Contributions:: Accepting Contributions +* Reading Non-Free Code:: Referring to Proprietary Programs +* Contributions:: Accepting Contributions @end menu @node Reading Non-Free Code @@ -161,37 +162,47 @@ @node Contributions @section Accepting Contributions -If someone else sends you a piece of code to add to the program you are -working on, we need legal papers to use it---the same sort of legal -papers we will need to get from you. @emph{Each} significant -contributor to a program must sign some sort of legal papers in order -for us to have clear title to the program. The main author alone is not +If the program you are working on is copyrighted by the Free Software +Foundation, then when someone else sends you a piece of code to add to +the program, we need legal papers to use it---just as we asked you to +sign papers initially. @emph{Each} person who makes a nontrivial +contribution to a program must sign some sort of legal papers in order +for us to have clear title to the program; the main author alone is not enough. -So, before adding in any contributions from other people, tell us -so we can arrange to get the papers. Then wait until we tell you +So, before adding in any contributions from other people, please tell +us, so we can arrange to get the papers. Then wait until we tell you that we have received the signed papers, before you actually use the contribution. This applies both before you release the program and afterward. If you receive diffs to fix a bug, and they make significant changes, we -need legal papers for it. +need legal papers for that change. + +This also applies to comments and documentation files. For copyright +law, comments and code are just text. Copyright applies to all kinds of +text, so we need legal papers for all kinds. + +We know it is frustrating to ask for legal papers; it's frustrating for +us as well. But if you don't wait, you are going out on a limb---for +example, what if the contributor's employer won't sign a disclaimer? +You might have to take that code out again! You don't need papers for changes of a few lines here or there, since they are not significant for copyright purposes. Also, you don't need papers if all you get from the suggestion is some ideas, not actual code -which you use. For example, if you write a different solution to the -problem, you don't need to get papers. - -We know this is frustrating; it's frustrating for us as well. But if -you don't wait, you are going out on a limb---for example, what if the -contributor's employer won't sign a disclaimer? You might have to take -that code out again! +which you use. For example, if someone send you one implementation, but +you write a different implementation of the same idea, you don't need to +get papers. The very worst thing is if you forget to tell us about the other contributor. We could be very embarrassed in court some day as a result. +We have more detailed advice for maintainers of programs; if you have +reached the stage of actually maintaining a program for GNU (whether +released or not), please ask us for a copy. + @node Design Advice @chapter General Program Design @@ -199,10 +210,10 @@ account when designing your program. @menu -* Compatibility:: Compatibility with other implementations -* Using Extensions:: Using non-standard features +* Compatibility:: Compatibility with other implementations +* Using Extensions:: Using non-standard features * ANSI C:: Using ANSI C features -* Source Language:: Using languages other than C +* Source Language:: Using languages other than C @end menu @node Compatibility @@ -211,20 +222,20 @@ With occasional exceptions, utility programs and libraries for GNU should be upward compatible with those in Berkeley Unix, and upward compatible with @sc{ansi} C if @sc{ansi} C specifies their behavior, and -upward compatible with @sc{POSIX} if @sc{POSIX} specifies their +upward compatible with @sc{posix} if @sc{posix} specifies their behavior. When these standards conflict, it is useful to offer compatibility modes for each of them. -@sc{ansi} C and @sc{POSIX} prohibit many kinds of extensions. Feel free +@sc{ansi} C and @sc{posix} prohibit many kinds of extensions. Feel free to make the extensions anyway, and include a @samp{--ansi}, @samp{--posix}, or @samp{--compatible} option to turn them off. However, if the extension has a significant chance of breaking any real programs or scripts, then it is not really upward compatible. Try to redesign its interface. -Many GNU programs suppress extensions that conflict with POSIX if the +Many GNU programs suppress extensions that conflict with @sc{posix} if the environment variable @code{POSIXLY_CORRECT} is defined (even if it is defined with a null value). Please make your program recognize this variable if appropriate. @@ -236,9 +247,6 @@ feature as well. (There is a free @code{vi} clone, so we offer it.) Additional useful features not in Berkeley Unix are welcome. -Additional programs with no counterpart in Unix may be useful, -but our first priority is usually to duplicate what Unix already -has. @node Using Extensions @section Using Non-standard Features @@ -282,9 +290,16 @@ @sc{ansi} C, there's no need to convert it to support non-@sc{ansi} compilers. +If you don't know non-@sc{ansi} C, there's no need to learn it; just +write in @sc{ansi} C. + However, it is easy to support non-@sc{ansi} compilers in most programs, -so you might still consider doing so when you write a program. Instead -of writing function definitions in @sc{ansi} prototype form, +so you might still consider doing so when you write a program. And if a +program you are maintaining has such support, you should try to keep it +working. + +To support pre-@sc{ansi} C, instead of writing function definitions in +@sc{ansi} prototype form, @example int @@ -311,11 +326,22 @@ You need such a declaration anyway, in a header file, to get the benefit of @sc{ansi} C prototypes in all the files where the function is called. -And once you have it, you lose nothing by writing the function -definition in the pre-@sc{ansi} style. - -If you don't know non-@sc{ansi} C, there's no need to learn it; just -write in @sc{ansi} C. +And once you have the declaration, you normally lose nothing by writing +the function definition in the pre-@sc{ansi} style. + +This technique does not work for integer types narrower than @code{int}. +If you think of an argument as being of a type narrower than @code{int}, +declare it as @code{int} instead. + +There are a few special cases where this technique is hard to use. For +example, if a function argument needs to hold the system type +@code{dev_t}, you run into trouble, because @code{dev_t} is shorter than +@code{int} on some machines; but you cannot use @code{int} instead, +because @code{dev_t} is wider than @code{int} on some machines. There +is no type you can safely use on all machines in a non-@sc{ansi} +definition. The only way to support non-@sc{ansi} C and pass such an +argument is to check the width of @code{dev_t} using Autoconf and choose +the argument type accordingly. This may not be worth the trouble. @node Source Language @section Using Languages Other Than C @@ -323,13 +349,16 @@ Using a language other than C is like using a non-standard feature: it will cause trouble for users. Even if GCC supports the other language, users may find it inconvenient to have to install the compiler for that -other language in order to build your program. So please write in C. - -There are three exceptions for this rule: +other language in order to build your program. For example, if you +write your program in C++, people will have to install the C++ compiler +in order to compile your program. Thus, it is better if you write in C. + +But there are three situations when there is no disadvantage in using +some other language: @itemize @bullet @item -It is okay to use a special language if the same program contains an +It is okay to use another language if your program contains an interpreter for that language. For example, if your program links with GUILE, it is ok to write part of @@ -343,10 +372,14 @@ those who have installed the other language anyway. @item -If an application is not of extremely widespread interest, then perhaps +If an application is of interest to a narrow community, then perhaps it's not important if the application is inconvenient to install. @end itemize +C has one other advantage over C++ and other compiled languages: more +people know C, so more people will find it easy to read and modify the +program if it is written in C. + @node Program Behavior @chapter Program Behavior for All Programs @@ -355,10 +388,11 @@ and how libraries should behave. @menu -* Semantics:: Writing robust programs -* Libraries:: Library behavior -* Errors:: Formatting error messages -* User Interfaces:: Standards for command line interfaces +* Semantics:: Writing robust programs +* Libraries:: Library behavior +* Errors:: Formatting error messages +* User Interfaces:: Standards for command line interfaces +* Option Table:: Table of long options. * Memory Usage:: When and how to care about memory needs @end menu @@ -371,9 +405,13 @@ are silently truncated''. This is not acceptable in a GNU utility. Utilities reading files should not drop NUL characters, or any other -nonprinting characters @emph{including those with codes above 0177}. The -only sensible exceptions would be utilities specifically intended for -interface to certain types of printers that can't handle those characters. +nonprinting characters @emph{including those with codes above 0177}. +The only sensible exceptions would be utilities specifically intended +for interface to certain types of terminals or printers +that can't handle those characters. +Whenever possible, try to make programs work properly with +sequences of bytes that represent multibyte characters, using encodings +such as UTF-8 and others. Check every system call for an error return, unless you know you wish to ignore errors. Include the system error text (from @code{perror} or @@ -415,11 +453,18 @@ as file directories, utmp, or the layout of kernel memory), since these are less likely to work compatibly. If you need to find all the files in a directory, use @code{readdir} or some other high-level interface. -These will be supported compatibly by GNU. - -By default, the GNU system will provide the signal handling functions of -@sc{BSD} and of @sc{POSIX}. So GNU software should be written to use -these. +These are supported compatibly by GNU. + +The preferred signal handling facilities are the BSD variant of +@code{signal}, and the @sc{posix} @code{sigaction} function; the +alternative USG @code{signal} interface is an inferior design. + +Nowadays, using the @sc{posix} signal functions may be the easiest way +to make a program portable. If you use @code{signal}, then on GNU/Linux +systems running GNU libc version 1, you should include +@file{bsd/signal.h} instead of @file{signal.h}, so as to get BSD +behavior. It is up to you whether to support systems where +@code{signal} has only the USG behavior, or give up on them. In error checks that detect ``impossible'' conditions, just abort. There is usually no point in printing any message. These checks @@ -477,6 +522,20 @@ @var{source-file-name}:@var{lineno}: @var{message} @end example +@noindent +If you want to mention the column number, use this format: + +@example +@var{source-file-name}:@var{lineno}:@var{column}: @var{message} +@end example + +@noindent +Line numbers should start from 1 at the beginning of the file, and +column numbers should start from 1 at the beginning of the line. (Both +of these conventions are chosen for compatibility.) Calculate column +numbers assuming that space and all ASCII printing characters have +equal width, and assuming tab stops every 8 columns. + Error messages from other noninteractive programs should look like this: @example @@ -493,6 +552,12 @@ @noindent when there is no relevant source file. +If you want to mention the column number, use this format: + +@example +@var{program}:@var{source-file-name}:@var{lineno}:@var{column}: @var{message} +@end example + In an interactive program (one that is reading commands from a terminal), it is better not to include the program name in an error message. The place to indicate which program is running is in the @@ -520,8 +585,10 @@ Likewise, please don't make the behavior of the program depend on the type of output device it is used with. Device independence is an -important principle of the system's design; do not compromise it -merely to save someone from typing an option now and then. +important principle of the system's design; do not compromise it merely +to save someone from typing an option now and then. (Variation in error +message syntax when using a terminal is ok, because that is a side issue +that people do not depend on.) If you think one behavior is most useful when the output is to a terminal, and another is most useful when the output is a file or a @@ -537,11 +604,11 @@ like @code{ls} except that its default output format is always multi-column format. -It is a good idea to follow the @sc{POSIX} guidelines for the +It is a good idea to follow the @sc{posix} guidelines for the command-line options of a program. The easiest way to do this is to use @code{getopt} to parse them. Note that the GNU version of @code{getopt} will normally permit options anywhere among the arguments unless the -special argument @samp{--} is used. This is not what @sc{POSIX} +special argument @samp{--} is used. This is not what @sc{posix} specifies; it is a GNU extension. Please define long-named options that are equivalent to the @@ -554,26 +621,119 @@ to expect the ``verbose'' option of any GNU program which has one, to be spelled precisely @samp{--verbose}. To achieve this uniformity, look at the table of common long-option names when you choose the option names -for your program. The table appears below. - -If you use names not already in the table, please send -@samp{gnu@@prep.ai.mit.edu} a list of them, with their meanings, so we -can update the table. - -It is usually a good idea for file names given as ordinary arguments -to be input files only; any output files would be specified using -options (preferably @samp{-o}). Even if you allow an output file name -as an ordinary argument for compatibility, try to provide a suitable -option as well. This will lead to more consistency among GNU -utilities, so that there are fewer idiosyncracies for users to -remember. - -Programs should support an option @samp{--version} which prints the -program's version number on standard output and exits successfully, and -an option @samp{--help} which prints option usage information on -standard output and exits successfully. These options should inhibit -the normal function of the command; they should do nothing except print -the requested information. +for your program (@pxref{Option Table}). + +It is usually a good idea for file names given as ordinary arguments to +be input files only; any output files would be specified using options +(preferably @samp{-o} or @samp{--output}). Even if you allow an output +file name as an ordinary argument for compatibility, try to provide an +option as another way to specify it. This will lead to more consistency +among GNU utilities, and fewer idiosyncracies for users to remember. + +All programs should support two standard options: @samp{--version} +and @samp{--help}. + +@table @code +@item --version +This option should direct the program to print information about its name, +version, origin and legal status, all on standard output, and then exit +successfully. Other options and arguments should be ignored once this +is seen, and the program should not perform its normal function. + +The first line is meant to be easy for a program to parse; the version +number proper starts after the last space. In addition, it contains +the canonical name for this program, in this format: + +@example +GNU Emacs 19.30 +@end example + +@noindent +The program's name should be a constant string; @emph{don't} compute it +from @code{argv[0]}. The idea is to state the standard or canonical +name for the program, not its file name. There are other ways to find +out the precise file name where a command is found in @code{PATH}. + +If the program is a subsidiary part of a larger package, mention the +package name in parentheses, like this: + +@example +emacsserver (GNU Emacs) 19.30 +@end example + +@noindent +If the package has a version number which is different from this +program's version number, you can mention the package version number +just before the close-parenthesis. + +If you @strong{need} to mention the version numbers of libraries which +are distributed separately from the package which contains this program, +you can do so by printing an additional line of version info for each +library you want to mention. Use the same format for these lines as for +the first line. + +Please do not mention all of the libraries that the program uses ``just +for completeness''---that would produce a lot of unhelpful clutter. +Please mention library version numbers only if you find in practice that +they are very important to you in debugging. + +The following line, after the version number line or lines, should be a +copyright notice. If more than one copyright notice is called for, put +each on a separate line. + +Next should follow a brief statement that the program is free software, +and that users are free to copy and change it on certain conditions. If +the program is covered by the GNU GPL, say so here. Also mention that +there is no warranty, to the extent permitted by law. + +It is ok to finish the output with a list of the major authors of the +program, as a way of giving credit. + +Here's an example of output that follows these rules: + +@smallexample +GNU Emacs 19.34.5 +Copyright (C) 1996 Free Software Foundation, Inc. +GNU Emacs comes with NO WARRANTY, +to the extent permitted by law. +You may redistribute copies of GNU Emacs +under the terms of the GNU General Public License. +For more information about these matters, +see the files named COPYING. +@end smallexample + +You should adapt this to your program, of course, filling in the proper +year, copyright holder, name of program, and the references to +distribution terms, and changing the rest of the wording as necessary. + +This copyright notice only needs to mention the most recent year in +which changes were made---there's no need to list the years for previous +versions' changes. You don't have to mention the name of the program in +these notices, if that is inconvenient, since it appeared in the first +line. + +@item --help +This option should output brief documentation for how to invoke the +program, on standard output, then exit successfully. Other options and +arguments should be ignored once this is seen, and the program should +not perform its normal function. + +Near the end of the @samp{--help} option's output there should be a line +that says where to mail bug reports. It should have this format: + +@example +Report bugs to @var{mailing-address}. +@end example +@end table + +@node Option Table +@section Table of Long Options + +Here is a table of long options used by GNU programs. It is surely +incomplete, but we aim to list all the options that a new program might +want to be compatible with. If you use names not already in the table, +please send @email{gnu@@gnu.org} a list of them, with their +meanings, so we can update the table. @c Please leave newlines between items in this table; it's much easier @c to update when it isn't completely squashed together and unreadable. @@ -581,10 +741,7 @@ @c a semicolon between the lists of the programs that use them, not a @c period. --friedman -Here is the table of long options used by GNU programs. - @table @samp - @item after-date @samp{-N} in @code{tar}. @@ -635,6 +792,9 @@ @item avoid-wraps @samp{-n} in @code{wdiff}. +@item background +For server programs, run in the background. + @item backward-search @samp{-B} in @code{ctags}. @@ -759,6 +919,9 @@ @item dereference-args @samp{-D} in @code{du}. +@item device +Specify an I/O device (special file name). + @item diacritics @samp{-d} in @code{recode}. @@ -891,6 +1054,11 @@ @item force-prefix @samp{-F} in @code{shar}. +@item foreground +For server programs, run in the foreground; +in other words, don't do anything special to run the server +in the background. + @item format Used in @code{ls}, @code{time}, and @code{ptx}. @@ -1070,7 +1238,7 @@ @item machine No listing of which programs already use this; someone should check to -see if any actually do and tell @code{gnu@@prep.ai.mit.edu}. +see if any actually do, and tell @email{gnu@@gnu.org}. @item macro-name @samp{-M} in @code{ptx}. @@ -1195,6 +1363,9 @@ @item no-validate Used in @code{makeinfo}. +@item no-wait +Used in @code{emacsclient}. + @item no-warn Used in various programs to inhibit warnings. @@ -1246,6 +1417,10 @@ @item only-time @samp{-F} in @code{gprof}. +@item options +@samp{-o} in @code{getopt}, @code{fdlist}, @code{fdmount}, +@code{fdmountd}, and @code{fdumount}. + @item output In various programs, specify the output file name. @@ -1330,6 +1505,9 @@ @item prompt @samp{-p} in @code{ed}. +@item proxy +Specify an HTTP proxy. + @item query-user @samp{-X} in @code{shar}. @@ -1337,9 +1515,9 @@ @samp{-q} in Make. @item quiet -Used in many programs to inhibit the usual output. @strong{Please -note:} every program accepting @samp{--quiet} should accept -@samp{--silent} as a synonym. +Used in many programs to inhibit the usual output. @strong{Note:} every +program accepting @samp{--quiet} should accept @samp{--silent} as a +synonym. @item quiet-unshar @samp{-Q} in @code{shar} @@ -1452,12 +1630,18 @@ @item silent Used in many programs to inhibit the usual output. -@strong{Please note:} every program accepting +@strong{Note:} every program accepting @samp{--silent} should accept @samp{--quiet} as a synonym. @item size @samp{-s} in @code{ls}. +@item socket +Specify a file descriptor for a network server to use for its socket, +instead of opening and binding a new socket. This provides a way to +run, in a nonpriveledged process, a server that normally needs a +reserved port number. + @item sort Used in @code{ls}. @@ -1556,6 +1740,9 @@ @item time Used in @code{ls} and @code{touch}. +@item timeout +Specify how long to wait before giving up on some operation. + @item to-stdout @samp{-O} in @code{tar}. @@ -1672,14 +1859,15 @@ when writing GNU software. @menu -* Formatting:: Formatting Your Source Code -* Comments:: Commenting Your Work -* Syntactic Conventions:: Clean Use of C Constructs -* Names:: Naming Variables and Functions -* System Portability:: Portability between different operating systems +* Formatting:: Formatting Your Source Code +* Comments:: Commenting Your Work +* Syntactic Conventions:: Clean Use of C Constructs +* Names:: Naming Variables and Functions +* System Portability:: Portability between different operating systems * CPU Portability:: Supporting the range of CPU types * System Functions:: Portability and ``standard'' library functions * Internationalization:: Techniques for internationalization +* Mmap:: How you can safely use @code{mmap}. @end menu @node Formatting @@ -1808,6 +1996,13 @@ Every program should start with a comment saying briefly what it is for. Example: @samp{fmt - filter for simple filling of text}. +Please write the comments in a GNU program in English, because English +is the one language that nearly all programmers in all countries can +read. If you do not write English well, please write comments in +English as well as you can, then ask other people to help rewrite them. +If you can't write comments in English, please find someone to work with +you and translate your comments into English. + Please put a comment on each function saying what the function does, what sorts of arguments it gets, and what the possible values of arguments mean and are used for. It is not necessary to duplicate in @@ -1862,6 +2057,11 @@ @dots{} #endif /* not foo */ @end group +@group +#ifdef foo + @dots{} +#endif /* foo */ +@end group @end example @noindent @@ -1875,9 +2075,13 @@ @dots{} #endif /* foo */ @end group +@group +#ifndef foo + @dots{} +#endif /* not foo */ +@end group @end example - @node Syntactic Conventions @section Clean Use of C Constructs @@ -2005,9 +2209,22 @@ casts to @code{void}. Zero without a cast is perfectly fine as a null pointer constant, except when calling a varargs function. -@node Names +@node Names @section Naming Variables and Functions +The names of global variables and functions in a program serve as +comments of a sort. So don't choose terse names---instead, look for +names that give useful information about the meaning of the variable or +function. In a GNU program, names should be English, like other +comments. + +Local variable names can be shorter, because they are used only within +one context, where (presumably) comments explain their purpose. + +Try to limit your use of abbreviations in symbol names. It is ok to +make a few abbreviations, explain what they mean, and then use them +frequently, but don't use lots of obscure abbreviations. + Please use underscores to separate words in a name, so that the Emacs word commands can be useful within them. Stick to lower case; reserve upper case for macros and @code{enum} constants, and for name-prefixes @@ -2033,10 +2250,10 @@ constants. Use file names of 14 characters or less, to avoid creating gratuitous -problems on older System V systems. You can use the program @code{doschk} to test for -this. @code{doschk} also tests for potential name conflicts if the -files were loaded onto an MS-DOS file system---something you may or may -not care about. +problems on older System V systems. You can use the program +@code{doschk} to test for this. @code{doschk} also tests for potential +name conflicts if the files were loaded onto an MS-DOS file +system---something you may or may not care about. @node System Portability @section Portability between System Types @@ -2066,14 +2283,10 @@ when there is a higher-level alternative (@code{readdir}). As for systems that are not like Unix, such as MSDOS, Windows, the -Macintosh, VMS, and MVS, supporting them is usually so much work that it -is better if you don't. - -The planned GNU kernel is not finished yet, but you can tell which -facilities it will provide by looking at the GNU C Library Manual. The -GNU kernel is based on Mach, so the features of Mach will also be -available. However, if you use Mach features, you'll probably have -trouble debugging your program today. +Macintosh, VMS, and MVS, supporting them is often a lot of work. When +that is the case, it is better to spend your time adding features that +will be useful on GNU and GNU/Linux, rather than on supporting other +incompatible systems. @node CPU Portability @section Portability between @sc{cpu}s @@ -2111,7 +2324,7 @@ @example error (s, a1, a2, a3) char *s; - int a1, a2, a3; + char *a1, *a2, *a3; @{ fprintf (stderr, "error: "); fprintf (stderr, s, a1, a2, a3); @@ -2119,16 +2332,18 @@ @end example @noindent -In practice, this works on all machines, and it is much simpler than any -``correct'' alternative. Be sure @emph{not} to use a prototype -for such functions. +In practice, this works on all machines, since a pointer is generally +the widest possible kind of argument, and it is much simpler than any +``correct'' alternative. Be sure @emph{not} to use a prototype for such +functions. However, avoid casting pointers to integers unless you really need to. -These assumptions really reduce portability, and in most programs they -are easy to avoid. In the cases where casting pointers to integers is -essential---such as, a Lisp interpreter which stores type information as -well as an address in one word---it is ok to do so, but you'll have to -make explicit provisions to handle different word sizes. +Outside of special situations, such casts greatly reduce portability, +and in most programs they are easy to avoid. In the cases where casting +pointers to integers is essential---such as, a Lisp interpreter which +stores type information as well as an address in one word---it is ok to +do it, but you'll have to make explicit provisions to handle different +word sizes. @node System Functions @section Calling System Functions @@ -2145,6 +2360,11 @@ characters written on some systems, but not on all systems. @item +@code{main} should be declared to return type @code{int}. It should +terminate either by calling @code{exit} or by returning the integer +status code; make sure it cannot ever return an undefined value. + +@item Don't declare system functions explicitly. Almost any declaration for a system function is wrong on some system. @@ -2275,13 +2495,18 @@ Normally, the text domain name should be the same as the name of the package---for example, @samp{fileutils} for the GNU file utilities. -To enable gettext to work, avoid writing code that makes assumptions -about the structure of words. Don't construct words from parts. Here -is an example of what not to do: +To enable gettext to work well, avoid writing code that makes +assumptions about the structure of words or sentences. When you want +the precise text of a sentence to vary depending on the data, use two or +more alternative string constants each containing a complete sentences, +rather than inserting conditionalized words or phrases into a single +sentence framework. + +Here is an example of what not to do: @example -prinf ("%d file%s processed", nfiles, - nfiles > 1 ? "s" : ""); +printf ("%d file%s processed", nfiles, + nfiles != 1 ? "s" : ""); @end example @noindent @@ -2289,8 +2514,8 @@ by adding `s'. If you apply gettext to the format string, like this, @example -prinf (gettext ("%d file%s processed"), nfiles, - nfiles > 1 ? "s" : ""); +printf (gettext ("%d file%s processed"), nfiles, + nfiles != 1 ? "s" : ""); @end example @noindent @@ -2298,9 +2523,9 @@ `s' for the plural. Here is a better way: @example -prinf ((nfiles > 1 ? "%d files processed" - : "%d file processed"), - nfiles); +printf ((nfiles != 1 ? "%d files processed" + : "%d file processed"), + nfiles); @end example @noindent @@ -2308,14 +2533,52 @@ independently: @example -prinf ((nfiles > 1 ? gettext ("%d files processed") - : gettext ("%d file processed")), - nfiles); +printf ((nfiles != 1 ? gettext ("%d files processed") + : gettext ("%d file processed")), + nfiles); +@end example + +@noindent +This can be any method of forming the plural of the word for ``file'', and +also handles languages that require agreement in the word for +``processed''. + +A similar problem appears at the level of sentence structure with this +code: + +@example +printf ("# Implicit rule search has%s been done.\n", + f->tried_implicit ? "" : " not"); @end example @noindent -This can handle any language, no matter how it forms the plural of the -word for ``file.'' +Adding @code{gettext} calls to this code cannot give correct results for +all languages, because negation in some languages requires adding words +at more than one place in the sentence. By contrast, adding +@code{gettext} calls does the job straightfowardly if the code starts +out like this: + +@example +printf (f->tried_implicit + ? "# Implicit rule search has been done.\n", + : "# Implicit rule search has not been done.\n"); +@end example + +@node Mmap +@section Mmap + +Don't assume that @code{mmap} either works on all files or fails +for all files. It may work on some files and fail on others. + +The proper way to use @code{mmap} is to try it on the specific file for +which you want to use it---and if @code{mmap} doesn't work, fall back on +doing the job in another way using @code{read} and @code{write}. + +The reason this precaution is needed is that the GNU kernel (the HURD) +provides a user-extensible file system, in which there can be many +different kinds of ``ordinary files.'' Many of them support +@code{mmap}, but some do not. It is important to make programs handle +all these kinds of files. @node Documentation @chapter Documenting Programs @@ -2323,8 +2586,9 @@ @menu * GNU Manuals:: Writing proper manuals. * Manual Structure Details:: Specific structure conventions. +* License for Manuals:: Writing the distribution terms for a manual. * NEWS File:: NEWS files supplement manuals. -* Change Logs:: Recording Changes +* Change Logs:: Recording Changes * Man Pages:: Man pages are secondary. * Reading other Manuals:: How far you can go in learning from other manuals. @@ -2334,21 +2598,54 @@ @section GNU Manuals The preferred way to document part of the GNU system is to write a -manual in the Texinfo formatting language. See the Texinfo manual, -either the hardcopy, or the on-line version available through -@code{info} or the Emacs Info subsystem (@kbd{C-h i}). - -The manual should document all of the program's command-line options and -all of its commands. It should give examples of their use. But don't -organize the manual as a list of features. Instead, organize it -logically, by subtopics. Address the goals that a user will have in -mind, and explain how to accomplish them. +manual in the Texinfo formatting language. This makes it possible to +produce a good quality formatted book, using @TeX{}, and to generate an +Info file. It is also possible to generate HTML output from Texinfo +source. See the Texinfo manual, either the hardcopy, or the on-line +version available through @code{info} or the Emacs Info subsystem +(@kbd{C-h i}). + +Programmers often find it most natural to structure the documentation +following the structure of the implementation, which they know. But +this structure is not necessarily good for explaining how to use the +program; it may be irrelevant and confusing for a user. + +At every level, from the sentences in a paragraph to the grouping of +topics into separate manuals, the right way to structure documentation +is according to the concepts and questions that a user will have in mind +when reading it. Sometimes this structure of ideas matches the +structure of the implementation of the software being documented---but +often they are different. Often the most important part of learning to +write good documentation is learning to notice when you are structuring +the documentation like the implementation, and think about better +alternatives. + +For example, each program in the GNU system probably ought to be +documented in one manual; but this does not mean each program should +have its own manual. That would be following the structure of the +implementation, rather than the structure that helps the user +understand. + +Instead, each manual should cover a coherent @emph{topic}. For example, +instead of a manual for @code{diff} and a manual for @code{diff3}, we +have one manual for ``comparison of files'' which covers both of those +programs, as well as @code{cmp}. By documenting these programs +together, we can make the whole subject clearer. + +The manual which discusses a program should document all of the +program's command-line options and all of its commands. It should give +examples of their use. But don't organize the manual as a list of +features. Instead, organize it logically, by subtopics. Address the +questions that a user will ask when thinking about the job that the +program does. In general, a GNU manual should serve both as tutorial and reference. It should be set up for convenient access to each topic through Info, and for reading straight through (appendixes aside). A GNU manual should give a good introduction to a beginner reading through from the start, and should also provide all the details that hackers want. +The Bison manual is a good example of this---please take a look at it +to see what we mean. That is not as hard as it first sounds. Arrange each chapter as a logical breakdown of its topic, but order the sections, and write their @@ -2363,29 +2660,38 @@ Bison manual provides a good example of how to do this. Don't use Unix man pages as a model for how to write GNU documentation; -they are a bad example to follow. +most of them are terse, badly structured, and give inadequate +explanation of the underlying concepts. (There are, of course +exceptions.) Also Unix man pages use a particular format which is +different from what we use in GNU manuals. + +Please include an email address in the manual for where to report +bugs @emph{in the manual}. Please do not use the term ``pathname'' that is used in Unix documentation; use ``file name'' (two words) instead. We use the term -``path'' only for search paths, which are lists of file names. +``path'' only for search paths, which are lists of directory names. + +Please do not use the term ``illegal'' to refer to erroneous input to a +computer program. Please use ``invalid'' for this, and reserve the term +``illegal'' for violations of law. @node Manual Structure Details @section Manual Structure Details -The title page of the manual should state the version of the program -to which the manual applies. The Top node of the manual should also -contain this information. If the manual is changing more frequently -than or independent of the program, also state a version number for -the manual in both of these places. - -The manual should have a node named @samp{@var{program} Invocation} or -@samp{Invoking @var{program}}, where @var{program} stands for the name -of the program being described, as you would type it in the shell to run -the program. This node (together with its subnodes, if any) should -describe the program's command line arguments and how to run it (the -sort of information people would look in a man page for). Start with an -@samp{@@example} containing a template for all the options and arguments -that the program uses. +The title page of the manual should state the version of the programs or +packages documented in the manual. The Top node of the manual should +also contain this information. If the manual is changing more +frequently than or independent of the program, also state a version +number for the manual in both of these places. + +Each program documented in the manual should have a node named +@samp{@var{program} Invocation} or @samp{Invoking @var{program}}. This +node (together with its subnodes, if any) should describe the program's +command line arguments and how to run it (the sort of information people +would look in a man page for). Start with an @samp{@@example} +containing a template for all the options and arguments that the program +uses. Alternatively, put a menu item in some menu whose item name fits one of the above patterns. This identifies the node which that item points to @@ -2397,6 +2703,18 @@ If one manual describes several programs, it should have such a node for each program described. +@node License for Manuals +@section License for Manuals + +If the manual contains a copy of the GNU GPL or GNU LGPL, or if it +contains chapters that make political or personal statements, please +copy the distribution terms of the GNU Emacs Manual, and adapt it by +modifying appropriately the list of special chapters that may not be +modified or deleted. + +If the manual does not contain any such chapters, then imitate the +simpler distribution terms of the Texinfo manual. + @node NEWS File @section The NEWS File @@ -2418,18 +2736,46 @@ files. The purpose of this is so that people investigating bugs in the future will know about the changes that might have introduced the bug. Often a new bug can be found by looking at what was recently changed. -More importantly, change logs can help eliminate conceptual -inconsistencies between different parts of a program; they can give you -a history of how the conflicting concepts arose. - -A change log file is normally called @file{ChangeLog} and covers an +More importantly, change logs can help you eliminate conceptual +inconsistencies between different parts of a program, by giving you a +history of how the conflicting concepts arose and who they came from. + +@menu +* Change Log Concepts:: +* Style of Change Logs:: +* Simple Changes:: +* Conditional Changes:: +@end menu + +@node Change Log Concepts +@subsection Change Log Concepts + +You can think of the change log as a conceptual ``undo list'' which +explains how earlier versions were different from the current version. +People can see the current version; they don't need the change log +to tell them what is in it. What they want from a change log is a +clear explanation of how the earlier version differed. + +The change log file is normally called @file{ChangeLog} and covers an entire directory. Each directory can have its own change log, or a directory can use the change log of its parent directory--it's up to you. Another alternative is to record change log information with a version control system such as RCS or CVS. This can be converted automatically -to a @file{ChangeLog} file. +to a @file{ChangeLog} file using @code{rcs2log}; in Emacs, the command +@kbd{C-x v a} (@code{vc-update-change-log}) does the job. + +There's no need to describe the full purpose of the changes or how they +work together. If you think that a change calls for explanation, you're +probably right. Please do explain it---but please put the explanation +in comments in the code, where people will see it whenever they see the +code. For example, ``New function'' is enough for the change log when +you add a function, because there should be a comment before the +function definition to explain what it does. + +However, sometimes it is useful to write one line to describe the +overall purpose of a batch of changes. The easiest way to add an entry to @file{ChangeLog} is with the Emacs command @kbd{M-x add-change-log-entry}. An entry should have an @@ -2437,12 +2783,10 @@ of the changed functions, variables or whatever, followed by a colon. Then describe the changes you made to that function or variable. -Separate unrelated entries with blank lines. When two entries -represent parts of the same change, so that they work together, then -don't put blank lines between them. Then you can omit the file name -and the asterisk when successive entries are in the same file. - -Here are some examples: +@node Style of Change Logs +@subsection Style of Change Logs + +Here are some examples of change log entries: @example * register.el (insert-register): Return nil. @@ -2461,44 +2805,87 @@ It's important to name the changed function or variable in full. Don't abbreviate function or variable names, and don't combine them. -Subsequent maintainers will often -search for a function name to find all the change log entries that -pertain to it; if you abbreviate the name, they won't find it when they -search. For example, some people are tempted to abbreviate groups of -function names by writing @samp{* register.el -(@{insert,jump-to@}-register)}; this is not a good idea, since searching -for @code{jump-to-register} or @code{insert-register} would not find the -entry. - -There's no need to describe the full purpose of the changes or how they -work together. It is better to put such explanations in comments in the -code. That's why just ``New function'' is enough; there is a comment -with the function in the source to explain what it does. - -However, sometimes it is useful to write one line to describe the -overall purpose of a large batch of changes. - -You can think of the change log as a conceptual ``undo list'' which -explains how earlier versions were different from the current version. -People can see the current version; they don't need the change log -to tell them what is in it. What they want from a change log is a -clear explanation of how the earlier version differed. - -When you change the calling sequence of a function in a simple -fashion, and you change all the callers of the function, there is no -need to make individual entries for all the callers. Just write in +Subsequent maintainers will often search for a function name to find all +the change log entries that pertain to it; if you abbreviate the name, +they won't find it when they search. + +For example, some people are tempted to abbreviate groups of function +names by writing @samp{* register.el (@{insert,jump-to@}-register)}; +this is not a good idea, since searching for @code{jump-to-register} or +@code{insert-register} would not find that entry. + +Separate unrelated change log entries with blank lines. When two +entries represent parts of the same change, so that they work together, +then don't put blank lines between them. Then you can omit the file +name and the asterisk when successive entries are in the same file. + +@node Simple Changes +@subsection Simple Changes + +Certain simple kinds of changes don't need much detail in the change +log. + +When you change the calling sequence of a function in a simple fashion, +and you change all the callers of the function, there is no need to make +individual entries for all the callers that you changed. Just write in the entry for the function being called, ``All callers changed.'' +@example +* keyboard.c (Fcommand_execute): New arg SPECIAL. +All callers changed. +@end example + When you change just comments or doc strings, it is enough to write an -entry for the file, without mentioning the functions. Write just, -``Doc fix.'' +entry for the file, without mentioning the functions. Just ``Doc +fixes'' is enough for the change log. There's no need to make change log entries for documentation files. This is because documentation is not susceptible to bugs that are hard to fix. Documentation does not consist of parts that must interact in a precisely engineered fashion. To correct an error, you need not know -the history of the erroneous passage; it is enough to compare the -passage with the way the program actually works. +the history of the erroneous passage; it is enough to compare what the +documentation says with the way the program actually works. + +@node Conditional Changes +@subsection Conditional Changes + +C programs often contain compile-time @code{#if} conditionals. Many +changes are conditional; sometimes you add a new definition which is +entirely contained in a conditional. It is very useful to indicate in +the change log the conditions for which the change applies. + +Our convention for indicating conditional changes is to use square +brackets around the name of the condition. + +Here is a simple example, describing a change which is conditional but +does not have a function or entity name associated with it: + +@example +* xterm.c [SOLARIS2]: Include string.h. +@end example + +Here is an entry describing a new definition which is entirely +conditional. This new definition for the macro @code{FRAME_WINDOW_P} is +used only when @code{HAVE_X_WINDOWS} is defined: + +@example +* frame.h [HAVE_X_WINDOWS] (FRAME_WINDOW_P): Macro defined. +@end example + +Here is an entry for a change within the function @code{init_display}, +whose definition as a whole is unconditional, but the changes themselves +are contained in a @samp{#ifdef HAVE_LIBNCURSES} conditional: + +@example +* dispnew.c (init_display) [HAVE_LIBNCURSES]: If X, call tgetent. +@end example + +Here is an entry for a change that takes affect only when +a certain macro is @emph{not} defined: + +@example +(gethostname) [!HAVE_SOCKETS]: Replace with winsock version. +@end example @node Man Pages @section Man Pages @@ -2558,9 +2945,9 @@ all GNU software. @menu -* Configuration:: How Configuration Should Work +* Configuration:: How Configuration Should Work * Makefile Conventions:: Makefile Conventions -* Releases:: Making Releases +* Releases:: Making Releases @end menu @node Configuration @@ -2633,7 +3020,7 @@ alternatives for how to describe a machine. Thus, @samp{sun3-sunos4.1} would be a valid alias. For many programs, @samp{vax-dec-ultrix} would be an alias for @samp{vax-dec-bsd}, simply because the differences -between Ultrix and @sc{BSD} are rarely noticeable, but a few programs +between Ultrix and BSD are rarely noticeable, but a few programs might need to distinguish them. @c Real 4.4BSD now runs on some Suns. @@ -2665,9 +3052,12 @@ @c Giving an optional @var{parameter} of @c @samp{no} should omit @var{package}, if it is used by default. -Possible values of @var{package} include @samp{x}, @samp{x-toolkit}, -@samp{gnu-as} (or @samp{gas}), @samp{gnu-ld}, @samp{gnu-libc}, and -@samp{gdb}. +Possible values of @var{package} include +@samp{gnu-as} (or @samp{gas}), @samp{gnu-ld}, @samp{gnu-libc}, +@samp{gdb}, +@samp{x}, +and +@samp{x-toolkit}. Do not use a @samp{--with} option to specify the file name to use to find certain files. That is outside the scope of what @samp{--with} @@ -2734,9 +3124,9 @@ @node Releases @section Making Releases -Package the distribution of Foo version 69.96 in a gzipped tar file -named @file{foo-69.96.tar.gz}. It should unpack into a subdirectory -named @file{foo-69.96}. +Package the distribution of @code{Foo version 69.96} up in a gzipped tar +file with the name @file{foo-69.96.tar.gz}. It should unpack into a +subdirectory named @file{foo-69.96}. Building and installing the program should never modify any of the files contained in the distribution. This means that all the files that form @@ -2745,6 +3135,21 @@ and never changed automatically; non-source files are produced from source files by programs under the control of the Makefile. +The distribution should contain a file named @file{README} which gives +the name of the package, and a general description of what it does. It +is also good to explain the purpose of each of the first-level +subdirectories in the package, if there are any. The @file{README} file +should either state the version number of the package, or refer to where +in the package it can be found. + +The @file{README} file should refer to the file @file{INSTALL}, which +should contain an explanation of the installation procedure. + +The @file{README} file should also refer to the file which contains the +copying conditions. The GNU GPL, if used, should be in a file called +@file{COPYING}. If the GNU LGPL is used, it should be in a file called +@file{COPYING.LIB}. + Naturally, all the source files must be in the distribution. It is okay to include non-source files in the distribution, provided they are up-to-date and machine-independent, so that building the distribution @@ -2769,7 +3174,7 @@ Make sure that no file name in the distribution is more than 14 characters long. Likewise, no file created by building the program should have a name longer than 14 characters. The reason for this is -that some systems adhere to a foolish interpretation of the POSIX +that some systems adhere to a foolish interpretation of the @sc{posix} standard, and refuse to open a longer name, rather than truncating as they did in the past. @@ -2797,6 +3202,31 @@ the expense of possible inconvenience to a user who doesn't know what other files to get. +@node References +@chapter References to Non-Free Software and Documentation + +A GNU program should not recommend use of any non-free program. We +can't stop some people from writing proprietary programs, or stop other +people from using them. But we can and should avoid helping to +advertise them to new customers. + +Sometimes it is important to mention how to build your package on top of +some non-free operating system or other non-free base package. In such +cases, please mention the name of the non-free package or system in the +briefest possible way. Don't include any references for where to find +more information about the proprietary program. The goal should be that +people already using the proprietary program will get the advice they +need about how to use your free program, while people who don't already +use the proprietary program will not see anything to encourage them to +take an interest in it. + +Likewise, a GNU package should not refer the user to any non-free +documentation for free software. The need for free documentation to go +with free software is now a major focus of the GNU project; to show that +we are serious about the need for free documentation, we must not +undermine our position by recommending use of documentation that isn't +free. + @contents @bye diff -r f4aeb21a5bad -r 74fd4e045ea6 man/term.texi --- a/man/term.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/term.texi Mon Aug 13 11:13:30 2007 +0200 @@ -8,11 +8,10 @@ @end titlepage @ifinfo -@c @format -@c START-INFO-DIR-ENTRY -@c * term mode:: Emacs terminal emulator mode. -@c END-INFO-DIR-ENTRY -@c @end format +@dircategory XEmacs Editor +@direntry +* Term mode: (term). Emacs terminal emulator mode. +@end direntry @node Top, , (DIR) @top Terminal emulator mode diff -r f4aeb21a5bad -r 74fd4e045ea6 man/termcap.texi --- a/man/termcap.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/termcap.texi Mon Aug 13 11:13:30 2007 +0200 @@ -2,6 +2,10 @@ @setfilename ../info/termcap.info @settitle The Termcap Library @ifinfo +@direntry +* Termcap: (termcap). Termcap library of the GNU system. +@end direntry + This file documents the termcap library of the GNU system. Copyright (C) 1988 Free Software Foundation, Inc. diff -r f4aeb21a5bad -r 74fd4e045ea6 man/texinfo.tex --- a/man/texinfo.tex Mon Aug 13 11:12:06 2007 +0200 +++ b/man/texinfo.tex Mon Aug 13 11:13:30 2007 +0200 @@ -1,7 +1,11 @@ % texinfo.tex -- TeX macros to handle Texinfo files. -% $Id: texinfo.tex,v 1.5 1998/06/13 04:28:12 steve Exp $ +% +% Load plain if necessary, i.e., if running under initex. +\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -% Copyright (C) 1985, 86, 88, 90, 91, 92, 93, 94, 95, 96, 97, 98 +\def\texinfoversion{1999-09-25.10} +% +% Copyright (C) 1985, 86, 88, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99 % Free Software Foundation, Inc. % % This texinfo.tex file is free software; you can redistribute it and/or @@ -25,36 +29,44 @@ % % Please try the latest version of texinfo.tex before submitting bug % reports; you can get the latest version from: -% ftp://ftp.cs.umb.edu/pub/tex/texinfo.tex -% /home/gd/gnu/doc/texinfo.tex on the GNU machines. -% -% Send bug reports to bug-texinfo@gnu.org. -% Please include a precise test case in each bug report, -% including a complete document with which we can reproduce the problem. -% -% Texinfo macros (with @macro) are *not* supported by texinfo.tex. You -% have to run makeinfo -E to expand macros first; the texi2dvi script -% does this. - - -% Make it possible to create a .fmt file just by loading this file: -% if the underlying format is not loaded, start by loading it now. -% Added by gildea November 1993. -\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi - -% This automatically updates the version number based on RCS. -\def\deftexinfoversion$#1: #2 ${\def\texinfoversion{#2}} -\deftexinfoversion$Revision: 1.5 $ -\message{Loading texinfo package [Version \texinfoversion]:} +% ftp://ftp.gnu.org/gnu/texinfo.tex +% (and all GNU mirrors, see http://www.gnu.org/order/ftp.html) +% ftp://texinfo.org/tex/texinfo.tex +% ftp://us.ctan.org/macros/texinfo/texinfo.tex +% (and all CTAN mirrors, finger ctan@us.ctan.org for a list). +% /home/gd/gnu/doc/texinfo.tex on the GNU machines. +% The texinfo.tex in any given Texinfo distribution could well be out +% of date, so if that's what you're using, please check. +% Texinfo has a small home page at http://texinfo.org/. +% +% Send bug reports to bug-texinfo@gnu.org. Please include including a +% complete document in each bug report with which we can reproduce the +% problem. Patches are, of course, greatly appreciated. +% +% To process a Texinfo manual with TeX, it's most reliable to use the +% texi2dvi shell script that comes with the distribution. For a simple +% manual foo.texi, however, you can get away with this: +% tex foo.texi +% texindex foo.?? +% tex foo.texi +% tex foo.texi +% dvips foo.dvi -o # or whatever, to process the dvi file; this makes foo.ps. +% The extra runs of TeX get the cross-reference information correct. +% Sometimes one run after texindex suffices, and sometimes you need more +% than two; texi2dvi does it as many times as necessary. +% +% It is possible to adapt texinfo.tex for other languages. You can get +% the existing language-specific files from ftp://ftp.gnu.org/gnu/texinfo/. + +\message{Loading texinfo [version \texinfoversion]:} % If in a .fmt file, print the version number % and turn on active characters that we couldn't do earlier because % they might have appeared in the input file name. -\everyjob{\message{[Texinfo version \texinfoversion]}\message{} +\everyjob{\message{[Texinfo version \texinfoversion]}% \catcode`+=\active \catcode`\_=\active} % Save some parts of plain tex whose names we will redefine. - \let\ptexb=\b \let\ptexbullet=\bullet \let\ptexc=\c @@ -70,18 +82,9 @@ \let\ptexstar=\* \let\ptext=\t -% Be sure we're in horizontal mode when doing a tie, since we make space -% equivalent to this in @example-like environments. Otherwise, a space -% at the beginning of a line will start with \penalty -- and -% since \penalty is valid in vertical mode, we'd end up putting the -% penalty on the vertical list instead of in the new paragraph. -{\catcode`@ = 11 - % Avoid using \@M directly, because that causes trouble - % if the definition is written into an index file. - \global\let\tiepenalty = \@M - \gdef\tie{\leavevmode\penalty\tiepenalty\ } -} - +% We never want plain's outer \+ definition in Texinfo. +% For @tex, we can use \tabalign. +\let\+ = \relax \message{Basics,} \chardef\other=12 @@ -90,18 +93,47 @@ % starts a new line in the output. \newlinechar = `^^J -% Set up fixed words for English. -\ifx\putwordChapter\undefined{\gdef\putwordChapter{Chapter}}\fi% -\def\putwordInfo{Info}% -\ifx\putwordSee\undefined{\gdef\putwordSee{See}}\fi% -\ifx\putwordsee\undefined{\gdef\putwordsee{see}}\fi% -\ifx\putwordfile\undefined{\gdef\putwordfile{file}}\fi% -\ifx\putwordpage\undefined{\gdef\putwordpage{page}}\fi% -\ifx\putwordsection\undefined{\gdef\putwordsection{section}}\fi% -\ifx\putwordSection\undefined{\gdef\putwordSection{Section}}\fi% -\ifx\putwordTableofContents\undefined{\gdef\putwordTableofContents{Table of Contents}}\fi% -\ifx\putwordShortContents\undefined{\gdef\putwordShortContents{Short Contents}}\fi% -\ifx\putwordAppendix\undefined{\gdef\putwordAppendix{Appendix}}\fi% +% Set up fixed words for English if not already set. +\ifx\putwordAppendix\undefined \gdef\putwordAppendix{Appendix}\fi +\ifx\putwordChapter\undefined \gdef\putwordChapter{Chapter}\fi +\ifx\putwordfile\undefined \gdef\putwordfile{file}\fi +\ifx\putwordin\undefined \gdef\putwordin{in}\fi +\ifx\putwordIndexIsEmpty\undefined \gdef\putwordIndexIsEmpty{(Index is empty)}\fi +\ifx\putwordIndexNonexistent\undefined \gdef\putwordIndexNonexistent{(Index is nonexistent)}\fi +\ifx\putwordInfo\undefined \gdef\putwordInfo{Info}\fi +\ifx\putwordInstanceVariableof\undefined \gdef\putwordInstanceVariableof{Instance Variable of}\fi +\ifx\putwordMethodon\undefined \gdef\putwordMethodon{Method on}\fi +\ifx\putwordNoTitle\undefined \gdef\putwordNoTitle{No Title}\fi +\ifx\putwordof\undefined \gdef\putwordof{of}\fi +\ifx\putwordon\undefined \gdef\putwordon{on}\fi +\ifx\putwordpage\undefined \gdef\putwordpage{page}\fi +\ifx\putwordsection\undefined \gdef\putwordsection{section}\fi +\ifx\putwordSection\undefined \gdef\putwordSection{Section}\fi +\ifx\putwordsee\undefined \gdef\putwordsee{see}\fi +\ifx\putwordSee\undefined \gdef\putwordSee{See}\fi +\ifx\putwordShortTOC\undefined \gdef\putwordShortTOC{Short Contents}\fi +\ifx\putwordTOC\undefined \gdef\putwordTOC{Table of Contents}\fi +% +\ifx\putwordMJan\undefined \gdef\putwordMJan{January}\fi +\ifx\putwordMFeb\undefined \gdef\putwordMFeb{February}\fi +\ifx\putwordMMar\undefined \gdef\putwordMMar{March}\fi +\ifx\putwordMApr\undefined \gdef\putwordMApr{April}\fi +\ifx\putwordMMay\undefined \gdef\putwordMMay{May}\fi +\ifx\putwordMJun\undefined \gdef\putwordMJun{June}\fi +\ifx\putwordMJul\undefined \gdef\putwordMJul{July}\fi +\ifx\putwordMAug\undefined \gdef\putwordMAug{August}\fi +\ifx\putwordMSep\undefined \gdef\putwordMSep{September}\fi +\ifx\putwordMOct\undefined \gdef\putwordMOct{October}\fi +\ifx\putwordMNov\undefined \gdef\putwordMNov{November}\fi +\ifx\putwordMDec\undefined \gdef\putwordMDec{December}\fi +% +\ifx\putwordDefmac\undefined \gdef\putwordDefmac{Macro}\fi +\ifx\putwordDefspec\undefined \gdef\putwordDefspec{Special Form}\fi +\ifx\putwordDefvar\undefined \gdef\putwordDefvar{Variable}\fi +\ifx\putwordDefopt\undefined \gdef\putwordDefopt{User Option}\fi +\ifx\putwordDeftypevar\undefined\gdef\putwordDeftypevar{Variable}\fi +\ifx\putwordDeffunc\undefined \gdef\putwordDeffunc{Function}\fi +\ifx\putwordDeftypefun\undefined\gdef\putwordDeftypefun{Function}\fi % Ignore a token. % @@ -122,30 +154,35 @@ % since that produces some useless output on the terminal. % \def\gloggingall{\begingroup \globaldefs = 1 \loggingall \endgroup}% +\ifx\eTeXversion\undefined \def\loggingall{\tracingcommands2 \tracingstats2 \tracingpages1 \tracingoutput1 \tracinglostchars1 \tracingmacros2 \tracingparagraphs1 \tracingrestores1 \showboxbreadth\maxdimen\showboxdepth\maxdimen }% +\else +\def\loggingall{\tracingcommands3 \tracingstats2 + \tracingpages1 \tracingoutput1 \tracinglostchars1 + \tracingmacros2 \tracingparagraphs1 \tracingrestores1 + \tracingscantokens1 \tracingassigns1 \tracingifs1 + \tracinggroups1 \tracingnesting2 + \showboxbreadth\maxdimen\showboxdepth\maxdimen +}% +\fi % For @cropmarks command. % Do @cropmarks to get crop marks. -% +% \newif\ifcropmarks \let\cropmarks = \cropmarkstrue % % Dimensions to add cropmarks at corners. % Added by P. A. MacKay, 12 Nov. 1986 % -\newdimen\cornerlong \newdimen\cornerthick -\newdimen\topandbottommargin -\newdimen\outerhsize \newdimen\outervsize -\cornerlong=1pc\cornerthick=.3pt % These set size of cropmarks -\outerhsize=7in -%\outervsize=9.5in -% Alternative @smallbook page size is 9.25in -\outervsize=9.25in -\topandbottommargin=.75in +\newdimen\outerhsize \newdimen\outervsize % set by the paper size routines +\newdimen\cornerlong \cornerlong=1pc +\newdimen\cornerthick \cornerthick=.3pt +\newdimen\topandbottommargin \topandbottommargin=.75in % Main output routine. \chardef\PAGE = 255 @@ -179,13 +216,16 @@ \shipout\vbox{% \ifcropmarks \vbox to \outervsize\bgroup \hsize = \outerhsize - \line{\ewtop\hfil\ewtop}% - \nointerlineskip - \line{% - \vbox{\moveleft\cornerthick\nstop}% - \hfill - \vbox{\moveright\cornerthick\nstop}% - }% + \vskip-\topandbottommargin + \vtop to0pt{% + \line{\ewtop\hfil\ewtop}% + \nointerlineskip + \line{% + \vbox{\moveleft\cornerthick\nstop}% + \hfill + \vbox{\moveright\cornerthick\nstop}% + }% + \vss}% \vskip\topandbottommargin \line\bgroup \hfil % center the page within the outer (page) hsize. @@ -203,18 +243,22 @@ \unvbox\footlinebox \fi % + \ifpdfmakepagedest \pdfmkdest{\the\pageno} \fi + % \ifcropmarks \egroup % end of \vbox\bgroup \hfil\egroup % end of (centering) \line\bgroup \vskip\topandbottommargin plus1fill minus1fill \boxmaxdepth = \cornerthick - \line{% - \vbox{\moveleft\cornerthick\nsbot}% - \hfill - \vbox{\moveright\cornerthick\nsbot}% + \vbox to0pt{\vss + \line{% + \vbox{\moveleft\cornerthick\nsbot}% + \hfill + \vbox{\moveright\cornerthick\nsbot}% + }% + \nointerlineskip + \line{\ewbot\hfil\ewbot}% }% - \nointerlineskip - \line{\ewbot\hfil\ewbot}% \egroup % \vbox from first cropmarks clause \fi }% end of \shipout\vbox @@ -330,11 +374,11 @@ %% Call \inENV within environments (after a \begingroup) \newif\ifENV \ENVfalse \def\inENV{\ifENV\relax\else\ENVtrue\fi} \def\ENVcheck{% -\ifENV\errmessage{Still within an environment. Type Return to continue.} +\ifENV\errmessage{Still within an environment; press RETURN to continue} \endgroup\fi} % This is not perfect, but it should reduce lossage % @begin foo is the same as @foo, for now. -\newhelp\EMsimple{Type <Return> to continue.} +\newhelp\EMsimple{Press RETURN to continue.} \outer\def\begin{\parsearg\beginxxx} @@ -393,7 +437,7 @@ % @@ prints an @ % Kludge this until the fonts are right (grr). -\def\@{{\tt \char '100}} +\def\@{{\tt\char64}} % This is turned off because it was never documented % and you can use @w{...} around a quote to suppress ligatures. @@ -403,8 +447,8 @@ %\def\'{{'}} % Used to generate quoted braces. -\def\mylbrace {{\tt \char '173}} -\def\myrbrace {{\tt \char '175}} +\def\mylbrace {{\tt\char123}} +\def\myrbrace {{\tt\char125}} \let\{=\mylbrace \let\}=\myrbrace \begingroup @@ -441,6 +485,18 @@ \fi\fi } +% Be sure we're in horizontal mode when doing a tie, since we make space +% equivalent to this in @example-like environments. Otherwise, a space +% at the beginning of a line will start with \penalty -- and +% since \penalty is valid in vertical mode, we'd end up putting the +% penalty on the vertical list instead of in the new paragraph. +{\catcode`@ = 11 + % Avoid using \@M directly, because that causes trouble + % if the definition is written into an index file. + \global\let\tiepenalty = \@M + \gdef\tie{\leavevmode\penalty\tiepenalty\ } +} + % @: forces normal size whitespace following. \def\:{\spacefactor=1000 } @@ -538,41 +594,47 @@ %% This method tries to make TeX break the page naturally %% if the depth of the box does not fit. %{\baselineskip=0pt% -%\vtop to #1\mil{\vfil}\kern -#1\mil\penalty 10000 +%\vtop to #1\mil{\vfil}\kern -#1\mil\nobreak %\prevdepth=-1000pt %}} \def\needx#1{% - % Go into vertical mode, so we don't make a big box in the middle of a + % Ensure vertical mode, so we don't make a big box in the middle of a % paragraph. \par % - % Don't add any leading before our big empty box, but allow a page - % break, since the best break might be right here. - \allowbreak - \nointerlineskip - \vtop to #1\mil{\vfil}% - % - % TeX does not even consider page breaks if a penalty added to the - % main vertical list is 10000 or more. But in order to see if the - % empty box we just added fits on the page, we must make it consider - % page breaks. On the other hand, we don't want to actually break the - % page after the empty box. So we use a penalty of 9999. - % - % There is an extremely small chance that TeX will actually break the - % page at this \penalty, if there are no other feasible breakpoints in - % sight. (If the user is using lots of big @group commands, which - % almost-but-not-quite fill up a page, TeX will have a hard time doing - % good page breaking, for example.) However, I could not construct an - % example where a page broke at this \penalty; if it happens in a real - % document, then we can reconsider our strategy. - \penalty9999 - % - % Back up by the size of the box, whether we did a page break or not. - \kern -#1\mil - % - % Do not allow a page break right after this kern. - \nobreak + % If the @need value is less than one line space, it's useless. + \dimen0 = #1\mil + \dimen2 = \ht\strutbox + \advance\dimen2 by \dp\strutbox + \ifdim\dimen0 > \dimen2 + % + % Do a \strut just to make the height of this box be normal, so the + % normal leading is inserted relative to the preceding line. + % And a page break here is fine. + \vtop to #1\mil{\strut\vfil}% + % + % TeX does not even consider page breaks if a penalty added to the + % main vertical list is 10000 or more. But in order to see if the + % empty box we just added fits on the page, we must make it consider + % page breaks. On the other hand, we don't want to actually break the + % page after the empty box. So we use a penalty of 9999. + % + % There is an extremely small chance that TeX will actually break the + % page at this \penalty, if there are no other feasible breakpoints in + % sight. (If the user is using lots of big @group commands, which + % almost-but-not-quite fill up a page, TeX will have a hard time doing + % good page breaking, for example.) However, I could not construct an + % example where a page broke at this \penalty; if it happens in a real + % document, then we can reconsider our strategy. + \penalty9999 + % + % Back up by the size of the box, whether we did a page break or not. + \kern -#1\mil + % + % Do not allow a page break right after this kern. + \nobreak + \fi } % @br forces paragraph break @@ -583,15 +645,19 @@ % We do .5em per period so that it has the same spacing in a typewriter % font as three actual period characters. % -\def\dots{\hbox to 1.5em{% - \hskip 0pt plus 0.25fil minus 0.25fil - .\hss.\hss.% - \hskip 0pt plus 0.5fil minus 0.5fil -}} +\def\dots{% + \leavevmode + \hbox to 1.5em{% + \hskip 0pt plus 0.25fil minus 0.25fil + .\hss.\hss.% + \hskip 0pt plus 0.5fil minus 0.5fil + }% +} % @enddots{} is an end-of-sentence ellipsis. -% +% \def\enddots{% + \leavevmode \hbox to 2em{% \hskip 0pt plus 0.25fil minus 0.25fil .\hss.\hss.\hss.% @@ -602,7 +668,7 @@ % @page forces the start of a new page - +% \def\page{\par\vfill\supereject} % @exdent text.... @@ -669,332 +735,50 @@ % @c is the same as @comment % @ignore ... @end ignore is another way to write a comment -\def\comment{\catcode 64=\other \catcode 123=\other \catcode 125=\other% -\parsearg \commentxxx} - -\def\commentxxx #1{\catcode 64=0 \catcode 123=1 \catcode 125=2 } +\def\comment{\begingroup \catcode`\^^M=\other% +\catcode`\@=\other \catcode`\{=\other \catcode`\}=\other% +\commentxxx} +{\catcode`\^^M=\other \gdef\commentxxx#1^^M{\endgroup}} \let\c=\comment -% @paragraphindent is defined for the Info formatting commands only. -\let\paragraphindent=\comment - -% Prevent errors for section commands. -% Used in @ignore and in failing conditionals. -\def\ignoresections{% -\let\chapter=\relax -\let\unnumbered=\relax -\let\top=\relax -\let\unnumberedsec=\relax -\let\unnumberedsection=\relax -\let\unnumberedsubsec=\relax -\let\unnumberedsubsection=\relax -\let\unnumberedsubsubsec=\relax -\let\unnumberedsubsubsection=\relax -\let\section=\relax -\let\subsec=\relax -\let\subsubsec=\relax -\let\subsection=\relax -\let\subsubsection=\relax -\let\appendix=\relax -\let\appendixsec=\relax -\let\appendixsection=\relax -\let\appendixsubsec=\relax -\let\appendixsubsection=\relax -\let\appendixsubsubsec=\relax -\let\appendixsubsubsection=\relax -\let\contents=\relax -\let\smallbook=\relax -\let\titlepage=\relax -} - -% Used in nested conditionals, where we have to parse the Texinfo source -% and so want to turn off most commands, in case they are used -% incorrectly. -% -\def\ignoremorecommands{% - \let\defcodeindex = \relax - \let\defcv = \relax - \let\deffn = \relax - \let\deffnx = \relax - \let\defindex = \relax - \let\defivar = \relax - \let\defmac = \relax - \let\defmethod = \relax - \let\defop = \relax - \let\defopt = \relax - \let\defspec = \relax - \let\deftp = \relax - \let\deftypefn = \relax - \let\deftypefun = \relax - \let\deftypevar = \relax - \let\deftypevr = \relax - \let\defun = \relax - \let\defvar = \relax - \let\defvr = \relax - \let\ref = \relax - \let\xref = \relax - \let\printindex = \relax - \let\pxref = \relax - \let\settitle = \relax - \let\setchapternewpage = \relax - \let\setchapterstyle = \relax - \let\everyheading = \relax - \let\evenheading = \relax - \let\oddheading = \relax - \let\everyfooting = \relax - \let\evenfooting = \relax - \let\oddfooting = \relax - \let\headings = \relax - \let\include = \relax - \let\lowersections = \relax - \let\down = \relax - \let\raisesections = \relax - \let\up = \relax - \let\set = \relax - \let\clear = \relax - \let\item = \relax -} - -% Ignore @ignore ... @end ignore. -% -\def\ignore{\doignore{ignore}} - -% Ignore @ifinfo, @ifhtml, @ifnottex, @html, @menu, and @direntry text. -% -\def\ifinfo{\doignore{ifinfo}} -\def\ifhtml{\doignore{ifhtml}} -\def\ifnottex{\doignore{ifnottex}} -\def\html{\doignore{html}} -\def\menu{\doignore{menu}} -\def\direntry{\doignore{direntry}} - -% Also ignore @macro ... @end macro. The user must run texi2dvi, -% which runs makeinfo to do macro expansion. Ignore @unmacro, too. -\def\macro{\doignore{macro}} -\let\unmacro = \comment - - -% @dircategory CATEGORY -- specify a category of the dir file -% which this file should belong to. Ignore this in TeX. -\let\dircategory = \comment - -% Ignore text until a line `@end #1'. -% -\def\doignore#1{\begingroup - % Don't complain about control sequences we have declared \outer. - \ignoresections - % - % Define a command to swallow text until we reach `@end #1'. - \long\def\doignoretext##1\end #1{\enddoignore}% - % - % Make sure that spaces turn into tokens that match what \doignoretext wants. - \catcode32 = 10 - % - % Ignore braces, too, so mismatched braces don't cause trouble. - \catcode`\{ = 9 - \catcode`\} = 9 - % - % And now expand that command. - \doignoretext -} - -% What we do to finish off ignored text. +% @paragraphindent NCHARS +% We'll use ems for NCHARS, close enough. +% We cannot implement @paragraphindent asis, though. +% +\def\asisword{asis} % no translation, these are keywords +\def\noneword{none} % -\def\enddoignore{\endgroup\ignorespaces}% - -\newif\ifwarnedobs\warnedobsfalse -\def\obstexwarn{% - \ifwarnedobs\relax\else - % We need to warn folks that they may have trouble with TeX 3.0. - % This uses \immediate\write16 rather than \message to get newlines. - \immediate\write16{} - \immediate\write16{***WARNING*** for users of Unix TeX 3.0!} - \immediate\write16{This manual trips a bug in TeX version 3.0 (tex hangs).} - \immediate\write16{If you are running another version of TeX, relax.} - \immediate\write16{If you are running Unix TeX 3.0, kill this TeX process.} - \immediate\write16{ Then upgrade your TeX installation if you can.} - \immediate\write16{ (See ftp://ftp.gnu.ai.mit.edu/pub/gnu/TeX.README.)} - \immediate\write16{If you are stuck with version 3.0, run the} - \immediate\write16{ script ``tex3patch'' from the Texinfo distribution} - \immediate\write16{ to use a workaround.} - \immediate\write16{} - \global\warnedobstrue +\def\paragraphindent{\parsearg\doparagraphindent} +\def\doparagraphindent#1{% + \def\temp{#1}% + \ifx\temp\asisword + \else + \ifx\temp\noneword + \defaultparindent = 0pt + \else + \defaultparindent = #1em \fi + \fi + \parindent = \defaultparindent } -% **In TeX 3.0, setting text in \nullfont hangs tex. For a -% workaround (which requires the file ``dummy.tfm'' to be installed), -% uncomment the following line: -%%%%%\font\nullfont=dummy\let\obstexwarn=\relax - -% Ignore text, except that we keep track of conditional commands for -% purposes of nesting, up to an `@end #1' command. -% -\def\nestedignore#1{% - \obstexwarn - % We must actually expand the ignored text to look for the @end - % command, so that nested ignore constructs work. Thus, we put the - % text into a \vbox and then do nothing with the result. To minimize - % the change of memory overflow, we follow the approach outlined on - % page 401 of the TeXbook: make the current font be a dummy font. - % - \setbox0 = \vbox\bgroup - % Don't complain about control sequences we have declared \outer. - \ignoresections - % - % Define `@end #1' to end the box, which will in turn undefine the - % @end command again. - \expandafter\def\csname E#1\endcsname{\egroup\ignorespaces}% - % - % We are going to be parsing Texinfo commands. Most cause no - % trouble when they are used incorrectly, but some commands do - % complicated argument parsing or otherwise get confused, so we - % undefine them. - % - % We can't do anything about stray @-signs, unfortunately; - % they'll produce `undefined control sequence' errors. - \ignoremorecommands - % - % Set the current font to be \nullfont, a TeX primitive, and define - % all the font commands to also use \nullfont. We don't use - % dummy.tfm, as suggested in the TeXbook, because not all sites - % might have that installed. Therefore, math mode will still - % produce output, but that should be an extremely small amount of - % stuff compared to the main input. - % - \nullfont - \let\tenrm = \nullfont \let\tenit = \nullfont \let\tensl = \nullfont - \let\tenbf = \nullfont \let\tentt = \nullfont \let\smallcaps = \nullfont - \let\tensf = \nullfont - % Similarly for index fonts (mostly for their use in - % smallexample) - \let\indrm = \nullfont \let\indit = \nullfont \let\indsl = \nullfont - \let\indbf = \nullfont \let\indtt = \nullfont \let\indsc = \nullfont - \let\indsf = \nullfont - % - % Don't complain when characters are missing from the fonts. - \tracinglostchars = 0 - % - % Don't bother to do space factor calculations. - \frenchspacing - % - % Don't report underfull hboxes. - \hbadness = 10000 - % - % Do minimal line-breaking. - \pretolerance = 10000 - % - % Do not execute instructions in @tex - \def\tex{\doignore{tex}}% -} - -% @set VAR sets the variable VAR to an empty value. -% @set VAR REST-OF-LINE sets VAR to the value REST-OF-LINE. -% -% Since we want to separate VAR from REST-OF-LINE (which might be -% empty), we can't just use \parsearg; we have to insert a space of our -% own to delimit the rest of the line, and then take it out again if we -% didn't need it. Make sure the catcode of space is correct to avoid -% losing inside @example, for instance. -% -\def\set{\begingroup\catcode` =10 - \catcode`\-=12 \catcode`\_=12 % Allow - and _ in VAR. - \parsearg\setxxx} -\def\setxxx#1{\setyyy#1 \endsetyyy} -\def\setyyy#1 #2\endsetyyy{% - \def\temp{#2}% - \ifx\temp\empty \global\expandafter\let\csname SET#1\endcsname = \empty - \else \setzzz{#1}#2\endsetzzz % Remove the trailing space \setxxx inserted. - \fi - \endgroup -} -% Can't use \xdef to pre-expand #2 and save some time, since \temp or -% \next or other control sequences that we've defined might get us into -% an infinite loop. Consider `@set foo @cite{bar}'. -\def\setzzz#1#2 \endsetzzz{\expandafter\gdef\csname SET#1\endcsname{#2}} - -% @clear VAR clears (i.e., unsets) the variable VAR. -% -\def\clear{\parsearg\clearxxx} -\def\clearxxx#1{\global\expandafter\let\csname SET#1\endcsname=\relax} - -% @value{foo} gets the text saved in variable foo. -% -\def\value{\begingroup - \catcode`\-=12 \catcode`\_=12 % Allow - and _ in VAR. - \valuexxx} -\def\valuexxx#1{% - \expandafter\ifx\csname SET#1\endcsname\relax - {\{No value for ``#1''\}}% +% @exampleindent NCHARS +% We'll use ems for NCHARS like @paragraphindent. +% It seems @exampleindent asis isn't necessary, but +% I preserve it to make it similar to @paragraphindent. +\def\exampleindent{\parsearg\doexampleindent} +\def\doexampleindent#1{% + \def\temp{#1}% + \ifx\temp\asisword \else - \csname SET#1\endcsname - \fi -\endgroup} - -% @ifset VAR ... @end ifset reads the `...' iff VAR has been defined -% with @set. -% -\def\ifset{\parsearg\ifsetxxx} -\def\ifsetxxx #1{% - \expandafter\ifx\csname SET#1\endcsname\relax - \expandafter\ifsetfail - \else - \expandafter\ifsetsucceed + \ifx\temp\noneword + \lispnarrowing = 0pt + \else + \lispnarrowing = #1em + \fi \fi } -\def\ifsetsucceed{\conditionalsucceed{ifset}} -\def\ifsetfail{\nestedignore{ifset}} -\defineunmatchedend{ifset} - -% @ifclear VAR ... @end ifclear reads the `...' iff VAR has never been -% defined with @set, or has been undefined with @clear. -% -\def\ifclear{\parsearg\ifclearxxx} -\def\ifclearxxx #1{% - \expandafter\ifx\csname SET#1\endcsname\relax - \expandafter\ifclearsucceed - \else - \expandafter\ifclearfail - \fi -} -\def\ifclearsucceed{\conditionalsucceed{ifclear}} -\def\ifclearfail{\nestedignore{ifclear}} -\defineunmatchedend{ifclear} - -% @iftex, @ifnothtml, @ifnotinfo always succeed; we read the text -% following, through the first @end iftex (etc.). Make `@end iftex' -% (etc.) valid only after an @iftex. -% -\def\iftex{\conditionalsucceed{iftex}} -\def\ifnothtml{\conditionalsucceed{ifnothtml}} -\def\ifnotinfo{\conditionalsucceed{ifnotinfo}} -\defineunmatchedend{iftex} -\defineunmatchedend{ifnothtml} -\defineunmatchedend{ifnotinfo} - -% We can't just want to start a group at @iftex (for example) and end it -% at @end iftex, since then @set commands inside the conditional have no -% effect (they'd get reverted at the end of the group). So we must -% define \Eiftex to redefine itself to be its previous value. (We can't -% just define it to fail again with an ``unmatched end'' error, since -% the @ifset might be nested.) -% -\def\conditionalsucceed#1{% - \edef\temp{% - % Remember the current value of \E#1. - \let\nece{prevE#1} = \nece{E#1}% - % - % At the `@end #1', redefine \E#1 to be its previous value. - \def\nece{E#1}{\let\nece{E#1} = \nece{prevE#1}}% - }% - \temp -} - -% We need to expand lots of \csname's, but we don't want to expand the -% control sequences after we've constructed them. -% -\def\nece#1{\expandafter\noexpand\csname#1\endcsname} % @asis just yields its argument. Used with @table, for example. % @@ -1017,33 +801,23 @@ \def\bullet{\implicitmath\ptexbullet\implicitmath} \def\minus{\implicitmath-\implicitmath} -\def\node{\ENVcheck\parsearg\nodezzz} -\def\nodezzz#1{\nodexxx [#1,]} -\def\nodexxx[#1,#2]{\gdef\lastnode{#1}} -\let\nwnode=\node -\let\lastnode=\relax - -\def\donoderef{\ifx\lastnode\relax\else -\expandafter\expandafter\expandafter\setref{\lastnode}\fi -\global\let\lastnode=\relax} - -\def\unnumbnoderef{\ifx\lastnode\relax\else -\expandafter\expandafter\expandafter\unnumbsetref{\lastnode}\fi -\global\let\lastnode=\relax} - -\def\appendixnoderef{\ifx\lastnode\relax\else -\expandafter\expandafter\expandafter\appendixsetref{\lastnode}\fi -\global\let\lastnode=\relax} - % @refill is a no-op. \let\refill=\relax +% If working on a large document in chapters, it is convenient to +% be able to disable indexing, cross-referencing, and contents, for test runs. +% This is done with @novalidate (before @setfilename). +% +\newif\iflinks \linkstrue % by default we want the aux files. +\let\novalidate = \linksfalse + % @setfilename is done at the beginning of every texinfo file. % So open here the files we need to have open while reading the input. % This makes it possible to make a .fmt file for texinfo. \def\setfilename{% - \readauxfile - \opencontents + \iflinks + \readauxfile + \fi % \openindices needs to do some work in any case. \openindices \fixbackslash % Turn off hack to swallow `\input texinfo'. \global\let\setfilename=\comment % Ignore extra @setfilename cmds. @@ -1059,30 +833,197 @@ \comment % Ignore the actual filename. } +% Called from \setfilename. +% +\def\openindices{% + \newindex{cp}% + \newcodeindex{fn}% + \newcodeindex{vr}% + \newcodeindex{tp}% + \newcodeindex{ky}% + \newcodeindex{pg}% +} + % @bye. \outer\def\bye{\pagealignmacro\tracingstats=1\ptexend} -% \def\macro#1{\begingroup\ignoresections\catcode`\#=6\def\macrotemp{#1}\parsearg\macroxxx} -% \def\macroxxx#1#2 \end macro{% -% \expandafter\gdef\macrotemp#1{#2}% -% \endgroup} - -%\def\linemacro#1{\begingroup\ignoresections\catcode`\#=6\def\macrotemp{#1}\parsearg\linemacroxxx} -%\def\linemacroxxx#1#2 \end linemacro{% -%\let\parsearg=\relax -%\edef\macrotempx{\csname M\butfirst\expandafter\string\macrotemp\endcsname}% -%\expandafter\xdef\macrotemp{\parsearg\macrotempx}% -%\expandafter\gdef\macrotempx#1{#2}% -%\endgroup} - -%\def\butfirst#1{} + +\message{pdf,} +% adobe `portable' document format +\newcount\tempnum +\newcount\lnkcount +\newtoks\filename +\newcount\filenamelength +\newcount\pgn +\newtoks\toksA +\newtoks\toksB +\newtoks\toksC +\newtoks\toksD +\newbox\boxA +\newcount\countA +\newif\ifpdf +\newif\ifpdfmakepagedest + +\ifx\pdfoutput\undefined + \pdffalse + \let\pdfmkdest = \gobble + \let\pdfurl = \gobble + \let\endlink = \relax + \let\linkcolor = \relax + \let\pdfmakeoutlines = \relax +\else + \pdftrue + \pdfoutput = 1 + \input pdfcolor + \def\dopdfimage#1#2#3{% + \def\imagewidth{#2}% + \def\imageheight{#3}% + \ifnum\pdftexversion < 14 + \pdfimage + \else + \pdfximage + \fi + \ifx\empty\imagewidth\else width \imagewidth \fi + \ifx\empty\imageheight\else height \imageheight \fi + {#1.pdf}% + \ifnum\pdftexversion < 14 \else + \pdfrefximage \pdflastximage + \fi} + \def\pdfmkdest#1{\pdfdest name{#1@} xyz} + \def\pdfmkpgn#1{#1@} + \let\linkcolor = \Cyan + \def\endlink{\Black\pdfendlink} + % Adding outlines to PDF; macros for calculating structure of outlines + % come from Petr Olsak + \def\expnumber#1{\expandafter\ifx\csname#1\endcsname\relax 0% + \else \csname#1\endcsname \fi} + \def\advancenumber#1{\tempnum=\expnumber{#1}\relax + \advance\tempnum by1 + \expandafter\xdef\csname#1\endcsname{\the\tempnum}} + \def\pdfmakeoutlines{{% + \openin 1 \jobname.toc + \ifeof 1\else\bgroup + \closein 1 + \indexnofonts + \def\tt{} + % thanh's hack / proper braces in bookmarks + \edef\mylbrace{\iftrue \string{\else}\fi}\let\{=\mylbrace + \edef\myrbrace{\iffalse{\else\string}\fi}\let\}=\myrbrace + % + \def\chapentry ##1##2##3{} + \def\unnumbchapentry ##1##2{} + \def\secentry ##1##2##3##4{\advancenumber{chap##2}} + \def\unnumbsecentry ##1##2{} + \def\subsecentry ##1##2##3##4##5{\advancenumber{sec##2.##3}} + \def\unnumbsubsecentry ##1##2{} + \def\subsubsecentry ##1##2##3##4##5##6{\advancenumber{subsec##2.##3.##4}} + \def\unnumbsubsubsecentry ##1##2{} + \input \jobname.toc + \def\chapentry ##1##2##3{% + \pdfoutline goto name{\pdfmkpgn{##3}}count-\expnumber{chap##2}{##1}} + \def\unnumbchapentry ##1##2{% + \pdfoutline goto name{\pdfmkpgn{##2}}{##1}} + \def\secentry ##1##2##3##4{% + \pdfoutline goto name{\pdfmkpgn{##4}}count-\expnumber{sec##2.##3}{##1}} + \def\unnumbsecentry ##1##2{% + \pdfoutline goto name{\pdfmkpgn{##2}}{##1}} + \def\subsecentry ##1##2##3##4##5{% + \pdfoutline goto name{\pdfmkpgn{##5}}count-\expnumber{subsec##2.##3.##4}{##1}} + \def\unnumbsubsecentry ##1##2{% + \pdfoutline goto name{\pdfmkpgn{##2}}{##1}} + \def\subsubsecentry ##1##2##3##4##5##6{% + \pdfoutline goto name{\pdfmkpgn{##6}}{##1}} + \def\unnumbsubsubsecentry ##1##2{% + \pdfoutline goto name{\pdfmkpgn{##2}}{##1}} + \input \jobname.toc + \egroup\fi + }} + \def\makelinks #1,{% + \def\params{#1}\def\E{END}% + \ifx\params\E + \let\nextmakelinks=\relax + \else + \let\nextmakelinks=\makelinks + \ifnum\lnkcount>0,\fi + \picknum{#1}% + \startlink attr{/Border [0 0 0]} + goto name{\pdfmkpgn{\the\pgn}}% + \linkcolor #1% + \advance\lnkcount by 1% + \endlink + \fi + \nextmakelinks + } + \def\picknum#1{\expandafter\pn#1} + \def\pn#1{% + \def\p{#1}% + \ifx\p\lbrace + \let\nextpn=\ppn + \else + \let\nextpn=\ppnn + \def\first{#1} + \fi + \nextpn + } + \def\ppn#1{\pgn=#1\gobble} + \def\ppnn{\pgn=\first} + \def\pdfmklnk#1{\lnkcount=0\makelinks #1,END,} + \def\addtokens#1#2{\edef\addtoks{\noexpand#1={\the#1#2}}\addtoks} + \def\skipspaces#1{\def\PP{#1}\def\D{|}% + \ifx\PP\D\let\nextsp\relax + \else\let\nextsp\skipspaces + \ifx\p\space\else\addtokens{\filename}{\PP}% + \advance\filenamelength by 1 + \fi + \fi + \nextsp} + \def\getfilename#1{\filenamelength=0\expandafter\skipspaces#1|\relax} + \ifnum\pdftexversion < 14 + \let \startlink \pdfannotlink + \else + \let \startlink \pdfstartlink + \fi + \def\pdfurl#1{% + \begingroup + \normalturnoffactive\def\@{@}% + \leavevmode\Red + \startlink attr{/Border [0 0 0]}% + user{/Subtype /Link /A << /S /URI /URI (#1) >>}% + % #1 + \endgroup} + \def\pdfgettoks#1.{\setbox\boxA=\hbox{\toksA={#1.}\toksB={}\maketoks}} + \def\addtokens#1#2{\edef\addtoks{\noexpand#1={\the#1#2}}\addtoks} + \def\adn#1{\addtokens{\toksC}{#1}\global\countA=1\let\next=\maketoks} + \def\poptoks#1#2|ENDTOKS|{\let\first=#1\toksD={#1}\toksA={#2}} + \def\maketoks{% + \expandafter\poptoks\the\toksA|ENDTOKS| + \ifx\first0\adn0 + \else\ifx\first1\adn1 \else\ifx\first2\adn2 \else\ifx\first3\adn3 + \else\ifx\first4\adn4 \else\ifx\first5\adn5 \else\ifx\first6\adn6 + \else\ifx\first7\adn7 \else\ifx\first8\adn8 \else\ifx\first9\adn9 + \else + \ifnum0=\countA\else\makelink\fi + \ifx\first.\let\next=\done\else + \let\next=\maketoks + \addtokens{\toksB}{\the\toksD} + \ifx\first,\addtokens{\toksB}{\space}\fi + \fi + \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi + \next} + \def\makelink{\addtokens{\toksB}% + {\noexpand\pdflink{\the\toksC}}\toksC={}\global\countA=0} + \def\pdflink#1{% + \startlink attr{/Border [0 0 0]} goto name{\mkpgn{#1}} + \linkcolor #1\endlink} + \def\mkpgn#1{#1@} + \def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st} +\fi % \ifx\pdfoutput \message{fonts,} - % Font-change commands. -% Texinfo supports the sans serif font style, which plain TeX does not. +% Texinfo sort of supports the sans serif font style, which plain TeX does not. % So we set up a \sf analogous to plain's \rm, etc. \newfam\sffam \def\sf{\fam=\sffam \tensf} @@ -1148,22 +1089,17 @@ \setfont\deftt\ttshape{10}{\magstep1} \def\df{\let\tentt=\deftt \let\tenbf = \defbf \bf} -% Fonts for indices and small examples (9pt). -% We actually use the slanted font rather than the italic, -% because texinfo normally uses the slanted fonts for that. -% Do not make many font distinctions in general in the index, since they -% aren't very useful. -\setfont\ninett\ttshape{9}{1000} -\setfont\indrm\rmshape{9}{1000} -\setfont\indit\slshape{9}{1000} -\let\indsl=\indit -\let\indtt=\ninett -\let\indttsl=\ninett -\let\indsf=\indrm -\let\indbf=\indrm -\setfont\indsc\scshape{10}{900} -\font\indi=cmmi9 -\font\indsy=cmsy9 +% Fonts for indices, footnotes, small examples (9pt). +\setfont\smallrm\rmshape{9}{1000} +\setfont\smalltt\ttshape{9}{1000} +\setfont\smallbf\bfshape{10}{900} +\setfont\smallit\itshape{9}{1000} +\setfont\smallsl\slshape{9}{1000} +\setfont\smallsf\sfshape{9}{1000} +\setfont\smallsc\scshape{10}{900} +\setfont\smallttsl\ttslshape{10}{900} +\font\smalli=cmmi9 +\font\smallsy=cmsy9 % Fonts for title page: \setfont\titlerm\rmbshape{12}{\magstep3} @@ -1277,11 +1213,12 @@ \let\tensf=\ssecsf \let\teni=\sseci \let\tensy=\ssecsy \let\tenttsl=\ssecttsl \resetmathfonts \setleading{15pt}} \let\subsubsecfonts = \subsecfonts % Maybe make sssec fonts scaled magstephalf? -\def\indexfonts{% - \let\tenrm=\indrm \let\tenit=\indit \let\tensl=\indsl - \let\tenbf=\indbf \let\tentt=\indtt \let\smallcaps=\indsc - \let\tensf=\indsf \let\teni=\indi \let\tensy=\indsy \let\tenttsl=\indttsl - \resetmathfonts \setleading{12pt}} +\def\smallfonts{% + \let\tenrm=\smallrm \let\tenit=\smallit \let\tensl=\smallsl + \let\tenbf=\smallbf \let\tentt=\smalltt \let\smallcaps=\smallsc + \let\tensf=\smallsf \let\teni=\smalli \let\tensy=\smallsy + \let\tenttsl=\smallttsl + \resetmathfonts \setleading{11pt}} % Set up the default fonts, so we can use them for creating boxes. % @@ -1305,13 +1242,14 @@ % \smartitalic{ARG} outputs arg in italics, followed by an italic correction % unless the following character is such as not to need one. \def\smartitalicx{\ifx\next,\else\ifx\next-\else\ifx\next.\else\/\fi\fi\fi} -\def\smartitalic#1{{\sl #1}\futurelet\next\smartitalicx} +\def\smartslanted#1{{\sl #1}\futurelet\next\smartitalicx} +\def\smartitalic#1{{\it #1}\futurelet\next\smartitalicx} \let\i=\smartitalic -\let\var=\smartitalic -\let\dfn=\smartitalic +\let\var=\smartslanted +\let\dfn=\smartslanted \let\emph=\smartitalic -\let\cite=\smartitalic +\let\cite=\smartslanted \def\b#1{{\bf #1}} \let\strong=\b @@ -1329,9 +1267,9 @@ } \let\ttfont=\t \def\samp#1{`\tclose{#1}'\null} -\setfont\smallrm\rmshape{8}{1000} -\font\smallsy=cmsy9 -\def\key#1{{\smallrm\textfont2=\smallsy \leavevmode\hbox{% +\setfont\keyrm\rmshape{8}{1000} +\font\keysy=cmsy9 +\def\key#1{{\keyrm\textfont2=\keysy \leavevmode\hbox{% \raise0.4pt\hbox{\angleleft}\kern-.08em\vtop{% \vbox{\hrule\kern-0.4pt \hbox{\raise0.4pt\hbox{\vphantom{\angleleft}}#1}}% @@ -1341,7 +1279,9 @@ %\def\key #1{{\ttsl \nohyphenation \uppercase{#1}}\null} \def\ctrl #1{{\tt \rawbackslash \hat}#1} +% @file, @option are the same as @samp. \let\file=\samp +\let\option=\samp % @code is a modification of @t, % which makes spaces the same size as normal in the surrounding text. @@ -1376,20 +1316,18 @@ % and arrange explicitly to hyphenate at a dash. % -- rms. { -\catcode`\-=\active -\catcode`\_=\active -\catcode`\|=\active -\global\def\code{\begingroup \catcode`\-=\active \let-\codedash \catcode`\_=\active \let_\codeunder \codex} -% The following is used by \doprintindex to insure that long function names -% wrap around. It is necessary for - and _ to be active before the index is -% read from the file, as \entry parses the arguments long before \code is -% ever called. -- mycroft -% _ is always active; and it shouldn't be \let = to an _ that is a -% subscript character anyway. Then, @cindex @samp{_} (for example) -% fails. --karl -\global\def\indexbreaks{% - \catcode`\-=\active \let-\realdash -} + \catcode`\-=\active + \catcode`\_=\active + % + \global\def\code{\begingroup + \catcode`\-=\active \let-\codedash + \catcode`\_=\active \let_\codeunder + \codex + } + % + % If we end up with any active - characters when handling the index, + % just treat them as a normal -. + \global\def\indexbreaks{\catcode`\-=\active \let-\realdash} } \def\realdash{-} @@ -1430,27 +1368,55 @@ \else{\tclose{\kbdfont\look}}\fi \else{\tclose{\kbdfont\look}}\fi} -% @url. Quotes do not seem necessary, so use \code. +% For @url, @env, @command quotes seem unnecessary, so use \code. \let\url=\code - -% @uref (abbreviation for `urlref') takes an optional second argument -% specifying the text to display. First (mandatory) arg is the url. -% Perhaps eventually put in a hypertex \special here. -% -\def\uref#1{\urefxxx #1,,\finish} -\def\urefxxx#1,#2,#3\finish{% - \setbox0 = \hbox{\ignorespaces #2}% +\let\env=\code +\let\command=\code + +% @uref (abbreviation for `urlref') takes an optional (comma-separated) +% second argument specifying the text to display and an optional third +% arg as text to display instead of (rather than in addition to) the url +% itself. First (mandatory) arg is the url. Perhaps eventually put in +% a hypertex \special here. +% +\def\uref#1{\douref #1,,,\finish} +\def\douref#1,#2,#3,#4\finish{\begingroup + \unsepspaces + \pdfurl{#1}% + \setbox0 = \hbox{\ignorespaces #3}% \ifdim\wd0 > 0pt - \unhbox0\ (\code{#1})% + \unhbox0 % third arg given, show only that \else - \code{#1}% + \setbox0 = \hbox{\ignorespaces #2}% + \ifdim\wd0 > 0pt + \ifpdf + \unhbox0 % PDF: 2nd arg given, show only it + \else + \unhbox0\ (\code{#1})% DVI: 2nd arg given, show both it and url + \fi + \else + \code{#1}% only url given, so show it + \fi \fi -} - -% rms does not like the angle brackets --karl, 17may97. -% So now @email is just like @uref. + \endlink +\endgroup} + +% rms does not like angle brackets --karl, 17may97. +% So now @email is just like @uref, unless we are pdf. +% %\def\email#1{\angleleft{\tt #1}\angleright} -\let\email=\uref +\ifpdf + \def\email#1{\doemail#1,,\finish} + \def\doemail#1,#2,#3\finish{\begingroup + \unsepspaces + \pdfurl{mailto:#1}% + \setbox0 = \hbox{\ignorespaces #2}% + \ifdim\wd0>0pt\unhbox0\else\code{#1}\fi + \endlink + \endgroup} +\else + \let\email=\uref +\fi % Check if we are currently using a typewriter font. Since all the % Computer Modern typewriter fonts have zero interword stretch (and @@ -1460,8 +1426,7 @@ \def\ifmonospace{\ifdim\fontdimen3\font=0pt } % Typeset a dimension, e.g., `in' or `pt'. The only reason for the -% argument is to make the input look right: @dmn{pt} instead of -% @dmn{}pt. +% argument is to make the input look right: @dmn{pt} instead of @dmn{}pt. % \def\dmn#1{\thinspace #1} @@ -1472,11 +1437,14 @@ % Polish suppressed-l. --karl, 22sep96. %\def\l#1{{\li #1}\null} +% Explicit font changes: @r, @sc, undocumented @ii. \def\r#1{{\rm #1}} % roman font -% Use of \lowercase was suggested. \def\sc#1{{\smallcaps#1}} % smallcaps font \def\ii#1{{\it #1}} % italic font +% @acronym downcases the argument and prints in smallcaps. +\def\acronym#1{{\smallcaps \lowercase{#1}}} + % @pounds{} is a sterling sign. \def\pounds{{\it\$}} @@ -1490,15 +1458,20 @@ \newif\ifseenauthor \newif\iffinishedtitlepage +% Do an implicit @contents or @shortcontents after @end titlepage if the +% user says @setcontentsaftertitlepage or @setshortcontentsaftertitlepage. +% +\newif\ifsetcontentsaftertitlepage + \let\setcontentsaftertitlepage = \setcontentsaftertitlepagetrue +\newif\ifsetshortcontentsaftertitlepage + \let\setshortcontentsaftertitlepage = \setshortcontentsaftertitlepagetrue + \def\shorttitlepage{\parsearg\shorttitlepagezzz} \def\shorttitlepagezzz #1{\begingroup\hbox{}\vskip 1.5in \chaprm \centerline{#1}% \endgroup\page\hbox{}\page} \def\titlepage{\begingroup \parindent=0pt \textfonts \let\subtitlerm=\tenrm -% I deinstalled the following change because \cmr12 is undefined. -% This change was not in the ChangeLog anyway. --rms. -% \let\subtitlerm=\cmr12 \def\subtitlefont{\subtitlerm \normalbaselineskip = 13pt \normalbaselines}% % \def\authorfont{\authorrm \normalbaselineskip = 16pt \normalbaselines}% @@ -1547,6 +1520,23 @@ % after the title page, which we certainly don't want. \oldpage \endgroup + % + % If they want short, they certainly want long too. + \ifsetshortcontentsaftertitlepage + \shortcontents + \contents + \global\let\shortcontents = \relax + \global\let\contents = \relax + \fi + % + \ifsetcontentsaftertitlepage + \contents + \global\let\contents = \relax + \global\let\shortcontents = \relax + \fi + % + \ifpdf \pdfmakepagedesttrue \fi + % \HEADINGSon } @@ -1560,10 +1550,10 @@ \let\thispage=\folio -\newtoks \evenheadline % Token sequence for heading line of even pages -\newtoks \oddheadline % Token sequence for heading line of odd pages -\newtoks \evenfootline % Token sequence for footing line of even pages -\newtoks \oddfootline % Token sequence for footing line of odd pages +\newtoks\evenheadline % headline on even pages +\newtoks\oddheadline % headline on odd pages +\newtoks\evenfootline % footline on even pages +\newtoks\oddfootline % footline on odd pages % Now make Tex use those variables \headline={{\textfonts\rm \ifodd\pageno \the\oddheadline @@ -1681,39 +1671,23 @@ % Subroutines used in generating headings % Produces Day Month Year style of output. -\def\today{\number\day\space -\ifcase\month\or -January\or February\or March\or April\or May\or June\or -July\or August\or September\or October\or November\or December\fi -\space\number\year} - -% Use this if you want the Month Day, Year style of output. -%\def\today{\ifcase\month\or -%January\or February\or March\or April\or May\or June\or -%July\or August\or September\or October\or November\or December\fi -%\space\number\day, \number\year} - -% @settitle line... specifies the title of the document, for headings -% It generates no output of its own - -\def\thistitle{No Title} +\def\today{% + \number\day\space + \ifcase\month + \or\putwordMJan\or\putwordMFeb\or\putwordMMar\or\putwordMApr + \or\putwordMMay\or\putwordMJun\or\putwordMJul\or\putwordMAug + \or\putwordMSep\or\putwordMOct\or\putwordMNov\or\putwordMDec + \fi + \space\number\year} + +% @settitle line... specifies the title of the document, for headings. +% It generates no output of its own. +\def\thistitle{\putwordNoTitle} \def\settitle{\parsearg\settitlezzz} \def\settitlezzz #1{\gdef\thistitle{#1}} \message{tables,} - -% @tabs -- simple alignment - -% These don't work. For one thing, \+ is defined as outer. -% So these macros cannot even be defined. - -%\def\tabs{\parsearg\tabszzz} -%\def\tabszzz #1{\settabs\+#1\cr} -%\def\tabline{\parsearg\tablinezzz} -%\def\tablinezzz #1{\+#1\cr} -%\def\&{&} - % Tables -- @table, @ftable, @vtable, @item(x), @kitem(x), @xitem(x). % default indentation of table text @@ -1757,11 +1731,6 @@ \itemindex{#1}% \nobreak % This prevents a break before @itemx. % - % Be sure we are not still in the middle of a paragraph. - %{\parskip = 0in - %\par - %}% - % % If the item text does not fit in the space we have, put it on a line % by itself, and do not allow a page break either before or after that % line. We do not start a paragraph here because then if the next @@ -1790,13 +1759,17 @@ \itemxneedsnegativevskipfalse \else % The item text fits into the space. Start a paragraph, so that the - % following text (if any) will end up on the same line. Since that - % text will be indented by \tableindent, we make the item text be in - % a zero-width box. + % following text (if any) will end up on the same line. \noindent - \rlap{\hskip -\tableindent\box0}\ignorespaces% - \endgroup% - \itemxneedsnegativevskiptrue% + % Do this with kerns and \unhbox so that if there is a footnote in + % the item text, it can migrate to the main vertical list and + % eventually be printed. + \nobreak\kern-\tableindent + \dimen0 = \itemmax \advance\dimen0 by \itemmargin \advance\dimen0 by -\wd0 + \unhbox0 + \nobreak\kern\dimen0 + \endgroup + \itemxneedsnegativevskiptrue \fi } @@ -1807,9 +1780,10 @@ \def\xitem{\errmessage{@xitem while not in a table}} \def\xitemx{\errmessage{@xitemx while not in a table}} -%% Contains a kludge to get @end[description] to work +% Contains a kludge to get @end[description] to work. \def\description{\tablez{\dontindex}{1}{}{}{}{}} +% @table, @ftable, @vtable. \def\table{\begingroup\inENV\obeylines\obeyspaces\tablex} {\obeylines\obeyspaces% \gdef\tablex #1^^M{% @@ -1869,7 +1843,7 @@ \def\itemize{\parsearg\itemizezzz} \def\itemizezzz #1{% - \begingroup % ended by the @end itemsize + \begingroup % ended by the @end itemize \itemizey {#1}{\Eitemize} } @@ -2082,46 +2056,60 @@ \multitablelinespace=0pt % Macros used to set up halign preamble: -% +% \let\endsetuptable\relax \def\xendsetuptable{\endsetuptable} \let\columnfractions\relax \def\xcolumnfractions{\columnfractions} \newif\ifsetpercent -% 2/1/96, to allow fractions to be given with more than one digit. -\def\pickupwholefraction#1 {\global\advance\colcount by1 % -\expandafter\xdef\csname col\the\colcount\endcsname{.#1\hsize}% -\setuptable} +% #1 is the part of the @columnfraction before the decimal point, which +% is presumably either 0 or the empty string (but we don't check, we +% just throw it away). #2 is the decimal part, which we use as the +% percent of \hsize for this column. +\def\pickupwholefraction#1.#2 {% + \global\advance\colcount by 1 + \expandafter\xdef\csname col\the\colcount\endcsname{.#2\hsize}% + \setuptable +} \newcount\colcount -\def\setuptable#1{\def\firstarg{#1}% -\ifx\firstarg\xendsetuptable\let\go\relax% -\else - \ifx\firstarg\xcolumnfractions\global\setpercenttrue% +\def\setuptable#1{% + \def\firstarg{#1}% + \ifx\firstarg\xendsetuptable + \let\go = \relax \else - \ifsetpercent - \let\go\pickupwholefraction % In this case arg of setuptable - % is the decimal point before the - % number given in percent of hsize. - % We don't need this so we don't use it. + \ifx\firstarg\xcolumnfractions + \global\setpercenttrue \else - \global\advance\colcount by1 - \setbox0=\hbox{#1 }% Add a normal word space as a separator; - % typically that is always in the input, anyway. - \expandafter\xdef\csname col\the\colcount\endcsname{\the\wd0}% + \ifsetpercent + \let\go\pickupwholefraction + \else + \global\advance\colcount by 1 + \setbox0=\hbox{#1\unskip }% Add a normal word space as a separator; + % typically that is always in the input, anyway. + \expandafter\xdef\csname col\the\colcount\endcsname{\the\wd0}% + \fi + \fi + \ifx\go\pickupwholefraction + % Put the argument back for the \pickupwholefraction call, so + % we'll always have a period there to be parsed. + \def\go{\pickupwholefraction#1}% + \else + \let\go = \setuptable \fi% - \fi% -\ifx\go\pickupwholefraction\else\let\go\setuptable\fi% -\fi\go} - -% multitable syntax -\def\tab{&\hskip1sp\relax} % 2/2/96 - % tiny skip here makes sure this column space is - % maintained, even if it is never used. + \fi + \go +} + +% This used to have \hskip1sp. But then the space in a template line is +% not enough. That is bad. So let's go back to just & until we +% encounter the problem it was intended to solve again. +% --karl, nathan@acm.org, 20apr99. +\def\tab{&} % @multitable ... @end multitable definitions: - +% \def\multitable{\parsearg\dotable} \def\dotable#1{\bgroup \vskip\parskip @@ -2160,15 +2148,15 @@ % In order to keep entries from bumping into each other % we will add a \leftskip of \multitablecolspace to all columns after % the first one. - % + % % If a template has been used, we will add \multitablecolspace % to the width of each template entry. - % + % % If the user has set preamble in terms of percent of \hsize we will % use that dimension as the width of the column, and the \leftskip % will keep entries from bumping into each other. Table will start at % left margin and final column will justify at right margin. - % + % % Make sure we don't inherit \rightskip from the outer environment. \rightskip=0pt \ifnum\colcount=1 @@ -2199,15 +2187,18 @@ % If so, do nothing. If not, give it an appropriate dimension based on % current baselineskip. \ifdim\multitablelinespace=0pt +\setbox0=\vbox{X}\global\multitablelinespace=\the\baselineskip +\global\advance\multitablelinespace by-\ht0 %% strut to put in table in case some entry doesn't have descenders, %% to keep lines equally spaced \let\multistrut = \strut +\else +%% FIXME: what is \box0 supposed to be? +\gdef\multistrut{\vrule height\multitablelinespace depth\dp0 +width0pt\relax} \fi %% Test to see if parskip is larger than space between lines of %% table. If not, do nothing. %% If so, set to same dimension as multitablelinespace. -\else -\gdef\multistrut{\vrule height\multitablelinespace depth\dp0 -width0pt\relax} \fi \ifdim\multitableparskip>\multitablelinespace \global\multitableparskip=\multitablelinespace \global\advance\multitableparskip-7pt %% to keep parskip somewhat smaller @@ -2220,6 +2211,356 @@ \fi} +\message{conditionals,} +% Prevent errors for section commands. +% Used in @ignore and in failing conditionals. +\def\ignoresections{% + \let\chapter=\relax + \let\unnumbered=\relax + \let\top=\relax + \let\unnumberedsec=\relax + \let\unnumberedsection=\relax + \let\unnumberedsubsec=\relax + \let\unnumberedsubsection=\relax + \let\unnumberedsubsubsec=\relax + \let\unnumberedsubsubsection=\relax + \let\section=\relax + \let\subsec=\relax + \let\subsubsec=\relax + \let\subsection=\relax + \let\subsubsection=\relax + \let\appendix=\relax + \let\appendixsec=\relax + \let\appendixsection=\relax + \let\appendixsubsec=\relax + \let\appendixsubsection=\relax + \let\appendixsubsubsec=\relax + \let\appendixsubsubsection=\relax + \let\contents=\relax + \let\smallbook=\relax + \let\titlepage=\relax +} + +% Used in nested conditionals, where we have to parse the Texinfo source +% and so want to turn off most commands, in case they are used +% incorrectly. +% +\def\ignoremorecommands{% + \let\defcodeindex = \relax + \let\defcv = \relax + \let\deffn = \relax + \let\deffnx = \relax + \let\defindex = \relax + \let\defivar = \relax + \let\defmac = \relax + \let\defmethod = \relax + \let\defop = \relax + \let\defopt = \relax + \let\defspec = \relax + \let\deftp = \relax + \let\deftypefn = \relax + \let\deftypefun = \relax + \let\deftypeivar = \relax + \let\deftypeop = \relax + \let\deftypevar = \relax + \let\deftypevr = \relax + \let\defun = \relax + \let\defvar = \relax + \let\defvr = \relax + \let\ref = \relax + \let\xref = \relax + \let\printindex = \relax + \let\pxref = \relax + \let\settitle = \relax + \let\setchapternewpage = \relax + \let\setchapterstyle = \relax + \let\everyheading = \relax + \let\evenheading = \relax + \let\oddheading = \relax + \let\everyfooting = \relax + \let\evenfooting = \relax + \let\oddfooting = \relax + \let\headings = \relax + \let\include = \relax + \let\lowersections = \relax + \let\down = \relax + \let\raisesections = \relax + \let\up = \relax + \let\set = \relax + \let\clear = \relax + \let\item = \relax +} + +% Ignore @ignore ... @end ignore. +% +\def\ignore{\doignore{ignore}} + +% Ignore @ifinfo, @ifhtml, @ifnottex, @html, @menu, and @direntry text. +% +\def\ifinfo{\doignore{ifinfo}} +\def\ifhtml{\doignore{ifhtml}} +\def\ifnottex{\doignore{ifnottex}} +\def\html{\doignore{html}} +\def\menu{\doignore{menu}} +\def\direntry{\doignore{direntry}} + +% @dircategory CATEGORY -- specify a category of the dir file +% which this file should belong to. Ignore this in TeX. +\let\dircategory = \comment + +% Ignore text until a line `@end #1'. +% +\def\doignore#1{\begingroup + % Don't complain about control sequences we have declared \outer. + \ignoresections + % + % Define a command to swallow text until we reach `@end #1'. + % This @ is a catcode 12 token (that is the normal catcode of @ in + % this texinfo.tex file). We change the catcode of @ below to match. + \long\def\doignoretext##1@end #1{\enddoignore}% + % + % Make sure that spaces turn into tokens that match what \doignoretext wants. + \catcode32 = 10 + % + % Ignore braces, too, so mismatched braces don't cause trouble. + \catcode`\{ = 9 + \catcode`\} = 9 + % + % We must not have @c interpreted as a control sequence. + \catcode`\@ = 12 + % + % Make the letter c a comment character so that the rest of the line + % will be ignored. This way, the document can have (for example) + % @c @end ifinfo + % and the @end ifinfo will be properly ignored. + % (We've just changed @ to catcode 12.) + \catcode`\c = 14 + % + % And now expand that command. + \doignoretext +} + +% What we do to finish off ignored text. +% +\def\enddoignore{\endgroup\ignorespaces}% + +\newif\ifwarnedobs\warnedobsfalse +\def\obstexwarn{% + \ifwarnedobs\relax\else + % We need to warn folks that they may have trouble with TeX 3.0. + % This uses \immediate\write16 rather than \message to get newlines. + \immediate\write16{} + \immediate\write16{WARNING: for users of Unix TeX 3.0!} + \immediate\write16{This manual trips a bug in TeX version 3.0 (tex hangs).} + \immediate\write16{If you are running another version of TeX, relax.} + \immediate\write16{If you are running Unix TeX 3.0, kill this TeX process.} + \immediate\write16{ Then upgrade your TeX installation if you can.} + \immediate\write16{ (See ftp://ftp.gnu.org/pub/gnu/TeX.README.)} + \immediate\write16{If you are stuck with version 3.0, run the} + \immediate\write16{ script ``tex3patch'' from the Texinfo distribution} + \immediate\write16{ to use a workaround.} + \immediate\write16{} + \global\warnedobstrue + \fi +} + +% **In TeX 3.0, setting text in \nullfont hangs tex. For a +% workaround (which requires the file ``dummy.tfm'' to be installed), +% uncomment the following line: +%%%%%\font\nullfont=dummy\let\obstexwarn=\relax + +% Ignore text, except that we keep track of conditional commands for +% purposes of nesting, up to an `@end #1' command. +% +\def\nestedignore#1{% + \obstexwarn + % We must actually expand the ignored text to look for the @end + % command, so that nested ignore constructs work. Thus, we put the + % text into a \vbox and then do nothing with the result. To minimize + % the change of memory overflow, we follow the approach outlined on + % page 401 of the TeXbook: make the current font be a dummy font. + % + \setbox0 = \vbox\bgroup + % Don't complain about control sequences we have declared \outer. + \ignoresections + % + % Define `@end #1' to end the box, which will in turn undefine the + % @end command again. + \expandafter\def\csname E#1\endcsname{\egroup\ignorespaces}% + % + % We are going to be parsing Texinfo commands. Most cause no + % trouble when they are used incorrectly, but some commands do + % complicated argument parsing or otherwise get confused, so we + % undefine them. + % + % We can't do anything about stray @-signs, unfortunately; + % they'll produce `undefined control sequence' errors. + \ignoremorecommands + % + % Set the current font to be \nullfont, a TeX primitive, and define + % all the font commands to also use \nullfont. We don't use + % dummy.tfm, as suggested in the TeXbook, because not all sites + % might have that installed. Therefore, math mode will still + % produce output, but that should be an extremely small amount of + % stuff compared to the main input. + % + \nullfont + \let\tenrm=\nullfont \let\tenit=\nullfont \let\tensl=\nullfont + \let\tenbf=\nullfont \let\tentt=\nullfont \let\smallcaps=\nullfont + \let\tensf=\nullfont + % Similarly for index fonts (mostly for their use in smallexample). + \let\smallrm=\nullfont \let\smallit=\nullfont \let\smallsl=\nullfont + \let\smallbf=\nullfont \let\smalltt=\nullfont \let\smallsc=\nullfont + \let\smallsf=\nullfont + % + % Don't complain when characters are missing from the fonts. + \tracinglostchars = 0 + % + % Don't bother to do space factor calculations. + \frenchspacing + % + % Don't report underfull hboxes. + \hbadness = 10000 + % + % Do minimal line-breaking. + \pretolerance = 10000 + % + % Do not execute instructions in @tex + \def\tex{\doignore{tex}}% + % Do not execute macro definitions. + % `c' is a comment character, so the word `macro' will get cut off. + \def\macro{\doignore{ma}}% +} + +% @set VAR sets the variable VAR to an empty value. +% @set VAR REST-OF-LINE sets VAR to the value REST-OF-LINE. +% +% Since we want to separate VAR from REST-OF-LINE (which might be +% empty), we can't just use \parsearg; we have to insert a space of our +% own to delimit the rest of the line, and then take it out again if we +% didn't need it. Make sure the catcode of space is correct to avoid +% losing inside @example, for instance. +% +\def\set{\begingroup\catcode` =10 + \catcode`\-=12 \catcode`\_=12 % Allow - and _ in VAR. + \parsearg\setxxx} +\def\setxxx#1{\setyyy#1 \endsetyyy} +\def\setyyy#1 #2\endsetyyy{% + \def\temp{#2}% + \ifx\temp\empty \global\expandafter\let\csname SET#1\endcsname = \empty + \else \setzzz{#1}#2\endsetzzz % Remove the trailing space \setxxx inserted. + \fi + \endgroup +} +% Can't use \xdef to pre-expand #2 and save some time, since \temp or +% \next or other control sequences that we've defined might get us into +% an infinite loop. Consider `@set foo @cite{bar}'. +\def\setzzz#1#2 \endsetzzz{\expandafter\gdef\csname SET#1\endcsname{#2}} + +% @clear VAR clears (i.e., unsets) the variable VAR. +% +\def\clear{\parsearg\clearxxx} +\def\clearxxx#1{\global\expandafter\let\csname SET#1\endcsname=\relax} + +% @value{foo} gets the text saved in variable foo. +{ + \catcode`\_ = \active + % + % We might end up with active _ or - characters in the argument if + % we're called from @code, as @code{@value{foo-bar_}}. So \let any + % such active characters to their normal equivalents. + \gdef\value{\begingroup + \catcode`\-=12 \catcode`\_=12 + \indexbreaks \let_\normalunderscore + \valuexxx} +} +\def\valuexxx#1{\expandablevalue{#1}\endgroup} + +% We have this subroutine so that we can handle at least some @value's +% properly in indexes (we \let\value to this in \indexdummies). Ones +% whose names contain - or _ still won't work, but we can't do anything +% about that. The command has to be fully expandable, since the result +% winds up in the index file. This means that if the variable's value +% contains other Texinfo commands, it's almost certain it will fail +% (although perhaps we could fix that with sufficient work to do a +% one-level expansion on the result, instead of complete). +% +\def\expandablevalue#1{% + \expandafter\ifx\csname SET#1\endcsname\relax + {[No value for ``#1'']}% + \else + \csname SET#1\endcsname + \fi +} + +% @ifset VAR ... @end ifset reads the `...' iff VAR has been defined +% with @set. +% +\def\ifset{\parsearg\ifsetxxx} +\def\ifsetxxx #1{% + \expandafter\ifx\csname SET#1\endcsname\relax + \expandafter\ifsetfail + \else + \expandafter\ifsetsucceed + \fi +} +\def\ifsetsucceed{\conditionalsucceed{ifset}} +\def\ifsetfail{\nestedignore{ifset}} +\defineunmatchedend{ifset} + +% @ifclear VAR ... @end ifclear reads the `...' iff VAR has never been +% defined with @set, or has been undefined with @clear. +% +\def\ifclear{\parsearg\ifclearxxx} +\def\ifclearxxx #1{% + \expandafter\ifx\csname SET#1\endcsname\relax + \expandafter\ifclearsucceed + \else + \expandafter\ifclearfail + \fi +} +\def\ifclearsucceed{\conditionalsucceed{ifclear}} +\def\ifclearfail{\nestedignore{ifclear}} +\defineunmatchedend{ifclear} + +% @iftex, @ifnothtml, @ifnotinfo always succeed; we read the text +% following, through the first @end iftex (etc.). Make `@end iftex' +% (etc.) valid only after an @iftex. +% +\def\iftex{\conditionalsucceed{iftex}} +\def\ifnothtml{\conditionalsucceed{ifnothtml}} +\def\ifnotinfo{\conditionalsucceed{ifnotinfo}} +\defineunmatchedend{iftex} +\defineunmatchedend{ifnothtml} +\defineunmatchedend{ifnotinfo} + +% We can't just want to start a group at @iftex (for example) and end it +% at @end iftex, since then @set commands inside the conditional have no +% effect (they'd get reverted at the end of the group). So we must +% define \Eiftex to redefine itself to be its previous value. (We can't +% just define it to fail again with an ``unmatched end'' error, since +% the @ifset might be nested.) +% +\def\conditionalsucceed#1{% + \edef\temp{% + % Remember the current value of \E#1. + \let\nece{prevE#1} = \nece{E#1}% + % + % At the `@end #1', redefine \E#1 to be its previous value. + \def\nece{E#1}{\let\nece{E#1} = \nece{prevE#1}}% + }% + \temp +} + +% We need to expand lots of \csname's, but we don't want to expand the +% control sequences after we've constructed them. +% +\def\nece#1{\expandafter\noexpand\csname#1\endcsname} + +% @defininfoenclose. +\let\definfoenclose=\comment + + \message{indexing,} % Index generation facilities @@ -2235,12 +2576,14 @@ % the file that accumulates this index. The file's extension is foo. % The name of an index should be no more than 2 characters long % for the sake of vms. - -\def\newindex #1{ -\expandafter\newwrite \csname#1indfile\endcsname% Define number for output file -\openout \csname#1indfile\endcsname \jobname.#1 % Open the file -\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex -\noexpand\doindex {#1}} +% +\def\newindex#1{% + \iflinks + \expandafter\newwrite \csname#1indfile\endcsname + \openout \csname#1indfile\endcsname \jobname.#1 % Open the file + \fi + \expandafter\xdef\csname#1index\endcsname{% % Define @#1index + \noexpand\doindex{#1}} } % @defindex foo == \newindex{foo} @@ -2249,31 +2592,37 @@ % Define @defcodeindex, like @defindex except put all entries in @code. -\def\newcodeindex #1{ -\expandafter\newwrite \csname#1indfile\endcsname% Define number for output file -\openout \csname#1indfile\endcsname \jobname.#1 % Open the file -\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex -\noexpand\docodeindex {#1}} +\def\newcodeindex#1{% + \iflinks + \expandafter\newwrite \csname#1indfile\endcsname + \openout \csname#1indfile\endcsname \jobname.#1 + \fi + \expandafter\xdef\csname#1index\endcsname{% + \noexpand\docodeindex{#1}} } \def\defcodeindex{\parsearg\newcodeindex} % @synindex foo bar makes index foo feed into index bar. % Do this instead of @defindex foo if you don't want it as a separate index. -\def\synindex #1 #2 {% -\expandafter\let\expandafter\synindexfoo\expandafter=\csname#2indfile\endcsname -\expandafter\let\csname#1indfile\endcsname=\synindexfoo -\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex -\noexpand\doindex {#2}}% +% The \closeout helps reduce unnecessary open files; the limit on the +% Acorn RISC OS is a mere 16 files. +\def\synindex#1 #2 {% + \expandafter\let\expandafter\synindexfoo\expandafter=\csname#2indfile\endcsname + \expandafter\closeout\csname#1indfile\endcsname + \expandafter\let\csname#1indfile\endcsname=\synindexfoo + \expandafter\xdef\csname#1index\endcsname{% define \xxxindex + \noexpand\doindex{#2}}% } % @syncodeindex foo bar similar, but put all entries made for index foo % inside @code. -\def\syncodeindex #1 #2 {% -\expandafter\let\expandafter\synindexfoo\expandafter=\csname#2indfile\endcsname -\expandafter\let\csname#1indfile\endcsname=\synindexfoo -\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex -\noexpand\docodeindex {#2}}% +\def\syncodeindex#1 #2 {% + \expandafter\let\expandafter\synindexfoo\expandafter=\csname#2indfile\endcsname + \expandafter\closeout\csname#1indfile\endcsname + \expandafter\let\csname#1indfile\endcsname=\synindexfoo + \expandafter\xdef\csname#1index\endcsname{% define \xxxindex + \noexpand\docodeindex{#2}}% } % Define \doindex, the driver for all \fooindex macros. @@ -2294,6 +2643,7 @@ \def\singlecodeindexer #1{\doind{\indexname}{\code{#1}}} \def\indexdummies{% +\def\ { }% % Take care of the plain tex accent commands. \def\"{\realbackslash "}% \def\`{\realbackslash `}% @@ -2323,8 +2673,11 @@ % (Must be a way to avoid doing expansion at all, and thus not have to % laboriously list every single command here.) \def\@{@}% will be @@ when we switch to @ as escape char. -%\let\{ = \lbracecmd -%\let\} = \rbracecmd +% Need these in case \tex is in effect and \{ is a \delimiter again. +% But can't use \lbracecmd and \rbracecmd because texindex assumes +% braces and backslashes are used only as delimiters. +\let\{ = \mylbrace +\let\} = \myrbrace \def\_{{\realbackslash _}}% \def\w{\realbackslash w }% \def\bf{\realbackslash bf }% @@ -2335,7 +2688,6 @@ \def\gtr{\realbackslash gtr}% \def\less{\realbackslash less}% \def\hat{\realbackslash hat}% -%\def\char{\realbackslash char}% \def\TeX{\realbackslash TeX}% \def\dots{\realbackslash dots }% \def\result{\realbackslash result}% @@ -2347,6 +2699,11 @@ \def\copyright{\realbackslash copyright}% \def\tclose##1{\realbackslash tclose {##1}}% \def\code##1{\realbackslash code {##1}}% +\def\uref##1{\realbackslash uref {##1}}% +\def\url##1{\realbackslash url {##1}}% +\def\env##1{\realbackslash env {##1}}% +\def\command##1{\realbackslash command {##1}}% +\def\option##1{\realbackslash option {##1}}% \def\dotless##1{\realbackslash dotless {##1}}% \def\samp##1{\realbackslash samp {##1}}% \def\,##1{\realbackslash ,{##1}}% @@ -2362,8 +2719,16 @@ \def\kbd##1{\realbackslash kbd {##1}}% \def\dfn##1{\realbackslash dfn {##1}}% \def\emph##1{\realbackslash emph {##1}}% -\def\value##1{\realbackslash value {##1}}% +\def\acronym##1{\realbackslash acronym {##1}}% +% +% Handle some cases of @value -- where the variable name does not +% contain - or _, and the value does not contain any +% (non-fully-expandable) commands. +\let\value = \expandablevalue +% \unsepspaces +% Turn off macro expansion +\turnoffmacros } % If an index command is used in an @example environment, any spaces @@ -2420,6 +2785,12 @@ %\let\tt=\indexdummyfont \let\tclose=\indexdummyfont \let\code=\indexdummyfont +\let\url=\indexdummyfont +\let\uref=\indexdummyfont +\let\env=\indexdummyfont +\let\acronym=\indexdummyfont +\let\command=\indexdummyfont +\let\option=\indexdummyfont \let\file=\indexdummyfont \let\samp=\indexdummyfont \let\kbd=\indexdummyfont @@ -2435,14 +2806,24 @@ % so we do not become unable to do a definition. {\catcode`\@=0 \catcode`\\=\other -@gdef@realbackslash{\}} + @gdef@realbackslash{\}} \let\indexbackslash=0 %overridden during \printindex. - -\let\SETmarginindex=\relax %initialize! -% workhorse for all \fooindexes -% #1 is name of index, #2 is stuff to put there -\def\doind #1#2{% +\let\SETmarginindex=\relax % put index entries in margin (undocumented)? + +% For \ifx comparisons. +\def\emptymacro{\empty} + +% Most index entries go through here, but \dosubind is the general case. +% +\def\doind#1#2{\dosubind{#1}{#2}\empty} + +% Workhorse for all \fooindexes. +% #1 is name of index, #2 is stuff to put there, #3 is subentry -- +% \empty if called from \doind, as we usually are. The main exception +% is with defuns, which call us directly. +% +\def\dosubind#1#2#3{% % Put the index entry in the margin if desired. \ifx\SETmarginindex\relax\else \insert\margin{\hbox{\vrule height8pt depth3pt width0pt #2}}% @@ -2453,48 +2834,75 @@ \indexdummies % Must do this here, since \bf, etc expand at this stage \escapechar=`\\ {% - \let\folio=0% We will expand all macros now EXCEPT \folio. + \let\folio = 0% We will expand all macros now EXCEPT \folio. \def\rawbackslashxx{\indexbackslash}% \indexbackslash isn't defined now % so it will be output as is; and it will print as backslash. % - % First process the index-string with all font commands turned off - % to get the string to sort by. - {\indexnofonts \xdef\indexsorttmp{#2}}% + \def\thirdarg{#3}% + % + % If third arg is present, precede it with space in sort key. + \ifx\thirdarg\emptymacro + \let\subentry = \empty + \else + \def\subentry{ #3}% + \fi + % + % First process the index entry with all font commands turned + % off to get the string to sort by. + {\indexnofonts \xdef\indexsorttmp{#2\subentry}}% % - % Now produce the complete index entry, with both the sort key and the - % original text, including any font commands. + % Now the real index entry with the fonts. \toks0 = {#2}% + % + % If third (subentry) arg is present, add it to the index + % string. And include a space. + \ifx\thirdarg\emptymacro \else + \toks0 = \expandafter{\the\toks0 \space #3}% + \fi + % + % Set up the complete index entry, with both the sort key + % and the original text, including any font commands. We write + % three arguments to \entry to the .?? file, texindex reduces to + % two when writing the .??s sorted result. \edef\temp{% \write\csname#1indfile\endcsname{% \realbackslash entry{\indexsorttmp}{\folio}{\the\toks0}}% }% - \temp + % + % If a skip is the last thing on the list now, preserve it + % by backing up by \lastskip, doing the \write, then inserting + % the skip again. Otherwise, the whatsit generated by the + % \write will make \lastskip zero. The result is that sequences + % like this: + % @end defun + % @tindex whatever + % @defun ... + % will have extra space inserted, because the \medbreak in the + % start of the @defun won't see the skip inserted by the @end of + % the previous defun. + % + % But don't do any of this if we're not in vertical mode. We + % don't want to do a \vskip and prematurely end a paragraph. + % + % Avoid page breaks due to these extra skips, too. + % + \iflinks + \ifvmode + \skip0 = \lastskip + \ifdim\lastskip = 0pt \else \nobreak\vskip-\lastskip \fi + \fi + % + \temp % do the write + % + % + \ifvmode \ifdim\skip0 = 0pt \else \nobreak\vskip\skip0 \fi \fi + \fi }% }% \penalty\count255 }% } -\def\dosubind #1#2#3{% -{\count10=\lastpenalty % -{\indexdummies % Must do this here, since \bf, etc expand at this stage -\escapechar=`\\% -{\let\folio=0% -\def\rawbackslashxx{\indexbackslash}% -% -% Now process the index-string once, with all font commands turned off, -% to get the string to sort the index by. -{\indexnofonts -\xdef\temp1{#2 #3}% -}% -% Now produce the complete index entry. We process the index-string again, -% this time with font commands expanded, to get what to print in the index. -\edef\temp{% -\write \csname#1indfile\endcsname{% -\realbackslash entry {\temp1}{\folio}{#2}{#3}}}% -\temp }% -}\penalty\count10}} - % The index entry written in the file actually looks like % \entry {sortstring}{page}{topic} % or @@ -2534,7 +2942,7 @@ \def\doprintindex#1{\begingroup \dobreak \chapheadingskip{10000}% % - \indexfonts \rm + \smallfonts \rm \tolerance = 9500 \indexbreaks % @@ -2550,7 +2958,7 @@ % and it loses the chapter title and the aux file entries for the % index. The easiest way to prevent this problem is to make sure % there is some text. - (Index is nonexistent) + \putwordIndexNonexistent \else % % If the index file exists but is empty, then \openin leaves \ifeof @@ -2558,7 +2966,7 @@ % it can discover if there is anything in it. \read 1 to \temp \ifeof 1 - (Index is empty) + \putwordIndexIsEmpty \else % Index files are almost Texinfo source, but we use \ as the escape % character. It would be better to use @, but that's too big a change @@ -2577,21 +2985,35 @@ % These macros are used by the sorted index file itself. % Change them to control the appearance of the index. -% Same as \bigskipamount except no shrink. -% \balancecolumns gets confused if there is any shrink. -\newskip\initialskipamount \initialskipamount 12pt plus4pt - -\def\initial #1{% -{\let\tentt=\sectt \let\tt=\sectt \let\sf=\sectt -\ifdim\lastskip<\initialskipamount -\removelastskip \penalty-200 \vskip \initialskipamount\fi -\line{\secbf#1\hfill}\kern 2pt\penalty10000}} +\def\initial#1{{% + % Some minor font changes for the special characters. + \let\tentt=\sectt \let\tt=\sectt \let\sf=\sectt + % + % Remove any glue we may have, we'll be inserting our own. + \removelastskip + % + % We like breaks before the index initials, so insert a bonus. + \penalty -300 + % + % Typeset the initial. Making this add up to a whole number of + % baselineskips increases the chance of the dots lining up from column + % to column. It still won't often be perfect, because of the stretch + % we need before each entry, but it's better. + % + % No shrink because it confuses \balancecolumns. + \vskip 1.67\baselineskip plus .5\baselineskip + \leftline{\secbf #1}% + \vskip .33\baselineskip plus .1\baselineskip + % + % Do our best not to break after the initial. + \nobreak +}} % This typesets a paragraph consisting of #1, dot leaders, and then #2 % flush to the right margin. It is used for index and table of contents % entries. The paragraph is indented by \leftskip. % -\def\entry #1#2{\begingroup +\def\entry#1#2{\begingroup % % Start a new paragraph if necessary, so our assignments below can't % affect previous text. @@ -2614,12 +3036,15 @@ % % \hangafter is reset to 1 (which is the value we want) at the start % of each paragraph, so we need not do anything with that. - \hangindent=2em + \hangindent = 2em % % When the entry text needs to be broken, just fill out the first line % with blank space. \rightskip = 0pt plus1fil % + % A bit of stretch before each entry for the benefit of balancing columns. + \vskip 0pt plus1pt + % % Start a ``paragraph'' for the index entry so the line breaking % parameters we've set above will have an effect. \noindent @@ -2644,7 +3069,11 @@ % The `\ ' here is removed by the implicit \unskip that TeX does as % part of (the primitive) \par. Without it, a spurious underfull % \hbox ensues. - \ #2% The page number ends the paragraph. + \ifpdf + \pdfgettoks#2.\ \the\toksA % The page number ends the paragraph. + \else + \ #2% The page number ends the paragraph. + \fi \fi% \par \endgroup} @@ -2673,24 +3102,26 @@ \def\begindoublecolumns{\begingroup % ended by \enddoublecolumns % Grab any single-column material above us. - \output = {\global\setbox\partialpage = \vbox{% - % + \output = {% + % % Here is a possibility not foreseen in manmac: if we accumulate a % whole lot of material, we might end up calling this \output % routine twice in a row (see the doublecol-lose test, which is % essentially a couple of indexes with @setchapternewpage off). In - % that case, we must prevent the second \partialpage from - % simply overwriting the first, causing us to lose the page. - % This will preserve it until a real output routine can ship it - % out. Generally, \partialpage will be empty when this runs and - % this will be a no-op. - \unvbox\partialpage + % that case we just ship out what is in \partialpage with the normal + % output routine. Generally, \partialpage will be empty when this + % runs and this will be a no-op. See the indexspread.tex test case. + \ifvoid\partialpage \else + \onepageout{\pagecontents\partialpage}% + \fi % - % Unvbox the main output page. - \unvbox255 - \kern-\topskip \kern\baselineskip - }}% - \eject + \global\setbox\partialpage = \vbox{% + % Unvbox the main output page. + \unvbox\PAGE + \kern-\topskip \kern\baselineskip + }% + }% + \eject % run that output routine to set \partialpage % % Use the double-column output routine for subsequent pages. \output = {\doublecolumnout}% @@ -2718,14 +3149,21 @@ % % Double the \vsize as well. (We don't need a separate register here, % since nobody clobbers \vsize.) + \advance\vsize by -\ht\partialpage \vsize = 2\vsize } + +% The double-column output routine for all double-column pages except +% the last. +% \def\doublecolumnout{% \splittopskip=\topskip \splitmaxdepth=\maxdepth % Get the available space for the double columns -- the normal % (undoubled) page height minus any material left over from the % previous page. - \dimen@=\pageheight \advance\dimen@ by-\ht\partialpage + \dimen@ = \vsize + \divide\dimen@ by 2 + % % box0 will be the left-hand column, box2 the right. \setbox0=\vsplit255 to\dimen@ \setbox2=\vsplit255 to\dimen@ \onepageout\pagesofar @@ -2734,42 +3172,67 @@ } \def\pagesofar{% % Re-output the contents of the output page -- any previous material, - % followed by the two boxes we just split. + % followed by the two boxes we just split, in box0 and box2. \unvbox\partialpage + % \hsize = \doublecolumnhsize - \wd0=\hsize \wd2=\hsize \hbox to\pagewidth{\box0\hfil\box2}% + \wd0=\hsize \wd2=\hsize + \hbox to\pagewidth{\box0\hfil\box2}% } \def\enddoublecolumns{% - \output = {\balancecolumns}\eject % split what we have + \output = {% + % Split the last of the double-column material. Leave it on the + % current page, no automatic page break. + \balancecolumns + % + % If we end up splitting too much material for the current page, + % though, there will be another page break right after this \output + % invocation ends. Having called \balancecolumns once, we do not + % want to call it again. Therefore, reset \output to its normal + % definition right away. (We hope \balancecolumns will never be + % called on to balance too much material, but if it is, this makes + % the output somewhat more palatable.) + \global\output = {\onepageout{\pagecontents\PAGE}}% + }% + \eject \endgroup % started in \begindoublecolumns % - % Back to normal single-column typesetting, but take account of the - % fact that we just accumulated some stuff on the output page. + % \pagegoal was set to the doubled \vsize above, since we restarted + % the current page. We're now back to normal single-column + % typesetting, so reset \pagegoal to the normal \vsize (after the + % \endgroup where \vsize got restored). \pagegoal = \vsize } \def\balancecolumns{% % Called at the end of the double column material. - \setbox0 = \vbox{\unvbox255}% + \setbox0 = \vbox{\unvbox255}% like \box255 but more efficient, see p.120. \dimen@ = \ht0 \advance\dimen@ by \topskip \advance\dimen@ by-\baselineskip - \divide\dimen@ by 2 + \divide\dimen@ by 2 % target to split to + %debug\message{final 2-column material height=\the\ht0, target=\the\dimen@.}% \splittopskip = \topskip % Loop until we get a decent breakpoint. - {\vbadness=10000 \loop - \global\setbox3=\copy0 - \global\setbox1=\vsplit3 to\dimen@ - \ifdim\ht3>\dimen@ \global\advance\dimen@ by1pt - \repeat}% + {% + \vbadness = 10000 + \loop + \global\setbox3 = \copy0 + \global\setbox1 = \vsplit3 to \dimen@ + \ifdim\ht3>\dimen@ + \global\advance\dimen@ by 1pt + \repeat + }% + %debug\message{split to \the\dimen@, column heights: \the\ht1, \the\ht3.}% \setbox0=\vbox to\dimen@{\unvbox1}% \setbox2=\vbox to\dimen@{\unvbox3}% + % \pagesofar } \catcode`\@ = \other \message{sectioning,} -% Define chapters, sections, etc. +% Chapters, sections, etc. \newcount\chapno \newcount\secno \secno=0 @@ -2778,58 +3241,48 @@ % This counter is funny since it counts through charcodes of letters A, B, ... \newcount\appendixno \appendixno = `\@ -\def\appendixletter{\char\the\appendixno} - -\newwrite\contentsfile -% This is called from \setfilename. -\def\opencontents{\openout\contentsfile = \jobname.toc } +% \def\appendixletter{\char\the\appendixno} +% We do the following for the sake of pdftex, which needs the actual +% letter in the expansion, not just typeset. +\def\appendixletter{% + \ifnum\appendixno=`A A% + \else\ifnum\appendixno=`B B% + \else\ifnum\appendixno=`C C% + \else\ifnum\appendixno=`D D% + \else\ifnum\appendixno=`E E% + \else\ifnum\appendixno=`F F% + \else\ifnum\appendixno=`G G% + \else\ifnum\appendixno=`H H% + \else\ifnum\appendixno=`I I% + \else\ifnum\appendixno=`J J% + \else\ifnum\appendixno=`K K% + \else\ifnum\appendixno=`L L% + \else\ifnum\appendixno=`M M% + \else\ifnum\appendixno=`N N% + \else\ifnum\appendixno=`O O% + \else\ifnum\appendixno=`P P% + \else\ifnum\appendixno=`Q Q% + \else\ifnum\appendixno=`R R% + \else\ifnum\appendixno=`S S% + \else\ifnum\appendixno=`T T% + \else\ifnum\appendixno=`U U% + \else\ifnum\appendixno=`V V% + \else\ifnum\appendixno=`W W% + \else\ifnum\appendixno=`X X% + \else\ifnum\appendixno=`Y Y% + \else\ifnum\appendixno=`Z Z% + % The \the is necessary, despite appearances, because \appendixletter is + % expanded while writing the .toc file. \char\appendixno is not + % expandable, thus it is written literally, thus all appendixes come out + % with the same letter (or @) in the toc without it. + \else\char\the\appendixno + \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi + \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi} % Each @chapter defines this as the name of the chapter. -% page headings and footings can use it. @section does likewise - -\def\thischapter{} \def\thissection{} -\def\seccheck#1{\ifnum \pageno<0 - \errmessage{@#1 not allowed after generating table of contents}% -\fi} - -\def\chapternofonts{% - \let\rawbackslash=\relax - \let\frenchspacing=\relax - \def\result{\realbackslash result}% - \def\equiv{\realbackslash equiv}% - \def\expansion{\realbackslash expansion}% - \def\print{\realbackslash print}% - \def\TeX{\realbackslash TeX}% - \def\dots{\realbackslash dots}% - \def\result{\realbackslash result}% - \def\equiv{\realbackslash equiv}% - \def\expansion{\realbackslash expansion}% - \def\print{\realbackslash print}% - \def\error{\realbackslash error}% - \def\point{\realbackslash point}% - \def\copyright{\realbackslash copyright}% - \def\tt{\realbackslash tt}% - \def\bf{\realbackslash bf}% - \def\w{\realbackslash w}% - \def\less{\realbackslash less}% - \def\gtr{\realbackslash gtr}% - \def\hat{\realbackslash hat}% - \def\char{\realbackslash char}% - \def\tclose##1{\realbackslash tclose{##1}}% - \def\code##1{\realbackslash code{##1}}% - \def\samp##1{\realbackslash samp{##1}}% - \def\r##1{\realbackslash r{##1}}% - \def\b##1{\realbackslash b{##1}}% - \def\key##1{\realbackslash key{##1}}% - \def\file##1{\realbackslash file{##1}}% - \def\kbd##1{\realbackslash kbd{##1}}% - % These are redefined because @smartitalic wouldn't work inside xdef. - \def\i##1{\realbackslash i{##1}}% - \def\cite##1{\realbackslash cite{##1}}% - \def\var##1{\realbackslash var{##1}}% - \def\emph##1{\realbackslash emph{##1}}% - \def\dfn##1{\realbackslash dfn{##1}}% -} +% page headings and footings can use it. @section does likewise. +\def\thischapter{} +\def\thissection{} \newcount\absseclevel % used to calculate proper heading level \newcount\secbase\secbase=0 % @raise/lowersections modify this count @@ -2901,59 +3354,59 @@ \fi } - +% @chapter, @appendix, @unnumbered. \def\thischaptername{No Chapter Title} \outer\def\chapter{\parsearg\chapteryyy} \def\chapteryyy #1{\numhead0{#1}} % normally numhead0 calls chapterzzz -\def\chapterzzz #1{\seccheck{chapter}% +\def\chapterzzz #1{% \secno=0 \subsecno=0 \subsubsecno=0 -\global\advance \chapno by 1 \message{\putwordChapter \the\chapno}% +\global\advance \chapno by 1 \message{\putwordChapter\space \the\chapno}% \chapmacro {#1}{\the\chapno}% \gdef\thissection{#1}% \gdef\thischaptername{#1}% % We don't substitute the actual chapter name into \thischapter % because we don't want its macros evaluated now. \xdef\thischapter{\putwordChapter{} \the\chapno: \noexpand\thischaptername}% -{\chapternofonts% \toks0 = {#1}% -\edef\temp{{\realbackslash chapentry{\the\toks0}{\the\chapno}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\donoderef % +\edef\temp{\noexpand\writetocentry{\realbackslash chapentry{\the\toks0}% + {\the\chapno}}}% +\temp +\donoderef \global\let\section = \numberedsec \global\let\subsection = \numberedsubsec \global\let\subsubsection = \numberedsubsubsec -}} +} \outer\def\appendix{\parsearg\appendixyyy} \def\appendixyyy #1{\apphead0{#1}} % normally apphead0 calls appendixzzz -\def\appendixzzz #1{\seccheck{appendix}% +\def\appendixzzz #1{% \secno=0 \subsecno=0 \subsubsecno=0 -\global\advance \appendixno by 1 \message{Appendix \appendixletter}% +\global\advance \appendixno by 1 +\message{\putwordAppendix\space \appendixletter}% \chapmacro {#1}{\putwordAppendix{} \appendixletter}% \gdef\thissection{#1}% \gdef\thischaptername{#1}% \xdef\thischapter{\putwordAppendix{} \appendixletter: \noexpand\thischaptername}% -{\chapternofonts% \toks0 = {#1}% -\edef\temp{{\realbackslash chapentry{\the\toks0}% - {\putwordAppendix{} \appendixletter}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\appendixnoderef % +\edef\temp{\noexpand\writetocentry{\realbackslash chapentry{\the\toks0}% + {\putwordAppendix{} \appendixletter}}}% +\temp +\appendixnoderef \global\let\section = \appendixsec \global\let\subsection = \appendixsubsec \global\let\subsubsection = \appendixsubsubsec -}} +} % @centerchap is like @unnumbered, but the heading is centered. \outer\def\centerchap{\parsearg\centerchapyyy} \def\centerchapyyy #1{{\let\unnumbchapmacro=\centerchapmacro \unnumberedyyy{#1}}} +% @top is like @unnumbered. \outer\def\top{\parsearg\unnumberedyyy} + \outer\def\unnumbered{\parsearg\unnumberedyyy} \def\unnumberedyyy #1{\unnmhead0{#1}} % normally unnmhead0 calls unnumberedzzz -\def\unnumberedzzz #1{\seccheck{unnumbered}% +\def\unnumberedzzz #1{% \secno=0 \subsecno=0 \subsubsecno=0 % % This used to be simply \message{#1}, but TeX fully expands the @@ -2965,155 +3418,139 @@ % Anyway, we don't want the fully-expanded definition of @cite to appear % as a result of the \message, we just want `@cite' itself. We use % \the<toks register> to achieve this: TeX expands \the<toks> only once, -% simply yielding the contents of the <toks register>. +% simply yielding the contents of <toks register>. (We also do this for +% the toc entries.) \toks0 = {#1}\message{(\the\toks0)}% % \unnumbchapmacro {#1}% \gdef\thischapter{#1}\gdef\thissection{#1}% -{\chapternofonts% \toks0 = {#1}% -\edef\temp{{\realbackslash unnumbchapentry{\the\toks0}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\unnumbnoderef % +\edef\temp{\noexpand\writetocentry{\realbackslash unnumbchapentry{\the\toks0}}}% +\temp +\unnumbnoderef \global\let\section = \unnumberedsec \global\let\subsection = \unnumberedsubsec \global\let\subsubsection = \unnumberedsubsubsec -}} - +} + +% Sections. \outer\def\numberedsec{\parsearg\secyyy} \def\secyyy #1{\numhead1{#1}} % normally calls seczzz -\def\seczzz #1{\seccheck{section}% +\def\seczzz #1{% \subsecno=0 \subsubsecno=0 \global\advance \secno by 1 % \gdef\thissection{#1}\secheading {#1}{\the\chapno}{\the\secno}% -{\chapternofonts% \toks0 = {#1}% -\edef\temp{{\realbackslash secentry % -{\the\toks0}{\the\chapno}{\the\secno}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\donoderef % -\penalty 10000 % -}} +\edef\temp{\noexpand\writetocentry{\realbackslash secentry{\the\toks0}% + {\the\chapno}{\the\secno}}}% +\temp +\donoderef +\nobreak +} \outer\def\appendixsection{\parsearg\appendixsecyyy} \outer\def\appendixsec{\parsearg\appendixsecyyy} \def\appendixsecyyy #1{\apphead1{#1}} % normally calls appendixsectionzzz -\def\appendixsectionzzz #1{\seccheck{appendixsection}% +\def\appendixsectionzzz #1{% \subsecno=0 \subsubsecno=0 \global\advance \secno by 1 % \gdef\thissection{#1}\secheading {#1}{\appendixletter}{\the\secno}% -{\chapternofonts% \toks0 = {#1}% -\edef\temp{{\realbackslash secentry % -{\the\toks0}{\appendixletter}{\the\secno}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\appendixnoderef % -\penalty 10000 % -}} +\edef\temp{\noexpand\writetocentry{\realbackslash secentry{\the\toks0}% + {\appendixletter}{\the\secno}}}% +\temp +\appendixnoderef +\nobreak +} \outer\def\unnumberedsec{\parsearg\unnumberedsecyyy} \def\unnumberedsecyyy #1{\unnmhead1{#1}} % normally calls unnumberedseczzz -\def\unnumberedseczzz #1{\seccheck{unnumberedsec}% +\def\unnumberedseczzz #1{% \plainsecheading {#1}\gdef\thissection{#1}% -{\chapternofonts% \toks0 = {#1}% -\edef\temp{{\realbackslash unnumbsecentry{\the\toks0}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\unnumbnoderef % -\penalty 10000 % -}} - +\edef\temp{\noexpand\writetocentry{\realbackslash unnumbsecentry{\the\toks0}}}% +\temp +\unnumbnoderef +\nobreak +} + +% Subsections. \outer\def\numberedsubsec{\parsearg\numberedsubsecyyy} \def\numberedsubsecyyy #1{\numhead2{#1}} % normally calls numberedsubseczzz -\def\numberedsubseczzz #1{\seccheck{subsection}% +\def\numberedsubseczzz #1{% \gdef\thissection{#1}\subsubsecno=0 \global\advance \subsecno by 1 % \subsecheading {#1}{\the\chapno}{\the\secno}{\the\subsecno}% -{\chapternofonts% \toks0 = {#1}% -\edef\temp{{\realbackslash subsecentry % -{\the\toks0}{\the\chapno}{\the\secno}{\the\subsecno}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\donoderef % -\penalty 10000 % -}} +\edef\temp{\noexpand\writetocentry{\realbackslash subsecentry{\the\toks0}% + {\the\chapno}{\the\secno}{\the\subsecno}}}% +\temp +\donoderef +\nobreak +} \outer\def\appendixsubsec{\parsearg\appendixsubsecyyy} \def\appendixsubsecyyy #1{\apphead2{#1}} % normally calls appendixsubseczzz -\def\appendixsubseczzz #1{\seccheck{appendixsubsec}% +\def\appendixsubseczzz #1{% \gdef\thissection{#1}\subsubsecno=0 \global\advance \subsecno by 1 % \subsecheading {#1}{\appendixletter}{\the\secno}{\the\subsecno}% -{\chapternofonts% \toks0 = {#1}% -\edef\temp{{\realbackslash subsecentry % -{\the\toks0}{\appendixletter}{\the\secno}{\the\subsecno}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\appendixnoderef % -\penalty 10000 % -}} +\edef\temp{\noexpand\writetocentry{\realbackslash subsecentry{\the\toks0}% + {\appendixletter}{\the\secno}{\the\subsecno}}}% +\temp +\appendixnoderef +\nobreak +} \outer\def\unnumberedsubsec{\parsearg\unnumberedsubsecyyy} \def\unnumberedsubsecyyy #1{\unnmhead2{#1}} %normally calls unnumberedsubseczzz -\def\unnumberedsubseczzz #1{\seccheck{unnumberedsubsec}% +\def\unnumberedsubseczzz #1{% \plainsubsecheading {#1}\gdef\thissection{#1}% -{\chapternofonts% \toks0 = {#1}% -\edef\temp{{\realbackslash unnumbsubsecentry{\the\toks0}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\unnumbnoderef % -\penalty 10000 % -}} - +\edef\temp{\noexpand\writetocentry{\realbackslash unnumbsubsecentry% + {\the\toks0}}}% +\temp +\unnumbnoderef +\nobreak +} + +% Subsubsections. \outer\def\numberedsubsubsec{\parsearg\numberedsubsubsecyyy} \def\numberedsubsubsecyyy #1{\numhead3{#1}} % normally numberedsubsubseczzz -\def\numberedsubsubseczzz #1{\seccheck{subsubsection}% +\def\numberedsubsubseczzz #1{% \gdef\thissection{#1}\global\advance \subsubsecno by 1 % \subsubsecheading {#1} {\the\chapno}{\the\secno}{\the\subsecno}{\the\subsubsecno}% -{\chapternofonts% \toks0 = {#1}% -\edef\temp{{\realbackslash subsubsecentry{\the\toks0} - {\the\chapno}{\the\secno}{\the\subsecno}{\the\subsubsecno} - {\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\donoderef % -\penalty 10000 % -}} +\edef\temp{\noexpand\writetocentry{\realbackslash subsubsecentry{\the\toks0}% + {\the\chapno}{\the\secno}{\the\subsecno}{\the\subsubsecno}}}% +\temp +\donoderef +\nobreak +} \outer\def\appendixsubsubsec{\parsearg\appendixsubsubsecyyy} \def\appendixsubsubsecyyy #1{\apphead3{#1}} % normally appendixsubsubseczzz -\def\appendixsubsubseczzz #1{\seccheck{appendixsubsubsec}% +\def\appendixsubsubseczzz #1{% \gdef\thissection{#1}\global\advance \subsubsecno by 1 % \subsubsecheading {#1} {\appendixletter}{\the\secno}{\the\subsecno}{\the\subsubsecno}% -{\chapternofonts% \toks0 = {#1}% -\edef\temp{{\realbackslash subsubsecentry{\the\toks0}% - {\appendixletter} - {\the\secno}{\the\subsecno}{\the\subsubsecno}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\appendixnoderef % -\penalty 10000 % -}} +\edef\temp{\noexpand\writetocentry{\realbackslash subsubsecentry{\the\toks0}% + {\appendixletter}{\the\secno}{\the\subsecno}{\the\subsubsecno}}}% +\temp +\appendixnoderef +\nobreak +} \outer\def\unnumberedsubsubsec{\parsearg\unnumberedsubsubsecyyy} \def\unnumberedsubsubsecyyy #1{\unnmhead3{#1}} %normally unnumberedsubsubseczzz -\def\unnumberedsubsubseczzz #1{\seccheck{unnumberedsubsubsec}% +\def\unnumberedsubsubseczzz #1{% \plainsubsubsecheading {#1}\gdef\thissection{#1}% -{\chapternofonts% \toks0 = {#1}% -\edef\temp{{\realbackslash unnumbsubsubsecentry{\the\toks0}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\unnumbnoderef % -\penalty 10000 % -}} +\edef\temp{\noexpand\writetocentry{\realbackslash unnumbsubsubsecentry% + {\the\toks0}}}% +\temp +\unnumbnoderef +\nobreak +} % These are variants which are not "outer", so they can appear in @ifinfo. % Actually, they should now be obsolete; ordinary section commands should work. @@ -3142,8 +3579,7 @@ % Define @majorheading, @heading and @subheading -% NOTE on use of \vbox for chapter headings, section headings, and -% such: +% NOTE on use of \vbox for chapter headings, section headings, and such: % 1) We use \vbox rather than the earlier \line to permit % overlong headings to fold. % 2) \hyphenpenalty is set to 10000 because hyphenation in a @@ -3190,12 +3626,12 @@ \def\setchapternewpage #1 {\csname CHAPPAG#1\endcsname} -\def\CHAPPAGoff{ +\def\CHAPPAGoff{% \global\let\contentsalignmacro = \chappager \global\let\pchapsepmacro=\chapbreak \global\let\pagealignmacro=\chappager} -\def\CHAPPAGon{ +\def\CHAPPAGon{% \global\let\contentsalignmacro = \chappager \global\let\pchapsepmacro=\chappager \global\let\pagealignmacro=\chappager @@ -3249,7 +3685,7 @@ \def\unnchfopen #1{% \chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000 \parindent=0pt\raggedright - \rm #1\hfill}}\bigskip \par\penalty 10000 % + \rm #1\hfill}}\bigskip \par\nobreak } \def\chfopen #1#2{\chapoddpage {\chapfonts @@ -3260,7 +3696,7 @@ \def\centerchfopen #1{% \chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000 \parindent=0pt - \hfill {\rm #1}\hfill}}\bigskip \par\penalty 10000 % + \hfill {\rm #1}\hfill}}\bigskip \par\nobreak } \def\CHAPFopen{ @@ -3313,24 +3749,45 @@ } -\message{toc printing,} -% Finish up the main text and prepare to read what we've written -% to \contentsfile. +\message{toc,} +% Table of contents. +\newwrite\tocfile + +% Write an entry to the toc file, opening it if necessary. +% Called from @chapter, etc. We supply {\folio} at the end of the +% argument, which will end up as the last argument to the \...entry macro. +% +% We open the .toc file here instead of at @setfilename or any other +% given time so that @contents can be put in the document anywhere. +% +\newif\iftocfileopened +\def\writetocentry#1{% + \iftocfileopened\else + \immediate\openout\tocfile = \jobname.toc + \global\tocfileopenedtrue + \fi + \iflinks \write\tocfile{#1{\folio}}\fi +} \newskip\contentsrightmargin \contentsrightmargin=1in +\newcount\savepageno +\newcount\lastnegativepageno \lastnegativepageno = -1 + +% Finish up the main text and prepare to read what we've written +% to \tocfile. +% \def\startcontents#1{% % If @setchapternewpage on, and @headings double, the contents should % start on an odd page, unlike chapters. Thus, we maintain % \contentsalignmacro in parallel with \pagealignmacro. % From: Torbjorn Granlund <tege@matematik.su.se> \contentsalignmacro - \immediate\closeout \contentsfile - \ifnum \pageno>0 - \pageno = -1 % Request roman numbered pages. - \fi + \immediate\closeout\tocfile + % % Don't need to put `Contents' or `Short Contents' in the headline. % It is abundantly clear what they are. \unnumbchapmacro{#1}\def\thischapter{}% + \savepageno = \pageno \begingroup % Set up to handle contents files properly. \catcode`\\=0 \catcode`\{=1 \catcode`\}=2 \catcode`\@=11 % We can't do this, because then an actual ^ in a section @@ -3338,20 +3795,31 @@ %\catcode`\^=7 % to see ^^e4 as \"a etc. juha@piuha.ydi.vtt.fi \raggedbottom % Worry more about breakpoints than the bottom. \advance\hsize by -\contentsrightmargin % Don't use the full line length. + % + % Roman numerals for page numbers. + \ifnum \pageno>0 \pageno = \lastnegativepageno \fi } % Normal (long) toc. -\outer\def\contents{% - \startcontents{\putwordTableofContents}% - \input \jobname.toc +\def\contents{% + \startcontents{\putwordTOC}% + \openin 1 \jobname.toc + \ifeof 1 \else + \closein 1 + \input \jobname.toc + \fi + \vfill \eject + \contentsalignmacro % in case @setchapternewpage odd is in effect + \pdfmakeoutlines \endgroup - \vfill \eject + \lastnegativepageno = \pageno + \pageno = \savepageno } % And just the chapters. -\outer\def\summarycontents{% - \startcontents{\putwordShortContents}% +\def\summarycontents{% + \startcontents{\putwordShortTOC}% % \let\chapentry = \shortchapentry \let\unnumbchapentry = \shortunnumberedentry @@ -3367,12 +3835,23 @@ \def\unnumbsubsecentry ##1##2{} \def\subsubsecentry ##1##2##3##4##5##6{} \def\unnumbsubsubsecentry ##1##2{} - \input \jobname.toc + \openin 1 \jobname.toc + \ifeof 1 \else + \closein 1 + \input \jobname.toc + \fi + \vfill \eject + \contentsalignmacro % in case @setchapternewpage odd is in effect \endgroup - \vfill \eject + \lastnegativepageno = \pageno + \pageno = \savepageno } \let\shortcontents = \summarycontents +\ifpdf + \pdfcatalog{/PageMode /UseOutlines}% +\fi + % These macros generate individual entries in the table of contents. % The first argument is the chapter or section name. % The last argument is the page number. @@ -3383,7 +3862,7 @@ % See comments in \dochapentry re vbox and related settings \def\shortchapentry#1#2#3{% - \tocentry{\shortchaplabel{#2}\labelspace #1}{\doshortpageno{#3}}% + \tocentry{\shortchaplabel{#2}\labelspace #1}{\doshortpageno\bgroup#3\egroup}% } % Typeset the label for a chapter or appendix for the short contents. @@ -3391,10 +3870,14 @@ % We could simplify the code here by writing out an \appendixentry % command in the toc file for appendices, instead of using \chapentry % for both, but it doesn't seem worth it. -\setbox0 = \hbox{\shortcontrm \putwordAppendix } -\newdimen\shortappendixwidth \shortappendixwidth = \wd0 - +% +\newdimen\shortappendixwidth +% \def\shortchaplabel#1{% + % Compute width of word "Appendix", may change with language. + \setbox0 = \hbox{\shortcontrm \putwordAppendix}% + \shortappendixwidth = \wd0 + % % We typeset #1 in a box of constant width, regardless of the text of % #1, so the chapter titles will come out aligned. \setbox0 = \hbox{#1}% @@ -3409,7 +3892,7 @@ } \def\unnumbchapentry#1#2{\dochapentry{#1}{#2}} -\def\shortunnumberedentry#1#2{\tocentry{#1}{\doshortpageno{#2}}} +\def\shortunnumberedentry#1#2{\tocentry{#1}{\doshortpageno\bgroup#2\egroup}} % Sections. \def\secentry#1#2#3#4{\dosecentry{#2.#3\labelspace#1}{#4}} @@ -3436,24 +3919,24 @@ \penalty-300 \vskip1\baselineskip plus.33\baselineskip minus.25\baselineskip \begingroup \chapentryfonts - \tocentry{#1}{\dopageno{#2}}% + \tocentry{#1}{\dopageno\bgroup#2\egroup}% \endgroup \nobreak\vskip .25\baselineskip plus.1\baselineskip } \def\dosecentry#1#2{\begingroup \secentryfonts \leftskip=\tocindent - \tocentry{#1}{\dopageno{#2}}% + \tocentry{#1}{\dopageno\bgroup#2\egroup}% \endgroup} \def\dosubsecentry#1#2{\begingroup \subsecentryfonts \leftskip=2\tocindent - \tocentry{#1}{\dopageno{#2}}% + \tocentry{#1}{\dopageno\bgroup#2\egroup}% \endgroup} \def\dosubsubsecentry#1#2{\begingroup \subsubsecentryfonts \leftskip=3\tocindent - \tocentry{#1}{\dopageno{#2}}% + \tocentry{#1}{\dopageno\bgroup#2\egroup}% \endgroup} % Final typesetting of a toc entry; we use the same \entry macro as for @@ -3481,6 +3964,7 @@ \message{environments,} +% @foo ... @end foo. % Since these characters are used in examples, it should be an even number of % \tt widths. Each \tt character is 1en, so two makes it 1em. @@ -3553,6 +4037,7 @@ \let\!=\ptexexclam \let\i=\ptexi \let\{=\ptexlbrace + \let\+=\tabalign \let\}=\ptexrbrace \let\*=\ptexstar \let\t=\ptext @@ -3604,8 +4089,8 @@ % \nonarrowing is a flag. If "set", @lisp etc don't narrow margins. \let\nonarrowing=\relax -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% \cartouche: draw rectangle w/rounded corners around argument +% @cartouche ... @end cartouche: draw rectangle w/rounded corners around +% environment contents. \font\circle=lcircle10 \newdimen\circthick \newdimen\cartouter\newdimen\cartinner @@ -3632,9 +4117,9 @@ \cartinner=\hsize \advance\cartinner by-\lskip \advance\cartinner by-\rskip \cartouter=\hsize - \advance\cartouter by 18pt % allow for 3pt kerns on either + \advance\cartouter by 18.4pt % allow for 3pt kerns on either % side, and for 6pt waste from -% each corner char +% each corner char, and rule thickness \normbskip=\baselineskip \normpskip=\parskip \normlskip=\lineskip % Flag to tell @lisp, etc., not to narrow margin. \let\nonarrowing=\comment @@ -3688,49 +4173,52 @@ \fi } -% To ending an @example-like environment, we first end the paragraph -% (via \afterenvbreak's vertical glue), and then the group. That way we -% keep the zero \parskip that the environments set -- \parskip glue -% will be inserted at the beginning of the next paragraph in the -% document, after the environment. +% Define the \E... control sequence only if we are inside the particular +% environment, so the error checking in \end will work. % -\def\nonfillfinish{\afterenvbreak\endgroup}% - +% To end an @example-like environment, we first end the paragraph (via +% \afterenvbreak's vertical glue), and then the group. That way we keep +% the zero \parskip that the environments set -- \parskip glue will be +% inserted at the beginning of the next paragraph in the document, after +% the environment. +% +\def\nonfillfinish{\afterenvbreak\endgroup} + +% @lisp: indented, narrowed, typewriter font. \def\lisp{\begingroup \nonfillstart \let\Elisp = \nonfillfinish \tt - % Make @kbd do something special, if requested. - \let\kbdfont\kbdexamplefont - \rawbackslash % have \ input char produce \ char from current font - \gobble + \let\kbdfont = \kbdexamplefont % Allow @kbd to do something special. + \gobble % eat return } -% Define the \E... control sequence only if we are inside the -% environment, so the error checking in \end will work. -% -% We must call \lisp last in the definition, since it reads the -% return following the @example (or whatever) command. -% +% @example: Same as @lisp. \def\example{\begingroup \def\Eexample{\nonfillfinish\endgroup}\lisp} -\def\smallexample{\begingroup \def\Esmallexample{\nonfillfinish\endgroup}\lisp} -\def\smalllisp{\begingroup \def\Esmalllisp{\nonfillfinish\endgroup}\lisp} - -% @smallexample and @smalllisp. This is not used unless the @smallbook -% command is given. Originally contributed by Pavel@xerox. + +% @small... is usually equivalent to the non-small (@smallbook +% redefines). We must call \example (or whatever) last in the +% definition, since it reads the return following the @example (or +% whatever) command. % +% This actually allows (for example) @end display inside an +% @smalldisplay. Too bad, but makeinfo will catch the error anyway. +% +\def\smalldisplay{\begingroup\def\Esmalldisplay{\nonfillfinish\endgroup}\display} +\def\smallexample{\begingroup\def\Esmallexample{\nonfillfinish\endgroup}\lisp} +\def\smallformat{\begingroup\def\Esmallformat{\nonfillfinish\endgroup}\format} +\def\smalllisp{\begingroup\def\Esmalllisp{\nonfillfinish\endgroup}\lisp} + +% Real @smallexample and @smalllisp (when @smallbook): use smaller fonts. +% Originally contributed by Pavel@xerox. \def\smalllispx{\begingroup - \nonfillstart - \let\Esmalllisp = \nonfillfinish - \let\Esmallexample = \nonfillfinish - % - % Smaller fonts for small examples. - \indexfonts \tt - \rawbackslash % make \ output the \ character from the current font (tt) - \gobble + \def\Esmalllisp{\nonfillfinish\endgroup}% + \def\Esmallexample{\nonfillfinish\endgroup}% + \smallfonts + \lisp } -% This is @display; same as @lisp except use roman font. +% @display: same as @lisp except keep current font. % \def\display{\begingroup \nonfillstart @@ -3738,7 +4226,15 @@ \gobble } -% This is @format; same as @display except don't narrow margins. +% @smalldisplay (when @smallbook): @display plus smaller fonts. +% +\def\smalldisplayx{\begingroup + \def\Esmalldisplay{\nonfillfinish\endgroup}% + \smallfonts \rm + \display +} + +% @format: same as @display except don't narrow margins. % \def\format{\begingroup \let\nonarrowing = t @@ -3747,20 +4243,27 @@ \gobble } -% @flushleft (same as @format) and @flushright. +% @smallformat (when @smallbook): @format plus smaller fonts. % -\def\flushleft{\begingroup - \let\nonarrowing = t - \nonfillstart - \let\Eflushleft = \nonfillfinish - \gobble +\def\smallformatx{\begingroup + \def\Esmallformat{\nonfillfinish\endgroup}% + \smallfonts \rm + \format } + +% @flushleft (same as @format). +% +\def\flushleft{\begingroup \def\Eflushleft{\nonfillfinish\endgroup}\format} + +% @flushright. +% \def\flushright{\begingroup \let\nonarrowing = t \nonfillstart \let\Eflushright = \nonfillfinish \advance\leftskip by 0pt plus 1fill - \gobble} + \gobble +} % @quotation does normal linebreaking (hence we can't use \nonfillstart) % and narrows the margins. @@ -3783,9 +4286,11 @@ \fi } + \message{defuns,} -% Define formatter for defuns -% First, allow user to change definition object font (\df) internally +% @defun etc. + +% Allow user to change definition object font (\df) internally \def\setdeffont #1 {\csname DEF#1\endcsname} \newskip\defbodyindent \defbodyindent=.4in @@ -3839,10 +4344,16 @@ %% contained text. This is especially needed for [ and ] \def\opnr{{\sf\char`\(}\global\advance\parencount by 1 } \def\clnr{{\sf\char`\)}\global\advance\parencount by -1 } -\def\ampnr{\&} +\let\ampnr = \& \def\lbrb{{\bf\char`\[}} \def\rbrb{{\bf\char`\]}} +% Active &'s sneak into the index arguments, so make sure it's defined. +{ + \catcode`& = 13 + \global\let& = \ampnr +} + % First, defname, which formats the header line itself. % #1 should be the function name. % #2 should be the type of definition, such as "Function". @@ -3852,20 +4363,18 @@ % outside the @def... \dimen2=\leftskip \advance\dimen2 by -\defbodyindent -\dimen3=\rightskip -\advance\dimen3 by -\defbodyindent -\noindent % +\noindent \setbox0=\hbox{\hskip \deflastargmargin{\rm #2}\hskip \deftypemargin}% \dimen0=\hsize \advance \dimen0 by -\wd0 % compute size for first line \dimen1=\hsize \advance \dimen1 by -\defargsindent %size for continuations -\parshape 2 0in \dimen0 \defargsindent \dimen1 % +\parshape 2 0in \dimen0 \defargsindent \dimen1 % Now output arg 2 ("Function" or some such) % ending at \deftypemargin from the right margin, % but stuck inside a box of width 0 so it does not interfere with linebreaking {% Adjust \hsize to exclude the ambient margins, % so that \rightline will obey them. -\advance \hsize by -\dimen2 \advance \hsize by -\dimen3 -\rlap{\rightline{{\rm #2}\hskip \deftypemargin}}}% +\advance \hsize by -\dimen2 +\rlap{\rightline{{\rm #2}\hskip -1.25pc }}}% % Make all lines underfull and no complaints: \tolerance=10000 \hbadness=10000 \advance\leftskip by -\defbodyindent @@ -3886,23 +4395,62 @@ \def#1{\endgraf\endgroup\medbreak}% \def#2{\begingroup\obeylines\activeparens\spacesplit#3}% \parindent=0in -\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent +\advance\leftskip by \defbodyindent \exdentamount=\defbodyindent \begingroup % \catcode 61=\active % 61 is `=' \obeylines\activeparens\spacesplit#3} -\def\defmethparsebody #1#2#3#4 {\begingroup\inENV % +% #1 is the \E... control sequence to end the definition (which we define). +% #2 is the \...x control sequence for consecutive fns (which we define). +% #3 is the control sequence to call to resume processing. +% #4, delimited by the space, is the class name. +% +\def\defmethparsebody#1#2#3#4 {\begingroup\inENV % \medbreak % % Define the end token that this defining construct specifies % so that it will exit this group. \def#1{\endgraf\endgroup\medbreak}% \def#2##1 {\begingroup\obeylines\activeparens\spacesplit{#3{##1}}}% \parindent=0in -\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent +\advance\leftskip by \defbodyindent \exdentamount=\defbodyindent \begingroup\obeylines\activeparens\spacesplit{#3{#4}}} +% Used for @deftypemethod and @deftypeivar. +% #1 is the \E... control sequence to end the definition (which we define). +% #2 is the \...x control sequence for consecutive fns (which we define). +% #3 is the control sequence to call to resume processing. +% #4, delimited by a space, is the class name. +% #5 is the method's return type. +% +\def\deftypemethparsebody#1#2#3#4 #5 {\begingroup\inENV + \medbreak + \def#1{\endgraf\endgroup\medbreak}% + \def#2##1 ##2 {\begingroup\obeylines\activeparens\spacesplit{#3{##1}{##2}}}% + \parindent=0in + \advance\leftskip by \defbodyindent + \exdentamount=\defbodyindent + \begingroup\obeylines\activeparens\spacesplit{#3{#4}{#5}}} + +% Used for @deftypeop. The change from \deftypemethparsebody is an +% extra argument at the beginning which is the `category', instead of it +% being the hardwired string `Method' or `Instance Variable'. We have +% to account for this both in the \...x definition and in parsing the +% input at hand. Thus also need a control sequence (passed as #5) for +% the \E... definition to assign the category name to. +% +\def\deftypeopparsebody#1#2#3#4#5 #6 {\begingroup\inENV + \medbreak + \def#1{\endgraf\endgroup\medbreak}% + \def#2##1 ##2 ##3 {% + \def#4{##1}% + \begingroup\obeylines\activeparens\spacesplit{#3{##2}{##3}}}% + \parindent=0in + \advance\leftskip by \defbodyindent + \exdentamount=\defbodyindent + \begingroup\obeylines\activeparens\spacesplit{#3{#5}{#6}}} + \def\defopparsebody #1#2#3#4#5 {\begingroup\inENV % \medbreak % % Define the end token that this defining construct specifies @@ -3911,7 +4459,7 @@ \def#2##1 ##2 {\def#4{##1}% \begingroup\obeylines\activeparens\spacesplit{#3{##2}}}% \parindent=0in -\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent +\advance\leftskip by \defbodyindent \exdentamount=\defbodyindent \begingroup\obeylines\activeparens\spacesplit{#3{#5}}} @@ -3926,7 +4474,7 @@ \def#1{\endgraf\endgroup\medbreak}% \def#2{\begingroup\obeylines\spacesplit#3}% \parindent=0in -\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent +\advance\leftskip by \defbodyindent \exdentamount=\defbodyindent \begingroup % \catcode 61=\active % @@ -3943,7 +4491,7 @@ \def#1{\endgraf\endgroup\medbreak}% \def#2##1 {\begingroup\obeylines\spacesplit{#3{##1}}}% \parindent=0in - \advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent + \advance\leftskip by \defbodyindent \exdentamount=\defbodyindent \begingroup\obeylines } @@ -3988,7 +4536,7 @@ \def#2##1 ##2 {\def#4{##1}% \begingroup\obeylines\spacesplit{#3{##2}}}% \parindent=0in -\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent +\advance\leftskip by \defbodyindent \exdentamount=\defbodyindent \begingroup\obeylines\spacesplit{#3{#5}}} @@ -4012,16 +4560,17 @@ % First, define the processing that is wanted for arguments of \defun % Use this to expand the args and terminate the paragraph they make up -\def\defunargs #1{\functionparens \sl +\def\defunargs#1{\functionparens \sl % Expand, preventing hyphenation at `-' chars. % Note that groups don't affect changes in \hyphenchar. -\hyphenchar\tensl=0 +% Set the font temporarily and use \font in case \setfont made \tensl a macro. +{\tensl\hyphenchar\font=0}% #1% -\hyphenchar\tensl=45 +{\tensl\hyphenchar\font=45}% \ifnum\parencount=0 \else \errmessage{Unbalanced parentheses in @def}\fi% \interlinepenalty=10000 \advance\rightskip by 0pt plus 1fil -\endgraf\penalty 10000\vskip -\parskip\penalty 10000% +\endgraf\nobreak\vskip -\parskip\nobreak } \def\deftypefunargs #1{% @@ -4032,7 +4581,7 @@ \tclose{#1}% avoid \code because of side effects on active chars \interlinepenalty=10000 \advance\rightskip by 0pt plus 1fil -\endgraf\penalty 10000\vskip -\parskip\penalty 10000% +\endgraf\nobreak\vskip -\parskip\nobreak } % Do complete processing of one @defun or @defunx line already parsed. @@ -4051,7 +4600,7 @@ \def\defun{\defparsebody\Edefun\defunx\defunheader} \def\defunheader #1#2{\doind {fn}{\code{#1}}% Make entry in function index -\begingroup\defname {#1}{Function}% +\begingroup\defname {#1}{\putwordDeffunc}% \defunargs {#2}\endgroup % \catcode 61=\other % Turn off change made in \defparsebody } @@ -4065,7 +4614,7 @@ % #1 is the data type, #2 the name, #3 the args. \def\deftypefunheaderx #1#2 #3\relax{% \doind {fn}{\code{#2}}% Make entry in function index -\begingroup\defname {\defheaderxcond#1\relax$$$#2}{Function}% +\begingroup\defname {\defheaderxcond#1\relax$$$#2}{\putwordDeftypefun}% \deftypefunargs {#3}\endgroup % \catcode 61=\other % Turn off change made in \defparsebody } @@ -4096,7 +4645,7 @@ \def\defmac{\defparsebody\Edefmac\defmacx\defmacheader} \def\defmacheader #1#2{\doind {fn}{\code{#1}}% Make entry in function index -\begingroup\defname {#1}{Macro}% +\begingroup\defname {#1}{\putwordDefmac}% \defunargs {#2}\endgroup % \catcode 61=\other % Turn off change made in \defparsebody } @@ -4106,53 +4655,77 @@ \def\defspec{\defparsebody\Edefspec\defspecx\defspecheader} \def\defspecheader #1#2{\doind {fn}{\code{#1}}% Make entry in function index -\begingroup\defname {#1}{Special Form}% +\begingroup\defname {#1}{\putwordDefspec}% \defunargs {#2}\endgroup % \catcode 61=\other % Turn off change made in \defparsebody } -% This definition is run if you use @defunx -% anywhere other than immediately after a @defun or @defunx. - -\def\deffnx #1 {\errmessage{@deffnx in invalid context}} -\def\defunx #1 {\errmessage{@defunx in invalid context}} -\def\defmacx #1 {\errmessage{@defmacx in invalid context}} -\def\defspecx #1 {\errmessage{@defspecx in invalid context}} -\def\deftypefnx #1 {\errmessage{@deftypefnx in invalid context}} -\def\deftypemethodx #1 {\errmessage{@deftypemethodx in invalid context}} -\def\deftypeunx #1 {\errmessage{@deftypeunx in invalid context}} - -% @defmethod, and so on - -% @defop {Funny Method} foo-class frobnicate argument - +% @defop CATEGORY CLASS OPERATION ARG... +% \def\defop #1 {\def\defoptype{#1}% \defopparsebody\Edefop\defopx\defopheader\defoptype} - -\def\defopheader #1#2#3{% -\dosubind {fn}{\code{#2}}{on #1}% Make entry in function index -\begingroup\defname {#2}{\defoptype{} on #1}% +% +\def\defopheader#1#2#3{% +\dosubind {fn}{\code{#2}}{\putwordon\ #1}% Make entry in function index +\begingroup\defname {#2}{\defoptype\ \putwordon\ #1}% \defunargs {#3}\endgroup % } -% @deftypemethod foo-class return-type foo-method args +% @deftypeop CATEGORY CLASS TYPE OPERATION ARG... +% +\def\deftypeop #1 {\def\deftypeopcategory{#1}% + \deftypeopparsebody\Edeftypeop\deftypeopx\deftypeopheader + \deftypeopcategory} +% +% #1 is the class name, #2 the data type, #3 the operation name, #4 the args. +\def\deftypeopheader#1#2#3#4{% + \dosubind{fn}{\code{#3}}{\putwordon\ \code{#1}}% entry in function index + \begingroup + \defname{\defheaderxcond#2\relax$$$#3} + {\deftypeopcategory\ \putwordon\ \code{#1}}% + \deftypefunargs{#4}% + \endgroup +} + +% @deftypemethod CLASS TYPE METHOD ARG... % \def\deftypemethod{% - \defmethparsebody\Edeftypemethod\deftypemethodx\deftypemethodheader} + \deftypemethparsebody\Edeftypemethod\deftypemethodx\deftypemethodheader} % % #1 is the class name, #2 the data type, #3 the method name, #4 the args. \def\deftypemethodheader#1#2#3#4{% - \deftypefnheaderx{Method on #1}{#2}#3 #4\relax + \dosubind{fn}{\code{#3}}{\putwordon\ \code{#1}}% entry in function index + \begingroup + \defname{\defheaderxcond#2\relax$$$#3}{\putwordMethodon\ \code{#1}}% + \deftypefunargs{#4}% + \endgroup +} + +% @deftypeivar CLASS TYPE VARNAME +% +\def\deftypeivar{% + \deftypemethparsebody\Edeftypeivar\deftypeivarx\deftypeivarheader} +% +% #1 is the class name, #2 the data type, #3 the variable name. +\def\deftypeivarheader#1#2#3{% + \dosubind{vr}{\code{#3}}{\putwordof\ \code{#1}}% entry in variable index + \begingroup + \defname{#3}{\putwordInstanceVariableof\ \code{#1}}% + \defvarargs{#3}% + \endgroup } % @defmethod == @defop Method - +% \def\defmethod{\defmethparsebody\Edefmethod\defmethodx\defmethodheader} - -\def\defmethodheader #1#2#3{% -\dosubind {fn}{\code{#2}}{on #1}% entry in function index -\begingroup\defname {#2}{Method on #1}% -\defunargs {#3}\endgroup % +% +% #1 is the class name, #2 the method name, #3 the args. +\def\defmethodheader#1#2#3{% + \dosubind{fn}{\code{#2}}{\putwordon\ \code{#1}}% entry in function index + \begingroup + \defname{#2}{\putwordMethodon\ \code{#1}}% + \defunargs{#3}% + \endgroup } % @defcv {Class Option} foo-class foo-flag @@ -4161,37 +4734,30 @@ \defopvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype} \def\defcvarheader #1#2#3{% -\dosubind {vr}{\code{#2}}{of #1}% Make entry in var index -\begingroup\defname {#2}{\defcvtype{} of #1}% +\dosubind {vr}{\code{#2}}{\putwordof\ #1}% Make entry in var index +\begingroup\defname {#2}{\defcvtype\ \putwordof\ #1}% \defvarargs {#3}\endgroup % } -% @defivar == @defcv {Instance Variable} - +% @defivar CLASS VARNAME == @defcv {Instance Variable} CLASS VARNAME +% \def\defivar{\defvrparsebody\Edefivar\defivarx\defivarheader} - -\def\defivarheader #1#2#3{% -\dosubind {vr}{\code{#2}}{of #1}% Make entry in var index -\begingroup\defname {#2}{Instance Variable of #1}% -\defvarargs {#3}\endgroup % +% +\def\defivarheader#1#2#3{% + \dosubind {vr}{\code{#2}}{\putwordof\ #1}% entry in var index + \begingroup + \defname{#2}{\putwordInstanceVariableof\ #1}% + \defvarargs{#3}% + \endgroup } -% These definitions are run if you use @defmethodx, etc., -% anywhere other than immediately after a @defmethod, etc. - -\def\defopx #1 {\errmessage{@defopx in invalid context}} -\def\defmethodx #1 {\errmessage{@defmethodx in invalid context}} -\def\defcvx #1 {\errmessage{@defcvx in invalid context}} -\def\defivarx #1 {\errmessage{@defivarx in invalid context}} - -% Now @defvar - +% @defvar % First, define the processing that is wanted for arguments of @defvar. % This is actually simple: just print them in roman. % This must expand the args and terminate the paragraph they make up \def\defvarargs #1{\normalparens #1% \interlinepenalty=10000 -\endgraf\penalty 10000\vskip -\parskip\penalty 10000} +\endgraf\nobreak\vskip -\parskip\nobreak} % @defvr Counter foo-count @@ -4205,7 +4771,7 @@ \def\defvar{\defvarparsebody\Edefvar\defvarx\defvarheader} \def\defvarheader #1#2{\doind {vr}{\code{#1}}% Make entry in var index -\begingroup\defname {#1}{Variable}% +\begingroup\defname {#1}{\putwordDefvar}% \defvarargs {#2}\endgroup % } @@ -4214,7 +4780,7 @@ \def\defopt{\defvarparsebody\Edefopt\defoptx\defoptheader} \def\defoptheader #1#2{\doind {vr}{\code{#1}}% Make entry in var index -\begingroup\defname {#1}{User Option}% +\begingroup\defname {#1}{\putwordDefopt}% \defvarargs {#2}\endgroup % } @@ -4226,9 +4792,9 @@ % is actually part of the data type, which should not be put into the index. \def\deftypevarheader #1#2{% \dovarind#2 \relax% Make entry in variables index -\begingroup\defname {\defheaderxcond#1\relax$$$#2}{Variable}% +\begingroup\defname {\defheaderxcond#1\relax$$$#2}{\putwordDeftypevar}% \interlinepenalty=10000 -\endgraf\penalty 10000\vskip -\parskip\penalty 10000 +\endgraf\nobreak\vskip -\parskip\nobreak \endgroup} \def\dovarind#1 #2\relax{\doind{vr}{\code{#1}}} @@ -4239,18 +4805,9 @@ \def\deftypevrheader #1#2#3{\dovarind#3 \relax% \begingroup\defname {\defheaderxcond#2\relax$$$#3}{#1} \interlinepenalty=10000 -\endgraf\penalty 10000\vskip -\parskip\penalty 10000 +\endgraf\nobreak\vskip -\parskip\nobreak \endgroup} -% This definition is run if you use @defvarx -% anywhere other than immediately after a @defvar or @defvarx. - -\def\defvrx #1 {\errmessage{@defvrx in invalid context}} -\def\defvarx #1 {\errmessage{@defvarx in invalid context}} -\def\defoptx #1 {\errmessage{@defoptx in invalid context}} -\def\deftypevarx #1 {\errmessage{@deftypevarx in invalid context}} -\def\deftypevrx #1 {\errmessage{@deftypevrx in invalid context}} - % Now define @deftp % Args are printed in bold, a slight difference from @defvar. @@ -4263,51 +4820,394 @@ \def\deftpheader #1#2#3{\doind {tp}{\code{#2}}% \begingroup\defname {#2}{#1}\deftpargs{#3}\endgroup} -% This definition is run if you use @deftpx, etc -% anywhere other than immediately after a @deftp, etc. - -\def\deftpx #1 {\errmessage{@deftpx in invalid context}} - - -\message{cross reference,} -% Define cross-reference macros -\newwrite \auxfile - -\newif\ifhavexrefs % True if xref values are known. +% These definitions are used if you use @defunx (etc.) +% anywhere other than immediately after a @defun or @defunx. +% +\def\defcvx#1 {\errmessage{@defcvx in invalid context}} +\def\deffnx#1 {\errmessage{@deffnx in invalid context}} +\def\defivarx#1 {\errmessage{@defivarx in invalid context}} +\def\defmacx#1 {\errmessage{@defmacx in invalid context}} +\def\defmethodx#1 {\errmessage{@defmethodx in invalid context}} +\def\defoptx #1 {\errmessage{@defoptx in invalid context}} +\def\defopx#1 {\errmessage{@defopx in invalid context}} +\def\defspecx#1 {\errmessage{@defspecx in invalid context}} +\def\deftpx#1 {\errmessage{@deftpx in invalid context}} +\def\deftypefnx#1 {\errmessage{@deftypefnx in invalid context}} +\def\deftypefunx#1 {\errmessage{@deftypefunx in invalid context}} +\def\deftypeivarx#1 {\errmessage{@deftypeivarx in invalid context}} +\def\deftypemethodx#1 {\errmessage{@deftypemethodx in invalid context}} +\def\deftypeopx#1 {\errmessage{@deftypeopx in invalid context}} +\def\deftypevarx#1 {\errmessage{@deftypevarx in invalid context}} +\def\deftypevrx#1 {\errmessage{@deftypevrx in invalid context}} +\def\defunx#1 {\errmessage{@defunx in invalid context}} +\def\defvarx#1 {\errmessage{@defvarx in invalid context}} +\def\defvrx#1 {\errmessage{@defvrx in invalid context}} + + +\message{macros,} +% @macro. + +% To do this right we need a feature of e-TeX, \scantokens, +% which we arrange to emulate with a temporary file in ordinary TeX. +\ifx\eTeXversion\undefined + \newwrite\macscribble + \def\scanmacro#1{% + \begingroup \newlinechar`\^^M + % Undo catcode changes of \startcontents and \doprintindex + \catcode`\@=0 \catcode`\\=12 \escapechar=`\@ + % Append \endinput to make sure that TeX does not see the ending newline. + \toks0={#1\endinput}% + \immediate\openout\macscribble=\jobname.tmp + \immediate\write\macscribble{\the\toks0}% + \immediate\closeout\macscribble + \let\xeatspaces\eatspaces + \input \jobname.tmp + \endgroup +} +\else +\def\scanmacro#1{% +\begingroup \newlinechar`\^^M +% Undo catcode changes of \startcontents and \doprintindex +\catcode`\@=0 \catcode`\\=12 \escapechar=`\@ +\let\xeatspaces\eatspaces\scantokens{#1\endinput}\endgroup} +\fi + +\newcount\paramno % Count of parameters +\newtoks\macname % Macro name +\newif\ifrecursive % Is it recursive? +\def\macrolist{} % List of all defined macros in the form + % \do\macro1\do\macro2... + +% Utility routines. +% Thisdoes \let #1 = #2, except with \csnames. +\def\cslet#1#2{% +\expandafter\expandafter +\expandafter\let +\expandafter\expandafter +\csname#1\endcsname +\csname#2\endcsname} + +% Trim leading and trailing spaces off a string. +% Concepts from aro-bend problem 15 (see CTAN). +{\catcode`\@=11 +\gdef\eatspaces #1{\expandafter\trim@\expandafter{#1 }} +\gdef\trim@ #1{\trim@@ @#1 @ #1 @ @@} +\gdef\trim@@ #1@ #2@ #3@@{\trim@@@\empty #2 @} +\def\unbrace#1{#1} +\unbrace{\gdef\trim@@@ #1 } #2@{#1} +} + +% Trim a single trailing ^^M off a string. +{\catcode`\^^M=12\catcode`\Q=3% +\gdef\eatcr #1{\eatcra #1Q^^MQ}% +\gdef\eatcra#1^^MQ{\eatcrb#1Q}% +\gdef\eatcrb#1Q#2Q{#1}% +} + +% Macro bodies are absorbed as an argument in a context where +% all characters are catcode 10, 11 or 12, except \ which is active +% (as in normal texinfo). It is necessary to change the definition of \. + +% It's necessary to have hard CRs when the macro is executed. This is +% done by making ^^M (\endlinechar) catcode 12 when reading the macro +% body, and then making it the \newlinechar in \scanmacro. + +\def\macrobodyctxt{% + \catcode`\~=12 + \catcode`\^=12 + \catcode`\_=12 + \catcode`\|=12 + \catcode`\<=12 + \catcode`\>=12 + \catcode`\+=12 + \catcode`\{=12 + \catcode`\}=12 + \catcode`\@=12 + \catcode`\^^M=12 + \usembodybackslash} + +\def\macroargctxt{% + \catcode`\~=12 + \catcode`\^=12 + \catcode`\_=12 + \catcode`\|=12 + \catcode`\<=12 + \catcode`\>=12 + \catcode`\+=12 + \catcode`\@=12 + \catcode`\\=12} + +% \mbodybackslash is the definition of \ in @macro bodies. +% It maps \foo\ => \csname macarg.foo\endcsname => #N +% where N is the macro parameter number. +% We define \csname macarg.\endcsname to be \realbackslash, so +% \\ in macro replacement text gets you a backslash. + +{\catcode`@=0 @catcode`@\=@active + @gdef@usembodybackslash{@let\=@mbodybackslash} + @gdef@mbodybackslash#1\{@csname macarg.#1@endcsname} +} +\expandafter\def\csname macarg.\endcsname{\realbackslash} + +\def\macro{\recursivefalse\parsearg\macroxxx} +\def\rmacro{\recursivetrue\parsearg\macroxxx} + +\def\macroxxx#1{% + \getargs{#1}% now \macname is the macname and \argl the arglist + \ifx\argl\empty % no arguments + \paramno=0% + \else + \expandafter\parsemargdef \argl;% + \fi + \if1\csname ismacro.\the\macname\endcsname + \message{Warning: redefining \the\macname}% + \else + \expandafter\ifx\csname \the\macname\endcsname \relax + \else \errmessage{The name \the\macname\space is reserved}\fi + \global\cslet{macsave.\the\macname}{\the\macname}% + \global\expandafter\let\csname ismacro.\the\macname\endcsname=1% + % Add the macroname to \macrolist + \toks0 = \expandafter{\macrolist\do}% + \xdef\macrolist{\the\toks0 + \expandafter\noexpand\csname\the\macname\endcsname}% + \fi + \begingroup \macrobodyctxt + \ifrecursive \expandafter\parsermacbody + \else \expandafter\parsemacbody + \fi} + +\def\unmacro{\parsearg\unmacroxxx} +\def\unmacroxxx#1{% + \if1\csname ismacro.#1\endcsname + \global\cslet{#1}{macsave.#1}% + \global\expandafter\let \csname ismacro.#1\endcsname=0% + % Remove the macro name from \macrolist + \begingroup + \edef\tempa{\expandafter\noexpand\csname#1\endcsname}% + \def\do##1{% + \def\tempb{##1}% + \ifx\tempa\tempb + % remove this + \else + \toks0 = \expandafter{\newmacrolist\do}% + \edef\newmacrolist{\the\toks0\expandafter\noexpand\tempa}% + \fi}% + \def\newmacrolist{}% + % Execute macro list to define \newmacrolist + \macrolist + \global\let\macrolist\newmacrolist + \endgroup + \else + \errmessage{Macro #1 not defined}% + \fi +} + +% This makes use of the obscure feature that if the last token of a +% <parameter list> is #, then the preceding argument is delimited by +% an opening brace, and that opening brace is not consumed. +\def\getargs#1{\getargsxxx#1{}} +\def\getargsxxx#1#{\getmacname #1 \relax\getmacargs} +\def\getmacname #1 #2\relax{\macname={#1}} +\def\getmacargs#1{\def\argl{#1}} + +% Parse the optional {params} list. Set up \paramno and \paramlist +% so \defmacro knows what to do. Define \macarg.blah for each blah +% in the params list, to be ##N where N is the position in that list. +% That gets used by \mbodybackslash (above). + +% We need to get `macro parameter char #' into several definitions. +% The technique used is stolen from LaTeX: let \hash be something +% unexpandable, insert that wherever you need a #, and then redefine +% it to # just before using the token list produced. +% +% The same technique is used to protect \eatspaces till just before +% the macro is used. + +\def\parsemargdef#1;{\paramno=0\def\paramlist{}% + \let\hash\relax\let\xeatspaces\relax\parsemargdefxxx#1,;,} +\def\parsemargdefxxx#1,{% + \if#1;\let\next=\relax + \else \let\next=\parsemargdefxxx + \advance\paramno by 1% + \expandafter\edef\csname macarg.\eatspaces{#1}\endcsname + {\xeatspaces{\hash\the\paramno}}% + \edef\paramlist{\paramlist\hash\the\paramno,}% + \fi\next} + +% These two commands read recursive and nonrecursive macro bodies. +% (They're different since rec and nonrec macros end differently.) + +\long\def\parsemacbody#1@end macro% +{\xdef\temp{\eatcr{#1}}\endgroup\defmacro}% +\long\def\parsermacbody#1@end rmacro% +{\xdef\temp{\eatcr{#1}}\endgroup\defmacro}% + +% This defines the macro itself. There are six cases: recursive and +% nonrecursive macros of zero, one, and many arguments. +% Much magic with \expandafter here. +% \xdef is used so that macro definitions will survive the file +% they're defined in; @include reads the file inside a group. +\def\defmacro{% + \let\hash=##% convert placeholders to macro parameter chars + \ifrecursive + \ifcase\paramno + % 0 + \expandafter\xdef\csname\the\macname\endcsname{% + \noexpand\scanmacro{\temp}}% + \or % 1 + \expandafter\xdef\csname\the\macname\endcsname{% + \bgroup\noexpand\macroargctxt + \noexpand\braceorline + \expandafter\noexpand\csname\the\macname xxx\endcsname}% + \expandafter\xdef\csname\the\macname xxx\endcsname##1{% + \egroup\noexpand\scanmacro{\temp}}% + \else % many + \expandafter\xdef\csname\the\macname\endcsname{% + \bgroup\noexpand\macroargctxt + \noexpand\csname\the\macname xx\endcsname}% + \expandafter\xdef\csname\the\macname xx\endcsname##1{% + \expandafter\noexpand\csname\the\macname xxx\endcsname ##1,}% + \expandafter\expandafter + \expandafter\xdef + \expandafter\expandafter + \csname\the\macname xxx\endcsname + \paramlist{\egroup\noexpand\scanmacro{\temp}}% + \fi + \else + \ifcase\paramno + % 0 + \expandafter\xdef\csname\the\macname\endcsname{% + \noexpand\norecurse{\the\macname}% + \noexpand\scanmacro{\temp}\egroup}% + \or % 1 + \expandafter\xdef\csname\the\macname\endcsname{% + \bgroup\noexpand\macroargctxt + \noexpand\braceorline + \expandafter\noexpand\csname\the\macname xxx\endcsname}% + \expandafter\xdef\csname\the\macname xxx\endcsname##1{% + \egroup + \noexpand\norecurse{\the\macname}% + \noexpand\scanmacro{\temp}\egroup}% + \else % many + \expandafter\xdef\csname\the\macname\endcsname{% + \bgroup\noexpand\macroargctxt + \expandafter\noexpand\csname\the\macname xx\endcsname}% + \expandafter\xdef\csname\the\macname xx\endcsname##1{% + \expandafter\noexpand\csname\the\macname xxx\endcsname ##1,}% + \expandafter\expandafter + \expandafter\xdef + \expandafter\expandafter + \csname\the\macname xxx\endcsname + \paramlist{% + \egroup + \noexpand\norecurse{\the\macname}% + \noexpand\scanmacro{\temp}\egroup}% + \fi + \fi} + +\def\norecurse#1{\bgroup\cslet{#1}{macsave.#1}} + +% \braceorline decides whether the next nonwhitespace character is a +% {. If so it reads up to the closing }, if not, it reads the whole +% line. Whatever was read is then fed to the next control sequence +% as an argument (by \parsebrace or \parsearg) +\def\braceorline#1{\let\next=#1\futurelet\nchar\braceorlinexxx} +\def\braceorlinexxx{% + \ifx\nchar\bgroup\else + \expandafter\parsearg + \fi \next} + +% We mant to disable all macros during \shipout so that they are not +% expanded by \write. +\def\turnoffmacros{\begingroup \def\do##1{\let\noexpand##1=\relax}% + \edef\next{\macrolist}\expandafter\endgroup\next} + + +% @alias. +% We need some trickery to remove the optional spaces around the equal +% sign. Just make them active and then expand them all to nothing. +\def\alias{\begingroup\obeyspaces\parsearg\aliasxxx} +\def\aliasxxx #1{\aliasyyy#1\relax} +\def\aliasyyy #1=#2\relax{\ignoreactivespaces +\edef\next{\global\let\expandafter\noexpand\csname#1\endcsname=% + \expandafter\noexpand\csname#2\endcsname}% +\expandafter\endgroup\next} + + +\message{cross references,} +% @xref etc. + +\newwrite\auxfile + +\newif\ifhavexrefs % True if xref values are known. \newif\ifwarnedxrefs % True if we warned once that they aren't known. -% @inforef is simple. +% @inforef is relatively simple. \def\inforef #1{\inforefzzz #1,,,,**} \def\inforefzzz #1,#2,#3,#4**{\putwordSee{} \putwordInfo{} \putwordfile{} \file{\ignorespaces #3{}}, node \samp{\ignorespaces#1{}}} -% \setref{foo} defines a cross-reference point named foo. - -\def\setref#1{% -\dosetq{#1-title}{Ytitle}% -\dosetq{#1-pg}{Ypagenumber}% -\dosetq{#1-snt}{Ysectionnumberandtype}} - -\def\unnumbsetref#1{% -\dosetq{#1-title}{Ytitle}% -\dosetq{#1-pg}{Ypagenumber}% -\dosetq{#1-snt}{Ynothing}} - -\def\appendixsetref#1{% -\dosetq{#1-title}{Ytitle}% -\dosetq{#1-pg}{Ypagenumber}% -\dosetq{#1-snt}{Yappendixletterandtype}} - -% \xref, \pxref, and \ref generate cross-references to specified points. -% For \xrefX, #1 is the node name, #2 the name of the Info -% cross-reference, #3 the printed node name, #4 the name of the Info -% file, #5 the name of the printed manual. All but the node name can be -% omitted. +% @node's job is to define \lastnode. +\def\node{\ENVcheck\parsearg\nodezzz} +\def\nodezzz#1{\nodexxx [#1,]} +\def\nodexxx[#1,#2]{\gdef\lastnode{#1}} +\let\nwnode=\node +\let\lastnode=\relax + +% The sectioning commands (@chapter, etc.) call these. +\def\donoderef{% + \ifx\lastnode\relax\else + \expandafter\expandafter\expandafter\setref{\lastnode}% + {Ysectionnumberandtype}% + \global\let\lastnode=\relax + \fi +} +\def\unnumbnoderef{% + \ifx\lastnode\relax\else + \expandafter\expandafter\expandafter\setref{\lastnode}{Ynothing}% + \global\let\lastnode=\relax + \fi +} +\def\appendixnoderef{% + \ifx\lastnode\relax\else + \expandafter\expandafter\expandafter\setref{\lastnode}% + {Yappendixletterandtype}% + \global\let\lastnode=\relax + \fi +} + + +% @anchor{NAME} -- define xref target at arbitrary point. +% +\newcount\savesfregister +\gdef\savesf{\relax \ifhmode \savesfregister=\spacefactor \fi} +\gdef\restoresf{\relax \ifhmode \spacefactor=\savesfregister \fi} +\gdef\anchor#1{\savesf \setref{#1}{Ynothing}\restoresf \ignorespaces} + +% \setref{NAME}{SNT} defines a cross-reference point NAME, namely +% NAME-title, NAME-pg, and NAME-SNT. Called from \foonoderef. We have +% to set \indexdummies so commands such as @code in a section title +% aren't expanded. It would be nicer not to expand the titles in the +% first place, but there's so many layers that that is hard to do. +% +\def\setref#1#2{{% + \indexdummies + \pdfmkdest{#1}% + \dosetq{#1-title}{Ytitle}% + \dosetq{#1-pg}{Ypagenumber}% + \dosetq{#1-snt}{#2}% +}} + +% @xref, @pxref, and @ref generate cross-references. For \xrefX, #1 is +% the node name, #2 the name of the Info cross-reference, #3 the printed +% node name, #4 the name of the Info file, #5 the name of the printed +% manual. All but the node name can be omitted. % \def\pxref#1{\putwordsee{} \xrefX[#1,,,,,,,]} \def\xref#1{\putwordSee{} \xrefX[#1,,,,,,,]} \def\ref#1{\xrefX[#1,,,,,,,]} \def\xrefX[#1,#2,#3,#4,#5,#6]{\begingroup + \unsepspaces \def\printedmanual{\ignorespaces #5}% \def\printednodename{\ignorespaces #3}% \setbox1=\hbox{\printedmanual}% @@ -4320,7 +5220,7 @@ \else % Use the actual chapter/section title appear inside % the square brackets. Use the real section title if we have it. - \ifdim \wd1>0pt% + \ifdim \wd1 > 0pt % It is in another manual, so we don't have it. \def\printednodename{\ignorespaces #1}% \else @@ -4341,27 +5241,54 @@ % are best written with fairly long node names, containing hyphens, this % is a loss. Therefore, we give the text of the node name again, so it % is as if TeX is seeing it for the first time. + \ifpdf + \leavevmode + \getfilename{#4}% + \ifnum\filenamelength>0 + \startlink attr{/Border [0 0 0]}% + goto file{\the\filename.pdf} name{#1@}% + \else + \startlink attr{/Border [0 0 0]}% + goto name{#1@}% + \fi + \linkcolor + \fi + % \ifdim \wd1 > 0pt - \putwordsection{} ``\printednodename'' in \cite{\printedmanual}% + \putwordsection{} ``\printednodename'' \putwordin{} \cite{\printedmanual}% \else % _ (for example) has to be the character _ for the purposes of the % control sequence corresponding to the node, but it has to expand % into the usual \leavevmode...\vrule stuff for purposes of % printing. So we \turnoffactive for the \refx-snt, back on for the % printing, back off for the \refx-pg. - {\turnoffactive \refx{#1-snt}{}}% - \space [\printednodename],\space + {\normalturnoffactive + % Only output a following space if the -snt ref is nonempty; for + % @unnumbered and @anchor, it won't be. + \setbox2 = \hbox{\ignorespaces \refx{#1-snt}{}}% + \ifdim \wd2 > 0pt \refx{#1-snt}\space\fi + }% + % [mynode], + [\printednodename],\space + % page 3 \turnoffactive \putwordpage\tie\refx{#1-pg}{}% \fi + \endlink \endgroup} % \dosetq is the interface for calls from other macros -% Use \turnoffactive so that punctuation chars such as underscore -% work in node names. -\def\dosetq #1#2{{\let\folio=0 \turnoffactive -\edef\next{\write\auxfile{\internalsetq {#1}{#2}}}% -\next}} +% Use \normalturnoffactive so that punctuation chars such as underscore +% and backslash work in node names. (\turnoffactive doesn't do \.) +\def\dosetq#1#2{% + {\let\folio=0% + \normalturnoffactive + \edef\next{\write\auxfile{\internalsetq{#1}{#2}}}% + \iflinks + \next + \fi + }% +} % \internalsetq {foo}{page} expands into % CHARACTERS 'xrdef {foo}{...expansion of \Ypage...} @@ -4413,12 +5340,14 @@ \expandafter\ifx\csname X#1\endcsname\relax % If not defined, say something at least. \angleleft un\-de\-fined\angleright - \ifhavexrefs - \message{\linenumber Undefined cross reference `#1'.}% - \else - \ifwarnedxrefs\else - \global\warnedxrefstrue - \message{Cross reference values unknown; you must run TeX again.}% + \iflinks + \ifhavexrefs + \message{\linenumber Undefined cross reference `#1'.}% + \else + \ifwarnedxrefs\else + \global\warnedxrefstrue + \message{Cross reference values unknown; you must run TeX again.}% + \fi \fi \fi \else @@ -4429,7 +5358,7 @@ } % This is the macro invoked by entries in the aux file. -% +% \def\xrdef#1{\begingroup % Reenable \ as an escape while reading the second argument. \catcode`\\ = 0 @@ -4492,8 +5421,7 @@ \catcode`\$=\other \catcode`\#=\other \catcode`\&=\other - % `\+ does not work, so use 43. - \catcode43=\other + \catcode`+=\other % avoid \+ for paranoia even though we've turned it off % Make the characters 128-255 be printing characters {% \count 1=128 @@ -4582,6 +5510,8 @@ \xspaceskip\z@skip \parindent\defaultparindent % + \smallfonts \rm + % % Hang the footnote text off the number. \hang \textindent{\thisfootno}% @@ -4596,7 +5526,7 @@ \else\let\next\f@t\fi \next} \def\f@@t{\bgroup\aftergroup\@foot\let\next} \def\f@t#1{#1\@foot} -\def\@foot{\strut\egroup} +\def\@foot{\strut\par\egroup} }%end \catcode `\@=11 @@ -4655,23 +5585,25 @@ % @image. We use the macros from epsf.tex to support this. % If epsf.tex is not installed and @image is used, we complain. -% +% % Check for and read epsf.tex up front. If we read it only at @image % time, we might be inside a group, and then its definitions would get % undone and the next image would fail. \openin 1 = epsf.tex \ifeof 1 \else \closein 1 - \def\epsfannounce{\toks0 = }% do not bother showing banner + % Do not bother showing banner with post-v2.7 epsf.tex (available in + % doc/epsf.tex until it shows up on ctan). + \def\epsfannounce{\toks0 = }% \input epsf.tex \fi % +% We will only complain once about lack of epsf.tex. \newif\ifwarnednoepsf \newhelp\noepsfhelp{epsf.tex must be installed for images to work. It is also included in the Texinfo distribution, or you can get - it from ftp://ftp.tug.org/tex/epsf.tex.} + it from ftp://tug.org/tex/epsf.tex.} % -% Only complain once about lack of epsf.tex. \def\image#1{% \ifx\epsfbox\undefined \ifwarnednoepsf \else @@ -4689,42 +5621,79 @@ % #2 is (optional) width, #3 is (optional) height. % #4 is just the usual extra ignored arg for parsing this stuff. \def\imagexxx#1,#2,#3,#4\finish{% - % \epsfbox itself resets \epsf?size at each figure. - \setbox0 = \hbox{\ignorespaces #2}\ifdim\wd0 > 0pt \epsfxsize=#2\relax \fi - \setbox0 = \hbox{\ignorespaces #3}\ifdim\wd0 > 0pt \epsfysize=#3\relax \fi - \epsfbox{#1.eps}% + \ifpdf + \centerline{\dopdfimage{#1}{#2}{#3}}% + \else + % \epsfbox itself resets \epsf?size at each figure. + \setbox0 = \hbox{\ignorespaces #2}\ifdim\wd0 > 0pt \epsfxsize=#2\relax \fi + \setbox0 = \hbox{\ignorespaces #3}\ifdim\wd0 > 0pt \epsfysize=#3\relax \fi + \begingroup + \catcode`\^^M = 5 % in case we're inside an example + % If the image is by itself, center it. + \ifvmode + \nobreak\bigskip + % Usually we'll have text after the image which will insert + % \parskip glue, so insert it here too to equalize the space + % above and below. + \nobreak\vskip\parskip + \nobreak + \centerline{\epsfbox{#1.eps}}% + \bigbreak + \else + % In the middle of a paragraph, no extra space. + \epsfbox{#1.eps}% + \fi + \endgroup + \fi } -% End of control word definitions. - - -\message{and turning on texinfo input format.} - -\def\openindices{% - \newindex{cp}% - \newcodeindex{fn}% - \newcodeindex{vr}% - \newcodeindex{tp}% - \newcodeindex{ky}% - \newcodeindex{pg}% + +\message{localization,} +% and i18n. + +% @documentlanguage is usually given very early, just after +% @setfilename. If done too late, it may not override everything +% properly. Single argument is the language abbreviation. +% It would be nice if we could set up a hyphenation file here. +% +\def\documentlanguage{\parsearg\dodocumentlanguage} +\def\dodocumentlanguage#1{% + \tex % read txi-??.tex file in plain TeX. + % Read the file if it exists. + \openin 1 txi-#1.tex + \ifeof1 + \errhelp = \nolanghelp + \errmessage{Cannot read language file txi-#1.tex}% + \let\temp = \relax + \else + \def\temp{\input txi-#1.tex }% + \fi + \temp + \endgroup } - -% Set some numeric style parameters, for 8.5 x 11 format. - -\hsize = 6in -\hoffset = .25in +\newhelp\nolanghelp{The given language definition file cannot be found or +is empty. Maybe you need to install it? In the current directory +should work if nowhere else does.} + + +% @documentencoding should change something in TeX eventually, most +% likely, but for now just recognize it. +\let\documentencoding = \comment + + +% Page size parameters. +% \newdimen\defaultparindent \defaultparindent = 15pt -\parindent = \defaultparindent -\parskip 3pt plus 2pt minus 1pt -\setleading{13.2pt} -\advance\topskip by 1.2cm \chapheadingskip = 15pt plus 4pt minus 2pt \secheadingskip = 12pt plus 3pt minus 2pt \subsecheadingskip = 9pt plus 2pt minus 2pt % Prevent underfull vbox error messages. -\vbadness=10000 +\vbadness = 10000 + +% Don't be so finicky about underfull hboxes, either. +\hbadness = 2000 % Following George Bush, just get rid of widows and orphans. \widowpenalty=10000 @@ -4733,101 +5702,125 @@ % Use TeX 3.0's \emergencystretch to help line breaking, but if we're % using an old version of TeX, don't do anything. We want the amount of % stretch added to depend on the line length, hence the dependence on -% \hsize. This makes it come to about 9pt for the 8.5x11 format. +% \hsize. We call this whenever the paper size is set. +% +\def\setemergencystretch{% + \ifx\emergencystretch\thisisundefined + % Allow us to assign to \emergencystretch anyway. + \def\emergencystretch{\dimen0}% + \else + \emergencystretch = .15\hsize + \fi +} + +% Parameters in order: 1) textheight; 2) textwidth; 3) voffset; +% 4) hoffset; 5) binding offset; 6) topskip. Then whoever calls us can +% set \parskip and call \setleading for \baselineskip. % -\ifx\emergencystretch\thisisundefined - % Allow us to assign to \emergencystretch anyway. - \def\emergencystretch{\dimen0}% -\else - \emergencystretch = \hsize - \divide\emergencystretch by 45 -\fi - -% Use @smallbook to reset parameters for 7x9.5 format (or else 7x9.25) -\def\smallbook{ - \global\chapheadingskip = 15pt plus 4pt minus 2pt - \global\secheadingskip = 12pt plus 3pt minus 2pt - \global\subsecheadingskip = 9pt plus 2pt minus 2pt +\def\internalpagesizes#1#2#3#4#5#6{% + \voffset = #3\relax + \topskip = #6\relax + \splittopskip = \topskip + % + \vsize = #1\relax + \advance\vsize by \topskip + \outervsize = \vsize + \advance\outervsize by 2\topandbottommargin + \pageheight = \vsize + % + \hsize = #2\relax + \outerhsize = \hsize + \advance\outerhsize by 0.5in + \pagewidth = \hsize % - \global\lispnarrowing = 0.3in - \setleading{12pt} - \advance\topskip by -1cm - \global\parskip 2pt plus 1pt - \global\hsize = 5in - \global\vsize=7.5in - \global\tolerance=700 - \global\hfuzz=1pt - \global\contentsrightmargin=0pt - \global\deftypemargin=0pt - \global\defbodyindent=.5cm + \normaloffset = #4\relax + \bindingoffset = #5\relax + % + \parindent = \defaultparindent + \setemergencystretch +} + +% @letterpaper (the default). +\def\letterpaper{{\globaldefs = 1 + \parskip = 3pt plus 2pt minus 1pt + \setleading{13.2pt}% % - \global\pagewidth=\hsize - \global\pageheight=\vsize + % If page is nothing but text, make it come out even. + \internalpagesizes{46\baselineskip}{6in}{\voffset}{.25in}{\bindingoffset}{36pt}% +}} + +% Use @smallbook to reset parameters for 7x9.5 (or so) format. +\def\smallbook{{\globaldefs = 1 + \parskip = 2pt plus 1pt + \setleading{12pt}% + % + \internalpagesizes{7.5in}{5.in}{\voffset}{.25in}{\bindingoffset}{16pt}% % - \global\let\smalllisp=\smalllispx - \global\let\smallexample=\smalllispx - \global\def\Esmallexample{\Esmalllisp} -} + \lispnarrowing = 0.3in + \tolerance = 700 + \hfuzz = 1pt + \contentsrightmargin = 0pt + \deftypemargin = 0pt + \defbodyindent = .5cm + % + \let\smalldisplay = \smalldisplayx + \let\smallexample = \smalllispx + \let\smallformat = \smallformatx + \let\smalllisp = \smalllispx +}} % Use @afourpaper to print on European A4 paper. -\def\afourpaper{ -\global\tolerance=700 -\global\hfuzz=1pt -\setleading{12pt} -\global\parskip 15pt plus 1pt - -\global\vsize= 53\baselineskip -\advance\vsize by \topskip -%\global\hsize= 5.85in % A4 wide 10pt -\global\hsize= 6.5in -\global\outerhsize=\hsize -\global\advance\outerhsize by 0.5in -\global\outervsize=\vsize -\global\advance\outervsize by 0.6in - -\global\pagewidth=\hsize -\global\pageheight=\vsize -} - -\bindingoffset=0pt -\normaloffset=\hoffset -\pagewidth=\hsize -\pageheight=\vsize - -% Allow control of the text dimensions. Parameters in order: textheight; -% textwidth; voffset; hoffset; binding offset; topskip. -% All require a dimension; -% header is additional; added length extends the bottom of the page. - -\def\changepagesizes#1#2#3#4#5#6{ - \global\vsize= #1 - \global\topskip= #6 - \advance\vsize by \topskip - \global\voffset= #3 - \global\hsize= #2 - \global\outerhsize=\hsize - \global\advance\outerhsize by 0.5in - \global\outervsize=\vsize - \global\advance\outervsize by 0.6in - \global\pagewidth=\hsize - \global\pageheight=\vsize - \global\normaloffset= #4 - \global\bindingoffset= #5} +\def\afourpaper{{\globaldefs = 1 + \setleading{12pt}% + \parskip = 3pt plus 2pt minus 1pt + % + \internalpagesizes{53\baselineskip}{160mm}{\voffset}{4mm}{\bindingoffset}{44pt}% + % + \tolerance = 700 + \hfuzz = 1pt +}} % A specific text layout, 24x15cm overall, intended for A4 paper. Top margin % 29mm, hence bottom margin 28mm, nominal side margin 3cm. -\def\afourlatex - {\global\tolerance=700 - \global\hfuzz=1pt - \setleading{12pt} - \global\parskip 15pt plus 1pt - \advance\baselineskip by 1.6pt - \changepagesizes{237mm}{150mm}{3.6mm}{3.6mm}{3mm}{7mm} - } +\def\afourlatex{{\globaldefs = 1 + \setleading{13.6pt}% + % + \afourpaper + \internalpagesizes{237mm}{150mm}{3.6mm}{3.6mm}{3mm}{7mm}% + % + \globaldefs = 0 +}} % Use @afourwide to print on European A4 paper in wide format. -\def\afourwide{\afourpaper -\changepagesizes{9.5in}{6.5in}{\hoffset}{\normaloffset}{\bindingoffset}{7mm}} +\def\afourwide{% + \afourpaper + \internalpagesizes{9.5in}{6.5in}{\hoffset}{\normaloffset}{\bindingoffset}{7mm}% + % + \globaldefs = 0 +} + +% @pagesizes TEXTHEIGHT[,TEXTWIDTH] +% Perhaps we should allow setting the margins, \topskip, \parskip, +% and/or leading, also. Or perhaps we should compute them somehow. +% +\def\pagesizes{\parsearg\pagesizesxxx} +\def\pagesizesxxx#1{\pagesizesyyy #1,,\finish} +\def\pagesizesyyy#1,#2,#3\finish{{% + \setbox0 = \hbox{\ignorespaces #2}\ifdim\wd0 > 0pt \hsize=#2\relax \fi + \globaldefs = 1 + % + \parskip = 3pt plus 2pt minus 1pt + \setleading{13.2pt}% + % + \internalpagesizes{#1}{\hsize}{\voffset}{\normaloffset}{\bindingoffset}{44pt}% +}} + +% Set default to letter. +% +\letterpaper + + +\message{and turning on texinfo input format.} % Define macros to output various characters with catcode for normal text. \catcode`\"=\other @@ -4838,6 +5831,7 @@ \catcode`\<=\other \catcode`\>=\other \catcode`\+=\other +\catcode`\$=\other \def\normaldoublequote{"} \def\normaltilde{~} \def\normalcaret{^} @@ -4846,6 +5840,7 @@ \def\normalless{<} \def\normalgreater{>} \def\normalplus{+} +\def\normaldollar{$} % This macro is used to make a character print one way in ttfont % where it can probably just be output, and another way in other fonts, @@ -4856,7 +5851,13 @@ % interword stretch (and shrink), and it is reasonable to expect all % typewriter fonts to have this, we can check that font parameter. % -\def\ifusingtt#1#2{\ifdim \fontdimen3\the\font=0pt #1\else #2\fi} +\def\ifusingtt#1#2{\ifdim \fontdimen3\font=0pt #1\else #2\fi} + +% Same as above, but check for italic font. Actually this also catches +% non-italic slanted fonts since it is impossible to distinguish them from +% italic fonts. But since this is only used by $ and it uses \sl anyway +% this is not a problem. +\def\ifusingit#1#2{\ifdim \fontdimen1\font>0pt #1\else #2\fi} % Turn off all special characters except @ % (and those which the user can use as if they were ordinary). @@ -4864,10 +5865,10 @@ % use math or other variants that look better in normal text. \catcode`\"=\active -\def\activedoublequote{{\tt \char '042}} +\def\activedoublequote{{\tt\char34}} \let"=\activedoublequote \catcode`\~=\active -\def~{{\tt \char '176}} +\def~{{\tt\char126}} \chardef\hat=`\^ \catcode`\^=\active \def^{{\tt \hat}} @@ -4878,7 +5879,7 @@ \def\_{\leavevmode \kern.06em \vbox{\hrule width.3em height.1ex}} \catcode`\|=\active -\def|{{\tt \char '174}} +\def|{{\tt\char124}} \chardef \less=`\< \catcode`\<=\active \def<{{\tt \less}} @@ -4887,6 +5888,8 @@ \def>{{\tt \gtr}} \catcode`\+=\active \def+{{\tt \char 43}} +\catcode`\$=\active +\def${\ifusingit{{\sl\$}}\normaldollar} %\catcode 27=\active %\def^^[{$\diamondsuit$} @@ -4917,9 +5920,6 @@ % \normalbackslash outputs one backslash in fixed width font. \def\normalbackslash{{\tt\rawbackslashxx}} -% Say @foo, not \foo, in error messages. -\escapechar=`\@ - % \catcode 17=0 % Define control-q \catcode`\\=\active @@ -4933,7 +5933,8 @@ @let|=@normalverticalbar @let<=@normalless @let>=@normalgreater -@let+=@normalplus} +@let+=@normalplus +@let$=@normaldollar} @def@normalturnoffactive{@let"=@normaldoublequote @let\=@normalbackslash @@ -4943,7 +5944,8 @@ @let|=@normalverticalbar @let<=@normalless @let>=@normalgreater -@let+=@normalplus} +@let+=@normalplus +@let$=@normaldollar} % Make _ and + \other characters, temporarily. % This is canceled by @fixbackslash. @@ -4962,16 +5964,29 @@ % Also back turn on active characters that might appear in the input % file name, in case not using a pre-dumped format. % -@gdef@fixbackslash{@ifx\@eatinput @let\ = @normalbackslash @fi - @catcode`+=@active @catcode`@_=@active} - -%% These look ok in all fonts, so just make them not special. The @rm below -%% makes sure that the current font starts out as the newly loaded cmr10 -@catcode`@$=@other @catcode`@%=@other @catcode`@&=@other @catcode`@#=@other - +@gdef@fixbackslash{% + @ifx\@eatinput @let\ = @normalbackslash @fi + @catcode`+=@active + @catcode`@_=@active +} + +% Say @foo, not \foo, in error messages. +@escapechar = `@@ + +% These look ok in all fonts, so just make them not special. +@catcode`@& = @other +@catcode`@# = @other +@catcode`@% = @other + +@c Set initial fonts. @textfonts @rm + @c Local variables: +@c eval: (add-hook 'write-file-hooks 'time-stamp) @c page-delimiter: "^\\\\message" +@c time-stamp-start: "def\\\\texinfoversion{" +@c time-stamp-format: "%:y-%02m-%02d.%02H" +@c time-stamp-end: "}" @c End: diff -r f4aeb21a5bad -r 74fd4e045ea6 man/texinfo.texi --- a/man/texinfo.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/texinfo.texi Mon Aug 13 11:13:30 2007 +0200 @@ -1,9 +1,9 @@ \input texinfo.tex @c -*-texinfo-*- -@c $Id: texinfo.texi,v 1.8.2.1 1999/03/04 15:48:24 steveb Exp $ +@c $Id: texinfo.texi,v 1.8.2.4 1999/12/05 19:02:24 martinb Exp $ @c %**start of header @c All text is ignored before the setfilename. -@setfilename ../info/texinfo +@setfilename ../info/texinfo.info @settitle Texinfo @value{edition} @c Edition number is now the same as the Texinfo distribution version number. @@ -7448,13 +7448,6 @@ @tex % Remove extra vskip; this is a kludge to counter the effect of display \vskip-3\baselineskip -{\ninett -\dots{} to make sure that you have the freedom to -distribute copies of free software (and charge for -this service if you wish), that you receive source -code or can get it if you want it, that you can -change the software or use pieces of it in new free -programs; and that you know you can do these things.} @end tex @end display @end ifclear @@ -14206,7 +14199,7 @@ (thousandths of an inch) remain on the current page. @xref{need, , @code{@@need}}.@refill -@item @@node @var{name, next, previous, up} +@item @@node @var{name}, @var{next}, @var{previous}, @var{up} Define the beginning of a new node in Info, and serve as a locator for references for @TeX{}. @xref{node, , @code{@@node}}.@refill diff -r f4aeb21a5bad -r 74fd4e045ea6 man/widget.texi --- a/man/widget.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/widget.texi Mon Aug 13 11:13:30 2007 +0200 @@ -1,7 +1,7 @@ \input texinfo.tex @c %**start of header -@setfilename ../info/widget +@setfilename ../info/widget.info @settitle The Emacs Widget Library @iftex @afourpaper @@ -9,6 +9,13 @@ @end iftex @c %**end of header +@ifinfo +@dircategory XEmacs Editor +@direntry +* Widgets: (widget). The Emacs Widget Library. +@end direntry +@end ifinfo + @node Top, Introduction, (dir), (dir) @comment node-name, next, previous, up @top The Emacs Widget Library @@ -291,69 +298,69 @@ (make-local-variable 'widget-example-repeat) (widget-insert "Here is some documentation.\n\nName: ") (widget-create 'editable-field - :size 13 - "My Name") + :size 13 + "My Name") (widget-create 'menu-choice - :tag "Choose" - :value "This" - :help-echo "Choose me, please!" - :notify (lambda (widget &rest ignore) - (message "%s is a good choice!" - (widget-value widget))) - '(item :tag "This option" :value "This") - '(choice-item "That option") - '(editable-field :menu-tag "No option" "Thus option")) + :tag "Choose" + :value "This" + :help-echo "Choose me, please!" + :notify (lambda (widget &rest ignore) + (message "%s is a good choice!" + (widget-value widget))) + '(item :tag "This option" :value "This") + '(choice-item "That option") + '(editable-field :menu-tag "No option" "Thus option")) (widget-insert "Address: ") (widget-create 'editable-field - "Some Place\nIn some City\nSome country.") + "Some Place\nIn some City\nSome country.") (widget-insert "\nSee also ") (widget-create 'link - :notify (lambda (&rest ignore) - (widget-value-set widget-example-repeat - '("En" "To" "Tre")) - (widget-setup)) - "other work") + :notify (lambda (&rest ignore) + (widget-value-set widget-example-repeat + '("En" "To" "Tre")) + (widget-setup)) + "other work") (widget-insert " for more information.\n\nNumbers: count to three below\n") (setq widget-example-repeat - (widget-create 'editable-list - :entry-format "%i %d %v" - :notify (lambda (widget &rest ignore) - (let ((old (widget-get widget - ':example-length)) - (new (length (widget-value widget)))) - (unless (eq old new) - (widget-put widget ':example-length new) - (message "You can count to %d." new)))) - :value '("One" "Eh, two?" "Five!") - '(editable-field :value "three"))) + (widget-create 'editable-list + :entry-format "%i %d %v" + :notify (lambda (widget &rest ignore) + (let ((old (widget-get widget + ':example-length)) + (new (length (widget-value widget)))) + (unless (eq old new) + (widget-put widget ':example-length new) + (message "You can count to %d." new)))) + :value '("One" "Eh, two?" "Five!") + '(editable-field :value "three"))) (widget-insert "\n\nSelect multiple:\n\n") (widget-create 'checkbox t) (widget-insert " This\n") (widget-create 'checkbox nil) (widget-insert " That\n") (widget-create 'checkbox - :notify (lambda (&rest ignore) (message "Tickle")) - t) + :notify (lambda (&rest ignore) (message "Tickle")) + t) (widget-insert " Thus\n\nSelect one:\n\n") (widget-create 'radio-button-choice - :value "One" - :notify (lambda (widget &rest ignore) - (message "You selected %s" - (widget-value widget))) - '(item "One") '(item "Another One.") '(item "A Final One.")) + :value "One" + :notify (lambda (widget &rest ignore) + (message "You selected %s" + (widget-value widget))) + '(item "One") '(item "Another One.") '(item "A Final One.")) (widget-insert "\n") (widget-create 'push-button - :notify (lambda (&rest ignore) - (if (= (length (widget-value widget-example-repeat)) - 3) - (message "Congratulation!") - (error "Three was the count!"))) - "Apply Form") + :notify (lambda (&rest ignore) + (if (= (length (widget-value widget-example-repeat)) + 3) + (message "Congratulation!") + (error "Three was the count!"))) + "Apply Form") (widget-insert " ") (widget-create 'push-button - :notify (lambda (&rest ignore) - (widget-example)) - "Reset Form") + :notify (lambda (&rest ignore) + (widget-example)) + "Reset Form") (widget-insert "\n") (use-local-map widget-keymap) (widget-setup)) @@ -455,11 +462,11 @@ @item %@{ @itemx %@} -The text inside will be displayed with the face specified by -@code{:sample-face}. +The text inside will be displayed in the face specified by +@code{:sample-face}. @item %v -This will be replaces with the buffer representation of the widgets +This will be replaced with the buffer representation of the widget's value. What this is depends on the widget type. @item %d @@ -553,8 +560,8 @@ @item :validate A function which takes a widget as an argument, and return nil if the -widgets current value is valid for the widget. Otherwise, it should -return the widget containing the invalid data, and set that widgets +widget's current value is valid for the widget. Otherwise it should +return the widget containing the invalid data, and set that widget's @code{:error} property to a string explaining the error. The following predefined function can be used: @@ -757,10 +764,10 @@ TYPE ::= (menu-choice [KEYWORD ARGUMENT]... TYPE ... ) @end example -The @var{type} arguments represents each possible choice. The widgets -value of will be the value of the chosen @var{type} argument. This -widget will match any value that matches at least one of the specified -@var{type} arguments. +The @var{type} argument represents each possible choice. The widget's +value will be that of the chosen @var{type} argument. This widget will +match any value matching at least one of the specified @var{type} +arguments. @table @code @item :void @@ -792,10 +799,10 @@ TYPE ::= (radio-button-choice [KEYWORD ARGUMENT]... TYPE ... ) @end example -The @var{type} arguments represents each possible choice. The widgets -value of will be the value of the chosen @var{type} argument. This -widget will match any value that matches at least one of the specified -@var{type} arguments. +The @var{type} argument represents each possible choice. The widget's +value will be that of the chosen @var{type} argument. This widget will +match any value matching at least one of the specified @var{type} +arguments. The following extra properties are recognized. @@ -882,8 +889,8 @@ TYPE ::= (toggle [KEYWORD ARGUMENT]...) @end example -The widget has two possible states, `on' and `off', which corresponds to -a @code{t} or @code{nil} value. +The widget has two possible states, `on' and `off', which correspond to +a @code{t} or @code{nil} value respectively. The following extra properties are recognized. @@ -923,10 +930,10 @@ TYPE ::= (checklist [KEYWORD ARGUMENT]... TYPE ... ) @end example -The @var{type} arguments represents each checklist item. The widgets -value of will be a list containing the value of each ticked @var{type} -argument. The checklist widget will match a list whose elements all -matches at least one of the specified @var{type} arguments. +The @var{type} arguments represents each checklist item. The widget's +value will be a list containing the values of all ticked @var{type} +arguments. The checklist widget will match a list whose elements all +match at least one of the specified @var{type} arguments. The following extra properties are recognized. @@ -944,11 +951,11 @@ @end table @item :greedy -Usually, a checklist will only match if the items are in the exact +Usually a checklist will only match if the items are in the exact sequence given in the specification. By setting @code{:greedy} to -non-nil, it will allow the items to come in any sequence. However, if -you extract the value they will be in the sequence given in the -checklist. I.e. the original sequence is forgotten. +non-nil, it will allow the items to appear in any sequence. However, if +you extract the values they will be in the sequence given in the +checklist. I.e. the original sequence is forgotten. @item button-args A list of keywords to pass to the checkboxes. Useful for setting @@ -1229,13 +1236,13 @@ @samp{(file t)} or @code{(file string string)}. This concept of inline is probably hard to understand. It was certainly -hard to implement so instead of confuse you more by trying to explain it -here, I'll just suggest you meditate over it for a while. +hard to implement so instead of confusing you more by trying to explain +it here, I'll just suggest you meditate over it for a while. @deffn Widget choice -Allows you to edit a sexp which may have one of fixed set of types. It -is currently implemented with the @code{choice-menu} basic widget, and -has a similar syntax. +Allows you to edit a sexp which may have one of a fixed set of types. +It is currently implemented with the @code{choice-menu} basic widget, +and has a similar syntax. @end deffn @deffn Widget set @@ -1319,9 +1326,9 @@ (widget-apply @var{widget} :activate) @end lisp -A widget is inactive if itself, or any of its ancestors (found by +A widget is inactive if itself or any of its ancestors (found by following the @code{:parent} link) have been deactivated. To make sure -a widget is really active, you must therefore activate both itself, and +a widget is really active, you must therefore activate both itself and all its ancestors. @lisp @@ -1331,12 +1338,12 @@ @end lisp You can check if a widget has been made inactive by examining the value -of @code{:inactive} keyword. If this is non-nil, the widget itself has -been deactivated. This is different from using the @code{:active} -keyword, in that the later tell you if the widget @strong{or} any of its -ancestors have been deactivated. Do not attempt to set the +of the @code{:inactive} keyword. If this is non-nil, the widget itself +has been deactivated. This is different from using the @code{:active} +keyword, in that the latter tells you if the widget @strong{or} any of +its ancestors have been deactivated. Do not attempt to set the @code{:inactive} keyword directly. Use the @code{:activate} -@code{:deactivated} keywords instead. +@code{:deactivate} keywords instead. @node Defining New Widgets, Widget Browser, Widget Properties, Top @@ -1344,9 +1351,9 @@ @section Defining New Widgets You can define specialized widgets with @code{define-widget}. It allows -you to create a shorthand for more complex widgets, including specifying -component widgets and default new default values for the keyword -arguments. +you to create a shorthand for more complex widgets. This includes +specifying component widgets and new default values for the keyword +arguments. @defun widget-define name class doc &rest args Define a new widget type named @var{name} from @code{class}. @@ -1356,7 +1363,7 @@ The third argument @var{DOC} is a documentation string for the widget. -After the new widget has been defined, the following two calls will +After the new widget has been defined the following two calls will create identical widgets: @itemize @bullet @@ -1373,8 +1380,8 @@ @end defun -Using @code{widget-define} does just store the definition of the widget -type in the @code{widget-type} property of @var{name}, which is what +Using @code{widget-define} just stores the definition of the widget type +in the @code{widget-type} property of @var{name}, which is what @code{widget-create} uses. If you just want to specify defaults for keywords with no complex @@ -1387,7 +1394,7 @@ Function to convert a widget type before creating a widget of that type. It takes a widget type as an argument, and returns the converted widget type. When a widget is created, this function is called for the -widget type and all the widgets parent types, most derived first. +widget type and all the widget's parent types, most derived first. The following predefined functions can be used here: @@ -1401,7 +1408,7 @@ @item :value-to-internal Function to convert the value to the internal format. The function -takes two arguments, a widget and an external value, and returns the +takes two arguments, a widget and an external value. It returns the internal value. The function is called on the present @code{:value} when the widget is created, and on any value set later with @code{widget-value-set}. @@ -1415,8 +1422,8 @@ @item :create Function to create a widget from scratch. The function takes one -argument, a widget type, and create a widget of that type, insert it in -the buffer, and return a widget object. +argument, a widget type, and creates a widget of that type, inserts it +in the buffer, and returns a widget object. @item :delete Function to delete a widget. The function takes one argument, a widget, @@ -1424,14 +1431,14 @@ @item :value-create Function to expand the @samp{%v} escape in the format string. It will -be called with the widget as its argument. Should -insert a representation of the widgets value in the buffer. +be called with the widget as its argument and should insert a +representation of the widget's value in the buffer. @item :value-delete -Should remove the representation of the widgets value from the buffer. +Should remove the representation of the widget's value from the buffer. It will be called with the widget as its argument. It doesn't have to remove the text, but it should release markers and delete nested widgets -if such has been used. +if such have been used. The following predefined function can be used here: @@ -1455,8 +1462,8 @@ You can set this to allow your widget to handle non-standard escapes. You should end up calling @code{widget-default-format-handler} to handle -unknown escape sequences, which will handle the @samp{%h} and any future -escape sequences, as well as give an error for unknown escapes. +unknown escape sequences. It will handle the @samp{%h} and any future +escape sequences as well as give an error for unknown escapes. @item :action Function to handle user initiated events. By default, @code{:notify} @@ -1474,9 +1481,9 @@ take four arguments, @var{widget}, @var{prompt}, @var{value}, and @var{unbound} and should return a value for widget entered by the user. @var{prompt} is the prompt to use. @var{value} is the default value to -use, unless @var{unbound} is non-nil in which case there are no default +use, unless @var{unbound} is non-nil. In this case there is no default value. The function should read the value using the method most natural -for this widget, and does not have to check that it matches. +for this widget and does not have to check whether it matches. @end table If you want to define a new widget from scratch, use the @code{default} diff -r f4aeb21a5bad -r 74fd4e045ea6 man/xemacs-faq.texi --- a/man/xemacs-faq.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/xemacs-faq.texi Mon Aug 13 11:13:30 2007 +0200 @@ -7,17 +7,25 @@ @finalout @titlepage @title XEmacs FAQ -@subtitle Frequently asked questions about XEmacs @* Last Modified: $Date: 1999/03/04 15:48:25 $ +@subtitle Frequently asked questions about XEmacs @* Last Modified: $Date: 2000/01/27 17:11:28 $ @sp 1 -@author Tony Rossini <arossini@@stat.sc.edu> -@author Ben Wing <wing@@666.com> +@author Tony Rossini <rossini@@biostat.washington.edu> +@author Ben Wing <ben@@xemacs.org> @author Chuck Thompson <cthomp@@xemacs.org> @author Steve Baur <steve@@xemacs.org> @author Andreas Kaempf <andreas@@sccon.com> @author Christian Nyb@o{} <chr@@mediascience.no> +@author Sandra Wambold <wambold@@xemacs.org> @page @end titlepage +@ifinfo +@dircategory XEmacs Editor +@direntry +* FAQ: (xemacs-faq). XEmacs FAQ. +@end direntry +@end ifinfo + @node Top, Introduction, (dir), (dir) @top XEmacs FAQ @unnumbered Introduction @@ -81,6 +89,7 @@ * Customization:: Customization and Options. * Subsystems:: Major Subsystems. * Miscellaneous:: The Miscellaneous Stuff. +* MS Windows:: XEmacs on Microsoft Windows. * Current Events:: What the Future Holds. @detailmenu @@ -130,7 +139,6 @@ * Q1.4.4:: May I see an example of a useful XEmacs Lisp function? * Q1.4.5:: And how do I bind it to a key? * Q1.4.6:: What's the difference between a macro and a function? -* Q1.4.7:: Why options saved with 19.13 don't work with 19.14 or later? Installation and Trouble Shooting @@ -146,8 +154,6 @@ * Q2.0.10:: After I run configure I find a coredump, is something wrong? * Q2.0.11:: XEmacs can't resolve host names. * Q2.0.12:: Why can't I strip XEmacs? -* Q2.0.13:: Can't link XEmacs on Solaris with Gcc. -* Q2.0.14:: Make on HP/UX 9 fails after linking temacs Trouble Shooting: * Q2.1.1:: XEmacs just crashed on me! @@ -167,12 +173,13 @@ * Q2.1.15:: How to debug an XEmacs problem with a debugger. * Q2.1.16:: XEmacs crashes in @code{strcat} on HP/UX 10. * Q2.1.17:: @samp{Marker does not point anywhere}. -* Q2.1.18:: 19.14 hangs on HP/UX 10.10. +* Q2.1.18:: [This question intentionally left blank] * Q2.1.19:: XEmacs does not follow the local timezone. * Q2.1.20:: @samp{Symbol's function definition is void: hkey-help-show.} -* Q2.1.21:: Every so often the XEmacs frame freezes. +* Q2.1.21:: [This question intentionally left blank] * Q2.1.22:: XEmacs seems to take a really long time to do some things. * Q2.1.23:: Movemail on Linux does not work for XEmacs 19.15 and later. +* Q2.1.24:: XEmacs won't start without network. (NEW) Customization and Options @@ -189,8 +196,8 @@ X Window System & Resources: * Q3.1.1:: Where is a list of X resources? * Q3.1.2:: How can I detect a color display? -* Q3.1.3:: @code{(set-screen-width)} worked in 19.6, but not in 19.13? -* Q3.1.4:: Specifying @code{Emacs*EmacsScreen.geometry} in @file{.emacs} does not work in 19.15? +* Q3.1.3:: [This question intentionally left blank] +* Q3.1.4:: [This question intentionally left blank] * Q3.1.5:: How can I get the icon to just say @samp{XEmacs}? * Q3.1.6:: How can I have the window title area display the full path? * Q3.1.7:: @samp{xemacs -name junk} doesn't work? @@ -298,6 +305,7 @@ Sparcworks, EOS, and WorkShop: * Q4.4.1:: What is SPARCworks, EOS, and WorkShop +* Q4.4.2:: How do I start the Sun Workshop support in XEmacs 21? Energize: * Q4.5.1:: What is/was Energize? @@ -308,7 +316,7 @@ Other Unbundled Packages: * Q4.7.1:: What is AUC TeX? Where do you get it? * Q4.7.2:: Are there any Emacs Lisp Spreadsheets? -* Q4.7.3:: Byte compiling AUC TeX on XEmacs 19.14 +* Q4.7.3:: [This question intentionally left blank] * Q4.7.4:: Problems installing AUC TeX * Q4.7.5:: Is there a reason for an Emacs package not to be included in XEmacs? * Q4.7.6:: Is there a MatLab mode? @@ -325,14 +333,14 @@ * Q5.0.8:: Why does edt emulation not work? * Q5.0.9:: How can I emulate VI and use it as my default mode? * Q5.0.10:: [This question intentionally left blank] -* Q5.0.11:: Filladapt doesn't work in 19.15? +* Q5.0.11:: How do I turn on filladapt for all buffers? * Q5.0.12:: How do I disable gnuserv from opening a new frame? * Q5.0.13:: How do I start gnuserv so that each subsequent XEmacs is a client? * Q5.0.14:: Strange things are happening in Shell Mode. * Q5.0.15:: Where do I get the latest CC Mode? * Q5.0.16:: I find auto-show-mode disconcerting. How do I turn it off? * Q5.0.17:: How can I get two instances of info? -* Q5.0.18:: I upgraded to XEmacs 19.14 and gnuserv stopped working +* Q5.0.18:: [This question intentionally left blank] * Q5.0.19:: Is there something better than LaTeX mode? * Q5.0.20:: Is there a way to start a new XEmacs if there's no gnuserv running, and otherwise use gnuclient? @@ -369,12 +377,38 @@ * Q5.3.11:: How do I add new Info directories? * Q5.3.12:: What do I need to change to make printing work? -What the Future Holds - -* Q6.0.1:: What is new in 20.2? -* Q6.0.2:: What is new in 20.3? -* Q6.0.3:: What is new in 20.4? -* Q6.0.4:: Procedural changes in XEmacs development. +XEmacs on MS Windows + +General Info: +* Q6.0.1:: What is the status of the XEmacs port to Windows? +* Q6.0.2:: What flavors of MS Windows are supported? +* Q6.0.3:: Are binary kits available? +* Q6.0.4:: Does XEmacs on MS Windows require an X server to run? + +Building XEmacs on MS Windows: +* Q6.1.1:: I decided to run with X. Where do I get an X server? +* Q6.1.2:: What compiler do I need to compile XEmacs? +* Q6.1.3:: How do I compile for the native port? +* Q6.1.4:: How do I compile for the X port? +* Q6.1.5:: How do I compile for Cygnus' Cygwin? +* Q6.1.6:: What do I need for Cygwin? + +Customization and User Interface: +* Q6.2.1:: How will the port cope with differences in the Windows user interface? +* Q6.2.2:: How do I change fonts in XEmacs on MS Windows? +* Q6.2.3:: Where do I put my @file{.emacs} file? + +Miscellaneous: +* Q6.3.1:: Will XEmacs rename all the win32-* symbols to w32-*? +* Q6.3.2:: What are the differences between the various MS Windows emacsen? +* Q6.3.3:: What is the porting team doing at the moment? + +Current Events: + +* Q7.0.1:: What is new in 20.2? +* Q7.0.2:: What is new in 20.3? +* Q7.0.3:: What is new in 20.4? +* Q7.0.4:: Procedural changes in XEmacs development. @end detailmenu @end menu @@ -388,26 +422,24 @@ wondering what to do next. It is also useful as a reference to available resources. -The previous maintainer of the FAQ was @email{rossini@@stat.sc.edu, +The previous maintainer of the FAQ was @email{rossini@@biostat.washington.edu, Anthony Rossini}, who started it, after getting tired of hearing JWZ complain about repeatedly having to answer questions. -@email{ben@@666.com, Ben Wing} and @email{cthomp@@xemacs.org, Chuck +@email{ben@@xemacs.org, Ben Wing} and @email{cthomp@@xemacs.org, Chuck Thompson}, the principal authors of XEmacs, then took over and Ben did a massive update reorganizing the whole thing. At which point Anthony took back over, but then had to give it up again. Some of the other contributors to this FAQ are listed later in this document. The previous version was converted to hypertext format, and edited by -@email{steve@@altair.xemacs.org, Steven L. Baur}. It was converted back to -texinfo by @email{hniksic@@srce.hr, Hrvoje Niksic}. - -The FAQ was then maintained by @email{andreas@@sccon.com, Andreas -Kaempf}, who passed it on to @email{faq@@xemacs.org, Christian -Nyb@o{}}, the current FAQ maintainer. +@email{steve@@xemacs.org, Steven L. Baur}. It was converted back to +texinfo by @email{hniksic@@xemacs.org, Hrvoje Niksic}. The FAQ was then +maintained by @email{andreas@@sccon.com, Andreas Kaempf}, who passed it +on to ChristianNyb@o{}. If you notice any errors or items which should be added or amended to -this FAQ please send email to @email{faq@@xemacs.org, Christian -Nyb@o{}}. Include @samp{XEmacs FAQ} on the Subject: line. +this FAQ please send email to @email{faq@@xemacs.org, Sandra +Wambold}. Include @samp{XEmacs FAQ} on the Subject: line. @menu Introduction: @@ -452,7 +484,6 @@ * Q1.4.4:: May I see an example of a useful XEmacs Lisp function? * Q1.4.5:: And how do I bind it to a key? * Q1.4.6:: What's the difference between a macro and a function? -* Q1.4.7:: Why options saved with 19.13 don't work with 19.14 or later? @end menu @node Q1.0.1, Q1.0.2, Introduction, Introduction @@ -469,6 +500,8 @@ @node Q1.0.2, Q1.0.3, Q1.0.1, Introduction @unnumberedsubsec Q1.0.2: What is the current version of XEmacs? +XEmacs 21.1.8 is the current stable version of XEmacs. + XEmacs 20.4 is a minor upgrade from 20.3, containing many bugfixes. It was released in February 1998. @@ -478,7 +511,7 @@ @node Q1.0.3, Q1.0.4, Q1.0.2, Introduction @unnumberedsubsec Q1.0.3: Where can I find it? -The canonical source and binaries is found via anonymous FTP at: +The canonical source and binaries can be found via anonymous FTP at: @example @uref{ftp://ftp.xemacs.org/pub/xemacs/} @@ -490,7 +523,7 @@ For a detailed description of the differences between GNU Emacs and XEmacs and a detailed history of XEmacs, check out the @example -@uref{http://www.xemacs.org/NEWS.html, NEWS file} +@uref{http://www.xemacs.org/About/XEmacsVsGNUemacs.html, NEWS file} @end example However, here is a list of some of the reasons why we think you might @@ -572,44 +605,37 @@ @node Q1.0.6, Q1.0.7, Q1.0.5, Introduction @unnumberedsubsec Q1.0.6: Where can I get help? -Probably the easiest way, if everything is installed, is to use info, by -pressing @kbd{C-h i}, or selecting @code{Emacs Info} from the Help Menu. - -Also, @kbd{M-x apropos} will look for commands for you. - -Try reading this FAQ, examining the regular GNU Emacs FAQ (which can be -found with the Emacs 19 distribution) as well as at -@uref{http://www.eecs.nwu.edu/emacs/faq/} and reading the Usenet group -comp.emacs.xemacs. - -If that does not help, try posting your question to comp.emacs.xemacs. -Please @strong{do not} post XEmacs related questions to gnu.emacs.help. +Probably the easiest way, if everything is installed, is to use Info, by +pressing @kbd{C-h i}, or selecting @code{Manuals->Info} from the +Help Menu. @kbd{M-x apropos} can be used to look for particular commands. + +For items not found in the manual, try reading this FAQ +@comment , examining the regular GNU Emacs FAQ (which can be +@comment found with the Emacs 19 distribution) as well as at +@comment @uref{http://www.eecs.nwu.edu/emacs/faq/} +and reading the Usenet group comp.emacs.xemacs. + +If you choose to post to a newsgroup, @strong{please use +comp.emacs.xemacs}. Please do not post XEmacs related questions to +gnu.emacs.help. If you cannot post or read Usenet news, there is a corresponding mailing list which is available. It can be subscribed to by sending a message -with a subject of @samp{subscribe} to @email{xemacs-request@@xemacs.org} -for subscription information and @email{xemacs@@xemacs.org} to send messages -to the list. - -To cancel a subscription, you @strong{must} use the xemacs-request -address. Send a message with a subject of @samp{unsubscribe} to be -removed. +to @email{xemacs-request@@xemacs.org} with @samp{subscribe} in the +body of the message. Send to the list at @email{xemacs@@xemacs.org}. +list. To cancel a subscription, you @strong{must} use the +xemacs-request address. Send a message with a subject of +@samp{unsubscribe} to be removed. @node Q1.0.7, Q1.0.8, Q1.0.6, Introduction @unnumberedsubsec Q1.0.7: Where is the mailing list archived? -The mailing list was archived in the directory -@example -@uref{ftp://ftp.xemacs.org/pub/mlists/}. -@end example - -However, this archive is out of date. The current mailing list server -supports an @code{archive} feature, which may be utilized. +The archives can be found at @uref{http://www.xemacs.org/Lists/Archive} @node Q1.0.8, Q1.0.9, Q1.0.7, Introduction @unnumberedsubsec Q1.0.8: How do you pronounce XEmacs? -I pronounce it @samp{Eks eemax}. +The most common pronounciation is @samp{Eks eemax}. @node Q1.0.9, Q1.0.10, Q1.0.8, Introduction @unnumberedsubsec Q1.0.9: What does XEmacs look like? @@ -622,51 +648,58 @@ @node Q1.0.10, Q1.0.11, Q1.0.9, Introduction @unnumberedsubsec Q1.0.10: Is there a port of XEmacs to Microsoft ('95 or NT)? -Thanks to efforts of many people, coordinated by -@email{davidh@@wr.com.au, David Hobley} and @email{marcpa@@cam.org, Marc -Paquette}, beta versions of XEmacs now run on 32-bit Windows platforms -(NT and 95). The current betas require having an X server to run -XEmacs; however, a native NT/95 port is in alpha, thanks to -@email{jhar@@tardis.ed.ac.uk, Jonathan Harris}. - -Although some features are still unimplemented, XEmacs 21.0 will support -MS-Windows. - -The NT development is now coordinated by a mailing list at -@email{xemacs-nt@@xemacs.org}. - -If you are willing to contribute or want to follow the progress, mail to -@iftex -@* -@end iftex -@email{xemacs-nt-request@@xemacs.org} to subscribe. - -Furthermore, Altrasoft is seeking corporate and government sponsors to -help fund a fully native port of XEmacs to Windows 95 and NT using -full-time, senior-level staff working under a professionally managed -project structure. See @uref{http://www.altrasoft.com/, the Altrasoft -web site} for more details -or contact Altrasoft directly at 1-888-ALTSOFT. - - -The closest existing port is @dfn{Win-Emacs}, which is based on Lucid -Emacs 19.6. Available from @uref{http://www.pearlsoft.com/}. - -There's a port of GNU Emacs (not XEmacs) at -@example -@uref{http://www.cs.washington.edu/homes/voelker/ntemacs.html}. -@end example +Yes, @xref{MS Windows}. + +@comment Thanks to efforts of many people, coordinated by +@comment @email{davidh@@wr.com.au, David Hobley} and @email{marcpa@@cam.org, Marc +@comment Paquette}, beta versions of XEmacs now run on 32-bit Windows platforms +@comment (NT and 95). The current betas require having an X server to run +@comment XEmacs; however, a native NT/95 port is in alpha, thanks to +@comment @email{jhar@@tardis.ed.ac.uk, Jonathan Harris}. +@comment +@comment Although some features are still unimplemented, XEmacs 21.0 will support +@comment MS-Windows. +@comment +@comment The NT development is now coordinated by a mailing list at +@comment @email{xemacs-nt@@xemacs.org}. +@comment +@comment If you are willing to contribute or want to follow the progress, mail to +@comment @iftex +@comment @* +@comment @end iftex +@comment @email{xemacs-nt-request@@xemacs.org} to subscribe. +@comment +@comment Furthermore, Altrasoft is seeking corporate and government sponsors to +@comment help fund a fully native port of XEmacs to Windows 95 and NT using +@comment full-time, senior-level staff working under a professionally managed +@comment project structure. See @uref{http://www.altrasoft.com/, the Altrasoft +@comment web site} for more details +@comment or contact Altrasoft directly at 1-888-ALTSOFT. +@comment +@comment +@comment The closest existing port is @dfn{Win-Emacs}, which is based on Lucid +@comment Emacs 19.6. Available from @uref{http://www.pearlsoft.com/}. +@comment +@comment There's a port of GNU Emacs (not XEmacs) at +@comment @example +@comment @uref{http://www.cs.washington.edu/homes/voelker/ntemacs.html}. +@comment @end example @node Q1.0.11, Q1.0.12, Q1.0.10, Introduction @unnumberedsubsec Q1.0.11: Is there a port of XEmacs to the Macintosh? @c changed -There has been a port to the MachTen environment of XEmacs 19.13, but no -patches have been submitted to the maintainers to get this in the -mainstream distribution. - -For the MacOS, there is a port of -@uref{ftp://ftp.cs.cornell.edu/pub/parmet/, Emacs 18.59}. +@c There has been a port to the MachTen environment of XEmacs 19.13, but no +@c patches have been submitted to the maintainers to get this in the +@c mainstream distribution. +@c +@c For the MacOS, there is a port of +@c @uref{ftp://ftp.cs.cornell.edu/pub/parmet/, Emacs 18.59}. + +Yes, there is a port of XEmacs 19.14, tested on MacOS 7.6.1 and MacOS +8.5.1 by @uref{pjarvis@@ispchannel.com,Pitts Jarvis}. It's available +at @uref{http://my.ispchannel.com/~pjarvis/xemacs.html, +http://my.ispchannel.com/~pjarvis/xemacs.html}. @node Q1.0.12, Q1.0.13, Q1.0.11, Introduction @unnumberedsubsec Q1.0.12: Is there a port of XEmacs to NextStep? @@ -678,44 +711,31 @@ @node Q1.0.13, Q1.0.14, Q1.0.12, Introduction @unnumberedsubsec Q1.0.13: Is there a port of XEmacs to OS/2? -No, and there is no news of anyone working on it. +No, but Alexander Nikolaev <avn_1251@@mail.ru> is working on it. @node Q1.0.14, Q1.1.1, Q1.0.13, Introduction @unnumberedsubsec Q1.0.14: Where can I obtain a printed copy of the XEmacs users manual? -Altrasoft Associates, a firm specializing in Emacs-related support and -development, will be maintaining the XEmacs user manual. The firm plans -to begin publishing printed copies of the manual soon. -@c This used to say `March 1997'! - -@example - Web: @uref{http://www.xemacs.com} - E-mail: @email{info@@xemacs.com} - Tel: +1 408 243 3300 -@end example +Pre-printed manuals are not available. If you are familiar with +TeX, you can generate your own manual from the XEmacs sources. + +HTML and Postscript versions of XEmacs manuals may be available from the +XEmacs web site in the future. + @node Q1.1.1, Q1.1.2, Q1.0.14, Introduction @unnumberedsec 1.1: Policies @unnumberedsubsec Q1.1.1: What is the FAQ editorial policy? The FAQ is actively maintained and modified regularly. All links should -be up to date. - -Changes are displayed on a monthly basis. @dfn{Months}, for this -purpose are defined as the 5th of the month through the 5th of the -month. Preexisting questions that have been changed are marked as such. -Brand new questions are tagged. - -All submissions are welcome. E-mail submissions -to -@iftex -@* -@end iftex -@email{faq@@xemacs.org, Christian Nyb@o{}}. +be up to date. Unfortunately, some of the information is out of date -- +a situation which the FAQ maintainer is working on. All submissions are +welcome, please e-mail submissions to @email{faq@@xemacs.org, XEmacs FAQ +maintainers}. Please make sure that @samp{XEmacs FAQ} appears on the Subject: line. If you think you have a better way of answering a question, or think a -question should be included, I'd like to hear about it. Questions and +question should be included, we'd like to hear about it. Questions and answers included into the FAQ will be edited for spelling and grammar, and will be attributed. Answers appearing without attribution are either from versions of the FAQ dated before May 1996, or are from one @@ -726,8 +746,8 @@ @node Q1.1.2, Q1.1.3, Q1.1.1, Introduction @unnumberedsubsec Q1.1.2: How do I become a Beta Tester? -Send an email message to @email{xemacs-beta-request@@xemacs.org} with a -subject line of @samp{subscribe}. +Send an email message to @email{xemacs-beta-request@@xemacs.org} with +the line @samp{subscribe} in the body of the message. Be prepared to get your hands dirty, as beta testers are expected to identify problems as best they can. @@ -735,7 +755,7 @@ @node Q1.1.3, Q1.2.1, Q1.1.2, Introduction @unnumberedsubsec Q1.1.3: How do I contribute to XEmacs itself? -Ben Wing @email{ben@@666.com} writes: +Ben Wing @email{ben@@xemacs.org} writes: @quotation BTW if you have a wish list of things that you want added, you have to @@ -778,14 +798,14 @@ @end ifhtml -@item @email{steve@@altair.xemacs.org, Steve Baur} +@item @email{steve@@xemacs.org, Steve Baur} @ifhtml <br><img src="steve.gif" alt="Portrait of Steve Baur"><br> @end ifhtml -@item @email{hniksic@@srce.hr, Hrvoje Niksic} +@item @email{hniksic@@xemacs.org, Hrvoje Niksic} @ifhtml <br><img src="hniksic.jpeg" alt="Portrait of Hrvoje Niksic"><br> @@ -804,7 +824,7 @@ Chuck was Mr. XEmacs from 19.11 through 19.14, and is responsible for XEmacs becoming a widely distributed program over the Internet. -@item @email{ben@@666.com, Ben Wing} +@item @email{ben@@xemacs.org, Ben Wing} @ifhtml <br><img src="wing.gif" alt="Portrait of Ben Wing"><br> @end ifhtml @@ -813,7 +833,7 @@ @itemize @bullet -@item @email{jwz@@netscape.com, Jamie Zawinski} +@item @email{jwz@@jwz.org, Jamie Zawinski} @ifhtml <br><img src="jwz.gif" alt="Portrait of Jamie Zawinski"><br> @end ifhtml @@ -837,7 +857,7 @@ @itemize @bullet @item @email{steve@@xemacs.org, SL Baur} -@item @email{hniksic@@srce.hr, Hrvoje Niksic} +@item @email{hniksic@@xemacs.org, Hrvoje Niksic} @item @email{Aki.Vehtari@@hut.fi, Aki Vehtari} @@ -852,14 +872,20 @@ @itemize @bullet @item @email{binge@@aloft.att.com, Curtis.N.Bingham} +@item @email{bruncott@@dormeur.inria.fr, Georges Brun-Cottan} + @item @email{rjc@@cogsci.ed.ac.uk, Richard Caley} @item @email{cognot@@ensg.u-nancy.fr, Richard Cognot} +@item @email{daku@@nortel.ca, Mark Daku} + @item @email{wgd@@martigny.ai.mit.edu, William G. Dubuque} @item @email{eeide@@cs.utah.edu, Eric Eide} +@item @email{af@@biomath.jussieu.fr, Alain Fauconnet} + @item @email{cflatter@@nrao.edu, Chris Flatters} @item @email{ginsparg@@adra.com, Evelyn Ginsparg} @@ -916,7 +942,7 @@ vintage-1980 Lisps; modern versions of Lisp consider this equivalence a bad idea, and have separate character types. In XEmacs version 20, the modern convention is followed, and characters are their own -primitive types. (This change was necessary in order for @sc{MULE}, +primitive types. (This change was necessary in order for @sc{mule}, i.e. Asian-language, support to be correctly implemented.) Even in XEmacs version 20, remnants of the equivalence between @@ -927,28 +953,28 @@ are integers are the same. Byte code compiled under any version 19 Emacs will have all such functions mapped to their @code{old-} equivalents when the byte code is read into XEmacs 20. This is to preserve -compatibility -- Emacs 19 converts all constant characters to the equivalent +compatibility---Emacs 19 converts all constant characters to the equivalent integer during byte-compilation, and thus there is no other way to preserve byte-code compatibility even if the code has specifically been written with the distinction between characters and integers in mind. Every character has an equivalent integer, called the @dfn{character code}. For example, the character @kbd{A} is represented as the -@w{integer 65}, following the standard @sc{ASCII} representation of -characters. If XEmacs was not compiled with @sc{MULE} support, the -range of this integer will always be 0 to 255 -- eight bits, or one +@w{integer 65}, following the standard @sc{ascii} representation of +characters. If XEmacs was not compiled with @sc{mule} support, the +range of this integer will always be 0 to 255---eight bits, or one byte. (Integers outside this range are accepted but silently truncated; however, you should most decidedly @emph{not} rely on this, because it -will not work under XEmacs with @sc{MULE} support.) When @sc{MULE} +will not work under XEmacs with @sc{mule} support.) When @sc{mule} support is present, the range of character codes is much larger. (Currently, 19 bits are used.) FSF GNU Emacs uses kludgy character codes above 255 to represent -keyboard input of @sc{ASCII} characters in combination with certain +keyboard input of @sc{ascii} characters in combination with certain modifiers. XEmacs does not use this (a more general mechanism is -used that does not distinguish between @sc{ASCII} keys and other +used that does not distinguish between @sc{ascii} keys and other keys), so you will never find character codes above 255 in a -non-@sc{MULE} XEmacs. +non-@sc{mule} XEmacs. Individual characters are not often used in programs. It is far more common to work with @emph{strings}, which are sequences composed of @@ -958,14 +984,12 @@ @node Q1.3.2, Q1.3.3, Q1.3.1, Introduction @unnumberedsubsec Q1.3.2: What is the status of Asian-language support, aka MULE? -The MULE support works OK but still needs a fair amount of work before -it's really solid. We could definitely use some help here, esp. people -who speak Japanese and will use XEmacs/MULE to work with Japanese and -have some experience with E-Lisp. - -As the fundings on Mule have stopped, the Mule part of XEmacs is currently -looking for a full-time maintainer. If you can provide help here, or -are willing to fund the work, please mail to @email{xemacs-beta@@xemacs.org}. +MULE support is now available for UNIX versions of XEmacs. + +If you would like to help, you may want to join the +@email{xemacs-mule@@xemacs.org} mailing list. Especially needed are +people who speak/write languages other than English, who are willing to +use XEmacs/MULE regularly, and have some experience with Elisp. @xref{Q1.1.2}. @@ -983,9 +1007,9 @@ enable it, add to your @file{Emacs} file entries like this: @example -Emacs*XlwMenu.resourceLabels: True -Emacs*XlwMenu.file.labelString: Fichier -Emacs*XlwMenu.openInOtherWindow.labelString: In anderem Fenster offnen +Emacs*XlwMenu.resourceLabels: True +Emacs*XlwMenu.file.labelString: Fichier +Emacs*XlwMenu.openInOtherWindow.labelString: In anderem Fenster offnen @end example The name of the resource is derived from the non-localized entry by @@ -1080,12 +1104,12 @@ (cond ((boundp 'MULE) ;; for original Mule ) - ((string-match "XEmacs" emacs-version) - ;; for XEmacs with Mule - ) - (t - ;; for next version of Emacs - )) + ((string-match "XEmacs" emacs-version) + ;; for XEmacs with Mule + ) + (t + ;; for next version of Emacs + )) ;; for old emacs variants ) @end lisp @@ -1154,23 +1178,23 @@ @node Q1.4.3, Q1.4.4, Q1.4.2, Introduction @unnumberedsubsec Q1.4.3: Any good tutorials around? -There's the XEmacs tutorial available from the Help Menu, or by typing -@kbd{C-h t}. To check whether it's available in a non-english language, -type @kbd{C-u C-h t TAB}, type the first letters of your preferred -language, then type @key{RET}. - -There's an Emacs Lisp tutorial at - -@example -@uref{ftp://prep.ai.mit.edu/pub/gnu/emacs-lisp-intro-1.04.tar.gz}. -@end example - -@email{erik@@petaxp.rug.ac.be, Erik Sundermann} has made a tutorial web -page at -@iftex -@* -@end iftex -@uref{http://petaxp.rug.ac.be/~erik/xemacs/}. +There's the XEmacs tutorial available from the Help Menu under +@samp{Basics->Tutorials}, or by typing @kbd{C-h t}. To check whether +it's available in a non-english language, type @kbd{C-u C-h t TAB}, type +the first letters of your preferred language, then type @key{RET}. + +@comment There's an Emacs Lisp tutorial at +@comment +@comment @example +@comment @uref{ftp://prep.ai.mit.edu/pub/gnu/emacs-lisp-intro-1.04.tar.gz}. +@comment @end example +@comment +@comment @email{erik@@petaxp.rug.ac.be, Erik Sundermann} has made a tutorial web +@comment page at +@comment @iftex +@comment @* +@comment @end iftex +@comment @uref{http://petaxp.rug.ac.be/~erik/xemacs/}. @node Q1.4.4, Q1.4.5, Q1.4.3, Introduction @unnumberedsubsec Q1.4.4: May I see an example of a useful XEmacs Lisp function? @@ -1218,7 +1242,7 @@ Or interactively, @kbd{M-x global-set-key} and follow the prompts. -@node Q1.4.6, Q1.4.7, Q1.4.5, Introduction +@node Q1.4.6, , Q1.4.5, Introduction @unnumberedsubsec Q1.4.6: What's the difference between a macro and a function? Quoting from the Lisp Reference (a.k.a @dfn{Lispref}) Manual: @@ -1238,36 +1262,6 @@ another matter, entirely. A keyboard macro is a key bound to several other keys. Refer to manual for details. -@node Q1.4.7, , Q1.4.6, Introduction -@unnumberedsubsec Q1.4.7: How come options saved with 19.13 don't work with 19.14 or later? - -There's a problem with options of the form: - -@lisp -(add-spec-list-to-specifier (face-property 'searchm-field 'font) - '((global (nil)))) -@end lisp - -saved by a 19.13 XEmacs that causes a 19.14 XEmacs grief. You must -delete these options. XEmacs 19.14 and later no longer write the -options directly to @file{.emacs} which should allow us to deal with -version incompatibilities better in the future. - -Options saved under XEmacs 19.13 are protected by code that specifically -requires a version 19 XEmacs. This won't be a problem unless you're -using XEmacs v20. You should consider changing the code to read: - -@lisp -(cond - ((and (string-match "XEmacs" emacs-version) - (boundp 'emacs-major-version) - (or (and (= emacs-major-version 19) - (>= emacs-minor-version 12)) - (>= emacs-major-version 20))) - ... - )) -@end lisp - @node Installation, Customization, Introduction, Top @unnumbered 2 Installation and Trouble Shooting @@ -1288,8 +1282,6 @@ * Q2.0.10:: After I run configure I find a coredump, is something wrong? * Q2.0.11:: XEmacs can't resolve host names. * Q2.0.12:: Why can't I strip XEmacs? -* Q2.0.13:: Can't link XEmacs on Solaris with Gcc. -* Q2.0.14:: Make on HP/UX 9 fails after linking temacs Trouble Shooting: * Q2.1.1:: XEmacs just crashed on me! @@ -1309,12 +1301,13 @@ * Q2.1.15:: How to debug an XEmacs problem with a debugger. * Q2.1.16:: XEmacs crashes in @code{strcat} on HP/UX 10. * Q2.1.17:: @samp{Marker does not point anywhere}. -* Q2.1.18:: 19.14 hangs on HP/UX 10.10. +* Q2.1.18:: [This question intentionally left blank] * Q2.1.19:: XEmacs does not follow the local timezone. * Q2.1.20:: @samp{Symbol's function definition is void: hkey-help-show.} -* Q2.1.21:: Every so often the XEmacs frame freezes. +* Q2.1.21:: [This question intentionally left blank] * Q2.1.22:: XEmacs seems to take a really long time to do some things. * Q2.1.23:: Movemail on Linux does not work for XEmacs 19.15 and later. +* Q2.1.24:: XEmacs won't start without network. (NEW) @end menu @node Q2.0.1, Q2.0.2, Installation, Installation @@ -1345,7 +1338,7 @@ Although this entry has been written for XEmacs 19.13, most of it still stands true. -@email{steve@@altair.xemacs.org, Steve Baur} writes: +@email{steve@@xemacs.org, Steve Baur} writes: @quotation The 45MB of space required by the installation directories can be @@ -1361,11 +1354,11 @@ Now examine the space used by directory: @format -0 /usr/local/bin/xemacs -2048 /usr/local/bin/xemacs-19.13 - -1546 /usr/local/lib/xemacs-19.13/i486-miranova-sco3.2v4.2 -1158 /usr/local/lib/xemacs-19.13/i486-unknown-linux1.2.13 +0 /usr/local/bin/xemacs +2048 /usr/local/bin/xemacs-19.13 + +1546 /usr/local/lib/xemacs-19.13/i486-miranova-sco3.2v4.2 +1158 /usr/local/lib/xemacs-19.13/i486-unknown-linux1.2.13 @end format You need to keep these. XEmacs isn't stripped by default in @@ -1373,15 +1366,15 @@ 5MB right there. @format -207 /usr/local/lib/xemacs-19.13/etc/w3 -122 /usr/local/lib/xemacs-19.13/etc/sounds -18 /usr/local/lib/xemacs-19.13/etc/sparcworks -159 /usr/local/lib/xemacs-19.13/etc/vm -6 /usr/local/lib/xemacs-19.13/etc/e -21 /usr/local/lib/xemacs-19.13/etc/eos -172 /usr/local/lib/xemacs-19.13/etc/toolbar -61 /usr/local/lib/xemacs-19.13/etc/ns -43 /usr/local/lib/xemacs-19.13/etc/gnus +207 /usr/local/lib/xemacs-19.13/etc/w3 +122 /usr/local/lib/xemacs-19.13/etc/sounds +18 /usr/local/lib/xemacs-19.13/etc/sparcworks +159 /usr/local/lib/xemacs-19.13/etc/vm +6 /usr/local/lib/xemacs-19.13/etc/e +21 /usr/local/lib/xemacs-19.13/etc/eos +172 /usr/local/lib/xemacs-19.13/etc/toolbar +61 /usr/local/lib/xemacs-19.13/etc/ns +43 /usr/local/lib/xemacs-19.13/etc/gnus @end format These are support directories for various packages. In general they @@ -1389,50 +1382,50 @@ do not require the package, you may delete or gzip the support too. @format -1959 /usr/local/lib/xemacs-19.13/etc -175 /usr/local/lib/xemacs-19.13/lisp/bytecomp -340 /usr/local/lib/xemacs-19.13/lisp/calendar -342 /usr/local/lib/xemacs-19.13/lisp/comint -517 /usr/local/lib/xemacs-19.13/lisp/dired -42 /usr/local/lib/xemacs-19.13/lisp/electric -212 /usr/local/lib/xemacs-19.13/lisp/emulators -238 /usr/local/lib/xemacs-19.13/lisp/energize -289 /usr/local/lib/xemacs-19.13/lisp/gnus -457 /usr/local/lib/xemacs-19.13/lisp/ilisp -1439 /usr/local/lib/xemacs-19.13/lisp/modes -2276 /usr/local/lib/xemacs-19.13/lisp/packages -1040 /usr/local/lib/xemacs-19.13/lisp/prim -176 /usr/local/lib/xemacs-19.13/lisp/pcl-cvs -154 /usr/local/lib/xemacs-19.13/lisp/rmail -3 /usr/local/lib/xemacs-19.13/lisp/epoch -45 /usr/local/lib/xemacs-19.13/lisp/term -860 /usr/local/lib/xemacs-19.13/lisp/utils -851 /usr/local/lib/xemacs-19.13/lisp/vm -13 /usr/local/lib/xemacs-19.13/lisp/vms -157 /usr/local/lib/xemacs-19.13/lisp/x11 -19 /usr/local/lib/xemacs-19.13/lisp/tooltalk -14 /usr/local/lib/xemacs-19.13/lisp/sunpro -291 /usr/local/lib/xemacs-19.13/lisp/games -198 /usr/local/lib/xemacs-19.13/lisp/edebug -619 /usr/local/lib/xemacs-19.13/lisp/w3 -229 /usr/local/lib/xemacs-19.13/lisp/eos -55 /usr/local/lib/xemacs-19.13/lisp/iso -59 /usr/local/lib/xemacs-19.13/lisp/mailcrypt -187 /usr/local/lib/xemacs-19.13/lisp/eterm -356 /usr/local/lib/xemacs-19.13/lisp/ediff -408 /usr/local/lib/xemacs-19.13/lisp/hyperbole/kotl -1262 /usr/local/lib/xemacs-19.13/lisp/hyperbole -247 /usr/local/lib/xemacs-19.13/lisp/hm--html-menus -161 /usr/local/lib/xemacs-19.13/lisp/mh-e -299 /usr/local/lib/xemacs-19.13/lisp/viper -53 /usr/local/lib/xemacs-19.13/lisp/oobr/tree-x -4 /usr/local/lib/xemacs-19.13/lisp/oobr/tree-nx/English.lproj/DocWindow.nib -3 /usr/local/lib/xemacs-19.13/lisp/oobr/tree-nx/English.lproj/InfoPanel.nib -3 /usr/local/lib/xemacs-19.13/lisp/oobr/tree-nx/English.lproj/TreeView.nib -11 /usr/local/lib/xemacs-19.13/lisp/oobr/tree-nx/English.lproj -53 /usr/local/lib/xemacs-19.13/lisp/oobr/tree-nx -466 /usr/local/lib/xemacs-19.13/lisp/oobr -14142 /usr/local/lib/xemacs-19.13/lisp +1959 /usr/local/lib/xemacs-19.13/etc +175 /usr/local/lib/xemacs-19.13/lisp/bytecomp +340 /usr/local/lib/xemacs-19.13/lisp/calendar +342 /usr/local/lib/xemacs-19.13/lisp/comint +517 /usr/local/lib/xemacs-19.13/lisp/dired +42 /usr/local/lib/xemacs-19.13/lisp/electric +212 /usr/local/lib/xemacs-19.13/lisp/emulators +238 /usr/local/lib/xemacs-19.13/lisp/energize +289 /usr/local/lib/xemacs-19.13/lisp/gnus +457 /usr/local/lib/xemacs-19.13/lisp/ilisp +1439 /usr/local/lib/xemacs-19.13/lisp/modes +2276 /usr/local/lib/xemacs-19.13/lisp/packages +1040 /usr/local/lib/xemacs-19.13/lisp/prim +176 /usr/local/lib/xemacs-19.13/lisp/pcl-cvs +154 /usr/local/lib/xemacs-19.13/lisp/rmail +3 /usr/local/lib/xemacs-19.13/lisp/epoch +45 /usr/local/lib/xemacs-19.13/lisp/term +860 /usr/local/lib/xemacs-19.13/lisp/utils +851 /usr/local/lib/xemacs-19.13/lisp/vm +13 /usr/local/lib/xemacs-19.13/lisp/vms +157 /usr/local/lib/xemacs-19.13/lisp/x11 +19 /usr/local/lib/xemacs-19.13/lisp/tooltalk +14 /usr/local/lib/xemacs-19.13/lisp/sunpro +291 /usr/local/lib/xemacs-19.13/lisp/games +198 /usr/local/lib/xemacs-19.13/lisp/edebug +619 /usr/local/lib/xemacs-19.13/lisp/w3 +229 /usr/local/lib/xemacs-19.13/lisp/eos +55 /usr/local/lib/xemacs-19.13/lisp/iso +59 /usr/local/lib/xemacs-19.13/lisp/mailcrypt +187 /usr/local/lib/xemacs-19.13/lisp/eterm +356 /usr/local/lib/xemacs-19.13/lisp/ediff +408 /usr/local/lib/xemacs-19.13/lisp/hyperbole/kotl +1262 /usr/local/lib/xemacs-19.13/lisp/hyperbole +247 /usr/local/lib/xemacs-19.13/lisp/hm--html-menus +161 /usr/local/lib/xemacs-19.13/lisp/mh-e +299 /usr/local/lib/xemacs-19.13/lisp/viper +53 /usr/local/lib/xemacs-19.13/lisp/oobr/tree-x +4 /usr/local/lib/xemacs-19.13/lisp/oobr/tree-nx/English.lproj/DocWindow.nib +3 /usr/local/lib/xemacs-19.13/lisp/oobr/tree-nx/English.lproj/InfoPanel.nib +3 /usr/local/lib/xemacs-19.13/lisp/oobr/tree-nx/English.lproj/TreeView.nib +11 /usr/local/lib/xemacs-19.13/lisp/oobr/tree-nx/English.lproj +53 /usr/local/lib/xemacs-19.13/lisp/oobr/tree-nx +466 /usr/local/lib/xemacs-19.13/lisp/oobr +14142 /usr/local/lib/xemacs-19.13/lisp @end format These are all Emacs Lisp source code and bytecompiled object code. You @@ -1458,14 +1451,14 @@ certain packages can be removed from them if you do not use them. @example -1972 /usr/local/lib/xemacs-19.13/info +1972 /usr/local/lib/xemacs-19.13/info @end example These are online texinfo sources. You may either gzip them or remove them. In either case, @kbd{C-h i} (info mode) will no longer work. @example -20778 /usr/local/lib/xemacs-19.13 +20778 /usr/local/lib/xemacs-19.13 @end example The 20MB achieved is less than half of what the full distribution takes up, @@ -1561,7 +1554,7 @@ Terminal type `xterm' undefined (or can't access database?) @end example -@email{ben@@666.com, Ben Wing} writes: +@email{ben@@xemacs.org, Ben Wing} writes: @quotation Your ncurses configuration is messed up. Your /usr/lib/terminfo is a @@ -1573,7 +1566,7 @@ No. The name @dfn{XEmacs} is unfortunate in the sense that it is @strong{not} an X Window System-only version of Emacs. Starting with -19.14 XEmacs has full color support on a color capable character +19.14 XEmacs has full color support on a color-capable character terminal. @node Q2.0.6, Q2.0.7, Q2.0.5, Installation @@ -1615,11 +1608,11 @@ suffice. If you don't understand how to do this, don't do it. @item -Rebuild XEmacs yourself -- any working ELF version of libc should be +Rebuild XEmacs yourself---any working ELF version of libc should be O.K. @end enumerate -@email{hniksic@@srce.hr, Hrvoje Niksic} writes: +@email{hniksic@@xemacs.org, Hrvoje Niksic} writes: @quotation Why not use a Perl one-liner for No. 2? @@ -1740,7 +1733,7 @@ to link against the DNS resolver library code. @end quotation -@node Q2.0.12, Q2.0.13, Q2.0.11, Installation +@node Q2.0.12, Q2.1.1, Q2.0.11, Installation @unnumberedsubsec Q2.0.12: Why can't I strip XEmacs? @email{cognot@@fronsac.ensg.u-nancy.fr, Richard Cognot} writes: @@ -1795,46 +1788,7 @@ @end enumerate @end quotation -@node Q2.0.13, Q2.0.14, Q2.0.12, Installation -@unnumberedsubsec Q2.0.13: Problems linking with Gcc on Solaris - -There are known difficulties linking with Gnu ld on Solaris. A typical -error message might look like: - -@example -unexec(): dlopen(../dynodump/dynodump.so): ld.so.1: ./temacs: -fatal: relocation error: -symbol not found: main: referenced in ../dynodump/dynodump.so -@end example - -@email{martin@@xemacs.org, Martin Buchholz} writes: - -@quotation -You need to specify @samp{-fno-gnu-linker} as part of your flags to pass -to ld. Future releases of XEmacs will try to do this automatically. -@end quotation - -@node Q2.0.14, Q2.1.1, Q2.0.13, Installation -@unnumberedsubsec Q2.0.14: Make on HP/UX 9 fails after linking temacs - -Problem when building xemacs-19.16 on hpux 9: - -@email{cognot@@ensg.u-nancy.fr, Richard Cognot} writes: - -@quotation -make on hpux fails after linking temacs with a message: - -@example -"make: don't know how to make .y." -@end example - -Solution: This is a problem with HP make revision 70.X. Either use GNU -make, or install PHCO_6552, which will bring make to revision -72.24.1.17. -@end quotation - - -@node Q2.1.1, Q2.1.2, Q2.0.14, Installation +@node Q2.1.1, Q2.1.2, Q2.0.12, Installation @unnumberedsec 2.1: Trouble Shooting @unnumberedsubsec Q2.1.1: Help! XEmacs just crashed on me! @@ -2051,10 +2005,10 @@ like: @example -*Foreground: Black ;everything will be of black on grey95, -*Background: Grey95 ;unless otherwise specified. -*cursorColor: Red3 ;red3 cursor with grey95 border. -*pointerColor: Red3 ;red3 pointer with grey95 border. +*Foreground: Black ;everything will be of black on grey95, +*Background: Grey95 ;unless otherwise specified. +*cursorColor: Red3 ;red3 cursor with grey95 border. +*pointerColor: Red3 ;red3 pointer with grey95 border. @end example @end quotation @@ -2203,7 +2157,7 @@ @node Q2.1.14, Q2.1.15, Q2.1.13, Installation @unnumberedsubsec Q2.1.14: @kbd{C-g} doesn't work for me. Is it broken? -@email{ben@@666.com, Ben Wing} writes: +@email{ben@@xemacs.org, Ben Wing} writes: @quotation @kbd{C-g} does work for most people in most circumstances. If it @@ -2298,17 +2252,55 @@ all you've got is a core dump, all is not lost. If you're using GDB, there are some macros in the file -@file{src/gdbinit} in the XEmacs source distribution that should make it -easier for you to decode Lisp objects. Copy this file to -@file{~/.gdbinit}, or @code{source} it from @file{~/.gdbinit}, and use -the macros defined therein. In particular, use the @code{pobj} macro to -print the internal C representation of a lisp object. This will work -with a core file or not-yet-run executable. The aliases @code{ldp} and -@code{lbt} are provided for conveniently calling @code{debug_print} and -@code{debug_backtrace}. +@file{src/.gdbinit} in the XEmacs source distribution that should make +it easier for you to decode Lisp objects. This file is automatically +read by gdb if gdb is run in the directory where xemacs was built, and +contains these useful macros to inspect the state of xemacs: + +@table @code +@item pobj +Usage: pobj lisp_object @* +Print the internal C representation of a lisp object. + +@item xtype +Usage: xtype lisp_object @* +Print the Lisp type of a lisp object. + +@item lbt +Usage: lbt @* +Print the current Lisp stack trace. +Requires a running xemacs process. + +@item ldp +Usage: ldp lisp_object @* +Print a Lisp Object value using the Lisp printer. +Requires a running xemacs process. + +@item run-temacs +Usage: run-temacs @* +Run temacs interactively, like xemacs. +Use this with debugging tools (like purify) that cannot deal with dumping, +or when temacs builds successfully, but xemacs does not. + +@item dump-temacs +Usage: dump-temacs @* +Run the dumping part of the build procedure. +Use when debugging temacs, not xemacs! +Use this when temacs builds successfully, but xemacs does not. + +@item check-xemacs +Usage: check-xemacs @* +Run the test suite. Equivalent to 'make check'. + +@item check-temacs +Usage: check-temacs @* +Run the test suite on temacs. Equivalent to 'make check-temacs'. +Use this with debugging tools (like purify) that cannot deal with dumping, +or when temacs builds successfully, but xemacs does not. +@end table If you are using Sun's @file{dbx} debugger, there is an equivalent file -@file{src/dbxrc} to copy to or source from @file{~/.dbxrc}. +@file{src/.dbxrc}, which defines the same commands for dbx. @item If you're using a debugger to get a C stack backtrace and you're seeing @@ -2359,22 +2351,21 @@ @item If you compile with the newer gcc variants gcc-2.8 or egcs, you will -also need gdb 4.17. Earlier releases of gdb can't handle the debug -information generated by the newer compilers. +also need gdb 4.17 or above. Earlier releases of gdb can't handle the +debug information generated by the newer compilers. @item -The above information on using @file{src/gdbinit} works for XEmacs-21.0 -and above. For older versions of XEmacs, there are different -@file{gdbinit} files provided in the @file{src} directory. Use the one -corresponding to the configure options used when building XEmacs. +In versions of XEmacs before 21.2.27, @file{src/.gdbinit} was named +@file{src/gdbinit}. This had the disadvantage of not being sourced +automatically by gdb, so you had to set that up yourself. @end itemize @node Q2.1.16, Q2.1.17, Q2.1.15, Installation @unnumberedsubsec Q2.1.16: XEmacs crashes in @code{strcat} on HP/UX 10 ->From the problems database (through -@uref{http://support.mayfield.hp.com/}): +From the problems database (through +the former address http://support.mayfield.hp.com/): @example Problem Report: 5003302299 @@ -2412,58 +2403,7 @@ @end enumerate @node Q2.1.18, Q2.1.19, Q2.1.17, Installation -@unnumberedsubsec Q2.1.18: 19.14 hangs on HP/UX 10.10. - -@email{cognot@@ensg.u-nancy.fr, Richard Cognot} writes: - -@quotation -For the record, compiling on hpux 10.10 leads to a hang in Gnus when -compiled with optimization on. - -I've just discovered that my hpux 10.01 binary was working less well -than expected. In fact, on a 10.10 system, @code{(while t)} was not -interrupted by @kbd{C-g}. I defined @code{BROKEN_SIGIO} and recompiled on -10.10, and... the hang is now gone. - -As far as configure goes, this will be a bit tricky: @code{BROKEN_SIGIO} -is needed on 10.10, but @strong{not} on 10.01: if I run my 10.01 binary -on a 10.01 machine, without @code{BROKEN_SIGIO} being defined, @kbd{C-g} -works as expected. -@end quotation - -@email{cognot@@ensg.u-nancy.fr, Richard Cognot} adds: - -@quotation -Apparently somebody has found the reason why there is this -@iftex -@* -@end iftex -@samp{poll: -interrupted...} message for each event. For some reason, libcurses -reimplements a @code{select()} system call, in a highly broken fashion. -The fix is to add a -lc to the link line @emph{before} the --lxcurses. XEmacs will then use the right version of @code{select()}. -@end quotation - - -@email{af@@biomath.jussieu.fr, Alain Fauconnet} writes: - -@quotation -The @emph{real} solution is to @emph{not} link -lcurses in! I just -changed -lcurses to -ltermcap in the Makefile and it fixed: - -@enumerate -@item -The @samp{poll: interrupted system call} message. - -@item -A more serious problem I had discovered in the meantime, that is the -fact that subprocess handling was seriously broken: subprocesses -e.g. started by AUC TeX for TeX compilation of a buffer would -@emph{hang}. Actually they would wait forever for emacs to read the -socket which connects stdout... -@end enumerate -@end quotation +@unnumberedsubsec Q2.1.18: removed @node Q2.1.19, Q2.1.20, Q2.1.18, Installation @unnumberedsubsec Q2.1.19: XEmacs does not follow the local timezone. @@ -2491,10 +2431,7 @@ where you load hyperbole and the problem should go away. @node Q2.1.21, Q2.1.22, Q2.1.20, Installation -@unnumberedsubsec Q2.1.21: Every so often the XEmacs frame freezes - -This problem has been fixed in 19.15, and was due to a not easily -reproducible race condition. +@unnumberedsubsec Q2.1.21: [This question intentionally left blank] @node Q2.1.22, Q2.1.23, Q2.1.21, Installation @unnumberedsubsec Q2.1.22: XEmacs seems to take a really long time to do some things @@ -2531,7 +2468,7 @@ some other strange cases. @end quotation -@node Q2.1.23, , Q2.1.22, Installation +@node Q2.1.23, Q2.1.24, Q2.1.22, Installation @unnumberedsubsec Q2.1.23: Movemail on Linux does not work for XEmacs 19.15 and later. Movemail used to work fine in 19.14 but has stopped working in 19.15 @@ -2550,6 +2487,20 @@ @end example @end quotation +@node Q2.1.24, , Q2.1.23, Installation +@unnumberedsubsec Q2.1.24: XEmacs won't start without network. (NEW) +Q2.1.23: Movemail on Linux does not work for XEmacs 19.15 and later. + +If XEmacs starts when you're on the network, but fails when you're not +on the network, you may be missing a "localhost" entry in your +@file{/etc/hosts} file. The file should contain an entry like: + +@example +127.0.0.1 localhost +@end example + +Add that line, and XEmacs will be happy. + @node Customization, Subsystems, Installation, Top @unnumbered 3 Customization and Options @@ -2571,8 +2522,8 @@ X Window System & Resources: * Q3.1.1:: Where is a list of X resources? * Q3.1.2:: How can I detect a color display? -* Q3.1.3:: @code{(set-screen-width)} worked in 19.6, but not in 19.13? -* Q3.1.4:: Specifying @code{Emacs*EmacsScreen.geometry} in @file{.emacs} does not work in 19.15? +* Q3.1.3:: [This question intentionally left blank] +* Q3.1.4:: [This question intentionally left blank] * Q3.1.5:: How can I get the icon to just say @samp{XEmacs}? * Q3.1.6:: How can I have the window title area display the full path? * Q3.1.7:: @samp{xemacs -name junk} doesn't work? @@ -2760,7 +2711,7 @@ @email{mannj@@ll.mit.edu, John Mann} writes: @quotation -You have to go to Options->Menubar Appearance and unselect +You have to go to Options->Frame Appearance and unselect @samp{Frame-Local Font Menu}. If this option is selected, font changes are only applied to the @emph{current} frame and do @emph{not} get saved when you save options. @@ -2785,14 +2736,14 @@ (setq default-minibuffer-frame (make-frame '(minibuffer only - width 86 - height 1 - menubar-visible-p nil - default-toolbar-visible-p nil - name "minibuffer" - top -2 - left -2 - has-modeline-p nil))) + width 86 + height 1 + menubar-visible-p nil + default-toolbar-visible-p nil + name "minibuffer" + top -2 + left -2 + has-modeline-p nil))) (frame-notice-user-settings) @end lisp @@ -2844,38 +2795,10 @@ @end lisp @node Q3.1.3, Q3.1.4, Q3.1.2, Customization -@unnumberedsubsec Q3.1.3: @code{(set-screen-width)} worked in 19.6, but not in 19.13? - -In Lucid Emacs 19.6 I did @code{(set-screen-width @var{characters})} and -@code{(set-screen-height @var{lines})} in my @file{.emacs} instead of -specifying @code{Emacs*EmacsScreen.geometry} in my -@iftex -@* -@end iftex -@file{.Xdefaults} but -this does not work in XEmacs 19.13. - -These two functions now take frame arguments: - -@lisp -(set-frame-width (selected-frame) @var{characters}) -(set-frame-height (selected-frame) @var{lines}) -@end lisp +@unnumberedsubsec Q3.1.3: [This question intentionally left blank] @node Q3.1.4, Q3.1.5, Q3.1.3, Customization -@unnumberedsubsec Q3.1.4: Specifying @code{Emacs*EmacsScreen.geometry} in @file{.emacs} does not work in 19.15? - -In XEmacs 19.11 I specified @code{Emacs*EmacsScreen.geometry} in -my @file{.emacs} but this does not work in XEmacs 19.15. - -We have switched from using the term @dfn{screen} to using the term -@dfn{frame}. - -The correct entry for your @file{.Xdefaults} is now: - -@example -Emacs*EmacsFrame.geometry -@end example +@unnumberedsubsec Q3.1.4: [This question intentionally left blank] @node Q3.1.5, Q3.1.6, Q3.1.4, Customization @unnumberedsubsec Q3.1.5: How can I get the icon to just say @samp{XEmacs}? @@ -2906,7 +2829,7 @@ @lisp (setq frame-title-format '("%S: " (buffer-file-name "%f" - (dired-directory dired-directory "%b")))) + (dired-directory dired-directory "%b")))) @end lisp That is, use the file name, or the dired-directory, or the buffer name. @@ -2969,7 +2892,7 @@ Using @samp{-unmapped} on the command line, and setting the @code{initiallyUnmapped} X Resource don't seem to help much either... -@email{ben@@666.com, Ben Wing} writes: +@email{ben@@xemacs.org, Ben Wing} writes: @quotation Ugh, this stuff is such an incredible mess that I've about given up @@ -2990,24 +2913,24 @@ (set-face-background 'default "bisque") ; frame background (set-face-foreground 'default "black") ; normal text (set-face-background 'zmacs-region "red") ; When selecting w/ - ; mouse + ; mouse (set-face-foreground 'zmacs-region "yellow") (set-face-font 'default "*courier-bold-r*120-100-100*") (set-face-background 'highlight "blue") ; Ie when selecting - ; buffers + ; buffers (set-face-foreground 'highlight "yellow") (set-face-background 'modeline "blue") ; Line at bottom - ; of buffer + ; of buffer (set-face-foreground 'modeline "white") (set-face-font 'modeline "*bold-r-normal*140-100-100*") (set-face-background 'isearch "yellow") ; When highlighting - ; while searching + ; while searching (set-face-foreground 'isearch "red") (setq x-pointer-foreground-color "black") ; Adds to bg color, - ; so keep black + ; so keep black (setq x-pointer-background-color "blue") ; This is color - ; you really - ; want ptr/crsr + ; you really + ; want ptr/crsr @end lisp @node Q3.2.2, Q3.2.3, Q3.2.1, Customization @@ -3183,7 +3106,7 @@ @lisp (add-hook 'TeX-mode-hook - '(lambda () (setq fume-display-in-modeline-p nil))) + '(lambda () (setq fume-display-in-modeline-p nil))) @end lisp @email{dhughes@@origin-at.co.uk, David Hughes} writes: @@ -3298,8 +3221,8 @@ @lisp (global-set-key [(control ?.)] (lambda () (interactive) (scroll-up 1))) -(global-set-key [(control ? ;)] - (lambda () (interactive) (scroll-up -1))) +(global-set-key [(control ?;)] + (lambda () (interactive) (scroll-up -1))) @end lisp This is fine if you only need a few functions within the lambda body. @@ -3333,7 +3256,7 @@ (scroll-down 1)) (global-set-key [(control ?.)] 'scroll-up-one-line) ; C-. -(global-set-key [(control ? ;)] 'scroll-down-one-line) ; C-; +(global-set-key [(control ?;)] 'scroll-down-one-line) ; C-; @end lisp The key point is that you can only bind simple functions to keys; you @@ -3450,7 +3373,7 @@ @c hey, show some respect, willya -- there's xkeycaps, isn't there? -- @c chr ;) @example - xmodmap -e 'keycode 0xff20 = Multi_key' + xmodmap -e 'keycode 0xff20 = Multi_key' @end example You will need to pick an appropriate keycode. Use xev to find out the @@ -3461,9 +3384,9 @@ Once you have Multi_key defined, you can use e.g. @example - Multi a ' => á - Multi e " => ë - Multi c , => ç + Multi a ' => á + Multi e " => ë + Multi c , => ç @end example etc. @@ -3471,9 +3394,9 @@ Also, recent versions of XFree86 define various AltGr-<key> combinations as dead keys, i.e. @example - AltGr [ => dead_diaeresis - AltGr ] => dead_tilde - AltGr ; => dead_acute + AltGr [ => dead_diaeresis + AltGr ] => dead_tilde + AltGr ; => dead_acute @end example etc. @@ -3533,7 +3456,7 @@ character typed come out in upper case. This will affect all the other modifier keys like Control and Meta as well. -@email{ben@@666.com, Ben Wing} writes: +@email{ben@@xemacs.org, Ben Wing} writes: @quotation One thing about the sticky modifiers is that if you move the mouse out @@ -3593,7 +3516,7 @@ You can use a color to make it stand out better: @example -Emacs*cursorColor: Red +Emacs*cursorColor: Red @end example @node Q3.6.2, Q3.6.3, Q3.6.1, Customization @@ -3967,13 +3890,19 @@ and you press a key to replace the selected region by the key you typed. Usually backspace kills the selected region. -To get this behavior, add the following line to your @file{.emacs}: +To get this behavior, add the following lines to your @file{.emacs}: @lisp -(turn-on-pending-delete) +(cond + ((fboundp 'turn-on-pending-delete) + (turn-on-pending-delete)) + ((fboundp 'pending-delete-on) + (pending-delete-on t))) @end lisp -Note that this will work with both Backspace and Delete. +Note that this will work with both Backspace and Delete. This code is a +tad more complicated than it has to be for XEmacs in order to make it +more portable. @node Q3.10.3, Q3.10.4, Q3.10.2, Customization @unnumberedsubsec Q3.10.3: Can I turn off the highlight during isearch? @@ -4020,18 +3949,18 @@ (interactive "_P") (let ((zmacs-region-stays t)) (if (interactive-p) - (condition-case nil - ad-do-it - (end-of-buffer (goto-char (point-max)))) + (condition-case nil + ad-do-it + (end-of-buffer (goto-char (point-max)))) ad-do-it))) (defadvice scroll-down (around scroll-down freeze) (interactive "_P") (let ((zmacs-region-stays t)) (if (interactive-p) - (condition-case nil - ad-do-it - (beginning-of-buffer (goto-char (point-min)))) + (condition-case nil + ad-do-it + (beginning-of-buffer (goto-char (point-min)))) ad-do-it))) @end lisp @@ -4079,6 +4008,7 @@ Sparcworks, EOS, and WorkShop: * Q4.4.1:: What is SPARCworks, EOS, and WorkShop +* Q4.4.2:: How do I start the Sun Workshop support in XEmacs 21? Energize: * Q4.5.1:: What is/was Energize? @@ -4089,7 +4019,7 @@ Other Unbundled Packages: * Q4.7.1:: What is AUC TeX? Where do you get it? * Q4.7.2:: Are there any Emacs Lisp Spreadsheets? -* Q4.7.3:: Byte compiling AUC TeX on XEmacs 19.14 +* Q4.7.3:: [This question intentionally left blank] * Q4.7.4:: Problems installing AUC TeX * Q4.7.5:: Is there a reason for an Emacs package not to be included in XEmacs? * Q4.7.6:: Is there a MatLab mode? @@ -4158,7 +4088,7 @@ @lisp (setq vm-reply-ignored-addresses '("wing@@nuspl@@nvwls.cc.purdue.edu,netcom[0-9]*.netcom.com" - "wing@@netcom.com" "wing@@666.com")) + "wing@@netcom.com" "wing@@xemacs.org")) @end lisp Note that each string is a regular expression. @@ -4265,7 +4195,7 @@ @quotation @lisp - ; Don't use multiple frames + ; Don't use multiple frames (setq vm-frame-per-composition nil) (setq vm-frame-per-folder nil) (setq vm-frame-per-edit nil) @@ -4280,7 +4210,7 @@ @lisp (add-hook 'mh-show-mode-hook '(lambda () - (smiley-region (point-min) + (smiley-region (point-min) (point-max)))) @end lisp @@ -4462,12 +4392,11 @@ tm is available from following anonymous ftp sites: @itemize @bullet -@item @uref{ftp://ftp.jaist.ac.jp/pub/GNU/elisp/mime/} (Japan). -@item @uref{ftp://ftp.nis.co.jp/pub/gnu/emacs-lisp/tm/} (Japan). -@c The host above is unknown. - -@item @uref{ftp://ftp.nisiq.net/pub/gnu/emacs-lisp/tm/} (US). -@item @uref{ftp://ftp.miranova.com/pub/gnus/jaist.ac.jp/} (US). +@comment @item @uref{ftp://ftp.jaist.ac.jp/pub/GNU/elisp/mime/} (Japan). +@comment @item @uref{ftp://ftp.nis.co.jp/pub/gnu/emacs-lisp/tm/} (Japan). +@comment @c The host above is unknown. +@comment @item @uref{ftp://ftp.nisiq.net/pub/gnu/emacs-lisp/tm/} (US). +@comment @item @uref{ftp://ftp.miranova.com/pub/gnus/jaist.ac.jp/} (US). @item @uref{ftp://ftp.unicamp.br/pub/mail/mime/tm/} (Brasil). @item @uref{ftp://ftp.th-darmstadt.de/pub/editors/GNU-Emacs/lisp/mime/} (Germany). @item @uref{ftp://ftp.tnt.uni-hannover.de/pub/editors/xemacs/contrib/} (Germany). @@ -4480,7 +4409,7 @@ @node Q4.3.3, Q4.3.4, Q4.3.2, Subsystems @unnumberedsubsec Q4.3.3: Why isn't this @code{movemail} program working? -Ben Wing @email{ben@@666.com} writes: +Ben Wing @email{ben@@xemacs.org} writes: @quotation It wasn't chown'ed/chmod'd correctly. @@ -4489,14 +4418,14 @@ @node Q4.3.4, Q4.3.5, Q4.3.3, Subsystems @unnumberedsubsec Q4.3.4: Movemail is also distributed by Netscape? Can that cause problems? -@email{steve@@altair.xemacs.org, Steve Baur} writes: +@email{steve@@xemacs.org, Steve Baur} writes: @quotation Yes. Always use the movemail installed with your XEmacs. Failure to do so can result in lost mail. @end quotation -Please refer to @email{jwz@@netscape.com, Jamie Zawinski's} notes at +Please refer to @email{jwz@@jwz.org, Jamie Zawinski's} notes at @iftex @* @end iftex @@ -4532,7 +4461,7 @@ @end iftex @uref{ftp://ftp.cdrom.com/pub/tex/ctan/support/latex2html/}. -@node Q4.4.1, Q4.5.1, Q4.3.5, Subsystems +@node Q4.4.1, Q4.4.2, Q4.3.5, Subsystems @unnumberedsec 4.4: Sparcworks, EOS, and WorkShop @unnumberedsubsec Q4.4.1: What is SPARCworks, EOS, and WorkShop? @@ -4573,10 +4502,48 @@ @iftex @* @end iftex -@uref{http://www.sun.com/software/Products/Developer-products/programs.html}. +@uref{http://www.sun.com/software/Products/Developer-products}. @end quotation -@node Q4.5.1, Q4.6.1, Q4.4.1, Subsystems +@node Q4.4.2, Q4.5.1, Q4.4.1, Subsystems +@unnumberedsubsec Q4.4.2: How do I start the Sun Workshop support in XEmacs 21? + +Add the switch ---with-workshop to the configure command when building +XEmacs and put the following in one of your startup files +(e.g. site-start.el or .emacs): + +@lisp +(when (featurep 'tooltalk) + (load "tooltalk-macros") + (load "tooltalk-util") + (load "tooltalk-init")) +(when (featurep 'sparcworks) + (load "sunpro-init") + (load "ring") + (load "comint") + (load "annotations") + (sunpro-startup)) +@end lisp + +If you are not using the latest Workshop (5.0) you have to apply the +following patch: + +@format +--- /opt/SUNWspro/lib/eserve.el.ORIG Fri May 14 15:23:26 1999 ++++ /opt/SUNWspro/lib/eserve.el Fri May 14 15:24:54 1999 +@@@@ -42,7 +42,7 @@@@ + (defvar running-xemacs nil "t if we're running XEmacs") + (defvar running-emacs nil "t if we're running GNU Emacs 19") + +-(if (string-match "^\\(19\\|20\\)\..*\\(XEmacs\\|Lucid\\)" emacs-version) ++(if (string-match "\\(XEmacs\\|Lucid\\)" emacs-version) + (setq running-xemacs t) + (setq running-emacs t)) +@end format + + + +@node Q4.5.1, Q4.6.1, Q4.4.2, Subsystems @unnumberedsec 4.5: Energize @unnumberedsubsec Q4.5.1: What is/was Energize? @@ -4789,17 +4756,7 @@ @uref{ftp://cs.nyu.edu/pub/local/fox/dismal/}. @node Q4.7.3, Q4.7.4, Q4.7.2, Subsystems -@unnumberedsubsec Q4.7.3: Byte compiling AUC TeX on XEmacs 19.14. - -@email{bruncott@@dormeur.inria.fr, Georges Brun-Cottan} writes: - -@quotation -When byte compiling auctex-9.4g, you must use the command: - -@example -xemacs -batch -l lpath.el -@end example -@end quotation +@unnumberedsubsec Q4.7.3: [This question intentionally left blank] @node Q4.7.4, Q4.7.5, Q4.7.3, Subsystems @unnumberedsubsec Q4.7.4: Problems installing AUC TeX. @@ -4855,7 +4812,7 @@ Each package bundled with XEmacs means more work for the maintainers, whether they want it or not. If you are ready to take over the maintenance responsibilities for the package you port, be sure to say -so -- we will more likely include it. +so---we will more likely include it. @item The package simply hasn't been noted by the XEmacs development. If @@ -4871,23 +4828,12 @@ @node Q4.7.6, , Q4.7.5, Subsystems @unnumberedsubsec Q4.7.5: Is there a MatLab mode? -@c New -Is there any way I can get syntax highlighting for MatLab .m files? -Can I "teach" emacs what words are MatLab commands, comments, etc. ? - -@email{elsner@@mathematik.tu-chemnitz.de, Ulrich Elsner} writes: -@quotation -One way to do this (and much more) is by using the -@iftex -@* -@end iftex -@uref{ftp://ftp.mathworks.com/pub/contrib/v5/tools/matlab.el, matlab mode}. - -Instructions on how to install this mode are included in this file. -@end quotation - - -@node Miscellaneous, Current Events, Subsystems, Top + +Yes, a matlab mode and other items are available at the +@uref{ftp://ftp.mathworks.com/pub/contrib/emacs_add_ons, +MathWorks' emacs_add_ons ftp directory}. + +@node Miscellaneous, MS Windows, Subsystems, Top @unnumbered 5 The Miscellaneous Stuff This is part 5 of the XEmacs Frequently Asked Questions list. This @@ -4906,14 +4852,14 @@ * Q5.0.8:: Why does edt emulation not work? * Q5.0.9:: How can I emulate VI and use it as my default mode? * Q5.0.10:: [This question intentionally left blank] -* Q5.0.11:: Filladapt doesn't work in 19.15? +* Q5.0.11:: How do I turn on filladapt for all buffers? * Q5.0.12:: How do I disable gnuserv from opening a new frame? * Q5.0.13:: How do I start gnuserv so that each subsequent XEmacs is a client? * Q5.0.14:: Strange things are happening in Shell Mode. * Q5.0.15:: Where do I get the latest CC Mode? * Q5.0.16:: I find auto-show-mode disconcerting. How do I turn it off? * Q5.0.17:: How can I get two instances of info? -* Q5.0.18:: I upgraded to XEmacs 19.14 and gnuserv stopped working +* Q5.0.18:: [This question intentionally left blank] * Q5.0.19:: Is there something better than LaTeX mode? * Q5.0.20:: Is there a way to start a new XEmacs if there's no gnuserv running, and otherwise use gnuclient? @@ -4960,8 +4906,8 @@ automatically start it by adding lines like: @lisp -(add-hook 'emacs-lisp-mode-hook 'turn-on-font-lock) -(add-hook 'dired-mode-hook 'turn-on-font-lock) +(add-hook 'emacs-lisp-mode-hook 'turn-on-font-lock) +(add-hook 'dired-mode-hook 'turn-on-font-lock) @end lisp to your @file{.emacs}. See the file @file{etc/sample.emacs} for more @@ -5105,6 +5051,10 @@ rename-uniquely} to rename the @code{*shell*} buffer instead of @kbd{M-x rename-buffer}. +Alternately, you can set the variable @code{shell-multiple-shells}. +If the value of this variable is non-nil, each time shell mode is invoked, +a new shell is made + @node Q5.0.7, Q5.0.8, Q5.0.6, Miscellaneous @unnumberedsubsec Q5.0.7: Telnet from shell filters too much @@ -5158,11 +5108,11 @@ Obsolete question, left blank to avoid renumbering @node Q5.0.11, Q5.0.12, Q5.0.10, Miscellaneous -@unnumberedsubsec Q5.0.11: Filladapt doesn't work in 19.15 - -Filladapt 2.x is included in 19.15. In it filladapt is now a minor -mode and minor modes are traditionally off by default. The following -added to your @file{.emacs} will turn it on for all buffers: +@unnumberedsubsec Q5.0.11: How do I turn on filladapt for all buffers? + +Filladapt is a minor mode and minor modes are traditionally off by +default. The following added to your @file{.emacs} will turn it on for +all buffers: @lisp (setq-default filladapt-mode t) @@ -5248,7 +5198,7 @@ @email{bwarsaw@@cnri.reston.va.us, Barry A. Warsaw} writes: @quotation -This can be had from @uref{http://www.python.org/ftp/emacs/}. +This can be had from @uref{http://www.python.org/emacs/}. @end quotation @node Q5.0.16, Q5.0.17, Q5.0.15, Miscellaneous @@ -5270,19 +5220,7 @@ You can't. The @code{info} package does not provide for multiple info buffers. @node Q5.0.18, Q5.0.19, Q5.0.17, Miscellaneous -@unnumberedsubsec Q5.0.18: I upgraded to XEmacs 19.14 and gnuserv stopped working. - -@email{daku@@nortel.ca, Mark Daku} writes: - -@quotation -It turns out I was using an older version of gnuserv. The installation -didn't put the binary into the public bin directory. It put it in -@iftex -@* -@end iftex -@file{lib/xemacs-19.14/hppa1.1-hp-hpux9.05/gnuserv}. Shouldn't it have -been put in @file{bin/hppa1.1-hp-hpux9.0}? -@end quotation +@unnumberedsubsec Q5.0.18: [This question intentionally left blank] @node Q5.0.19, Q5.0.20, Q5.0.18, Miscellaneous @unnumberedsubsec Q5.0.19: Is there something better than LaTeX mode? @@ -5493,7 +5431,7 @@ @lisp (let ((case-fold-search nil)) - ... ; code with searches that must be case-sensitive + ... ; code with searches that must be case-sensitive ...) @end lisp @@ -5558,7 +5496,7 @@ @lisp (defun my-function (whatever) - (let (a) ; default initialization is to nil + (let (a) ; default initialization is to nil ... build a large list ... ... and exit, unbinding `a' in the process ...) @end lisp @@ -5571,11 +5509,11 @@ The reason for the warning is the following: @lisp -(defun flurgoze nil) ; ok, global internal variable +(defun flurgoze nil) ; ok, global internal variable ... -(setq flurghoze t) ; ops! a typo, but semantically correct. - ; however, the byte-compiler warns. +(setq flurghoze t) ; ops! a typo, but semantically correct. + ; however, the byte-compiler warns. While compiling toplevel forms: ** assignment to free variable flurghoze @@ -5697,7 +5635,7 @@ an easy way to find out where it spends time? @c New -z@email{hniksic@@srce.hr, Hrvoje Niksic} writes: +z@email{hniksic@@xemacs.org, Hrvoje Niksic} writes: @quotation Under XEmacs 20.4 and later you can use @kbd{M-x profile-key-sequence}, press a key (say @key{RET} in the Gnus Group buffer), and get the results using @@ -5715,7 +5653,7 @@ (setq sound-alist nil) @end lisp -That will make your XEmacs totally silent -- even the default ding sound +That will make your XEmacs totally silent---even the default ding sound (TTY beep on TTY-s) will be gone. Starting with XEmacs-20.2 you can also change these with Customize. @@ -5812,7 +5750,7 @@ like: @lisp -(add-hook 'postscript-mode-hook 'turn-on-font-lock) +(add-hook 'postscript-mode-hook 'turn-on-font-lock) @end lisp Take it out, restart XEmacs, and it won't try to fontify your postscript @@ -6029,8 +5967,9 @@ It might also be helpful to use @email{stig@@hackvan.com, Stig's} script (included in the compface distribution at XEmacs.org) to do the -conversion. For convenience xbm2xface is available for anonymous FTP at -@uref{ftp://ftp.miranova.com/pub/xemacs/xbm2xface.pl}. +conversion. +@comment For convenience xbm2xface is available for anonymous FTP at +@comment @uref{ftp://ftp.miranova.com/pub/xemacs/xbm2xface.pl}. Contributors for this item: @@ -6050,8 +5989,8 @@ @lisp (setq Info-directory-list (cons - (expand-file-name "~/info") - Info-default-directory-list)) + (expand-file-name "~/info") + Info-default-directory-list)) @end lisp @email{davidm@@prism.kla.com, David Masterson} writes: @@ -6131,25 +6070,394 @@ printing (the @code{Pretty Print Buffer} menu item) @strong{requires} a window system environment. It cannot be used outside of X11. -@node Current Events, , Miscellaneous, Top -@unnumbered 6 What the Future Holds - -This is part 6 of the XEmacs Frequently Asked Questions list. This +@node MS Windows, Current Events, Miscellaneous, Top +@unnumbered 6 XEmacs on MS Windows + +This is part 6 of the XEmacs Frequently Asked Questions list, written by +Hrvoje Niksic and others. This section is devoted to the MS Windows +port of XEmacs. + +@menu + +General Info +* Q6.0.1:: What is the status of the XEmacs port to Windows? +* Q6.0.2:: What flavors of MS Windows are supported? +* Q6.0.3:: Where are the XEmacs on MS Windows binaries? +* Q6.0.4:: Does XEmacs on MS Windows require an X server to run? + +Building XEmacs on MS Windows +* Q6.1.1:: I decided to run with X. Where do I get an X server? +* Q6.1.2:: What compiler do I need to compile XEmacs? +* Q6.1.3:: How do I compile for the native port? +* Q6.1.4:: How do I compile for the X port? +* Q6.1.5:: How do I compile for Cygnus' Cygwin? +* Q6.1.6:: What do I need for Cygwin? + +Customization and User Interface +* Q6.2.1:: How will the port cope with differences in the Windows user interface? +* Q6.2.2:: How do I change fonts in XEmacs on MS Windows? +* Q6.2.3:: Where do I put my @file{.emacs} file? + +Miscellaneous +* Q6.3.1:: Will XEmacs rename all the win32-* symbols to w32-*? +* Q6.3.2:: What are the differences between the various MS Windows emacsen? +* Q6.3.3:: What is the porting team doing at the moment? + +@end menu + +@node Q6.0.1, Q6.0.2, MS Windows, MS Windows +@unnumberedsec 6.0: General Info +@unnumberedsubsec Q6.0.1: What is the status of the XEmacs port to Windows? + +Is XEmacs really getting ported to MS Windows? What is the status of the port? + +Yes, a group of volunteers actively works on making XEmacs code base +cleanly compile and run on MS Windows operating systems. The mailing +list at @email{xemacs-nt@@xemacs.org} is dedicated to that effort (please use +the -request address to subscribe). + +At this time, XEmacs on MS Windows is usable, but lacks some of the +features of XEmacs on UNIX and UNIX-like systems. Notably, +internationalization does not work. + +@node Q6.0.2, Q6.0.3, Q6.0.1, MS Windows +@unnumberedsubsec Q6.0.2: What flavors of MS Windows are supported? The list name implies NT only. + +The list name is misleading, as XEmacs will support both Windows 95, +Windows 98 and Windows NT. The MS Windows-specific code is based on +Microsoft Win32 API, and will not work on MS Windows 3.x or on MS-DOS. + + +@node Q6.0.3, Q6.0.4, Q6.0.2, MS Windows +@unnumberedsubsec Q6.0.3: Are binary kits available? + +Binary kits are available at +@uref{ftp://ftp.xemacs.org/pub/xemacs/binary-kits/win32/} for the +"plain" MS Windows version. + +@node Q6.0.4, Q6.1.1, Q6.0.3, MS Windows +@unnumberedsubsec Q6.0.4: Does XEmacs on MS Windows require an X server to run? + +Short answer: No. + +Long answer: XEmacs can be built in several ways in the MS Windows +environment, some of them requiring an X server and some not. + +One is what we call the "X" port---it requires X libraries to build +and an X server to run. Internally it uses the Xt event loop and +makes use of X toolkits. Its look is quite un-Windowsy, but it works +reliably and supports all of the graphical features of Unix XEmacs. + +The other is what we call the "native" port. It uses the Win32 API +and does not require X libraries to build, nor does it require an X to +run. In fact, it has no connection with X whatsoever. At this time, +the native port obsoletes the X port, providing almost all of its +features, including support for menus, scrollbars, toolbars, embedded +images and background pixmaps, frame pointers, etc. Most of the +future work will be based on the native port. + +There is also a third special case, the Cygwin port. It takes +advantage of Cygnus emulation library under Win32, which enables it to +reuse much of the Unix XEmacs code base, such as processes and network +support, or internal select() mechanisms. + +Cygwin port supports all display types---TTY, X & MS gui, and can be +built with support for all three. If you build with ms gui support +then the Cygwin version uses the majority of the msw code, which is +mostly related to display. If you want to build with X support you +need X libraries. If you want to build with tty support you need +ncurses. MS gui requires no additional libraries. + +Some of the advantages of the Cygwin version are that it: + +@itemize @bullet + +@item integrates well with Cygwin environment for existing Cygwin users; +@item uses configure so building with different features is very easy; +@item has process support in X & tty. + +@end itemize + +The disadvantage is that it requires several Unix utilities and the +whole Cygwin environment, whereas the native port requires only a +suitable MS Windows compiler. Also, it follows the Unix filesystem and +process model very closely (some will undoubtedly view this as an +advantage). + +@node Q6.1.1, Q6.1.2, Q6.0.4, MS Windows +@unnumberedsec 6.1: Building XEmacs on MS Windows +@unnumberedsubsec Q6.1.1: I decided to run with X. Where do I get an X server? + +Pointers to X servers can be found at +@iftex +@* +@end iftex +@uref{http://dao.gsfc.nasa.gov/software/grads/win32/X11R6.3/}; + +look for "Where to get an X server". Also note that, although the above +page talks about Cygnus gnu-win32 (Cygwin), the information on X servers +is Cygwin-independent. You don't have to be running/using Cygwin to use +these X servers, and you don't have to compile XEmacs under Cygwin to +use XEmacs with these X servers. An "X port" XEmacs compiled under +Visual C++ will work with these X servers (as will XEmacs running on a +Unix box, redirected to the server running on your PC). + + +@node Q6.1.2, Q6.1.3, Q6.1.1, MS Windows +@unnumberedsubsec Q6.1.2: What compiler do I need to compile XEmacs? + +You need Visual C++ 4.2 or 5.0, with the exception of the Cygwin port, +which uses Gcc. + + +@node Q6.1.3, Q6.1.4, Q6.1.2, MS Windows +@unnumberedsubsec Q6.1.3: How do I compile for the native port? + +Please read the file @file{nt/README} in the XEmacs distribution, which +contains the full description. + + +@node Q6.1.4, Q6.1.5, Q6.1.3, MS Windows +@unnumberedsubsec Q6.1.4: How do I compile for the X port? + +Again, it is described in @file{nt/README} in some detail. Basically, you +need to get X11 libraries from ftp.x.org, and compile them. If the +precompiled versions are available somewhere, I don't know of it. + + +@node Q6.1.5, Q6.1.6, Q6.1.4, MS Windows +@unnumberedsubsec Q6.1.5: How do I compile for Cygnus' Cygwin? + +Similar as on Unix; use the usual `configure' and `make' process. +Some problems to watch out for: + +@itemize @bullet +@item +make sure HOME is set. This controls where you @file{.emacs} file comes +from; + +@item +CYGWIN32 needs to be set to tty for process support +work. e.g. CYGWIN32=tty; + +@item +picking up some other grep or other unix like tools can kill configure; + +@item +static heap too small, adjust src/sheap-adjust.h to a more positive +number; + +@item +The Cygwin version doesn't understand @file{//machine/path} type paths so you +will need to manually mount a directory of this form under a unix style +directory for a build to work on the directory. + +@end itemize + +@node Q6.1.6, Q6.2.1, Q6.1.5, MS Windows +@unnumberedsubsec Q6.1.6: What do I need for Cygwin? + +You can find the Cygwin tools and compiler at: + +@uref{http://sourceware.cygnus.com/cygwin/} + +You will need version b19 or later. + +You will also need the X libraries. There are libraries at +@iftex +@* +@end iftex +@uref{http://dao.gsfc.nasa.gov/software/grads/win32/X11R6.3/}, but +these are not b19 compatible. You can get b19 X11R6.3 binaries, as +well as pre-built ncurses and graphic libraries, from: + +@uref{ftp://ftp.parallax.co.uk/pub/andyp/}. + + +@node Q6.2.1, Q6.2.2, Q6.1.6, MS Windows +@unnumberedsec 6.2: Customization and User Interface +@unnumberedsubsec Q6.2.1: How will the port cope with differences in the Windows user interface? + +XEmacs (and Emacs in general) UI is pretty +different from what is expected of a typical MS Windows program. How will +the MS Windows port cope with it? + +Fortunately, Emacs is also one of the most configurable editor beasts +in the world. The MS Windows "look and feel" (mark via shift-arrow, +self-inserting deletes region, etc.) can be easily configured via +various packages distributed with XEmacs. The `pending-delete' +package is an example of such a utility. + +In future versions, some of these packages might be turned on by +default in the MS Windows environment. + + +@node Q6.2.2, Q6.2.3, Q6.2.1, MS Windows +@unnumberedsubsec Q6.2.2: How do I change fonts in XEmacs on MS Windows? + +In 21.2.*, use the font menu. In 21.1.*, you can change font +manually. For example: + +@display + (set-face-font 'default "Lucida Console:Regular:10") + (set-face-font 'modeline "MS Sans Serif:Regular:10") +@end display + + +@node Q6.2.3, Q6.3.1, Q6.2.2, MS Windows +@unnumberedsubsec Q6.2.3: Where do I put my @file{.emacs} file? + +If the HOME environment variable is set, @file{.emacs} will be looked for +there. Else the directory defaults to `c:\'. + +@node Q6.3.1, Q6.3.2, Q6.2.3, MS Windows +@unnumberedsec 6.3: Miscellaneous +@unnumberedsubsec Q6.3.1: Will XEmacs rename all the win32-* symbols to w32-*? + +In his flavor of Emacs 20, Richard Stallman has renamed all the win32-* +symbols to w32-*. Will XEmacs do the same? + +We consider such a move counter-productive, thus we will not use the +`w32' prefix. However, we do recognize that Win32 name is little more +than a marketing buzzword (will it be Win64 in the next release?), so +we decided not to use it. Using `windows-' would be wrong because the +term is too generic, which is why we settled on a compromise +`mswindows' term. + +Thus all the XEmacs variables and functions directly related to Win32 +are prefixed `mswindows-'. The user-variables shared with NT Emacs +will be provided as compatibility aliases. + +Architectural note: We believe that there should be a very small +number of window-systems-specific variables, and will try to provide +generic interfaces whenever possible. + + +@node Q6.3.2, Q6.3.3, Q6.3.1, MS Windows +@unnumberedsubsec Q6.3.2: What are the differences between the various MS Windows emacsen? + +XEmacs, Win-Emacs, DOS Emacs, NT Emacs, this is all very confusing. +Could you briefly explain the differences between them? + +Here is a recount of various Emacs versions running on MS Windows: + +@itemize @bullet + +@item +Win-Emacs + +@itemize @minus + +@item +Win-Emacs is a port of Lucid Emacs 19.6 to MS Windows using X +compatibility libraries. Win-Emacs has been written by Ben Wing. The +MS Windows code has not made it back to Lucid Emacs, which left Win-Emacs +pretty much dead for our purposes. Win-Emacs used to be available at +Pearlsoft, but not anymore, since Pearlsoft went out of business. +@end itemize + +@item +GNU Emacs for DOS + +@itemize @minus + +@item +GNU Emacs features support for MS-DOS and DJGPP (D.J. Delorie's DOS +port of Gcc). Such an Emacs is heavily underfeatured, because it does +not supports long file names, lacks proper subprocesses support, and +is far too big compared to typical DOS editors. +@end itemize + +@item +GNU Emacs compiled with Win32 + +@itemize @minus + +@item +Starting with version 19.30, it has been possible to compile GNU Emacs +under MS Windows using the DJGPP compiler and X libraries. The result +is is very similar to GNU Emacs compiled under MS DOS, only it +supports longer file names, etc. This "port" is similar to the "X" +flavor of XEmacs on MS Windows. +@end itemize + +@item +NT Emacs + +@itemize @minus + +@item +NT Emacs is a version of GNU Emacs modified to compile and run under +MS MS Windows 95 and NT using the native Win32 API. As such, it is close +in spirit to the XEmacs "native" port. + +@item +NT Emacs has been written by Geoff Voelker, and more information can be +found at +@iftex +@* +@end iftex +@uref{http://www.cs.washington.edu/homes/voelker/ntemacs.html}. + +@end itemize + +@item +XEmacs + +@itemize @minus + +@item +Beginning with XEmacs 19.12, XEmacs' architecture has been redesigned +in such a way to allow clean support of multiple window systems. At +this time the TTY support was added, making X and TTY the first two +"window systems" XEmacs supported. The 19.12 design is the basis for +the current native MS Windows code. + +@item +Some time during 1997, David Hobley (soon joined by Marc Paquette) +imported some of the NT-specific portions of GNU Emacs, making XEmacs +with X support compile under Windows NT, and creating the "X" port. + +@item +Several months later, Jonathan Harris sent out initial patches to use +the Win32 API, thus creating the native port. Since then, various +people have contributed, including Kirill M. Katsnelson (contributed +support for menubars, subprocesses and network, as well as loads of +other code), Andy Piper (ported XEmacs to Cygwin environment, +contributed Windows unexec, Windows-specific glyphs and toolbars code, +and more), Jeff Sparkes (contributed scrollbars support) and many +others. + +@end itemize + +@end itemize + + +@node Q6.3.3, , Q6.3.2, MS Windows +@unnumberedsubsec Q6.3.3: What is the porting team doing at the moment? + +The porting team is continuing work on the MS Windows-specific code. + + +@node Current Events, , MS Windows, Top +@unnumbered 7 What the Future Holds + +This is part 7 of the XEmacs Frequently Asked Questions list. This section will change monthly, and contains any interesting items that have transpired over the previous month. If you are reading this from the XEmacs distribution, please see the version on the Web or archived at the various FAQ FTP sites, as this file is surely out of date. @menu -* Q6.0.1:: What is new in 20.2? -* Q6.0.2:: What is new in 20.3? -* Q6.0.3:: What is new in 20.4? -* Q6.0.4:: Procedural changes in XEmacs development. +* Q7.0.1:: What is new in 20.2? +* Q7.0.2:: What is new in 20.3? +* Q7.0.3:: What is new in 20.4? +* Q7.0.4:: Procedural changes in XEmacs development. @end menu -@node Q6.0.1, Q6.0.2, Current Events, Current Events -@unnumberedsec 6.0: Changes -@unnumberedsubsec Q6.0.1: What is new in 20.2? +@node Q7.0.1, Q7.0.2, Current Events, Current Events +@unnumberedsec 7.0: Changes +@unnumberedsubsec Q7.0.1: What is new in 20.2? The biggest changes in 20.2 include integration of EFS (the next generation of ange-ftp) and AUC Tex (the Emacs subsystem that includes a @@ -6161,8 +6469,8 @@ XEmacs 20.2 is the development release (20.0 was beta), and is no longer considered unstable. -@node Q6.0.2, Q6.0.3, Q6.0.1, Current Events -@unnumberedsubsec Q6.0.2: What is new in 20.3? +@node Q7.0.2, Q7.0.3, Q7.0.1, Current Events +@unnumberedsubsec Q7.0.2: What is new in 20.3? XEmacs 20.3 was released in November 1997. It contains many bugfixes, and a number of new features, including Autoconf 2 based configuration, @@ -6174,22 +6482,22 @@ The XEmacs/Mule support has been only seriously tested in a Japanese locale, and no doubt many problems still remain. The support for ISO-Latin-1 and Japanese is fairly strong. MULE support comes at a -price -- about a 30% slowdown from 19.16. We're making progress on +price---about a 30% slowdown from 19.16. We're making progress on improving performance and XEmacs 20.3 compiled without Mule (which is the default) is definitely faster than XEmacs 19.16. XEmacs 20.3 is the first non-beta v20 release, and will be the basis for all further development. -@node Q6.0.3, Q6.0.4, Q6.0.2, Current Events -@unnumberedsubsec Q6.0.3: What's new in XEmacs 20.4? +@node Q7.0.3, Q7.0.4, Q7.0.2, Current Events +@unnumberedsubsec Q7.0.3: What's new in XEmacs 20.4? XEmacs 20.4 is a bugfix release with no user-visible changes. @c Filled in from NEWS file of 20.5-b33 -@node Q6.0.4, , Q6.0.3, Current Events -@unnumberedsubsec Q6.0.4: Procedural changes in XEmacs development. +@node Q7.0.4, , Q7.0.3, Current Events +@unnumberedsubsec Q7.0.4: Procedural changes in XEmacs development. @enumerate @item @@ -6218,7 +6526,7 @@ the collected bugfixes. @item -As of December 1996, @email{steve@@altair.xemacs.org, Steve Baur} has become +As of December 1996, @email{steve@@xemacs.org, Steve Baur} has become the lead maintainer of XEmacs. @end enumerate diff -r f4aeb21a5bad -r 74fd4e045ea6 man/xemacs/Makefile --- a/man/xemacs/Makefile Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,56 +0,0 @@ -# Makefile for the XEmacs Reference Manual. - -# This file is part of XEmacs. - -# XEmacs is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any -# later version. - -# XEmacs is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. - -# You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. - -# Modified by Ben Wing, February 1994 - -NAME=xemacs - -MAKEINFO = makeinfo -TEXI2DVI = texi2dvi - -# List of all the texinfo files in the manual: - -srcs = xemacs.texi abbrevs.texi basic.texi buffers.texi building.texi \ - calendar.texi cmdargs.texi custom.texi display.texi entering.texi \ - files.texi fixit.texi glossary.texi gnu.texi help.texi indent.texi \ - keystrokes.texi killing.texi xemacs.texi m-x.texi major.texi mark.texi \ - menus.texi mini.texi misc.texi mouse.texi new.texi picture.texi \ - programs.texi reading.texi regs.texi frame.texi search.texi sending.texi \ - text.texi trouble.texi undo.texi windows.texi - -all : info -info : ../../info/$(NAME).info - -dvi: $(NAME).dvi -.texi.dvi : - $(TEXI2DVI) $< - -../../info/$(NAME).info: $(srcs) - $(MAKEINFO) -o $@ $(NAME).texi - -.PHONY: mostlyclean clean distclean realclean extraclean -mostlyclean: - rm -f *.toc *.aux *.oaux *.log *.cp *.cps *.fn *.fns *.tp *.tps \ - *.vr *.vrs *.pg *.pgs *.ky *.kys -clean: mostlyclean - rm -f *.dvi *.ps make.out core -distclean: clean -realclean: distclean -extraclean: distclean - -rm -f *~ \#* diff -r f4aeb21a5bad -r 74fd4e045ea6 man/xemacs/abbrevs.texi --- a/man/xemacs/abbrevs.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/xemacs/abbrevs.texi Mon Aug 13 11:13:30 2007 +0200 @@ -186,9 +186,9 @@ @example (lisp-mode-abbrev-table) -"dk" 0 "define-key" +"dk" 0 "define-key" (global-abbrev-table) -"dfn" 0 "definition" +"dfn" 0 "definition" @end example @noindent diff -r f4aeb21a5bad -r 74fd4e045ea6 man/xemacs/buffers.texi --- a/man/xemacs/buffers.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/xemacs/buffers.texi Mon Aug 13 11:13:30 2007 +0200 @@ -117,14 +117,14 @@ MR Buffer Size Mode File -- ------ ---- ---- ---- .* emacs.tex 383402 Texinfo /u2/emacs/man/emacs.tex - *Help* 1287 Fundamental + *Help* 1287 Fundamental files.el 23076 Emacs-Lisp /u2/emacs/lisp/files.el % RMAIL 64042 RMAIL /u/rms/RMAIL - *% man 747 Dired /u2/emacs/man/ + *% man 747 Dired /u2/emacs/man/ net.emacs 343885 Fundamental /u/rms/net.emacs fileio.c 27691 C /u2/emacs/src/fileio.c NEWS 67340 Text /u2/emacs/etc/NEWS - *scratch* 0 Lisp Interaction + *scratch* 0 Lisp Interaction @end smallexample @noindent diff -r f4aeb21a5bad -r 74fd4e045ea6 man/xemacs/cmdargs.texi --- a/man/xemacs/cmdargs.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/xemacs/cmdargs.texi Mon Aug 13 11:13:30 2007 +0200 @@ -155,10 +155,17 @@ @item -vanilla This is equivalent to @samp{-q -no-site-file -no-early-packages}. +@item -user-init-file @var{file} +Load @var{file} as your Emacs init file instead of @file{~/.emacs}. + +@item -user-init-directory @var{directory} +Use @var{directory} as the location of your early package hierarchies +and the various user-specific initialization files. + @item -user @var{user} @itemx -u @var{user} -Load @var{user}'s Emacs init file @file{~@var{user}/.emacs} instead of -your own. +Equivalent to +@samp{-user-init-file ~@var{user}/.emacs -user-init-directory ~@var{user}/.xemacs}. @end table @@ -224,6 +231,9 @@ @item -cr @var{color} Use @var{color} as the text-cursor foreground color. + +@item -private +Install a private colormap for XEmacs. @end table In addition, XEmacs allows you to use a number of standard Xt diff -r f4aeb21a5bad -r 74fd4e045ea6 man/xemacs/custom.texi --- a/man/xemacs/custom.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/xemacs/custom.texi Mon Aug 13 11:13:30 2007 +0200 @@ -30,7 +30,7 @@ file. * Audible Bell:: Changing how Emacs sounds the bell. * Faces:: Changing the fonts and colors of a region of text. -* X Resources:: X resources controlling various aspects of the +* X Resources:: X resources controlling various aspects of the behavior of XEmacs. @end menu @@ -761,16 +761,16 @@ mode and variable settings should be. For example, these are all legal: @example - ;;; -*- mode: emacs-lisp -*- - ;;; -*- mode: postscript; version-control: never -*- - ;;; -*- tags-file-name: "/foo/bar/TAGS" -*- + ;;; -*- mode: emacs-lisp -*- + ;;; -*- mode: postscript; version-control: never -*- + ;;; -*- tags-file-name: "/foo/bar/TAGS" -*- @end example For historical reasons, the syntax @code{`-*- modename -*-'} is allowed as well; for example, you can use: @example - ;;; -*- emacs-lisp -*- + ;;; -*- emacs-lisp -*- @end example @vindex enable-local-variables @@ -1093,9 +1093,9 @@ local map, which affects all buffers using the same major mode. @menu -* Interactive Rebinding:: Changing Key Bindings Interactively -* Programmatic Rebinding:: Changing Key Bindings Programmatically -* Key Bindings Using Strings::Using Strings for Changing Key Bindings +* Interactive Rebinding:: Changing Key Bindings Interactively +* Programmatic Rebinding:: Changing Key Bindings Programmatically +* Key Bindings Using Strings:: Using Strings for Changing Key Bindings @end menu @node Interactive Rebinding @@ -1232,13 +1232,13 @@ @example ;;; Bind @code{my-command} to @key{f1} -(global-set-key 'f1 'my-command) +(global-set-key 'f1 'my-command) ;;; Bind @code{my-command} to @kbd{Shift-f1} (global-set-key '(shift f1) 'my-command) ;;; Bind @code{my-command} to @kbd{C-c Shift-f1} -(global-set-key '[(control c) (shift f1)] 'my-command) +(global-set-key '[(control c) (shift f1)] 'my-command) ;;; Bind @code{my-command} to the middle mouse button. (global-set-key 'button2 'my-command) @@ -1288,14 +1288,14 @@ After binding a command to two key sequences with a form like: @example - (define-key global-map "\^X\^I" 'command-1) + (define-key global-map "\^X\^I" 'command-1) @end example it is possible to redefine only one of those sequences like so: @example - (define-key global-map [(control x) (control i)] 'command-2) - (define-key global-map [(control x) tab] 'command-3) + (define-key global-map [(control x) (control i)] 'command-2) + (define-key global-map [(control x) tab] 'command-3) @end example This applies only when running under a window system. If you are @@ -1539,18 +1539,13 @@ When you start Emacs, it normally loads the file @file{.emacs} in your home directory. This file, if it exists, should contain Lisp code. It is called your initialization file or @dfn{init file}. Use the command -line switches @samp{-q} and @samp{-u} to tell Emacs whether to load an -init file (@pxref{Entering Emacs}). - -@vindex init-file-user -When the @file{.emacs} file is read, the variable @code{init-file-user} -says which user's init file it is. The value may be the null string or a -string containing a user's name. If the value is a null string, it means -that the init file was taken from the user that originally logged in. - -In all cases, @code{(concat "~" init-file-user "/")} evaluates to the -directory name of the directory where the @file{.emacs} file was looked -for. +line switch @samp{-q} to tell Emacs whether to load an +init file (@pxref{Entering Emacs}). Use the command line switch +@samp{-user-init-file} (@pxref{Command Switches}) to tell Emacs to load +a different file instead of @file{~/.emacs}. + +When the @file{.emacs} file is read, the variable @code{user-init-file} +says which init file was loaded. At some sites there is a @dfn{default init file}, which is the library named @file{default.el}, found via the standard search path for @@ -1923,16 +1918,16 @@ @item undefined-key You type a key that is undefined -@item undefined-click +@item undefined-click You use an undefined mouse-click combination -@item no-completion +@item no-completion Completion was not possible -@item y-or-n-p +@item y-or-n-p You type something other than the required @code{y} or @code{n} -@item yes-or-no-p +@item yes-or-no-p You type something other than @code{yes} or @code{no} @end table @@ -2071,7 +2066,7 @@ Starting with XEmacs 21, XEmacs uses the class @samp{XEmacs} if it finds any XEmacs resources in the resource database when the X connection is initialized. Otherwise, it will use the class @samp{Emacs} for -backwards compatability. The variable @var{x-emacs-application-class} +backwards compatibility. The variable @var{x-emacs-application-class} may be consulted to determine the application class being used. The examples in this section assume the application class is @samp{Emacs}. @@ -2103,11 +2098,11 @@ @menu * Geometry Resources:: Controlling the size and position of frames. -* Iconic Resources:: Controlling whether frames come up iconic. -* Resource List:: List of resources settable on a frame or device. -* Face Resources:: Controlling faces using resources. -* Widgets:: The widget hierarchy for XEmacs. -* Menubar Resources:: Specifying resources for the menubar. +* Iconic Resources:: Controlling whether frames come up iconic. +* Resource List:: List of resources settable on a frame or device. +* Face Resources:: Controlling faces using resources. +* Widgets:: The widget hierarchy for XEmacs. +* Menubar Resources:: Specifying resources for the menubar. @end menu @node Geometry Resources @@ -2364,8 +2359,8 @@ The foreground and background colors of this face. @item @code{attributeBackgroundPixmap} (class @code{AttributeBackgroundPixmap}): file-name -The name of an @sc{XBM} file (or @sc{XPM} file, if your version of Emacs -supports @sc{XPM}), to use as a background stipple. +The name of an @sc{xbm} file (or @sc{xpm} file, if your version of Emacs +supports @sc{xpm}), to use as a background stipple. @item @code{attributeUnderline} (class @code{AttributeUnderline}): boolean Whether text in this face should be underlined. diff -r f4aeb21a5bad -r 74fd4e045ea6 man/xemacs/keystrokes.texi --- a/man/xemacs/keystrokes.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/xemacs/keystrokes.texi Mon Aug 13 11:13:30 2007 +0200 @@ -169,9 +169,9 @@ Here are some examples of complete key sequences: @table @kbd -@item [(control c) (control a)] +@item [(control c) (control a)] Typing @kbd{C-c} followed by @kbd{C-a} -@item [(control c) (control 65)] +@item [(control c) (control 65)] Typing @kbd{C-c} followed by @kbd{C-a}. (Using the ASCII code for the character `a')@refill @item [(control c) (break)] @@ -299,9 +299,9 @@ Create a file called @code{~/.xmodmap}. In this file, place the lines @example - remove Lock = Caps_Lock - keysym Caps_Lock = Super_L - add Mod2 = Super_L + remove Lock = Caps_Lock + keysym Caps_Lock = Super_L + add Mod2 = Super_L @end example The first line says that the key that is currently called @code{Caps_Lock} diff -r f4aeb21a5bad -r 74fd4e045ea6 man/xemacs/menus.texi --- a/man/xemacs/menus.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/xemacs/menus.texi Mon Aug 13 11:13:30 2007 +0200 @@ -430,18 +430,18 @@ The following functions are available: @table @kbd -@item add-menu: @var{(menu-path menu-name menu-items &optional before)} +@item add-menu: (@var{menu-path} @var{menu-name} @var{menu-items} &optional @var{before}) Add a menu to the menu bar or one of its submenus. -@item add-menu-item: @var{(menu-path item-name function enabled-p -&optional before)} +@item add-menu-item: (@var{menu-path} @var{item-name} @var{function} +@var{enabled-p} &optional @var{before}) Add a menu item to a menu, creating the menu first if necessary. -@item delete-menu-item: @var{(path)} +@item delete-menu-item: (@var{path}) Remove the menu item defined by @var{path} from the menu hierarchy. -@item disable-menu-item: @var{(path)} +@item disable-menu-item: (@var{path}) Disable the specified menu item. -@item enable-menu-item: @var{(path)} +@item enable-menu-item: (@var{path}) Enable the specified previously disabled menu item. -@item relabel-menu-item: @var{(path new-name)} +@item relabel-menu-item: (@var{path} @var{new-name}) Change the string of the menu item specified by @var{path} to @var{new-name}. diff -r f4aeb21a5bad -r 74fd4e045ea6 man/xemacs/mini.texi --- a/man/xemacs/mini.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/xemacs/mini.texi Mon Aug 13 11:13:30 2007 +0200 @@ -3,20 +3,19 @@ @chapter The Minibuffer @cindex minibuffer - Emacs commands use the @dfn{minibuffer} to read arguments more -complicated than a single number. Minibuffer arguments can be file -names, buffer names, Lisp function names, Emacs command names, Lisp -expressions, and many other things, depending on the command reading the -argument. To edit the argument in the minibuffer, you can use Emacs -editing commands. - + The @dfn{minibuffer} is the facility used by XEmacs commands to read +arguments more complicated than a single number. Minibuffer arguments +can be file names, buffer names, Lisp function names, XEmacs command +names, Lisp expressions, and many other things, depending on the command +reading the argument. You can use the usual XEmacs editing commands in +the minibuffer to edit the argument text. @cindex prompt When the minibuffer is in use, it appears in the echo area, and the cursor moves there. The beginning of the minibuffer line displays a -@dfn{prompt} indicating what kind of input you should supply and how it -will be used. The prompt is often derived from the name of the command -the argument is for. The prompt normally ends with a colon. +@dfn{prompt} which says what kind of input you should supply and how it +will be used. Often this prompt is derived from the name of the command +that the argument is for. The prompt normally ends with a colon. @cindex default argument Sometimes a @dfn{default argument} appears in parentheses after the @@ -26,14 +25,14 @@ is the name of the buffer that will be used if you type just @key{RET}. @kindex C-g - The simplest way to give a minibuffer argument is to type the text you -want, terminated by @key{RET} to exit the minibuffer. To get out -of the minibuffer and cancel the command that it was for, type -@kbd{C-g}. + The simplest way to enter a minibuffer argument is to type the text +you want, terminated by @key{RET} which exits the minibuffer. You can +cancel the command that wants the argument, and get out of the +minibuffer, by typing @kbd{C-g}. Since the minibuffer uses the screen space of the echo area, it can -conflict with other ways Emacs customarily uses the echo area. Here is how -Emacs handles such conflicts: +conflict with other ways XEmacs customarily uses the echo area. Here is +how XEmacs handles such conflicts: @itemize @bullet @item @@ -44,9 +43,9 @@ anything. @item -If you use a command in the minibuffer whose purpose is to print a -message in the echo area (for example @kbd{C-x =}) the message is -displayed normally, and the minibuffer is hidden for a while. It comes back +If in the minibuffer you use a command whose purpose is to print a +message in the echo area, such as @kbd{C-x =}, the message is printed +normally, and the minibuffer is hidden for a while. It comes back after a few seconds, or as soon as you type anything. @item @@ -58,6 +57,7 @@ * File: Minibuffer File. Entering file names with the minibuffer. * Edit: Minibuffer Edit. How to edit in the minibuffer. * Completion:: An abbreviation facility for minibuffer input. +* Minibuffer History:: Reusing recent minibuffer arguments. * Repetition:: Re-executing commands that used the minibuffer. @end menu @@ -66,37 +66,43 @@ Sometimes the minibuffer starts out with text in it. For example, when you are supposed to give a file name, the minibuffer starts out containing -the @dfn{default directory}, which ends with a slash. This informs -you in which directory the file will be looked for if you do not specify -a different one. For example, the minibuffer might start out with: +the @dfn{default directory}, which ends with a slash. This is to inform +you which directory the file will be found in if you do not specify a +directory. + + For example, the minibuffer might start out with these contents: @example Find File: /u2/emacs/src/ @end example @noindent -where @samp{Find File:@: } is the prompt. Typing @kbd{buffer.c} specifies -the file -@*@file{/u2/emacs/src/buffer.c}. To find files in nearby -directories, use @samp{..}; thus, if you type @kbd{../lisp/simple.el}, the -file that you visit will be the one named -@*@file{/u2/emacs/lisp/simple.el}. -Alternatively, you can use @kbd{M-@key{DEL}} to kill directory names you -don't want (@pxref{Words}).@refill +where @samp{Find File:@: } is the prompt. Typing @kbd{buffer.c} +specifies the file @file{/u2/emacs/src/buffer.c}. To find files in +nearby directories, use @kbd{..}; thus, if you type +@kbd{../lisp/simple.el}, you will get the file named +@file{/u2/emacs/lisp/simple.el}. Alternatively, you can kill with +@kbd{M-@key{DEL}} the directory names you don't want (@pxref{Words}). - You can also type an absolute file name, one starting with a slash or a -tilde, ignoring the default directory. For example, to find the file -@file{/etc/termcap}, just type the name, giving: + If you don't want any of the default, you can kill it with @kbd{C-a +C-k}. But you don't need to kill the default; you can simply ignore it. +Insert an absolute file name, one starting with a slash or a tilde, +after the default directory. For example, to specify the file +@file{/etc/termcap}, just insert that name, giving these minibuffer +contents: @example Find File: /u2/emacs/src//etc/termcap @end example @noindent -Two slashes in a row are not normally meaningful in Unix file names, but -they are allowed in XEmacs. They mean, ``ignore everything before the -second slash in the pair.'' Thus, @samp{/u2/emacs/src/} is ignored, and -you get the file @file{/etc/termcap}. +@cindex // in file name +@cindex double slash in file name +@cindex slashes repeated in file name +XEmacs gives a special meaning to a double slash (which is not normally +a useful thing to write): it means, ``ignore everything before the +second slash in the pair.'' Thus, @samp{/u2/emacs/src/} is ignored in +the example above, and you get the file @file{/etc/termcap}. @vindex insert-default-directory If you set @code{insert-default-directory} to @code{nil}, the default @@ -107,126 +113,141 @@ @node Minibuffer Edit, Completion, Minibuffer File, Minibuffer @section Editing in the Minibuffer - The minibuffer is an Emacs buffer (albeit a peculiar one), and the usual -Emacs commands are available for editing the text of an argument you are -entering. + The minibuffer is an XEmacs buffer (albeit a peculiar one), and the +usual XEmacs commands are available for editing the text of an argument +you are entering. Since @key{RET} in the minibuffer is defined to exit the minibuffer, -you must use @kbd{C-o} or @kbd{C-q @key{LFD}} to insert a newline into -the minibuffer. (Recall that a newline is really the @key{LFD} -character.) +you can't use it to insert a newline in the minibuffer. To do that, +type @kbd{C-o} or @kbd{C-q C-j}. (Recall that a newline is really the +character control-J.) - The minibuffer has its own window, which always has space on the screen -but acts as if it were not there when the minibuffer is not in use. The -minibuffer window is just like the others; you can switch to another -window with @kbd{C-x o}, edit text in other windows, and perhaps even -visit more files before returning to the minibuffer to submit the -argument. You can kill text in another window, return to the minibuffer -window, and then yank the text to use it in the argument. @xref{Windows}. + The minibuffer has its own window which always has space on the screen +but acts as if it were not there when the minibuffer is not in use. +When the minibuffer is in use, its window is just like the others; you +can switch to another window with @kbd{C-x o}, edit text in other +windows and perhaps even visit more files, before returning to the +minibuffer to submit the argument. You can kill text in another window, +return to the minibuffer window, and then yank the text to use it in the +argument. @xref{Windows}. - There are, however, some restrictions on the use of the minibuffer window. -You cannot switch buffers in it---the minibuffer and its window are -permanently attached. You also cannot split or kill the minibuffer -window, but you can make it taller with @kbd{C-x ^}. + There are some restrictions on the use of the minibuffer window, +however. You cannot switch buffers in it---the minibuffer and its +window are permanently attached. Also, you cannot split or kill the +minibuffer window. But you can make it taller in the normal fashion with +@kbd{C-x ^}. @kindex C-M-v - If you are in the minibuffer and issue a command that displays help -text in another window, that window will be scrolled if you type -@kbd{M-C-v} while in the minibuffer until you exit the minibuffer. This -feature is helpful if a completing minibuffer gives you a long list of -possible completions. + If while in the minibuffer you issue a command that displays help text +of any sort in another window, you can use the @kbd{C-M-v} command while +in the minibuffer to scroll the help text. This lasts until you exit +the minibuffer. This feature is especially useful if a completing +minibuffer gives you a list of possible completions. @xref{Other Window}. +@vindex minibuffer-confirm-incomplete If the variable @code{minibuffer-confirm-incomplete} is @code{t}, you are asked for confirmation if there is no known completion for the text you typed. For example, if you attempted to visit a non-existent file, the minibuffer might read: @example - Find File:chocolate_bar.c [no completions, confirm] + Find File: chocolate_bar.c [no completions, confirm] @end example If you press @kbd{Return} again, that confirms the filename. Otherwise, you can continue editing it. - Emacs supports recursive use of the minibuffer. However, it is -easy to do this by accident (because of autorepeating keyboards, for -example) and get confused. Therefore, most Emacs commands that use the -minibuffer refuse to operate if the minibuffer window is selected. If the -minibuffer is active but you have switched to a different window, recursive -use of the minibuffer is allowed---if you know enough to try to do this, -you probably will not get confused. + XEmacs supports recursive use of the minibuffer. However, it is easy +to do this by accident (because of autorepeating keyboards, for example) +and get confused. Therefore, most XEmacs commands that use the +minibuffer refuse to operate if the minibuffer window is selected. If +the minibuffer is active but you have switched to a different window, +recursive use of the minibuffer is allowed---if you know enough to try +to do this, you probably will not get confused. @vindex enable-recursive-minibuffers - If you set the variable @code{enable-recursive-minibuffers} to be + If you set the variable @code{enable-recursive-minibuffers} to a non-@code{nil}, recursive use of the minibuffer is always allowed. -@node Completion, Repetition, Minibuffer Edit, Minibuffer +@node Completion, Minibuffer History, Minibuffer Edit, Minibuffer @section Completion @cindex completion - When appropriate, the minibuffer provides a @dfn{completion} facility. -You type the beginning of an argument and one of the completion keys, -and Emacs visibly fills in the rest, depending on what you have already -typed. + For certain kinds of arguments, you can use @dfn{completion} to enter +the argument value. Completion means that you type part of the +argument, then XEmacs visibly fills in the rest, or as much as +can be determined from the part you have typed. When completion is available, certain keys---@key{TAB}, @key{RET}, and -@key{SPC}---are redefined to complete an abbreviation present in the +@key{SPC}---are rebound to complete the text present in the minibuffer into a longer string that it stands for, by matching it against a set of @dfn{completion alternatives} provided by the command reading the argument. @kbd{?} is defined to display a list of possible completions of what you have inserted. - For example, when the minibuffer is being used by @kbd{Meta-x} to read -the name of a command, it is given a list of all available Emacs command -names to complete against. The completion keys match the text in the -minibuffer against all the command names, find any additional characters of -the name that are implied by the ones already present in the minibuffer, -and add those characters to the ones you have given. + For example, when @kbd{M-x} uses the minibuffer to read the name of a +command, it provides a list of all available XEmacs command names to +complete against. The completion keys match the text in the minibuffer +against all the command names, find any additional name characters +implied by the ones already present in the minibuffer, and add those +characters to the ones you have given. This is what makes it possible +to type @kbd{M-x inse @key{SPC} b @key{RET}} instead of @kbd{M-x +insert-buffer @key{RET}} (for example). - Case is normally significant in completion because it is significant in -most of the names that you can complete (buffer names, file names, and -command names). Thus, @samp{fo} will not complete to @samp{Foo}. When you -are completing a name in which case does not matter, case may be ignored -for completion's sake if specified by program. + Case is normally significant in completion because it is significant +in most of the names that you can complete (buffer names, file names and +command names). Thus, @samp{fo} does not complete to @samp{Foo}. When +you are completing a name in which case does not matter, case may be +ignored for completion's sake if specified by program. When a completion list is displayed, the completions will highlight as you move the mouse over them. Clicking the middle mouse button on any highlighted completion will ``select'' it just as if you had typed it in and hit @key{RET}. -@subsection A Completion Example +@menu +* Example: Completion Example. +* Commands: Completion Commands. +* Strict Completion:: +* Options: Completion Options. +@end menu + +@node Completion Example, Completion Commands, Completion, Completion +@subsection Completion Example @kindex TAB @findex minibuffer-complete - Consider the following example. If you type @kbd{Meta-x au @key{TAB}}, -@key{TAB} looks for alternatives (in this case, command names) that -start with @samp{au}. There are only two commands: @code{auto-fill-mode} and -@code{auto-save-mode}. They are the same as far as @code{auto-}, so the -@samp{au} in the minibuffer changes to @samp{auto-}.@refill + A concrete example may help here. If you type @kbd{M-x au @key{TAB}}, +the @key{TAB} looks for alternatives (in this case, command names) that +start with @samp{au}. There are several, including +@code{auto-fill-mode} and @code{auto-save-mode}---but they are all the +same as far as @code{auto}, so the @samp{au} in the minibuffer changes +to @samp{auto}. - If you type @key{TAB} again immediately, there are multiple possibilities -for the very next character---it could be @samp{s} or @samp{f}---so no more -characters are added; but a list of all possible completions is displayed -in another window. + If you type @key{TAB} again immediately, there are multiple +possibilities for the very next character---it could be any of +@samp{c-}---so no more characters are added; instead, @key{TAB} +displays a list of all possible completions in another window. If you go on to type @kbd{f @key{TAB}}, this @key{TAB} sees @samp{auto-f}. The only command name starting this way is -@code{auto-fill-mode}, so completion inserts the rest of that command. You -now have @samp{auto-fill-mode} in the minibuffer after typing just @kbd{au -@key{TAB} f @key{TAB}}. Note that @key{TAB} has this effect because in the -minibuffer it is bound to the function @code{minibuffer-complete} when -completion is supposed to be done.@refill +@code{auto-fill-mode}, so completion fills in the rest of that. You now +have @samp{auto-fill-mode} in the minibuffer after typing just @kbd{au +@key{TAB} f @key{TAB}}. Note that @key{TAB} has this effect because in +the minibuffer it is bound to the command @code{minibuffer-complete} +when completion is available. +@node Completion Commands, Strict Completion, Completion Example, Completion @subsection Completion Commands - Here is a list of all the completion commands defined in the minibuffer + Here is a list of the completion commands defined in the minibuffer when completion is available. @table @kbd @item @key{TAB} -Complete the text in the minibuffer as much as possible @* +Complete the text in the minibuffer as much as possible (@code{minibuffer-complete}). @item @key{SPC} -Complete the text in the minibuffer but don't add or fill out more -than one word (@code{minibuffer-complete-word}). +Complete the minibuffer text, but don't go beyond one word +(@code{minibuffer-complete-word}). @item @key{RET} Submit the text in the minibuffer as the argument, possibly completing first as described below (@code{minibuffer-complete-and-exit}). @@ -244,14 +265,51 @@ @kindex SPC @findex minibuffer-complete-word -@key{SPC} completes in a way that is similar to @key{TAB}, but it never -goes beyond the next hyphen or space. If you have @samp{auto-f} in the -minibuffer and type @key{SPC}, it finds that the completion is - @samp{auto-fill-mode}, but it stops completing after @samp{fill-}. -The result is @samp{auto-fill-}. Another @key{SPC} at this point -completes all the way to @samp{auto-fill-mode}. @key{SPC} in the -minibuffer runs the function @code{minibuffer-complete-word} when -completion is available.@refill + @key{SPC} completes much like @key{TAB}, but never goes beyond the +next hyphen or space. If you have @samp{auto-f} in the minibuffer and +type @key{SPC}, it finds that the completion is @samp{auto-fill-mode}, +but it stops completing after @samp{fill-}. This gives +@samp{auto-fill-}. Another @key{SPC} at this point completes all the +way to @samp{auto-fill-mode}. @key{SPC} in the minibuffer when +completion is available runs the command +@code{minibuffer-complete-word}. + + Here are some commands you can use to choose a completion from a +window that displays a list of completions: + +@table @kbd +@findex mouse-choose-completion +@item button2up +Clicking mouse button 2 on a completion in the list of possible +completions chooses that completion (@code{mouse-choose-completion}). +You normally use this command while point is in the minibuffer; but you +must click in the list of completions, not in the minibuffer itself. + +@findex choose-completion +@item @key{RET} +Typing @key{RET} @emph{in the completion list buffer} chooses the +completion that point is in or next to (@code{choose-completion}). To +use this command, you must first switch windows to the window that shows +the list of completions. + +@findex next-list-mode-item +@item @key{RIGHT} +@itemx @key{TAB} +@itemx C-f +Typing the right-arrow key @key{RIGHT}, @key{TAB} or @kbd{C-f} @emph{in +the completion list buffer} moves point to the following completion +(@code{next-list-mode-item}). + +@findex previous-list-mode-item +@item @key{LEFT} +@itemx C-b +Typing the left-arrow key @key{LEFT} or @kbd{C-b} @emph{in the +completion list buffer} moves point toward the beginning of the buffer, +to the previous completion (@code{previous-list-mode-item}). +@end table + +@node Strict Completion, Completion Options, Completion Commands, Completion +@subsection Strict Completion There are three different ways that @key{RET} can work in completing minibuffers, depending on how the argument will be used. @@ -276,7 +334,7 @@ already exist. @item -@dfn{Permissive} completion is used when any string is +@dfn{Permissive} completion is used when any string whatever is meaningful, and the list of completion alternatives is just a guide. For example, when @kbd{C-x C-f} reads the name of a file to visit, any file name is allowed, in case you want to create a file. In @@ -284,21 +342,26 @@ exactly as given, without completing it. @end itemize - The completion commands display a list of all possible completions in a -window whenever there is more than one possibility for the very next -character. Typing @kbd{?} explicitly requests such a list. The -list of completions counts as help text, so @kbd{C-M-v} typed in the -minibuffer scrolls the list. + The completion commands display a list of all possible completions in +a window whenever there is more than one possibility for the very next +character. Also, typing @kbd{?} explicitly requests such a list. If +the list of completions is long, you can scroll it with @kbd{C-M-v} +(@pxref{Other Window}). + +@node Completion Options, , Strict Completion, Completion +@subsection Completion Options @vindex completion-ignored-extensions When completion is done on file names, certain file names are usually -ignored. The variable @code{completion-ignored-extensions} contains a list -of strings; a file whose name ends in any of those strings is ignored as a -possible completion. The standard value of this variable has several -elements including @code{".o"}, @code{".elc"}, @code{".dvi"} and @code{"~"}. -The effect is that, for example, @samp{foo} completes to @samp{foo.c} -even though @samp{foo.o} exists as well. If the only possible completions -are files that end in ``ignored'' strings, they are not ignored.@refill +ignored. The variable @code{completion-ignored-extensions} contains a +list of strings; a file whose name ends in any of those strings is +ignored as a possible completion. The standard value of this variable +has several elements including @code{".o"}, @code{".elc"}, @code{".dvi"} +and @code{"~"}. The effect is that, for example, @samp{foo} can +complete to @samp{foo.c} even though @samp{foo.o} exists as well. +However, if @emph{all} the possible completions end in ``ignored'' +strings, then they are not ignored. Ignored extensions do not apply to +lists of completions---those always mention all possible completions. @vindex completion-auto-help If a completion command finds the next character is undetermined, it @@ -312,47 +375,135 @@ not valid completions, an extra @key{RET} must be typed to confirm the response. This is helpful for catching typos. -@node Repetition,, Completion, Minibuffer +@node Minibuffer History, Repetition, Completion, Minibuffer +@section Minibuffer History +@cindex minibuffer history +@cindex history of minibuffer input + + Every argument that you enter with the minibuffer is saved on a +@dfn{minibuffer history list} so that you can use it again later in +another argument. Special commands load the text of an earlier argument +in the minibuffer. They discard the old minibuffer contents, so you can +think of them as moving through the history of previous arguments. + +@table @kbd +@item @key{UP} +@itemx M-p +Move to the next earlier argument string saved in the minibuffer history +(@code{previous-history-element}). +@item @key{DOWN} +@itemx M-n +Move to the next later argument string saved in the minibuffer history +(@code{next-history-element}). +@item M-r @var{regexp} @key{RET} +Move to an earlier saved argument in the minibuffer history that has a +match for @var{regexp} (@code{previous-matching-history-element}). +@item M-s @var{regexp} @key{RET} +Move to a later saved argument in the minibuffer history that has a +match for @var{regexp} (@code{next-matching-history-element}). +@end table + +@kindex M-p @r{(minibuffer history)} +@kindex M-n @r{(minibuffer history)} +@findex next-history-element +@findex previous-history-element + The simplest way to reuse the saved arguments in the history list is +to move through the history list one element at a time. While in the +minibuffer, use @kbd{M-p} or up-arrow (@code{previous-history-element}) +to ``move to'' the next earlier minibuffer input, and use @kbd{M-n} or +down-arrow (@code{next-history-element}) to ``move to'' the next later +input. + + The previous input that you fetch from the history entirely replaces +the contents of the minibuffer. To use it as the argument, exit the +minibuffer as usual with @key{RET}. You can also edit the text before +you reuse it; this does not change the history element that you +``moved'' to, but your new argument does go at the end of the history +list in its own right. + + For many minibuffer arguments there is a ``default'' value. In some +cases, the minibuffer history commands know the default value. Then you +can insert the default value into the minibuffer as text by using +@kbd{M-n} to move ``into the future'' in the history. + +@findex previous-matching-history-element +@findex next-matching-history-element +@kindex M-r @r{(minibuffer history)} +@kindex M-s @r{(minibuffer history)} + There are also commands to search forward or backward through the +history; they search for history elements that match a regular +expression that you specify with the minibuffer. @kbd{M-r} +(@code{previous-matching-history-element}) searches older elements in +the history, while @kbd{M-s} (@code{next-matching-history-element}) +searches newer elements. By special dispensation, these commands can +use the minibuffer to read their arguments even though you are already +in the minibuffer when you issue them. As with incremental searching, +an uppercase letter in the regular expression makes the search +case-sensitive (@pxref{Search Case}). + + All uses of the minibuffer record your input on a history list, but +there are separate history lists for different kinds of arguments. For +example, there is a list for file names, used by all the commands that +read file names. + + There are several other very specific history lists, including one for +command names read by @kbd{M-x}, one for buffer names, one for arguments +of commands like @code{query-replace}, and one for compilation commands +read by @code{compile}. Finally, there is one ``miscellaneous'' history +list that most minibuffer arguments use. + +@c Do wee need this? +@ignore +@vindex history-length + The variable @code{history-length} specifies the maximum length of a +minibuffer history list; once a list gets that long, the oldest element +is deleted each time an element is added. If the value of +@code{history-length} is @code{t}, though, there is no maximum length +and elements are never deleted. +@end ignore + +@node Repetition, , Minibuffer History, Minibuffer @section Repeating Minibuffer Commands @cindex command history @cindex history of commands Every command that uses the minibuffer at least once is recorded on a -special history list, together with the values of the minibuffer arguments, -so that you can repeat the command easily. In particular, every -use of @kbd{Meta-x} is recorded, since @kbd{M-x} uses the minibuffer to -read the command name. +special history list, together with the values of its arguments, so that +you can repeat the entire command. In particular, every use of +@kbd{M-x} is recorded there, since @kbd{M-x} uses the minibuffer to read +the command name. @findex list-command-history @c widecommands @table @kbd -@item C-x @key{ESC} -Re-execute a recent minibuffer command @*(@code{repeat-complex-command}). +@item C-x @key{ESC} @key{ESC} +Re-execute a recent minibuffer command (@code{repeat-complex-command}). @item M-p Within @kbd{C-x @key{ESC}}, move to previous recorded command (@code{previous-history-element}). @item M-n Within @kbd{C-x @key{ESC}}, move to the next (more recent) recorded -command (@code{next-history-element}).@refill +command (@code{next-history-element}). @item M-x list-command-history Display the entire command history, showing all the commands -@kbd{C-x @key{ESC}} can repeat, most recent first.@refill +@kbd{C-x @key{ESC} @key{ESC}} can repeat, most recent first. @end table -@kindex C-x ESC +@kindex C-x ESC ESC @findex repeat-complex-command - @kbd{C-x @key{ESC}} is used to re-execute a recent command that used -the minibuffer. With no argument, it repeats the last command. A numeric -argument specifies which command to repeat; 1 means the last one, and -larger numbers specify earlier commands. + @kbd{C-x @key{ESC} @key{ESC}} is used to re-execute a recent +minibuffer-using command. With no argument, it repeats the last such +command. A numeric argument specifies which command to repeat; one +means the last one, and larger numbers specify earlier ones. - @kbd{C-x @key{ESC}} works by turning the previous command into a Lisp -expression and then entering a minibuffer initialized with the text for -that expression. If you type just @key{RET}, the command is repeated as -before. You can also change the command by editing the Lisp expression. -The expression you finally submit will be executed. The repeated -command is added to the front of the command history unless it is -identical to the most recently executed command already there. + @kbd{C-x @key{ESC} @key{ESC}} works by turning the previous command +into a Lisp expression and then entering a minibuffer initialized with +the text for that expression. If you type just @key{RET}, the command +is repeated as before. You can also change the command by editing the +Lisp expression. Whatever expression you finally submit is what will be +executed. The repeated command is added to the front of the command +history unless it is identical to the most recently executed command +already there. Even if you don't understand Lisp syntax, it will probably be obvious which command is displayed for repetition. If you do not change the text, @@ -362,17 +513,17 @@ @kindex M-p @findex next-complex-command @findex previous-complex-command - If you are in the minibuffer for @kbd{C-x @key{ESC}} and the command shown -to you is not the one you want to repeat, you can move around the list of -previous commands using @kbd{M-n} and @kbd{M-p}. @kbd{M-p} replaces the -contents of the minibuffer with the next earlier recorded command, and -@kbd{M-n} replaces it with the next later command. After finding the -desired previous command, you can edit its expression and then -resubmit it by typing @key{RET}. Any editing you have done on the -command to be repeated is lost if you use @kbd{M-n} or @kbd{M-p}. + If you are in the minibuffer for @kbd{C-x @key{ESC} @key{ESC}} and the +command shown to you is not the one you want to repeat, you can move +around the list of previous commands using @kbd{M-n} and @kbd{M-p}. +@kbd{M-p} replaces the contents of the minibuffer with the next earlier +recorded command, and @kbd{M-n} replaces it with the next later command. +After finding the desired previous command, you can edit its expression +and then resubmit it by typing @key{RET}. Any editing you have done on +the command to be repeated is lost if you use @kbd{M-n} or @kbd{M-p}. -@kbd{M-n} and @kbd{M-p} are specially defined within @kbd{C-x @key{ESC}} -to run the commands @code{previous-history-element} and +@kbd{M-n} and @kbd{M-p} are specially defined within @kbd{C-x @key{ESC} +@key{ESC}} to run the commands @code{previous-history-element} and @code{next-history-element}. @vindex command-history diff -r f4aeb21a5bad -r 74fd4e045ea6 man/xemacs/new.texi --- a/man/xemacs/new.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/xemacs/new.texi Mon Aug 13 11:13:30 2007 +0200 @@ -240,8 +240,8 @@ )) (cond ((and (string-match "XEmacs" emacs-version) - (or (> emacs-major-version 19) - (>= emacs-minor-version 12))) + (or (> emacs-major-version 19) + (>= emacs-minor-version 12))) ;; ;; Code which requires XEmacs version 19.12 or newer goes here ;; @@ -254,7 +254,7 @@ )) (cond ((and (not (string-match "Lucid" emacs-version)) - (= emacs-major-version 19)) + (= emacs-major-version 19)) ;; ;; Code specific to FSF Emacs 19 (not XEmacs) goes here ;; @@ -321,20 +321,20 @@ XEmacs has the following new default function keybindings: @table @kbd -@item @key{HELP} +@item @key{HELP} Same as @kbd{C-h}. -@item @key{UNDO} +@item @key{UNDO} Same as @kbd{M-x undo}. -@item @key{CUT} +@item @key{CUT} Same as the Cut menu item; that is, it copies the selected text to the X Clipboard selection. -@item @key{COPY} +@item @key{COPY} Same as the Copy menu item. -@item @key{PASTE} +@item @key{PASTE} Same as the Paste menu item. @item @key{PGUP} @@ -352,7 +352,7 @@ @item @key{LEFT-ARROW} Same as the function @code{backward-char}. -@item @key{RIGHT-ARROW} +@item @key{RIGHT-ARROW} Same as the function @code{forward-char}. @item @key{UP-ARROW} diff -r f4aeb21a5bad -r 74fd4e045ea6 man/xemacs/packages.texi --- a/man/xemacs/packages.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/xemacs/packages.texi Mon Aug 13 11:13:30 2007 +0200 @@ -6,8 +6,8 @@ The XEmacs 21 distribution comes only with a very basic set of built-in modes and packages. Most of the packages that were part of -the distribution of earlier versions of XEmacs are now separately -available. The installer as well as the user can choose which +the distribution of earlier versions of XEmacs are now available +separately. The installer as well as the user can choose which packages to install; the actual installation process is easy. This gives an installer the ability to tailor an XEmacs installation for local needs with safe removal of unnecessary code. @@ -91,7 +91,7 @@ also listed on the @code{Options} menu under: @example - Options->Customize->Emacs->Packages + Options->Customize->Emacs->Packages @end example However, don't select any of these menu picks unless you actually want @@ -103,7 +103,7 @@ access it via the menus: @example - Options->Manage Packages->List & Install + Options->Manage Packages->List & Install @end example Or, you can get to it via the keyboard: @@ -116,6 +116,17 @@ idea to install all packages and not interfere with the wishes of your users. +If you can't find which package provides the feature you require, try +using the @code{package-get-package-provider} function. Eg., if you know +that you need @code{thingatpt}, type: + +@example +M-x package-get-package-provider RET thingatpt +@end example + +which will return something like (fsf-compat "1.06"). You can the use +one of the methods above for installing the package you want. + @subsection XEmacs and Installing Packages Normally, packages are installed over the network, using EFS @@ -138,7 +149,7 @@ add these directory names to @code{package-get-remote} using: @example - M-x pui-add-install-directory + M-x pui-add-install-directory @end example Note, however, that any directories added using this function are not @@ -154,11 +165,11 @@ browser and installer, using the menu pick: @example - Options->Manage Packages->List & Install + Options->Manage Packages->List & Install @end example or @example - Options->Manage Packages->Using Custom->Select-> ... + Options->Manage Packages->Using Custom->Select-> ... @end example You can also access it using the keyboard: @@ -225,17 +236,17 @@ customize menus, under: @example - Options->Customize->Emacs->Packages-> ... + Options->Customize->Emacs->Packages-> ... @end example or @example - Options->Manage Packages->Using Custom->Select-> ... + Options->Manage Packages->Using Custom->Select-> ... @end example Set their state to on, and then do: @example - Options->Manage Packages->Using Custom->Update Packages + Options->Manage Packages->Using Custom->Update Packages @end example This will automatically retrieve the packages you have selected from the @@ -258,13 +269,18 @@ @subsection Manual Binary Package Installation Pre-compiled, binary packages can be installed in either a system -package directory (this is determined when XEmacs is compiled), or in a -subdirectory of your @file{$HOME} directory: +package directory (this is determined when XEmacs is compiled), or in +one of the following +subdirectories of your @file{$HOME} directory: @example -~/.xemacs/packages +~/.xemacs/mule-packages +~/.xemacs/xemacs-packages @end example +Packages in the former directory will only be found by a Mule-enabled +XEmacs. + XEmacs does not have to be running to install binary packages, although XEmacs will not know about any newly-installed packages until you restart XEmacs. Note, however, that installing a newer version of a @@ -279,11 +295,13 @@ will typically be a gzip'd tarball. @item -Decide where to install the packages: in the system package directory, -or in @file{~/.xemacs/packages}. If you want to install the -packages in the system package directory, make sure you can write into -that directory. If you want to install in your @file{$HOME} directory, -create the directory, @file{~/.xemacs/packages}. +Decide where to install the packages: in the system package +directory, or in @file{~/.xemacs/mule-packages} or +@file{~/.xemacs/xemacs-packages}, respectively. If you want to install +the packages in the system package directory, make sure you can write +into that directory. If you want to install in your @file{$HOME} +directory, create the directory, @file{~/.xemacs/mule-packages} or +@file{~/.xemacs/xemacs-packages}, respectively. @item Next, @code{cd} to the directory under which you want to install the @@ -295,7 +313,7 @@ typically do this using the commands: @example - gunzip < package.tar.gz | tar xvf - + gunzip < package.tar.gz | tar xvf - @end example Above, replace @file{package.tar.gz} with the filename of the @@ -304,7 +322,7 @@ Of course, if you use GNU @code{tar}, you could also use: @example - tar xvzf package.tar.gz + tar xvzf package.tar.gz @end example @comment What about native MS Windows users??? diff -r f4aeb21a5bad -r 74fd4e045ea6 man/xemacs/programs.texi --- a/man/xemacs/programs.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/xemacs/programs.texi Mon Aug 13 11:13:30 2007 +0200 @@ -508,7 +508,7 @@ until the end of the list. @end table -@node C Indent,, Lisp Indent, Grinding +@node C Indent, , Lisp Indent, Grinding @subsection Customizing C Indentation Two variables control which commands perform C indentation and when. @@ -884,7 +884,7 @@ @findex insert-parentheses @findex move-over-close-and-reindent The commands @kbd{M-(} (@code{insert-parentheses}) and @kbd{M-)} -(@code{move-over-close-@*and-reindent}) are designed to facilitate a style of +(@code{move-over-close-and-reindent}) are designed to facilitate a style of editing which keeps parentheses balanced at all times. @kbd{M-(} inserts a pair of parentheses, either together as in @samp{()}, or, if given an argument, around the next several sexps, and leaves point after the open @@ -1012,7 +1012,7 @@ names and positions of the functions (or other named subunits) in each file. Grouping the related files makes it possible to search or replace through all the files with one command. Recording the function names -and positions makes possible the @kbd{M-.} command which finds the +and positions makes possible the @kbd{M-.} command which finds the definition of a function by looking up which of the files it is in. Tags tables are stored in files called @dfn{tags table files}. The @@ -1029,15 +1029,16 @@ recorded is called a @dfn{tag}. @menu -* Tag Syntax:: Tag syntax for various types of code and text files. +* Tag Syntax:: Tag syntax for various types of code and text files. * Create Tags Table:: Creating a tags table with @code{etags}. +* Etags Regexps:: Create arbitrary tags using regular expressions. * Select Tags Table:: How to visit a tags table. -* Find Tag:: Commands to find the definition of a specific tag. +* Find Tag:: Commands to find the definition of a specific tag. * Tags Search:: Using a tags table for searching and replacing. * List Tags:: Listing and finding tags defined in a file. @end menu -@node Tag Syntax +@node Tag Syntax, Create Tags Table, Tags, Tags @subsection Source File Tag Syntax Here is how tag syntax is defined for the most popular languages: @@ -1045,25 +1046,28 @@ @itemize @bullet @item In C code, any C function or typedef is a tag, and so are definitions of -@code{struct}, @code{union} and @code{enum}. @code{#define} macro -definitions and @code{enum} constants are also tags, unless you specify -@samp{--no-defines} when making the tags table. Similarly, global -variables are tags, unless you specify @samp{--no-globals}. Use of -@samp{--no-globals} and @samp{--no-defines} can make the tags table file -much smaller. +@code{struct}, @code{union} and @code{enum}. You can tag function +declarations and external variables in addition to function definitions +by giving the @samp{--declarations} option to @code{etags}. +@code{#define} macro definitions and @code{enum} constants are also +tags, unless you specify @samp{--no-defines} when making the tags table. +Similarly, global variables are tags, unless you specify +@samp{--no-globals}. Use of @samp{--no-globals} and @samp{--no-defines} +can make the tags table file much smaller. @item In C++ code, in addition to all the tag constructs of C code, member functions are also recognized, and optionally member variables if you use the @samp{--members} option. Tags for variables and functions in classes are named @samp{@var{class}::@var{variable}} and -@samp{@var{class}::@var{function}}. +@samp{@var{class}::@var{function}}. @code{operator} functions tags are +named, for example @samp{operator+}. @item In Java code, tags include all the constructs recognized in C++, plus -the @code{extends} and @code{implements} constructs. Tags for variables -and functions in classes are named @samp{@var{class}.@var{variable}} and -@samp{@var{class}.@var{function}}. +the @code{interface}, @code{extends} and @code{implements} constructs. +Tags for variables and functions in classes are named +@samp{@var{class}.@var{variable}} and @samp{@var{class}.@var{function}}. @item In La@TeX{} text, the argument of any of the commands @code{\chapter}, @@ -1075,7 +1079,7 @@ Other commands can make tags as well, if you specify them in the environment variable @code{TEXTAGS} before invoking @code{etags}. The value of this environment variable should be a colon-separated list of -commands names. For example, +command names. For example, @example TEXTAGS="def:newcommand:newenvironment" @@ -1101,6 +1105,12 @@ Several other languages are also supported: @itemize @bullet + +@item +In Ada code, functions, procedures, packages, tasks, and types are +tags. Use the @samp{--packages-only} option to create tags for packages +only. + @item In assembler code, labels appearing at the beginning of a line, followed by a colon, are tags. @@ -1111,39 +1121,44 @@ as C code. @item -In Cobol code, paragraphs names are the tags, i.e. any word starting in -column 8 and followed by a full stop. +In Cobol code, tags are paragraph names; that is, any word starting in +column 8 and followed by a period. @item In Erlang code, the tags are the functions, records, and macros defined in the file. @item -In Fortran code, functions and subroutines are tags. +In Fortran code, functions, subroutines and blockdata are tags. @item In Objective C code, tags include Objective C definitions for classes, -class categories, methods and protocols. +class categories, methods, and protocols. @item In Pascal code, the tags are the functions and procedures defined in the file. @item -In Perl code, the tags are the procedures defined by the @code{sub} -keyword. +In Perl code, the tags are the procedures defined by the @code{sub}, +@code{my} and @code{local} keywords. Use @samp{--globals} if you want +to tag global variables. @item In Postscript code, the tags are the functions. @item In Prolog code, a tag name appears at the left margin. + +@item +In Python code, @code{def} or @code{class} at the beginning of a line +generate a tag. @end itemize - You can also generate tags based on regexp matching (@pxref{Create -Tags Table}) to handle other formats and languages. + You can also generate tags based on regexp matching +(@pxref{Etags Regexps}) to handle other formats and languages. -@node Create Tags Table +@node Create Tags Table, Etags Regexps, Tag Syntax, Tags @subsection Creating Tags Tables @cindex @code{etags} program @@ -1162,10 +1177,18 @@ @end example @noindent -The @code{etags} program reads the specified files, and writes a tags table -named @file{TAGS} in the current working directory. @code{etags} -recognizes the language used in an input file based on its file name and -contents. You can specify the language with the +The @code{etags} program reads the specified files, and writes a tags +table named @file{TAGS} in the current working directory. You can +intermix compressed and plain text source file names. @code{etags} +knows about the most common compression formats, and does the right +thing. So you can compress all your source files and have @code{etags} +look for compressed versions of its file name arguments, if it does not +find uncompressed versions. Under MS-DOS, @code{etags} also looks for +file names like @samp{mycode.cgz} if it is given @samp{mycode.c} on the +command line and @samp{mycode.c} does not exist. + + @code{etags} recognizes the language used in an input file based on +its file name and contents. You can specify the language with the @samp{--language=@var{name}} option, described below. If the tags table data become outdated due to changes in the files @@ -1202,7 +1225,7 @@ the tags file will contain absolute file names. This way, the tags file will still refer to the same files even if you move it, as long as the source files remain in the same place. Absolute file names start with -@samp{/}, or with @samp{@var{device}:/} on MS-DOS and Windows. +@samp{/}, or with @samp{@var{device}:/} on MS-DOS and MS-Windows. When you want to make a tags table from a great number of files, you may have problems listing them on the command line, because some systems @@ -1210,9 +1233,9 @@ is to tell @code{etags} to read the file names from its standard input, by typing a dash in place of the file names, like this: -@example +@smallexample find . -name "*.[chCH]" -print | etags - -@end example +@end smallexample Use the option @samp{--language=@var{name}} to specify the language explicitly. You can intermix these options with file names; each one @@ -1220,18 +1243,25 @@ @samp{--language=auto} to tell @code{etags} to resume guessing the language from the file names and file contents. Specify @samp{--language=none} to turn off language-specific processing -entirely; then @code{etags} recognizes tags by regexp matching alone. -@samp{etags --help} prints the list of the languages @code{etags} knows, -and the file name rules for guessing the language. +entirely; then @code{etags} recognizes tags by regexp matching alone +(@pxref{Etags Regexps}). + + @samp{etags --help} prints the list of the languages @code{etags} +knows, and the file name rules for guessing the language. It also prints +a list of all the available @code{etags} options, together with a short +explanation. + +@node Etags Regexps, Select Tags Table, Create Tags Table, Tags +@subsection Etags Regexps The @samp{--regex} option provides a general way of recognizing tags based on regexp matching. You can freely intermix it with file names. Each @samp{--regex} option adds to the preceding ones, and applies only to the following files. The syntax is: -@example +@smallexample --regex=/@var{tagregexp}[/@var{nameregexp}]/ -@end example +@end smallexample @noindent where @var{tagregexp} is used to match the lines to tag. It is always @@ -1251,18 +1281,25 @@ You should not match more characters with @var{tagregexp} than that needed to recognize what you want to tag. If the match is such that -more characters than needed are unavoidably matched by @var{tagregexp}, -you may find useful to add a @var{nameregexp}, in order to narrow the tag -scope. You can find some examples below. +more characters than needed are unavoidably matched by @var{tagregexp} +(as will usually be the case), you should add a @var{nameregexp}, to +pick out just the tag. This will enable Emacs to find tags more +accurately and to do completion on tag names more reliably. You can +find some examples below. + + The option @samp{--ignore-case-regex} (or @samp{-c}) is like +@samp{--regex}, except that the regular expression provided will be +matched without regard to case, which is appropriate for various +programming languages. The @samp{-R} option deletes all the regexps defined with @samp{--regex} options. It applies to the file names following it, as you can see from the following example: -@example +@smallexample etags --regex=/@var{reg1}/ voo.doo --regex=/@var{reg2}/ \ bar.ber -R --lang=lisp los.er -@end example +@end smallexample @noindent Here @code{etags} chooses the parsing language for @file{voo.doo} and @@ -1272,38 +1309,90 @@ @file{bar.ber}. @code{etags} uses the Lisp tags rules, and no regexp matching, to recognize tags in @file{los.er}. + A regular expression can be bound to a given language, by prepending +it with @samp{@{lang@}}. When you do this, @code{etags} will use the +regular expression only for files of that language. @samp{etags --help} +prints the list of languages recognised by @code{etags}. The following +example tags the @code{DEFVAR} macros in the Emacs source files. +@code{etags} applies this regular expression to C files only: + +@smallexample +--regex='@{c@}/[ \t]*DEFVAR_[A-Z_ \t(]+"\([^"]+\)"/' +@end smallexample + +@noindent +This feature is particularly useful when storing a list of regular +expressions in a file. The following option syntax instructs +@code{etags} to read two files of regular expressions. The regular +expressions contained in the second file are matched without regard to +case. + +@smallexample +--regex=@@first-file --ignore-case-regex=@@second-file +@end smallexample + +@noindent +A regex file contains one regular expressions per line. Empty lines, +and lines beginning with space or tab are ignored. When the first +character in a line is @samp{@@}, @code{etags} assumes that the rest of +the line is the name of a file of regular expressions. This means that +such files can be nested. All the other lines are taken to be regular +expressions. For example, one can create a file called +@samp{emacs.tags} with the following contents (the first line in the +file is a comment): + +@smallexample + -- This is for GNU Emacs source files +@{c@}/[ \t]*DEFVAR_[A-Z_ \t(]+"\([^"]+\)"/\1/ +@end smallexample + +@noindent +and then use it like this: + +@smallexample +etags --regex=@@emacs.tags *.[ch] */*.[ch] +@end smallexample + Here are some more examples. The regexps are quoted to protect them from shell interpretation. -@noindent -Tag the @code{DEFVAR} macros in the emacs source files: +@itemize @bullet + +@item +Tag Octave files: -@example ---regex='/[ \t]*DEFVAR_[A-Z_ \t(]+"\([^"]+\)"/' -@end example +@smallexample +etags --language=none \ + --regex='/[ \t]*function.*=[ \t]*\([^ \t]*\)[ \t]*(/\1/' \ + --regex='/###key \(.*\)/\1/' \ + --regex='/[ \t]*global[ \t].*/' \ + *.m +@end smallexample @noindent -Tag VHDL files (this example is a single long line, broken here for -formatting reasons): +Note that tags are not generated for scripts so that you have to add a +line by yourself of the form `###key <script-name>' if you want to jump +to it. + +@item +Tag Tcl files: -@example ---language=none ---regex='/[ \t]*\(ARCHITECTURE\|CONFIGURATION\) +[^ ]* +OF/' +@smallexample +etags --language=none --regex='/proc[ \t]+\([^ \t]+\)/\1/' *.tcl +@end smallexample + +@item +Tag VHDL files: + +@smallexample +--language=none \ +--regex='/[ \t]*\(ARCHITECTURE\|CONFIGURATION\) +[^ ]* +OF/' \ --regex='/[ \t]*\(ATTRIBUTE\|ENTITY\|FUNCTION\|PACKAGE\ \( BODY\)?\|PROCEDURE\|PROCESS\|TYPE\)[ \t]+\([^ \t(]+\)/\3/' -@end example - -@noindent -Tag TCL files (this last example shows the usage of a @var{nameregexp}): +@end smallexample +@end itemize -@example ---lang=none --regex='/proc[ \t]+\([^ \t]+\)/\1/' -@end example - - For a list of the other available @code{etags} options, execute -@code{etags --help}. - -@node Select Tags Table, Find Tag, Create Tags Table, Tags +@node Select Tags Table, Find Tag, Etags Regexps, Tags @subsection Selecting a Tags Table @vindex tag-table-alist @@ -1335,11 +1424,11 @@ @example (setq tag-table-alist - '(("/usr/src/public/perl/" . "/usr/src/public/perl/perl-3.0/") - ("\\.el$" . "/usr/local/emacs/src/") - ("/jbw/gnu/" . "/usr15/degree/stud/jbw/gnu/") - ("" . "/usr/local/emacs/src/") - )) + '(("/usr/src/public/perl/" . "/usr/src/public/perl/perl-3.0/") + ("\\.el$" . "/usr/local/emacs/src/") + ("/jbw/gnu/" . "/usr15/degree/stud/jbw/gnu/") + ("" . "/usr/local/emacs/src/") + )) @end example The example defines the tags table alist in the following way: @@ -1451,15 +1540,15 @@ @table @kbd @item tag-table-alist Controls which tables apply to which buffers. -@item tags-file-name +@item tags-file-name Stores a default tags table. -@item tags-build-completion-table +@item tags-build-completion-table Controls completion behavior. -@item buffer-tag-table +@item buffer-tag-table Specifies a buffer-local table. -@item make-tags-files-invisible +@item make-tags-files-invisible Sets whether tags tables should be very hidden. -@item tag-mark-stack-max +@item tag-mark-stack-max Specifies how many tags-based hops to remember. @end table @@ -1555,7 +1644,7 @@ Visit the next file in the selected tags table. @end table -@node List Tags,, Tags Search, Tags +@node List Tags, , Tags Search, Tags @subsection Tags Table Inquiries @table @kbd @@ -1740,7 +1829,7 @@ retain its meaning when reindented even if the conventions are not followed. -@node ForIndent Vars,, ForIndent Conv, Fortran Indent +@node ForIndent Vars, , ForIndent Conv, Fortran Indent @subsubsection Variables for Fortran Indentation @vindex fortran-do-indent @@ -1897,7 +1986,7 @@ columns wide. When you edit in this window, you can immediately see when a line gets too wide to be correct Fortran. -@node Fortran Abbrev,, Fortran Columns, Fortran +@node Fortran Abbrev, , Fortran Columns, Fortran @subsection Fortran Keyword Abbrevs Fortran mode provides many built-in abbrevs for common keywords and @@ -1917,7 +2006,7 @@ Type @samp{;?} or @samp{;C-h} to display a list of all built-in Fortran abbrevs and what they stand for. -@node Asm Mode,, Fortran, Programs +@node Asm Mode, , Fortran, Programs @section Asm Mode @cindex Asm mode diff -r f4aeb21a5bad -r 74fd4e045ea6 man/xemacs/regs.texi --- a/man/xemacs/regs.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/xemacs/regs.texi Mon Aug 13 11:13:30 2007 +0200 @@ -3,22 +3,20 @@ @chapter Registers @cindex registers - Emacs @dfn{registers} are places in which you can save text or -positions for later use. Text saved in a register can be copied into -the buffer once or many times; a position saved in a register is used by -moving point to that position. Rectangles can also be copied into and -out of registers (@pxref{Rectangles}). + XEmacs @dfn{registers} are places in which you can save text or +positions for later use. Once you save text or a rectangle in a +register, you can copy it into the buffer once or many times; a position +saved in a register is used by moving point to that position. +Rectangles can also be copied into and out of registers +(@pxref{Rectangles}). - Each register has a name, which is a single character. A register can -store either a piece of text, a position, or a rectangle, but only one -thing at any given time. Whatever you store in a register remains -there until you store something else in that register. - -@menu -* RegPos:: Saving positions in registers. -* RegText:: Saving text in registers. -* RegRect:: Saving rectangles in registers. -@end menu +@findex view-register + Each register has a name which is a single character. A register can +store a piece of text, a rectangle, a position, a window configuration, +or a file name, but only one thing at any given time. Whatever you +store in a register remains there until you store something else in that +register. To see what a register @var{r} contains, use @kbd{M-x +view-register}. @table @kbd @item M-x view-register @key{RET} @var{r} @@ -29,34 +27,49 @@ @kbd{M-x view-register} reads a register name as an argument and then displays the contents of the specified register. +@menu +* Position: RegPos. Saving positions in registers. +* Text: RegText. Saving text in registers. +* Rectangle: RegRect. Saving rectangles in registers. +* Configurations: RegConfig. Saving window configurations in registers. +* Files: RegFiles. File names in registers. +* Numbers: RegNumbers. Numbers in registers. +* Bookmarks:: Bookmarks are like registers, but persistent. +@end menu + @node RegPos, RegText, Registers, Registers @section Saving Positions in Registers - Saving a position records a spot in a buffer so you can move -back there later. Moving to a saved position re-selects the buffer -and moves point to the spot. + Saving a position records a place in a buffer so that you can move +back there later. Moving to a saved position switches to that buffer +and moves point to that place in it. @table @kbd -@item C-x r SPC @var{r} -Save the location of point in register @var{r} (@code{point-to-register}). +@item C-x r @key{SPC} @var{r} +Save position of point in register @var{r} (@code{point-to-register}). @item C-x r j @var{r} -Jump to the location saved in register @var{r} (@code{register-to-point}). +Jump to the position saved in register @var{r} (@code{jump-to-register}). @end table @kindex C-x r SPC @findex point-to-register - To save the current location of point in a register, choose a name -@var{r} and type @kbd{C-x r SPC @var{r}}. The register @var{r} retains -the location thus saved until you store something else in that -register.@refill + To save the current position of point in a register, choose a name +@var{r} and type @kbd{C-x r @key{SPC} @var{r}}. The register @var{r} +retains the position thus saved until you store something else in that +register. @kindex C-x r j -@findex register-to-point - The command @kbd{C-x r j @var{r}} moves point to the location recorded +@findex jump-to-register + The command @kbd{C-x r j @var{r}} moves point to the position recorded in register @var{r}. The register is not affected; it continues to record the same location. You can jump to the same position using the same register as often as you want. + If you use @kbd{C-x r j} to go to a saved position, but the buffer it +was saved from has been killed, @kbd{C-x r j} tries to create the buffer +again by visiting the same file. Of course, this works only for buffers +that were visiting files. + @node RegText, RegRect, RegPos, Registers @section Saving Text in Registers @@ -65,46 +78,234 @@ the piece of text further down on the ring. It becomes hard to keep track of the argument needed to retrieve the same text with @kbd{C-y}. An alternative is to store the text in a register with @kbd{C-x r s} -(@code{copy-to-register}) and then retrieve it with @kbd{C-x r g} +(@code{copy-to-register}) and then retrieve it with @kbd{C-x r i} (@code{insert-register}). @table @kbd @item C-x r s @var{r} Copy region into register @var{r} (@code{copy-to-register}). @item C-x r g @var{r} +@itemx C-x r i @var{r} Insert text contents of register @var{r} (@code{insert-register}). @end table @kindex C-x r s @kindex C-x r g +@kindex C-x r i @findex copy-to-register @findex insert-register @kbd{C-x r s @var{r}} stores a copy of the text of the region into the -register named @var{r}. Given a numeric argument, @kbd{C-x r s} deletes the -text from the buffer as well. +register named @var{r}. Given a numeric argument, @kbd{C-x r s @var{r}} +deletes the text from the buffer as well. - @kbd{C-x r g @var{r}} inserts the text from register @var{r} in the buffer. -By default it leaves point before the text and places the mark after it. -With a numeric argument, it puts point after the text and the mark -before it. + @kbd{C-x r i @var{r}} inserts the text from register @var{r} in the buffer. +By default it leaves point before the text and places the mark after +it. With a numeric argument (@kbd{C-u}), it puts point after the text +and the mark before it. -@node RegRect,, RegText, Registers +@node RegRect, RegConfig, RegText, Registers @section Saving Rectangles in Registers @cindex rectangle -@findex copy-region-to-rectangle A register can contain a rectangle instead of lines of text. The rectangle is represented as a list of strings. @xref{Rectangles}, for basic information on rectangles and how to specify rectangles in a buffer. @table @kbd +@findex copy-rectangle-to-register +@kindex C-x r r @item C-x r r @var{r} -Copy the region-rectangle into register @var{r}(@code{copy-rectangle-to-register}). -With a numeric argument, delete it as well. +Copy the region-rectangle into register @var{r} +(@code{copy-rectangle-to-register}). With a numeric argument, delete it +as well. @item C-x r g @var{r} +@itemx C-x r i @var{r} Insert the rectangle stored in register @var{r} (if it contains a rectangle) (@code{insert-register}). @end table - The @kbd{C-x r g} command inserts linear text if the register contains + The @kbd{C-x r i @var{r}} command inserts linear text if the register + contains that, or inserts a rectangle if the register contains one. + + See also the command @code{sort-columns}, which you can think of +as sorting a rectangle. @xref{Sorting}. + +@node RegConfig, RegNumbers, RegRect, Registers +@section Saving Window Configurations in Registers + +@findex window-configuration-to-register +@findex frame-configuration-to-register +@kindex C-x r w +@c @kindex C-x r f + You can save the window configuration of the selected frame in a +register, or even the configuration of all windows in all frames, and +restore the configuration later. + +@table @kbd +@item C-x r w @var{r} +Save the state of the selected frame's windows in register @var{r} +(@code{window-configuration-to-register}). +@c @item C-x r f @var{r} +@item M-x frame-configuration-to-register @key{RET} @var{r} +Save the state of all frames, including all their windows, in register +@var{r} (@code{frame-configuration-to-register}). +@end table + + Use @kbd{C-x r j @var{r}} to restore a window or frame configuration. +This is the same command used to restore a cursor position. When you +restore a frame configuration, any existing frames not included in the +configuration become invisible. If you wish to delete these frames +instead, use @kbd{C-u C-x r j @var{r}}. + +@node RegNumbers, RegFiles, RegConfig, Registers +@section Keeping Numbers in Registers + + There are commands to store a number in a register, to insert +the number in the buffer in decimal, and to increment it. These commands +can be useful in keyboard macros (@pxref{Keyboard Macros}). + +@table @kbd +@item C-u @var{number} C-x r n @var{reg} +@kindex C-x r n +@findex number-to-register +Store @var{number} into register @var{reg} (@code{number-to-register}). +@item C-u @var{number} C-x r + @var{reg} +@kindex C-x r + +@findex increment-register +Increment the number in register @var{reg} by @var{number} +(@code{increment-register}). +@item C-x r g @var{reg} +Insert the number from register @var{reg} into the buffer. +@end table + + @kbd{C-x r g} is the same command used to insert any other +sort of register contents into the buffer. + +@node RegFiles, Bookmarks, RegNumbers, Registers +@section Keeping File Names in Registers + + If you visit certain file names frequently, you can visit them more +conveniently if you put their names in registers. Here's the Lisp code +used to put a file name in a register: + +@smallexample +(set-register ?@var{r} '(file . @var{name})) +@end smallexample + +@need 3000 +@noindent +For example, + +@smallexample +(set-register ?z '(file . "/usr/src/xemacs/src/ChangeLog")) +@end smallexample + +@noindent +puts the file name shown in register @samp{z}. + + To visit the file whose name is in register @var{r}, type @kbd{C-x r j +@var{r}}. (This is the same command used to jump to a position or +restore a frame configuration.) + +@node Bookmarks, , RegFiles, Registers +@section Bookmarks +@cindex bookmarks + + @dfn{Bookmarks} are somewhat like registers in that they record +positions you can jump to. Unlike registers, they have long names, and +they persist automatically from one Emacs session to the next. The +prototypical use of bookmarks is to record ``where you were reading'' in +various files. + + Note: bookmark.el is distributed in edit-utils package. You need to +install that to use bookmark facility (@pxref{Packages}). + +@table @kbd +@item C-x r m @key{RET} +Set the bookmark for the visited file, at point. + +@item C-x r m @var{bookmark} @key{RET} +@findex bookmark-set +Set the bookmark named @var{bookmark} at point (@code{bookmark-set}). + +@item C-x r b @var{bookmark} @key{RET} +@findex bookmark-jump +Jump to the bookmark named @var{bookmark} (@code{bookmark-jump}). + +@item C-x r l +@findex list-bookmarks +List all bookmarks (@code{list-bookmarks}). + +@item M-x bookmark-save +@findex bookmark-save +Save all the current bookmark values in the default bookmark file. +@end table + +@kindex C-x r m +@findex bookmark-set +@kindex C-x r b +@findex bookmark-jump + The prototypical use for bookmarks is to record one current position +in each of several files. So the command @kbd{C-x r m}, which sets a +bookmark, uses the visited file name as the default for the bookmark +name. If you name each bookmark after the file it points to, then you +can conveniently revisit any of those files with @kbd{C-x r b}, and move +to the position of the bookmark at the same time. + +@kindex C-x r l + To display a list of all your bookmarks in a separate buffer, type +@kbd{C-x r l} (@code{list-bookmarks}). If you switch to that buffer, +you can use it to edit your bookmark definitions or annotate the +bookmarks. Type @kbd{C-h m} in that buffer for more information about +its special editing commands. + + When you kill XEmacs, XEmacs offers to save your bookmark values in +your default bookmark file, @file{~/.emacs.bmk}, if you have changed any +bookmark values. You can also save the bookmarks at any time with the +@kbd{M-x bookmark-save} command. The bookmark commands load your +default bookmark file automatically. This saving and loading is how +bookmarks persist from one XEmacs session to the next. + +@vindex bookmark-save-flag + If you set the variable @code{bookmark-save-flag} to 1, then each +command that sets a bookmark will also save your bookmarks; this way, +you don't lose any bookmark values even if XEmacs crashes. (The value, +if a number, says how many bookmark modifications should go by between +saving.) + +@vindex bookmark-search-size + Bookmark position values are saved with surrounding context, so that +@code{bookmark-jump} can find the proper position even if the file is +modified slightly. The variable @code{bookmark-search-size} says how +many characters of context to record, on each side of the bookmark's +position. + + Here are some additional commands for working with bookmarks: + +@table @kbd +@item M-x bookmark-load @key{RET} @var{filename} @key{RET} +@findex bookmark-load +Load a file named @var{filename} that contains a list of bookmark +values. You can use this command, as well as @code{bookmark-write}, to +work with other files of bookmark values in addition to your default +bookmark file. + +@item M-x bookmark-write @key{RET} @var{filename} @key{RET} +@findex bookmark-write +Save all the current bookmark values in the file @var{filename}. + +@item M-x bookmark-delete @key{RET} @var{bookmark} @key{RET} +@findex bookmark-delete +Delete the bookmark named @var{bookmark}. + +@item M-x bookmark-insert-location @key{RET} @var{bookmark} @key{RET} +@findex bookmark-insert-location +Insert in the buffer the name of the file that bookmark @var{bookmark} +points to. + +@item M-x bookmark-insert @key{RET} @var{bookmark} @key{RET} +@findex bookmark-insert +Insert in the buffer the @emph{contents} of the file that bookmark +@var{bookmark} points to. +@end table diff -r f4aeb21a5bad -r 74fd4e045ea6 man/xemacs/sending.texi --- a/man/xemacs/sending.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/xemacs/sending.texi Mon Aug 13 11:13:30 2007 +0200 @@ -174,7 +174,7 @@ In this version of Emacs, what you see is what you get: in contrast to some other versions, no abbreviations are expanded after you have sent the mail. This means you don't suffer the annoyance of having the system do -things behind your back --- if the system rewrites an address you typed, +things behind your back---if the system rewrites an address you typed, you know it immediately, instead of after the mail has been sent and it's too late to do anything about it. For example, you will never again be in trouble because you forgot to delete an old alias from your diff -r f4aeb21a5bad -r 74fd4e045ea6 man/xemacs/startup.texi --- a/man/xemacs/startup.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/xemacs/startup.texi Mon Aug 13 11:13:30 2007 +0200 @@ -89,7 +89,7 @@ respectively. If two components are present, they locate the early and late hierarchies. If only one component is present, it locates the late hierarchy. At run time, the package path may also be specified via the -@code{PACKAGEPATH} environment variable. +@code{EMACSPACKAGEPATH} environment variable. An XEmacs package is laid out just like a normal installed XEmacs lisp directory. It may have @file{lisp}, @file{etc}, @file{info}, and diff -r f4aeb21a5bad -r 74fd4e045ea6 man/xemacs/xemacs.texi --- a/man/xemacs/xemacs.texi Mon Aug 13 11:12:06 2007 +0200 +++ b/man/xemacs/xemacs.texi Mon Aug 13 11:13:30 2007 +0200 @@ -1,10 +1,14 @@ - -\input ../texinfo @c -*-texinfo-*- +\input texinfo @c -*-texinfo-*- @setfilename ../../info/xemacs.info @comment node-name, next, previous, up @ifinfo +@dircategory XEmacs Editor +@direntry +* XEmacs: (xemacs). XEmacs Editor. +@end direntry + This file documents the XEmacs editor. Copyright (C) 1985, 1986, 1988 Richard M. Stallman. @@ -86,9 +90,8 @@ @page @ifinfo @node Top, License,, (dir) +@top The XEmacs Editor -The XEmacs Editor -***************** XEmacs is the extensible, customizable, self-documenting real-time display editor. This Info file describes how to edit with Emacs diff -r f4aeb21a5bad -r 74fd4e045ea6 modules/base64/.cvsignore --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/modules/base64/.cvsignore Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,2 @@ +*.ell +*_i.c diff -r f4aeb21a5bad -r 74fd4e045ea6 modules/base64/Makefile --- a/modules/base64/Makefile Mon Aug 13 11:12:06 2007 +0200 +++ b/modules/base64/Makefile Mon Aug 13 11:13:30 2007 +0200 @@ -25,6 +25,8 @@ all: $(MODNAME).ell +distclean: clean + clean: rm -f $(MODNAME).ell $(OBJS) base64_i.o base64_i.c diff -r f4aeb21a5bad -r 74fd4e045ea6 modules/ldap/.cvsignore --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/modules/ldap/.cvsignore Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,2 @@ +*.ell +*_i.c diff -r f4aeb21a5bad -r 74fd4e045ea6 modules/ldap/Makefile --- a/modules/ldap/Makefile Mon Aug 13 11:12:06 2007 +0200 +++ b/modules/ldap/Makefile Mon Aug 13 11:13:30 2007 +0200 @@ -25,6 +25,8 @@ all: $(MODNAME).ell +distclean: clean + clean: rm -f $(MODNAME).ell $(OBJS) eldap_i.o eldap_i.c diff -r f4aeb21a5bad -r 74fd4e045ea6 modules/sample/.cvsignore --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/modules/sample/.cvsignore Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,2 @@ +*.ell +*_i.c diff -r f4aeb21a5bad -r 74fd4e045ea6 modules/sample/Makefile --- a/modules/sample/Makefile Mon Aug 13 11:12:06 2007 +0200 +++ b/modules/sample/Makefile Mon Aug 13 11:13:30 2007 +0200 @@ -25,6 +25,8 @@ all: $(MODNAME).ell +distclean: clean + clean: rm -f $(MODNAME).ell $(OBJS) sample_i.o sample_i.c diff -r f4aeb21a5bad -r 74fd4e045ea6 modules/zlib/.cvsignore --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/modules/zlib/.cvsignore Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,2 @@ +*.ell +*_i.c \ No newline at end of file diff -r f4aeb21a5bad -r 74fd4e045ea6 modules/zlib/Makefile --- a/modules/zlib/Makefile Mon Aug 13 11:12:06 2007 +0200 +++ b/modules/zlib/Makefile Mon Aug 13 11:13:30 2007 +0200 @@ -25,6 +25,8 @@ all: $(MODNAME).ell +distclean: clean + clean: rm -f $(MODNAME).ell $(OBJS) zlib_i.o zlib_i.c diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/ChangeLog --- a/nt/ChangeLog Mon Aug 13 11:12:06 2007 +0200 +++ b/nt/ChangeLog Mon Aug 13 11:13:30 2007 +0200 @@ -1,3 +1,246 @@ +2000-02-16 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.29 is released. + +2000-02-06 Mike Alexander <mta@arbortext.com> + + * xemacs.mak (install): Copy xemacs.dmp if using the portable + dumper. + +2000-02-07 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.28 is released. + +2000-02-03 Kirill 'Big K' Katsnelson <kkm@dtmx.com> + + * Xpm.def: New file, required to build Xpm.dll. + + * Xpm.mak: Use DEBUG instead of DEBUG_XEMACS - this library is not + xemacs-specific. Initialize to DEBUG_XEMACS if specified for + compatibility. + Build DLL instead of static LIB when USE_CRTDLL=1 is given to + make. + + * xemacs.mak: Introduced USE_SYSTEM_MALLOC and USE_CRTDLL. + Do not build lastfile.lib when neither unexec not gmalloc are + used. + + * config.h: Deleted GNU_MALLOC and SYSTEM_MALLOC, as they are set + in makefile. + +2000-01-26 Kirill 'Big K' Katsnelson <kkm@dtmx.com> + + * xemacs.mak (DOC_SRC9): Added tests.c ... + (TEMACS_DEBUG_OBJS): ... and tests.obj + ($(DOC)): Tweaked a bit, for `nmake docfile' unconditionally + rebuild the docfile. + +2000-01-22 Kirill 'Big K' Katsnelson <kkm@dtmx.com> + + * xemacs.mak (docfile): Added shortcut target. + +2000-01-19 Kirill 'Big K' Katsnelson <kkm@dtmx.com> + + * xemacs.mak (TEMACS_LIBS): Added winspool.lib + +2000-01-20 Martin Buchholz <martin@xemacs.org> + + * xemacs.mak (dump-xemacs): Remove redundant EMACSBOOTSTRAPMODULEPATH. + +2000-01-18 Kirill 'Big K' Katsnelson <kkm@dtmx.com> + + * xemacs.mak: Patch of 01/13 got in corrupted, fixed. + +2000-01-18 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.27 is released. + +2000-01-18 Martin Buchholz <martin@xemacs.org> + + * minitar.c: Errno.h --> errno.h. Remove errno declaration. + +2000-01-13 Kirill 'Big K' Katsnelson <kkm@dtmx.com> + + * xemacs.mak: Added USE_PORTABLE_DUMPER make command line macro. + (temacs:) Added dependency for lastfile.lib so that 'make temacs' + builds it first. + +1999-12-28 Scott Blachowicz <Scott.Blachowicz@seaslug.org> + + * minitar.mak: Add vars to allow building from main xemacs.mak. + + * xemacs.mak: Add rules to build & install minitar. + +2000-01-03 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de> + + * config.h: Fix stuff related to mail locking. + +1999-12-31 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.26 is released. + +1999-12-24 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.25 is released. + +1999-12-15 Scott Blachowicz <Scott.Blachowicz@seaslug.org> + + * minitar.c (main): Add explicit exit(0) to get successful return + code. + +1999-12-14 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.24 is released. + +1999-11-28 Adrian Aichner <adrian@xemacs.org> + + * xemacs.mak (depend): Only update `depend' if there were changes. + Use "perl ./make-src-depend" instead of "mkdepend". + +1999-12-07 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.23 is released. + +1999-11-27 Adrian Aichner <adrian@xemacs.org> + + * xemacs.mak (SRCDIR): Make path to xemacs absolute to + facilitate building info in man subdirs. Echo all cd commands, + not just some of them. + + (makeinfo-test): Test for availability of `texinfo' package to + build info. Recommend use of external `makeinfo' program for + building info docs faster. + + (info): cd into man subdirs to support use of external `makeinfo' + program. + +1999-11-17 Martin Buchholz <martin@xemacs.org> + + * xemacs.mak: Remove references to index.unperm, index.perm. + Fix dependencies. + Shouldn't .obj and .info be in SUFFIXES? + Remove extra `\'. + +1999-11-29 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.22 is released + +1999-11-28 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.21 is released. + +1999-11-10 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.20 is released + +1999-10-07 Norbert Koch <n.koch@eai-delta.de> + + * xemacs.mak: Ignore return code of 'del' calls. Use a make + variable for 'del'. + +1999-09-26 Adrian Aichner <adrian@xemacs.org> + + * xemacs.mak (all): Update $(LISP)/auto-autoloads.elc? and + $(LISP)/custom-load.el using XEmacs itself, like xemacs-packages + do. + ($(LISP)\auto-autoloads.el): Add new rule. + ($(LISP)\custom-load.el): Ditto. + +1999-08-04 Andy Piper <andy@xemacs.org> + + * xemacs.mak (HAVE_WIDGETS): add define to appropriate places. + +1999-07-26 Adrian Aichner <adrian@xemacs.org> + + * xemacs.mak ($(MANDIR)\lispref\lispref.texi): Replace bad + dependency. + +1999-07-30 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.19 is released + +1999-07-10 Adrian Aichner <adrian@xemacs.org> + + * xemacs.mak (.SUFFIXES): Add .texi. + (check): Improve automated test section. + (info): Generate info files using XEmacs (no makeinfo.exe needed). + +1999-07-19 Andy Piper <andy@xemacs.org> + + * xemacs.mak (DOC_SRC3): add gutter.c + (TEMACS_OBJS): add gutter.obj. + +1999-07-13 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.18 is released + +1999-06-22 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.17 is released + +1999-06-13 Adrian Aichner <adrian@xemacs.org> + + * xemacs.mak (DOC_SRC8): Remove mule-coding.c. + (TEMACS_MULE_OBJS): Remove mule-coding.obj + (check): Implement according to src/Makefile. + (check-temacs): ditto. + +1999-06-05 Norbert Koch <n.koch@delta-ii.de> + + * xemacs.mak (mule): remove dependencies from mule-coding.c + +1999-06-11 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.16 is released + +1999-05-14 Adrian Aichner <adrian@xemacs.org> + + * xemacs.mak (GUNG_HO): Explicitly default to 0. + Fix some comment typos. + ($(XEMACS)\Installation): Create it in the toplevel-directory, + where it is expected by loadup.el + +1999-06-04 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.15 is released + +1999-05-31 Andy Piper <andy@xemacs.org> + + * xemacs.mak: add select & select-x targets. + +1999-05-14 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.14 is released + +1999-05-12 SL Baur <steve@gneiss.etl.go.jp> + + * xemacs.mak: please document me + From Norbert Koch <n.koch@delta-ii.de> + +1999-05-03 Hrvoje Niksic <hniksic@srce.hr> + + * xemacs.mak ($(LISP)\Installation.el): Don't use + `replace-in-string'. + +1999-03-17 Adrian Aichner <adrian@xemacs.org> + + * xemacs.mak: Remove ESC macro -- no longer needed. + Remove small configuration report. Remove simplified version of + Installation and Installation.el + (Installation.el): Create it depending on "Installation" file. + Replace \r characters by use of `replace-in-string' in lisp-land. + (all): Make it depend on "Installation" file. + (Installation): Create a complete "Installation" file, looking + much like what is generated by "configure" on UNIX systems. + Insert WARNING where appropriate (currently when building without + HAVE_XPM, HAVE_PNG, and HAVE_MSW_C_DIRED). + Type "Installation" to STDOUT much like the "small configuration + report" did. + +1999-04-29 Andy Piper <andy@xemacs.org> + + * sys/file.h: conditionalise definition of X_OK. + 1999-03-12 XEmacs Build Bot <builds@cvs.xemacs.org> * XEmacs 21.2.13 is released @@ -55,7 +298,7 @@ * XEmacs 21.2.9 is released -1999-01-14 Adrian Aichner <aichner@ecf.teradyne.com> +1999-01-14 Adrian Aichner <adrian@xemacs.org> * xemacs.mak (MODULES): Adding variable. (update-elc): Setting EMACSBOOTSTRAPMODULEPATH. @@ -106,7 +349,7 @@ * XEmacs 21.2.6 is released -1998-12-11 Adrian Aichner <aichner@ecf.teradyne.com> +1998-12-11 Adrian Aichner <adrian@xemacs.org> * xemacs.mak (DOC_SRC2): CLASH_DETECTION is not supported under native Windows NT. Therefore src\filelock.c is not to be @@ -128,7 +371,7 @@ (DOC_SRC4): - Remove pure.c, pure.obj -1998-11-04 Adrian Aichner <aichner@ecf.teradyne.com> +1998-11-04 Adrian Aichner <adrian@xemacs.org> * xemacs.mak: Creating minimal versions of Installation, Installation.el, and config.values to make @@ -157,7 +400,7 @@ * XEmacs 21.2-beta2 is released. -1998-09-19 Adrian Aichner <aichner@ecf.teradyne.com> +1998-09-19 Adrian Aichner <adrian@xemacs.org> * tiff.mak: New file provided by Charles Wilson <cwilson@ee.gatech.edu> @@ -247,7 +490,7 @@ * config.h: * xemacs.mak: NT native sound fixes - From Fabrice POPINEAU via Adrian Aichner <aichner@ecf.teradyne.com> + From Fabrice POPINEAU via Adrian Aichner <adrian@xemacs.org> 1998-06-21 Martin Buchholz <martin@xemacs.org> @@ -270,7 +513,7 @@ * xemacs.mak (distclean): Reorder when puresize-adjust.h gets deleted. - From Adrian Aichner <aichner@ecf.teradyne.com> + From Adrian Aichner <adrian@xemacs.org> 1998-06-08 Kirill M. Katsnelson <kkm@kis.ru> diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/Xpm.def --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/nt/Xpm.def Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,50 @@ +; Export definition file for XPM port to Win32 +; Copyright (C) 2000 Kirill 'Big K' Katsnelson +; +; This file is part of XEmacs. +; +; XEmacs is free software; you can redistribute it and/or modify it +; under the terms of the GNU General Public License as published by the +; Free Software Foundation; either version 2, or (at your option) any +; later version. +; +; XEmacs is distributed in the hope that it will be useful, but WITHOUT +; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +; for more details. +; +; You should have received a copy of the GNU General Public License +; along with XEmacs; see the file COPYING. If not, write to +; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +; Boston, MA 02111-1307, USA. +; +; Synched up with: Not in FSF. +; + +LIBRARY Xpm.dll +EXPORTS + XpmCreateImageFromData + XpmCreateDataFromImage + XpmReadFileToImage + XpmWriteFileFromImage + XpmCreateImageFromBuffer + XpmReadFileToBuffer + XpmWriteFileFromBuffer + XpmReadFileToData + XpmWriteFileFromData + XpmAttributesSize + XpmFreeAttributes + XpmFreeExtensions + XpmFreeXpmImage + XpmFreeXpmInfo + XpmGetErrorString + XpmLibraryVersion + XpmReadFileToXpmImage + XpmWriteFileFromXpmImage + XpmCreateImageFromXpmImage + XpmCreateXpmImageFromImage + XpmCreateDataFromXpmImage + XpmCreateXpmImageFromData + XpmCreateXpmImageFromBuffer + XpmCreateBufferFromXpmImage + XpmFree diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/config.h --- a/nt/config.h Mon Aug 13 11:12:06 2007 +0200 +++ b/nt/config.h Mon Aug 13 11:13:30 2007 +0200 @@ -67,12 +67,6 @@ numbers. */ #undef LISP_FLOAT_TYPE -/* Define GNU_MALLOC if you want to use the *new* GNU memory allocator. */ -#define GNU_MALLOC - -/* Define USE_SYSTEM_MALLOC if you forcing the use of it. */ -#undef USE_SYSTEM_MALLOC - /* Define HAVE_TTY if you want TTY support compiled in. */ #undef HAVE_TTY @@ -336,6 +330,20 @@ #endif /* DEBUG_XEMACS */ +/* Define convenient conditionally defined assertion macros. */ +#ifdef ERROR_CHECK_TYPECHECK +#define type_checking_assert(assertion) assert (assertion) +#else +#define type_checking_assert(assertion) +#endif + +#ifdef ERROR_CHECK_BUFPOS +#define bufpos_checking_assert(assertion) assert (assertion) +#else +#define bufpos_checking_assert(assertion) +#endif + + /* Define MEMORY_USAGE_STATS if you want extra code compiled in to determine where XEmacs's memory is going. */ #undef MEMORY_USAGE_STATS @@ -412,8 +420,6 @@ compiling-running-crashing. */ #undef NO_DOC_FILE -#define CONST const - /* If not defined, use unions instead of ints. A few systems (DEC Alpha) seem to require this, probably because something with the int definitions isn't right with 64-bit systems. @@ -611,16 +617,8 @@ /* Should movemail use hesiod for getting POP server host? */ #undef HESIOD /* Determine type of mail locking. */ -/* Play preprocessor games so that configure options override s&m files */ -#undef REAL_MAIL_USE_LOCKF -#undef REAL_MAIL_USE_FLOCK -#undef MAIL_USE_LOCKF -#undef MAIL_USE_FLOCK -#ifdef REAL_MAIL_USE_FLOCK -#define MAIL_USE_FLOCK -#endif -#ifdef REAL_MAIL_USE_LOCKF -#define MAIL_USE_LOCKF -#endif +#undef MAIL_LOCK_LOCKF +#undef REAL_LOCK_FLOCK +#undef MAIL_LOCK_DOT #endif /* _SRC_CONFIG_H_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/inc/sys/dir.h --- a/nt/inc/sys/dir.h Mon Aug 13 11:12:06 2007 +0200 +++ b/nt/inc/sys/dir.h Mon Aug 13 11:13:30 2007 +0200 @@ -65,7 +65,7 @@ char dd_buf[DIRBLKSIZ]; /* directory block */ } DIR; /* stream data from opendir() */ -DIR *opendir (CONST char *filename); +DIR *opendir (const char *filename); void closedir (DIR *dirp); struct direct *readdir (DIR *dirp); struct direct *readdirver (DIR *dirp); diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/inc/sys/file.h --- a/nt/inc/sys/file.h Mon Aug 13 11:12:06 2007 +0200 +++ b/nt/inc/sys/file.h Mon Aug 13 11:13:30 2007 +0200 @@ -3,6 +3,9 @@ */ #define F_OK 0 +#ifdef X_OK +#undef X_OK +#endif #define X_OK 1 #define W_OK 2 #define R_OK 4 diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/installer/Wise/README --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/nt/installer/Wise/README Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,31 @@ +To use: + +You need to build and install the XEmacs distribution. Also you need +the xemacs packages in both source and installed versions. + +Edit "dirs.py" to reflect the locations of the above components. + +Edit "version.py" to reflect the current version, as well as the +welcome message. + +Run + python pre_wise.py > xemacs-XXX.wse + + (for XXX use a version or date code of your choosing) + +Run + cmd /c xemacs-XXX.wse + +to produce xemacs-XXX.exe + + +"pre_wise.py" is a preprocessor for the Wise installer maker. It +reads "xemacs.tmpl" which is a Wise input file, except that certain +portions are enclosed in triple angle brackets <<<like this>>> + +These portions are evaluated as Python expressions and replaced by the +string representations of the resulting value. This allows for +things to change from release to release without having to re-do the +Wise installation each time. Also it keeps you from having to +manually drag-n-drop all the package files, which is rather tedious! + diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/installer/Wise/dirs.py --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/nt/installer/Wise/dirs.py Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,21 @@ +#Configuration variables + +#where the source is: + +source = r"X:\XEmacs-21" +#where the installed distribution is: +installed = r"C:\Program Files\XEmacs\xemacs-21.0-b62" + +#where the (built and installed) packages are +packages = r"C:\Program Files\XEmacs\xemacs-packages" + +#where the package source is +pkg_src = r"X:\xemacs-packages" + +#Subdirs relative to the base installation directory +#Everything except packages goes here: +dst = "XEmacs-21.0-b62" +#packages go here: +pkg_dst = "xemacs-packages" + + diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/installer/Wise/display readme.dlg --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/nt/installer/Wise/display readme.dlg Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,63 @@ +Document Type: DLG +item: Custom Dialog + Name=Display ReadMe + Display Variable=DISPLAY + item: Dialog + Title=Read Me File + Title French=Fichier Lisez-moi + Title German=Liesmich-Datei + Title Portuguese=Ficheiro Leia-me + Title Spanish=Archivo Léeme + Title Italian=File Leggimi + Title Danish=Vigtigt fil + Title Dutch=Leesmij-bestand + Title Norwegian=Informasjonsfil + Title Swedish=Läs mig-fil + Width=280 + Height=224 + Font Name=Helv + Font Size=8 + item: Push Button + Rectangle=172 185 214 199 + Variable=DIRECTION + Value=N + Create Flags=01010000000000010000000000000001 + Text=I &Agree > + Text French=&Suivant> + Text German=&Weiter> + Text Portuguese=&Próximo> + Text Spanish=&Siguiente > + Text Italian=&Avanti > + Text Danish=&Næste> + Text Dutch=&Volgende> + Text Norwegian=&Neste> + Text Swedish=&Nästa > + end + item: Push Button + Rectangle=222 185 264 199 + Action=3 + Create Flags=01010000000000010000000000000000 + Text=Cancel + Text French=Annuler + Text German=Abbrechen + Text Portuguese=Cancelar + Text Spanish=Cancelar + Text Italian=Annulla + Text Danish=Slet + Text Dutch=Annuleren + Text Norwegian=Avbryt + Text Swedish=Avbryt + end + item: Static + Rectangle=9 177 263 178 + Action=3 + Create Flags=01010000000000000000000000000111 + end + item: Editbox + Rectangle=85 11 254 170 + Value=%TEMP%\%READMEFILE% + Help Context=16711681 + Create Flags=01010000101000000000100000000100 + end + end +end diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/installer/Wise/el.reg --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/nt/installer/Wise/el.reg Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,36 @@ + +REGEDIT4 + +[HKEY_CLASSES_ROOT\.el] +@="elfile" +"Content Type"="text/plain" + +[HKEY_CLASSES_ROOT\elfile] +@="Emacs lisp" +"EditFlags"=hex:00,00,01,00 + +[HKEY_CLASSES_ROOT\elfile\Shell] +@="" + +[HKEY_CLASSES_ROOT\elfile\Shell\open] + +[HKEY_CLASSES_ROOT\elfile\Shell\open\command] +@="\"C:\\Program Files\\XEmacs\\XEmacs-21.0\\i386-pc-win32\\runemacs.exe\" \"%1\"" + +[HKEY_CLASSES_ROOT\elfile\Shell\open\ddeexec] +@="open(\"%1\")" + +[HKEY_CLASSES_ROOT\elfile\Shell\open\ddeexec\Application] +@="XEmacs" + +[HKEY_CLASSES_ROOT\elfile\Shell\open\ddeexec\topic] +@="System" + +[HKEY_CLASSES_ROOT\elfile\DefaultIcon] +@="C:\\Program Files\\XEmacs\\XEmacs-21.0\\i386-pc-win32\\runemacs.exe,2" + +[HKEY_CLASSES_ROOT\elfile\QuickView] +@="*" + + + diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/installer/Wise/filelist.py --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/nt/installer/Wise/filelist.py Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,23 @@ +import os +import dirs +import string + +def listdir_recursive(basedir): + ret = [] + for f in os.listdir(basedir): + if os.path.isfile(basedir+"\\"+f): + ret.append(f) + elif os.path.isdir(basedir+"\\"+f): + for f1 in listdir_recursive(basedir+"\\"+f): + ret.append(f+"\\"+f1) + return ret + +all = [] + + + +for f in listdir_recursive(dirs.installed): + if string.find(f,'CVS')>=0: + continue + all.append((f, dirs.installed, dirs.dst)) + diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/installer/Wise/files.py --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/nt/installer/Wise/files.py Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,36 @@ +import os +import dirs + +def listdir_recursive(basedir): + ret = [] + for f in os.listdir(basedir): + if os.path.isfile(basedir+"\\"+f): + ret.append(f) + elif os.path.isdir(basedir+"\\"+f): + for f1 in listdir_recursive(basedir+"\\"+f): + ret.append(f+"\\"+f1) + return ret + +install = [] + +for f in os.listdir(dirs.source+"\\lib-src"): + if f == "DOC" or f[-4:]==".exe": + install.append((f,dirs.source+"\\lib-src",dirs.bin_dst)) + + +for f in ['runemacs.exe', 'xemacs.exe']: + install.append((f,dirs.source+"\\src",dirs.bin_dst)) + +for f in listdir_recursive(dirs.source+"\\lisp"): + install.append((f,dirs.source+"\\lisp",dirs.lisp_dst)) + +for f in listdir_recursive(dirs.source+"\\etc"): + install.append((f,dirs.source+"\\etc",dirs.etc_dst)) + + +for f in os.listdir(dirs.source+"\\info"): + install.append((f,dirs.source+"\\info",dirs.info_dst)) + + + + diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/installer/Wise/gnu.bmp Binary file nt/installer/Wise/gnu.bmp has changed diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/installer/Wise/libs.dlg --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/nt/installer/Wise/libs.dlg Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,170 @@ +Document Type: DLG +item: Custom Dialog + Name=Select Components + Display Variable=DISPLAY + Flags=00000001 + item: Dialog + Title=Select Components + Title French=Sélectionner les éléments + Title German=Komponenten auswählen + Title Portuguese=Seleccionar Componentes + Title Spanish=Seleccione los Componentes + Title Italian=Seleziona Componenti + Title Danish=Vælg komponenter + Title Dutch=Selecteer onderdelen + Title Norwegian=Velg komponenter + Title Swedish=Välj komponenter + Width=280 + Height=224 + Font Name=Helv + Font Size=8 + item: Push Button + Rectangle=172 185 214 199 + Variable=DIRECTION + Value=N + Create Flags=01010000000000010000000000000001 + Text=&Next > + Text French=&Suivant> + Text German=&Weiter> + Text Portuguese=&Próximo> + Text Spanish=&Siguiente > + Text Italian=&Avanti > + Text Danish=&Næste> + Text Dutch=&Volgende> + Text Norwegian=&Neste> + Text Swedish=&Nästa > + end + item: Push Button + Rectangle=130 185 172 199 + Variable=DIRECTION + Value=B + Create Flags=01010000000000010000000000000000 + Text=< &Back + Text French=<&Retour + Text German=<&Zurück + Text Portuguese=<&Retornar + Text Spanish=<&Retroceder + Text Italian=< &Indietro + Text Danish=<&Tilbage + Text Dutch=<&Terug + Text Norwegian=<&Tilbake + Text Swedish=< &Tillbaka + end + item: Push Button + Rectangle=222 185 264 199 + Action=3 + Create Flags=01010000000000010000000000000000 + Text=Cancel + Text French=Annuler + Text German=Abbrechen + Text Portuguese=Cancelar + Text Spanish=Cancelar + Text Italian=Annulla + Text Danish=Annuller + Text Dutch=Annuleren + Text Norwegian=Avbryt + Text Swedish=Avbryt + end + item: Static + Rectangle=9 177 263 178 + Action=3 + Create Flags=01010000000000000000000000000111 + end + item: Static + Rectangle=205 156 253 166 + Variable=COMPONENTS + Value=MAINDIR + Create Flags=01010000000000000000000000000010 + end + item: Static + Rectangle=205 148 253 157 + Variable=COMPONENTS + Create Flags=01010000000000000000000000000010 + end + item: Static + Rectangle=95 147 184 158 + Create Flags=01010000000000000000000000000000 + Text=Disk Space Required: + Text French=Espace disque requis + Text German=Benötigter Festplattenspeicher: + Text Portuguese=Espaço de disco necessário: + Text Spanish=Espacio de Disco Requerido: + Text Italian=Spazio su disco richiesto: + Text Danish=Nødvendig diskplads: + Text Dutch=Vereiste hoeveelheid schijfruimte + Text Norwegian=Diskplass nødvendig: + Text Swedish=Erforderligt diskutrymme + end + item: Static + Rectangle=95 157 190 167 + Create Flags=01010000000000000000000000000000 + Text=Disk Space Remaining: + Text French=Espace disque disponible + Text German=Verbleibender Festplattenspeicher: + Text Portuguese=Espaço de disco restante: + Text Spanish=Espacio de Disco Remanente: + Text Italian=Spazio su disco rimanente: + Text Danish=Ledig diskplads: + Text Dutch=Resterende schijfruimte + Text Norwegian=Ledig diskplass: + Text Swedish=Återstående diskutrymme + end + item: Static + Rectangle=90 138 264 168 + Action=1 + Create Flags=01010000000000000000000000000111 + end + item: Static + Rectangle=90 8 260 41 + Create Flags=01010000000000000000000000000000 + Text=In the options list below, select the checkboxes for the options that you would like to have installed. The disk space fields reflect the requirements of the options you have selected. + Text French=Dans la liste d'options suivante, veuillez sélectionner les cases des options que vous désirez installer. Le champ d'espace disque indique les conditions requises pour les options choisies + Text German=Wählen Sie in der Optionenliste unten die Kontrollkästchen für diejenigen Optionen, die Sie installieren möchten. Die Speicherfelder zeigen die benötigte Speicherkapazität für die gewählten Optionen an. + Text Portuguese=Na lista de opções abaixo, seleccione as caixas de verificação para as opções que gostaria de ter instalado. Os campos de espaço de disco reflectem os requerimentos das opções que seleccionou. + Text Spanish=En la lista de opciones que se ofrece a continuación, seleccione las casillas de comprobación para las opciones que desea instalar. Los campos del espacio en el disco reflejan los requerimientos de las opciones que ha seleccionado. + Text Italian=Nell’elenco delle opzioni sotto, marca le caselle di controllo delle opzioni che vuoi installare. I campi dello spazio sul disco riflettono i requisiti delle opzioni selezionate. + Text Danish=Marker afkrydsningsfelterne for de komponenter, der skal installeres, på listen herunder. Diskpladsfelterne angiver pladskravene for de valgte komponenter. + Text Dutch=Kruis in de onderstaande lijst het vakje aan naast de opties die u wilt installeren. Achter elke optie staat de benodigde schijfruimte vermeld. + Text Norwegian=I listen over alternativer nedenfor, klikk i kontrollrutene for de alternativene du ønsker å installere. Diskplassfeltene gjenspeiler kravene for de alternativene du har valgt. + Text Swedish=Kryssa för i rutorna nedan vilka alternativ du vill få installerade. I diskutrymmesfälten anges utrymmesbehoven för de alternativ du väljer. + end + item: Checkbox + Rectangle=91 41 126 56 + Variable=COMPONENTS LIBS + Enabled Color=00000000000000001111111111111111 + Create Flags=01010000000000010000000000000011 + Flags=0000000000000010 + Text=Libraries + Text= + end + item: Checkbox + Rectangle=90 56 148 71 + Variable=COMPONENTS COMM + Enabled Color=00000000000000001111111111111111 + Create Flags=01010000000000010000000000000011 + Flags=0000000000000010 + Text=Communications + Text= + end + end + item: Dialog + Title=Library Packages + Width=268 + Height=204 + Font Name=Helv + Font Size=8 + end + item: Dialog + Title=Library Packages + Width=268 + Height=204 + Font Name=Helv + Font Size=8 + item: Push Button + Rectangle=219 170 254 185 + Enabled Color=00000000000000001111111111111111 + Create Flags=01010000000000010000000000000000 + Text=OK + end + end +end diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/installer/Wise/packages.py --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/nt/installer/Wise/packages.py Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,140 @@ +#configuration variables + +#package categories +category_names = ["libs", "comm", "oa", "os", "prog", "wp", "games"] + +category_descriptions = {"libs":"Libraries", + "comm":"Communication", + "oa": "Productivity", #??? + "os": "Operating System", + "prog": "Programming", + "wp": "Word Processing", + "games": "Games and Amusements"} + + +#packages to install by default +default=["xemacs-base","edit-utils","efs", + "text-modes","prog-modes", + "dired","apel", + "c-support","cc-mode", + "mail-lib","pc","sounds-wav"] + +def category_of_letter(x): + return category_names[ord(x)-ord('A')] + +def letter_of_category(cat): + return chr(ord('A')+category_names.index(cat)) + +def letter_of_package(x): + return chr(ord('A')+packages_of_category(category_of_package(x)).index(x)) + +import dirs, os +catpkg = {} +pkgcat = {} + +for cat in category_names: + pkgcat[cat]=[] + dd = os.path.join(dirs.pkg_src,cat) + for d in os.listdir(dd): + if d == "CVS": + continue + manifest = dirs.packages + "\\pkginfo\\MANIFEST." + d + if not os.path.exists(manifest): #it's not installed, skip it + continue + if os.path.isdir(os.path.join(dd,d)): + catpkg[d] = cat + pkgcat[cat].append(d) + +def category_of_package(p): + return catpkg[p] + +def packages_of_category(c): + return pkgcat[c] + +#Brief descriptions of the packages. +#This data is up-to-date as of 13 January 1998. +package_descriptions={ + "Sun":"Support for Sparcworks.", + "apel":"A Portable Emacs Library", + "edebug":"A Lisp debugger", + "dired":"The DIRectory EDitor", + "efs":"Access remote filesystems", + "mail-lib":"Fundamental email support", + "tooltalk":"Tooltalk", + "xemacs-base":"Fundamental XEmacs support", + "xemacs-devel":"Lisp developer support.", + "footnote":"Footnoting in mail messages", + "gnats":"XEmacs bug reports", + "gnus":"Newsreader and Mailreader", + "mailcrypt":"Message encryption with PGP.", + "mh-e":"Support for MH mailreader", + "net-utils":"Networking Utilities", + "ph":"CCSO/qi directory client", + "rmail":"An obsolete Emacs mailer", + "supercite":"Mail/News Citation tool", + "tm":"Emacs MIME support", + "vm":"An Emacs mailer", + "w3":"A Web browser", + "cookie":"Spook and Yow (Zippy quotes)", + "games":"Tetris, Sokoban, and Snake", + "mine":"Minehunt", + "misc-games":"Other amusements and diversions", + "egg-its":"Wnn(4.2 and 6)/SJ3 support", + "leim":"Quail", + "locale":"Localized menubars", + "mule-base":"Basic Mule support", + "skk":"Another Japanese Language Input Method", + "calendar":"Calendar and diary", + "edit-utils":"Various XEmacs goodies", + "forms":"Obsolete forms editing support", + "frame-icon":"Change icon based on mode", + "hm--html-menus":"HTML editing", + "ispell":"Spell-checking with ispell", + "pc":"PC style interface emulation", + "psgml":"Validated HTML/SGML editing", + "sgml":"SGML/Linuxdoc-SGML editing", + "slider":"User interface tool", + "speedbar":"??? Document me.", + "strokes":"Mouse enhancement utility", + "text-modes":"Packages for editing text files", + "time":"Display time and date", + "eterm":"Terminal emulator", + "igrep":"Enhanced Grep", + "ilisp":"Front-end for Inferior Lisp", + "os-utils":"Misc. OS utilities", + "view-process":"Unix process viewer", + "ada":"Ada language support", + "c-support":"Add-ons for editing C code", + "cc-mode":"C, C++ and Java language editing", + "debug": "GUD, gdb, dbx debugging support", + "ediff": "Compare files", + "emerge": "Merge files", + "pcl-cvs":"CVS frontend.", + "prog-modes":"Various programming languages", + "scheme":"Front-end for Inferior Scheme", + "sh-script":"Support for editing shell scripts", + "vc":"Version Control", + "vc-cc":"Broken", + "vhdl":"Support for VHDL", + "auctex":"Basic TeX/LaTeX support", + "crisp":"Crisp/Brief emulation", + "edt":"DEC EDIT/EDT emulation", + "texinfo":"XEmacs TeXinfo support.", + "textools":"TeX support", + "tpu":"DEC EDIT/TPU support", + "viper":"VI emulation", + "elib":"Portable elisp utility library", + "fsf-compat": "FSF Emacs compatibility files", + "sounds-wav": "XEmacs Microsoft sound files", + "bbdb": "The Big Brother Data Base", + "eudc": "Emacs Unified Directory Client", + "mew": "Messaging in an Emacs World", + "zenirc": "IRC client", + "calc": "Emacs calculator", + "jde": "Java development environment", + "reftex": "LaTeX cross-referencing and citations" +} + + + + diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/installer/Wise/pre_wise.py --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/nt/installer/Wise/pre_wise.py Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,133 @@ +import string +import re +import os +import types + +infile=open("xemacs.tmpl","r") + +import version +import dirs +import filelist +import packages + +def letter(package): + index = packages.all.index(package) + if index>29: + raise "WISE error: too many components" + return chr(ord("A")+index) + +def letters(package_list): + ret = "" + for p in package_list: + ret = ret+letter(p) + return ret + +def describe(package): + if package in packages.descriptions.keys(): + return ": "+packages.descriptions[package] + else: return "" + +def ifblock(var,val): + return("item: If/While Statement\n Variable=%s\n Value=%s\n Flags=00001010\nend\n" % (var,val)) + +def endblock(): + return("item: End Block\nend\n") + +def setvar(var,val): + return("item: Set Variable\n Variable=%s\n Value=%s\n Flags=10000000\nend\n" % (string.upper(var), val)) + +def default_letters_of_category(cat): + val = "" + for p in packages.default: + if packages.category_of_package(p) == cat: + val = val + packages.letter_of_package(p) + return val + +def set_category_defaults(): + ret = "" + for c in packages.category_names: + ret = ret + setvar(c, default_letters_of_category(c)) + return ret + +def do_category(cat): + ret = ifblock("COMPONENTS", packages.letter_of_category(cat)) + for pkg in packages.packages_of_category(cat): + ret = ret + ifblock(string.upper(cat),packages.letter_of_package(pkg)) + for f in files_of_package(pkg): + ret = ret+install_pkg_file(f) + ret = ret + endblock() + ret = ret + endblock() + return ret + +def files_of_package(package): + manifest_file = dirs.packages + "\\pkginfo\\MANIFEST." + package + manifest = open(manifest_file,"r") + lines = manifest.readlines() + lines = map(lambda s:s[:-1], lines) + lines = map(lambda s:string.replace(s,'/','\\'), lines) + return lines + +def category_dialog(cat): + npkg = len(packages.packages_of_category(cat)) + ret="" + ret=ret+" item: Dialog\n Title="+packages.category_descriptions[cat]+" Packages\n" + ret=ret+" Width=210\n" + ret=ret+" Height=%d\n" % (45+npkg*10) + ret=ret+" Font Name=Helv\n" + ret=ret+" Font Size=8\n" + ret=ret+" item: Push Button\n" + ret=ret+" Rectangle=107 %d 147 %d\n" % (5+npkg*10+2, 5+npkg*10+17) + ret=ret+" Create Flags=01010000000000010000000000000001\n" + ret=ret+" Text=OK\n" + ret=ret+" end\n" + ret=ret+" item: Push Button\n" + ret=ret+" Rectangle=153 %d 193 %d\n" % (5+npkg*10+2, 5+npkg*10+17) + ret=ret+" Variable=%s\n" % string.upper(cat) + ret=ret+" Value=%%%s_SAVE%%\n" % string.upper(cat) + ret=ret+" Create Flags=01010000000000010000000000000000\n" + ret=ret+" Flags=0000000000000001\n" + ret=ret+" Text=Cancel\n" + ret=ret+" end\n" + ret=ret+" item: Checkbox\n" + ret=ret+" Rectangle=0 5 191 %d\n" % (10*npkg) + ret=ret+" Variable=%s\n"%string.upper(cat) + ret=ret+" Create Flags=01010000000000010000000000000011\n" + ret=ret+" Flags=0000000000000010\n" + for pkg in packages.packages_of_category(cat): + ret = ret+" Text=%s: %s\n"%( pkg, packages.package_descriptions[pkg]) + ret=ret+" Text=\n" + ret=ret+" end\n" + ret=ret+" end\n" + return ret + +def src_path(src,name): + return src + "\\" + name + +def dst_path(dst,name): + return "%MAINDIR%"+"\\"+dst+"\\" + name + +def install_file(name,src,dst): + return("item: Install File\n Source=%s\n Destination=%s\n Flags=0000000010000010\nend\n" % (src_path(src,name),dst_path(dst,name))) + +def install_pkg_file(name): + return install_file(name,dirs.packages,dirs.pkg_dst) + +def do_package(package): + return ifblock("COMPONENTS",letter(package)) + \ + string.join(map(install_pkg_file,files(package)),"")+ \ + endblock() + +for line in infile.readlines(): + left=string.find(line,"<<<") + if left>=0: + right=string.find(line,">>>") + expr=line[left+3:right] + val=eval(expr) + if type(val)==types.StringType: + print line[:left] + val + line[right+3:], + elif type(val)==types.ListType: + for v in val: + print line[:left] + v + line[right+3:], + else: print line, + + diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/installer/Wise/type.dlg --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/nt/installer/Wise/type.dlg Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,32 @@ +Document Type: DLG +item: Custom Dialog + Name=type + item: Dialog + Title=type + Width=238 + Height=208 + Font Name=Helv + Font Size=8 + item: Radio Button + Rectangle=5 5 40 20 + Enabled Color=00000000000000001111111111111111 + Create Flags=01010000000000010000000000001001 + Text=minimal + Text= + end + item: Radio Button + Rectangle=5 25 40 40 + Enabled Color=00000000000000001111111111111111 + Create Flags=01010000000000010000000000001001 + Text=custom + Text= + end + item: Radio Button + Rectangle=5 45 40 60 + Enabled Color=00000000000000001111111111111111 + Create Flags=01010000000000010000000000001001 + Text=full + Text= + end + end +end diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/installer/Wise/version.py --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/nt/installer/Wise/version.py Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,3 @@ +title="XEmacs 21.0b62 EXPERIMENTAL" +welcome="Welcome to the %APPTITLE% setup program. Please note that this is an experimental release and some features may not work correctly, especially on machines running Windows 95. Please read the file PROBLEMS in the xemacs installation directory. Send comments or bug reports to xemacs-nt@xemacs.org. For more info see http://www.xemacs.org" + diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/installer/Wise/welcome.dlg --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/nt/installer/Wise/welcome.dlg Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,63 @@ +Document Type: DLG +item: Custom Dialog + Name=Welcome + Display Variable=DISPLAY + item: Dialog + Title=Welcome + Title French=Bienvenue + Title German=Willkommen + Title Portuguese=Bem-vindo + Title Spanish=Bienvenido + Title Italian=Benvenuto + Title Danish=Velkommen + Title Dutch=Welkom + Title Norwegian=Velkommen + Title Swedish=Välkommen + Width=280 + Height=224 + Font Name=Helv + Font Size=8 + item: Push Button + Rectangle=172 185 214 199 + Variable=DIRECTION + Value=N + Create Flags=01010000000000010000000000000001 + Text=&Next > + Text French=&Suivant> + Text German=&Weiter> + Text Portuguese=&Próximo> + Text Spanish=&Siguiente > + Text Italian=&Avanti > + Text Danish=&Næste> + Text Dutch=&Volgende> + Text Norwegian=&Neste> + Text Swedish=&Nästa > + end + item: Push Button + Rectangle=222 185 264 199 + Action=3 + Create Flags=01010000000000010000000000000000 + Text=Cancel + Text French=Annuler + Text German=Abbrechen + Text Portuguese=Cancelar + Text Spanish=Cancelar + Text Italian=Annulla + Text Danish=Annuller + Text Dutch=Annuleren + Text Norwegian=Avbryt + Text Swedish=Avbryt + end + item: Static + Rectangle=9 177 263 178 + Action=3 + Create Flags=01010000000000000000000000000111 + end + item: Static + Rectangle=91 22 245 118 + Enabled Color=00000000000000001111111111111111 + Create Flags=01010000000000000000000000000000 + Text=Welcome to the %APPTITLE% setup program. Please note that this is an experimental release and some features may not work correctly. Send comments or bug reports to xemacs-nt@xemacs.org rather than one of the other XEmacs mailing lists. For more info see http://www.xemacs.org + end + end +end diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/installer/Wise/xemacs-beta.bmp Binary file nt/installer/Wise/xemacs-beta.bmp has changed diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/installer/Wise/xemacs.tmpl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/nt/installer/Wise/xemacs.tmpl Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,1310 @@ +Document Type: WSE +item: Global + Version=7.0 + Title=<<<version.title + " Installation">>> + Flags=00000100 + Languages=65 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + Japanese Font Name=MS Gothic + Japanese Font Size=10 + Progress Bar DLL=%_WISE_%\Progress\WIZ%_EXE_OS_TYPE_%.DLL + Start Gradient=0 0 255 + End Gradient=0 0 0 + Windows Flags=00000100000000010010110000001000 + Log Pathname=%MAINDIR%\INSTALL.LOG + Message Font=MS Sans Serif + Font Size=8 + Disk Filename=SETUP + Patch Flags=0000000000000001 + Patch Threshold=85 + Patch Memory=4000 + FTP Cluster Size=20 + Dialogs Version=6 + Variable Name1=_SYS_ + Variable Default1=C:\WINDOWS\SYSTEM + Variable Flags1=00001000 + Variable Name2=_WISE_ + Variable Default2=C:\PROGRAM FILES\WISE INSTALLBUILDER + Variable Flags2=00001000 +end +item: Get Temporary Filename + Variable=READMEFILE +end +item: Install File + Source=<<<dirs.source>>>\nt\Wise\Copying.txt + Destination=%TEMP%\%READMEFILE% + Flags=0000000000100010 +end +item: Open/Close INSTALL.LOG + Flags=00000001 +end +item: Check if File/Dir Exists + Pathname=%SYS% + Flags=10000100 +end +item: Set Variable + Variable=SYS + Value=%WIN% +end +item: End Block +end +item: Set Variable + Variable=APPTITLE + Value=<<<version.title>>> + Flags=10000000 +end +item: Set Variable + Variable=GROUP + Value=XEmacs + Flags=10000000 +end +item: Set Variable + Variable=DISABLED + Value=! +end +item: Set Variable + Variable=MAINDIR + Value=XEmacs + Flags=10000000 +end +item: Check Configuration + Flags=10111011 +end +item: Get Registry Key Value + Variable=COMMON + Key=SOFTWARE\Microsoft\Windows\CurrentVersion + Default=C:\Program Files\Common Files + Value Name=CommonFilesDir + Flags=00000100 +end +item: Get Registry Key Value + Variable=PROGRAM_FILES + Key=SOFTWARE\Microsoft\Windows\CurrentVersion + Default=C:\Program Files + Value Name=ProgramFilesDir + Flags=00000100 +end +item: Set Variable + Variable=MAINDIR + Value=%PROGRAM_FILES%\%MAINDIR% + Flags=00001100 +end +item: Set Variable + Variable=EXPLORER + Value=1 +end +item: Else Statement +end +item: Set Variable + Variable=MAINDIR + Value=C:\%MAINDIR% + Flags=00001100 +end +item: End Block +end +item: Set Variable + Variable=BACKUP + Value=%MAINDIR%\BACKUP + Flags=10000000 +end +item: Set Variable + Variable=DOBACKUP + Value=B + Flags=10000000 +end +item: Set Variable + Variable=COMPONENTS + Value=ACE + Flags=10000000 +end +<<<set_category_defaults()>>> +item: Wizard Block + Direction Variable=DIRECTION + Display Variable=DISPLAY + Bitmap Pathname=<<<dirs.source>>>\nt\Wise\gnu.bmp + X Position=9 + Y Position=10 + Filler Color=8421440 + Dialog=Select Program Manager Group + Dialog=Select Backup Directory + Dialog=Display Registration Information + Dialog=Get Registration Information + Variable=EXPLORER + Variable=DOBACKUP + Variable=DOBRAND + Variable=DOBRAND + Value=1 + Value=A + Value=1 + Value=1 + Compare=0 + Compare=1 + Compare=0 + Compare=1 + Flags=00000011 +end +item: Custom Dialog Set + Name=Welcome + Display Variable=DISPLAY + item: Dialog + Title=Welcome + Title French=Bienvenue + Title German=Willkommen + Title Portuguese=Bem-vindo + Title Spanish=Bienvenido + Title Italian=Benvenuto + Title Danish=Velkommen + Title Dutch=Welkom + Title Norwegian=Velkommen + Title Swedish=Välkommen + Width=280 + Height=224 + Font Name=Helv + Font Size=8 + item: Push Button + Rectangle=172 185 214 199 + Variable=DIRECTION + Value=N + Create Flags=01010000000000010000000000000001 + Text=&Next > + Text French=&Suivant> + Text German=&Weiter> + Text Portuguese=&Próximo> + Text Spanish=&Siguiente > + Text Italian=&Avanti > + Text Danish=&Næste> + Text Dutch=&Volgende> + Text Norwegian=&Neste> + Text Swedish=&Nästa > + end + item: Push Button + Rectangle=222 185 264 199 + Action=3 + Create Flags=01010000000000010000000000000000 + Text=Cancel + Text French=Annuler + Text German=Abbrechen + Text Portuguese=Cancelar + Text Spanish=Cancelar + Text Italian=Annulla + Text Danish=Annuller + Text Dutch=Annuleren + Text Norwegian=Avbryt + Text Swedish=Avbryt + end + item: Static + Rectangle=9 177 263 178 + Action=3 + Create Flags=01010000000000000000000000000111 + end + item: Static + Rectangle=91 22 245 118 + Enabled Color=00000000000000001111111111111111 + Create Flags=01010000000000000000000000000000 + Text=<<<version.welcome>>> + end + end +end +item: Custom Dialog Set + Name=Display ReadMe + Display Variable=DISPLAY + item: Dialog + Title=Read Me File + Title French=Fichier Lisez-moi + Title German=Liesmich-Datei + Title Portuguese=Ficheiro Leia-me + Title Spanish=Archivo Léeme + Title Italian=File Leggimi + Title Danish=Vigtigt fil + Title Dutch=Leesmij-bestand + Title Norwegian=Informasjonsfil + Title Swedish=Läs mig-fil + Width=280 + Height=224 + Font Name=Helv + Font Size=8 + item: Push Button + Rectangle=172 185 214 199 + Variable=DIRECTION + Value=N + Create Flags=01010000000000010000000000000001 + Text=I &Agree > + Text French=&Suivant> + Text German=&Weiter> + Text Portuguese=&Próximo> + Text Spanish=&Siguiente > + Text Italian=&Avanti > + Text Danish=&Næste> + Text Dutch=&Volgende> + Text Norwegian=&Neste> + Text Swedish=&Nästa > + end + item: Push Button + Rectangle=222 185 264 199 + Action=3 + Create Flags=01010000000000010000000000000000 + Text=Cancel + Text French=Annuler + Text German=Abbrechen + Text Portuguese=Cancelar + Text Spanish=Cancelar + Text Italian=Annulla + Text Danish=Slet + Text Dutch=Annuleren + Text Norwegian=Avbryt + Text Swedish=Avbryt + end + item: Static + Rectangle=9 177 263 178 + Action=3 + Create Flags=01010000000000000000000000000111 + end + item: Editbox + Rectangle=85 11 254 170 + Value=%TEMP%\%READMEFILE% + Help Context=16711681 + Create Flags=01010000101000000000100000000100 + end + end +end +item: Custom Dialog Set + Name=Select Destination Directory + Display Variable=DISPLAY + item: Dialog + Title=Choose Destination Location + Title French=Choisissez la localisation de destination + Title German=Zielpfad wählen + Title Portuguese=Escolher Local de Destino + Title Spanish=Elegir una localización de destino + Title Italian=Scegli Posizione di Destinazione + Title Danish=Vælg destinationsmappe + Title Dutch=Kies doellocatie + Title Norwegian=Velg målplassering + Title Swedish=Välj ställe för installationen + Width=280 + Height=224 + Font Name=Helv + Font Size=8 + item: Push Button + Rectangle=172 185 214 199 + Variable=DIRECTION + Value=N + Create Flags=01010000000000010000000000000001 + Text=&Next > + Text French=&Suivant> + Text German=&Weiter> + Text Portuguese=&Próximo> + Text Spanish=&Siguiente > + Text Italian=&Avanti > + Text Danish=&Næste> + Text Dutch=&Volgende> + Text Norwegian=&Neste> + Text Swedish=&Nästa > + end + item: Push Button + Rectangle=130 185 172 199 + Variable=DIRECTION + Value=B + Create Flags=01010000000000010000000000000000 + Flags=0000000000000001 + Text=< &Back + Text French=<&Retour + Text German=<&Zurück + Text Portuguese=<&Retornar + Text Spanish=<&Retroceder + Text Italian=< &Indietro + Text Danish=<&Tilbage + Text Dutch=<&Terug + Text Norwegian=<&Tilbake + Text Swedish=< &Tillbaka + end + item: Push Button + Rectangle=222 185 264 199 + Action=3 + Create Flags=01010000000000010000000000000000 + Text=Cancel + Text French=Annuler + Text German=Abbrechen + Text Portuguese=Cancelar + Text Spanish=Cancelar + Text Italian=Annulla + Text Danish=Annuller + Text Dutch=Annuleren + Text Norwegian=Avbryt + Text Swedish=Avbryt + end + item: Static + Rectangle=9 177 263 178 + Action=3 + Create Flags=01010000000000000000000000000111 + end + item: Static + Rectangle=90 10 260 122 + Create Flags=01010000000000000000000000000000 + Text=Setup will install %APPTITLE% in the following folder. + Text= + Text=To install into a different folder, click Browse, and select another folder. + Text= + Text=You can choose not to install %APPTITLE% by clicking Cancel to exit Setup. + Text French=%APPTITLE% va être installé dans le répertoire ci-dessous + Text French= + Text French=Pour l'installer dans un répertoire différent, cliquez sur Parcourir et sélectionnez un autre répertoire + Text French= + Text French=Vous pouvez choisir de ne pas installer %APPTITLE% en cliquant sur Annuler pour quitter l'Installation + Text German=Installation speichert %APPTITLE% im unten angegebenen Ordner: + Text German= + Text German=Zur Installation in einem anderen Ordner auf Blättern klicken und einen anderen Ordner wählen. + Text German= + Text German=Wenn Sie %APPTITLE% nicht installieren möchten, können Sie durch Klicken auf Abbrechen die Installation beenden. + Text Portuguese=Configuração instalará %APPTITLE% na seguinte pasta + Text Portuguese= + Text Portuguese=Para instalar numa pasta diferente, faça um clique sobre Procurar, e seleccione uma outra pasta. + Text Portuguese= + Text Portuguese=Pode escolher não instalar %APPTITLE% clicando no botão Cancelar para sair da Configuração + Text Spanish=El programa de Configuración instalará %APPTITLE% en la siguiente carpeta. + Text Spanish= + Text Spanish=Para instalar en una carpeta diferente, haga un clic en Visualizar, y seleccione otra carpeta. + Text Spanish= + Text Spanish=Puede elegir no instalar %APPTITLE% haciendo un clic en Cancelar para salir de Configuración. + Text Italian=Il programma di installazione installerà %APPTITLE% nella seguente cartella. + Text Italian= + Text Italian=Per effettuare l’installazione in una cartella diversa, fai clic su Sfoglia, e scegli un’altra cartella. + Text Italian= + Text Italian=Puoi scegliere di non installare %APPTITLE% facendo clic su Annulla per uscire dal programma di installazione + Text Danish=Installationsprogrammet installerer %APPTITLE% i denne mappe. + Text Danish= + Text Danish=Man installerer i en anden mappe ved at klikke på Browse og vælge en anden mappe. + Text Danish= + Text Danish=Man kan vælge ikke at installere %APPTITLE% ved at klikke på Slet og forlade installationsprogrammet. + Text Dutch=Het installatieprogramma installeert %APPTITLE% in de volgende directory. + Text Dutch= + Text Dutch=Als u het in een andere directory wilt installeren, klik dan op Bladeren en kies een andere locatie. + Text Dutch= + Text Dutch=U kunt ervoor kiezen om %APPTITLE% niet te installeren: klik op Annuleren om het installatieprogramma te verlaten. + Text Norwegian=Oppsett vil installere %APPTITLE% i følgende mappe. + Text Norwegian= + Text Norwegian=For å installere i en annen mappe, klikk Bla igjennom og velg en annen mappe. + Text Norwegian= + Text Norwegian=Du kan velge å ikke installere %APPTITLE% ved å velge Avbryt for å gå ut av Oppsett. + Text Swedish=Installationsprogrammet installerar %APPTITLE% i följande mapp. + Text Swedish= + Text Swedish=Om du vill att installationen ska göras i en annan mapp, klickar du på Bläddra och väljer en annan mapp. + Text Swedish= + Text Swedish=Du kan välja att inte installera %APPTITLE% genom att klicka på Avbryt för att lämna installationsprogrammet. + end + item: Static + Rectangle=90 134 260 162 + Action=1 + Create Flags=01010000000000000000000000000111 + Text=Destination Folder + Text French=Répertoire de destination + Text German=Zielordner + Text Portuguese=Pasta de Destino + Text Spanish=Carpeta de Destino + Text Italian=Cartella di destinazione + Text Danish=Destinationsmappe + Text Dutch=Doeldirectory + Text Norwegian=Målmappe + Text Swedish=Destinationsmapp + end + item: Push Button + Rectangle=213 143 255 157 + Variable=MAINDIR_SAVE + Value=%MAINDIR% + Destination Dialog=1 + Action=2 + Create Flags=01010000000000010000000000000000 + Text=B&rowse... + Text French=P&arcourir + Text German=B&lättern... + Text Portuguese=P&rocurar + Text Spanish=V&isualizar... + Text Italian=Sfoglia... + Text Danish=&Gennemse... + Text Dutch=B&laderen... + Text Norwegian=Bla igjennom + Text Swedish=&Bläddra + end + item: Static + Rectangle=95 146 211 157 + Destination Dialog=2 + Create Flags=01010000000000000000000000000000 + Text=%MAINDIR% + Text French=%MAINDIR% + Text German=%MAINDIR% + Text Portuguese=%MAINDIR% + Text Spanish=%MAINDIR% + Text Italian=%MAINDIR% + Text Danish=%MAINDIR% + Text Dutch=%MAINDIR% + Text Norwegian=%MAINDIR% + Text Swedish=%MAINDIR% + end + end + item: Dialog + Title=Select Destination Directory + Title French=Choisissez le répertoire de destination + Title German=Zielverzeichnis wählen + Title Portuguese=Seleccionar Directório de Destino + Title Spanish=Seleccione el Directorio de Destino + Title Italian=Seleziona Directory di destinazione + Title Danish=Vælg Destinationsbibliotek + Title Dutch=Kies doeldirectory + Title Norwegian=Velg målkatalog + Title Swedish=Välj destinationskalatog + Width=221 + Height=173 + Font Name=Helv + Font Size=8 + item: Listbox + Rectangle=5 2 160 149 + Variable=MAINDIR + Create Flags=01010000100000010000000101000000 + Flags=0000110000100010 + Text=%MAINDIR% + Text French=%MAINDIR% + Text German=%MAINDIR% + Text Portuguese=%MAINDIR% + Text Spanish=%MAINDIR% + Text Italian=%MAINDIR% + Text Danish=%MAINDIR% + Text Dutch=%MAINDIR% + Text Norwegian=%MAINDIR% + Text Swedish=%MAINDIR% + end + item: Push Button + Rectangle=167 6 212 21 + Create Flags=01010000000000010000000000000001 + Text=OK + Text French=OK + Text German=OK + Text Portuguese=OK + Text Spanish=ACEPTAR + Text Italian=OK + Text Danish=OK + Text Dutch=OK + Text Norwegian=OK + Text Swedish=OK + end + item: Push Button + Rectangle=167 25 212 40 + Variable=MAINDIR + Value=%MAINDIR_SAVE% + Create Flags=01010000000000010000000000000000 + Flags=0000000000000001 + Text=Cancel + Text French=Annuler + Text German=Abbrechen + Text Portuguese=Cancelar + Text Spanish=Cancelar + Text Italian=Annulla + Text Danish=Slet + Text Dutch=Annuleren + Text Norwegian=Avbryt + Text Swedish=Avbryt + end + end +end +item: Custom Dialog Set + Name=Select Packages + Display Variable=DISPLAY + item: Dialog + Title=Select Packages + Width=271 + Height=224 + Font Name=Helv + Font Size=8 + item: Push Button + Rectangle=150 187 195 202 + Variable=DIRECTION + Value=N + Create Flags=01010000000000010000000000000001 + Text=&Next > + Text French=&Suite > + Text German=&Weiter > + Text Spanish=&Siguiente > + Text Italian=&Avanti > + end + item: Push Button + Rectangle=105 187 150 202 + Variable=DIRECTION + Value=B + Create Flags=01010000000000010000000000000000 + Text=< &Back + Text French=< &Retour + Text German=< &Zurück + Text Spanish=< &Atrás + Text Italian=< &Indietro + end + item: Push Button + Rectangle=211 187 256 202 + Action=3 + Create Flags=01010000000000010000000000000000 + Text=&Cancel + Text French=&Annuler + Text German=&Abbrechen + Text Spanish=&Cancelar + Text Italian=&Annulla + end + item: Static + Rectangle=8 180 256 181 + Action=3 + Create Flags=01010000000000000000000000000111 + end + item: Static + Rectangle=86 8 258 28 + Create Flags=01010000000000000000000000000000 + Flags=0000000000000001 + Name=Times New Roman + Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18 + Text=Select Packages + Text French=Sélectionner les composants + Text German=Komponenten auswählen + Text Spanish=Seleccione componentes + Text Italian=Selezionare i componenti + end + item: Checkbox + Rectangle=83 62 211 146 + Variable=COMPONENTS LIBS,COMM,OA,OS,PROG,WP,GAMES + Create Flags=01010000000000010000000000000011 + Flags=0000000000000110 + Text=Libraries + Text=Communication + Text=Productivity + Text=Operating System + Text=Programming + Text=Word Processing + Text=Games and Amusements + Text= + end + item: Static + Rectangle=194 162 242 172 + Variable=COMPONENTS, LIBS, COMM, OA, OS, PROG, WP, GAMES + Value=MAINDIR + Create Flags=01010000000000000000000000000010 + end + item: Static + Rectangle=194 153 242 162 + Variable=COMPONENTS, LIBS, COMM, OA, OS, PROG, WP, GAMES + Create Flags=01010000000000000000000000000010 + end + item: Static + Rectangle=107 153 196 164 + Create Flags=01010000000000000000000000000000 + Text=Disk Space Required: + Text French=Espace disque requis : + Text German=Notwendiger Speicherplatz: + Text Spanish=Espacio requerido en el disco: + Text Italian=Spazio su disco necessario: + end + item: Static + Rectangle=107 162 196 172 + Create Flags=01010000000000000000000000000000 + Text=Disk Space Remaining: + Text French=Espace disque disponible : + Text German=Verbleibender Speicherplatz: + Text Spanish=Espacio en disco disponible: + Text Italian=Spazio su disco disponibile: + end + item: Static + Rectangle=80 146 256 175 + Action=1 + Create Flags=01010000000000000000000000000111 + end + item: Static + Rectangle=83 30 256 57 + Create Flags=01010000000000000000000000000000 + Text=Choose which package categories to install by checking the boxes below. Press the Options buttons to select individual packages. + Text French=Choisissez les composants que vous voulez installer en cochant les cases ci-dessous. + Text German=Wählen Sie die zu installierenden Komponenten, indem Sie in die entsprechenden Kästchen klicken. + Text Spanish=Elija los componentes que desee instalar marcando los cuadros de abajo. + Text Italian=Scegliere quali componenti installare selezionando le caselle sottostanti. + end + item: Push Button + Rectangle=230 62 254 72 + Variable=LIBS_SAVE + Value=%LIBS% + Destination Dialog=1 + Action=2 + Create Flags=01010000000000010000000000000000 + Text=Options + Text French=&Annuler + Text German=&Abbrechen + Text Spanish=&Cancelar + Text Italian=&Annulla + end + item: Push Button + Rectangle=230 74 254 84 + Variable=COMM_SAVE + Value=%COMM% + Destination Dialog=2 + Action=2 + Create Flags=01010000000000010000000000000000 + Text=Options + Text French=&Annuler + Text German=&Abbrechen + Text Spanish=&Cancelar + Text Italian=&Annulla + end + item: Push Button + Rectangle=230 86 254 96 + Variable=OA_SAVE + Value=%OA% + Destination Dialog=3 + Action=2 + Create Flags=01010000000000010000000000000000 + Text=Options + Text French=&Annuler + Text German=&Abbrechen + Text Spanish=&Cancelar + Text Italian=&Annulla + end + item: Push Button + Rectangle=230 98 254 108 + Variable=OS_SAVE + Value=%OS% + Destination Dialog=4 + Action=2 + Create Flags=01010000000000010000000000000000 + Text=Options + Text French=&Annuler + Text German=&Abbrechen + Text Spanish=&Cancelar + Text Italian=&Annulla + end + item: Push Button + Rectangle=230 110 254 120 + Variable=PROG_SAVE + Value=%PROG% + Destination Dialog=5 + Action=2 + Create Flags=01010000000000010000000000000000 + Text=Options + Text French=&Annuler + Text German=&Abbrechen + Text Spanish=&Cancelar + Text Italian=&Annulla + end + item: Push Button + Rectangle=230 122 254 132 + Variable=WP_SAVE + Value=%WP% + Destination Dialog=6 + Action=2 + Create Flags=01010000000000010000000000000000 + Text=Options + Text French=&Annuler + Text German=&Abbrechen + Text Spanish=&Cancelar + Text Italian=&Annulla + end + item: Push Button + Rectangle=230 134 254 144 + Variable=GAMES_SAVE + Value=%GAMES% + Destination Dialog=7 + Action=2 + Create Flags=01010000000000010000000000000000 + Text=Options + Text French=&Annuler + Text German=&Abbrechen + Text Spanish=&Cancelar + Text Italian=&Annulla + end + item: Set Variable + Variable=COMPONENTS + Value=X + Flags=00000001 + end + end +<<<string.join(map(category_dialog,packages.category_names),"")>>> +end +item: Custom Dialog Set + Name=Select Program Manager Group + Display Variable=DISPLAY + item: Dialog + Title=Select Program Manager Group + Title French=Sélectionnez le Groupe du Gestionnaire de Programmes + Title German=Programm-Managergruppe wählen + Title Portuguese=Seleccionar o Grupo Gestor de Programas + Title Spanish=Seleccione el Grupo del Administrador del Programa + Title Italian=Seleziona il gruppo Program Manager + Title Danish=Vælg Programstyringsgruppen + Title Dutch=Kies Programmabeheergroep. + Title Norwegian=Velg Programbehandlingsgruppen + Title Swedish=Välj grupp i Programhanteraren + Width=280 + Height=224 + Font Name=Helv + Font Size=8 + item: Push Button + Rectangle=172 185 214 199 + Variable=DIRECTION + Value=N + Create Flags=01010000000000010000000000000001 + Text=&Next > + Text French=&Suivant> + Text German=&Weiter> + Text Portuguese=&Próximo> + Text Spanish=&Siguiente > + Text Italian=&Avanti > + Text Danish=&Næste> + Text Dutch=&Volgende> + Text Norwegian=&Neste> + Text Swedish=&Nästa > + end + item: Push Button + Rectangle=130 185 172 199 + Variable=DIRECTION + Value=B + Create Flags=01010000000000010000000000000000 + Flags=0000000000000001 + Text=< &Back + Text French=<&Retour + Text German=<&Zurück + Text Portuguese=<&Retornar + Text Spanish=<&Retroceder + Text Italian=< &Indietro + Text Danish=<&Back + Text Dutch=<&Terug + Text Norwegian=<&Tilbake + Text Swedish=< &Tillbaka + end + item: Push Button + Rectangle=222 185 264 199 + Action=3 + Create Flags=01010000000000010000000000000000 + Text=Cancel + Text French=Annuler + Text German=Abbrechen + Text Portuguese=Cancelar + Text Spanish=Cancelar + Text Italian=Annulla + Text Danish=Slet + Text Dutch=Annuleren + Text Norwegian=Avbryt + Text Swedish=Avbryt + end + item: Static + Rectangle=9 177 263 178 + Action=3 + Create Flags=01010000000000000000000000000111 + end + item: Static + Rectangle=90 10 260 38 + Create Flags=01010000000000000000000000000000 + Text=Enter the name of the Program Manager group to add %APPTITLE% icons to: + Text French=Entrez le nom du groupe du Gestionnaire de Programmes où placer les icônes %APPTITLE% à : + Text German=Den Namen der Programm-Managergruppe wählen, in der die %APPTITLE%-Symbole gespeichert werden sollen: + Text Portuguese=Introduzir o nome do Grupo Gestor de Programa para acrescentar os ícones %APPTITLE% para: + Text Spanish=Introduzca el nombre del grupo del Administrador del Programa para añadir los iconos %APPTITLE para: + Text Italian=Inserisci il nome del gruppo Program Manager per aggiungere le icone di %APPTITLE% a: + Text Danish=Indtast navnet på Programstyringsgruppen der skal tilføjes %APPTITLE% elementer: + Text Dutch=Breng de naam van de programmabeheergroep in waaraan u %APPTITLE%-pictogrammen wilt toevoegen. + Text Norwegian=Tast inn navnet på programbehandlingsgruppen for å legge %APPTITLE%-ikoner til: + Text Swedish=Skriv in namnet på den grupp i Programhanteraren där du vill ha ikonerna för %APPTITLE%: + end + item: Combobox + Rectangle=90 42 260 148 + Variable=GROUP + Create Flags=01010000001000010000001100000001 + Flags=0000000000000001 + Text=%GROUP% + Text= + Text French=%GROUP% + Text French= + Text German=%GROUP% + Text German= + Text Portuguese=%GROUP% + Text Portuguese= + Text Spanish=%GROUP% + Text Spanish= + Text Italian=%GROUP% + Text Italian= + Text Danish=%GROUP% + Text Danish= + Text Dutch=%GROUP% + Text Dutch= + Text Norwegian=%GROUP% + Text Norwegian= + Text Swedish=%GROUP% + Text Swedish= + end + end +end +item: Custom Dialog Set + Name=Start Installation + Display Variable=DISPLAY + item: Dialog + Title=Start Installation + Title French=Commencer l'installation + Title German=Installation beginnen + Title Portuguese=Iniciar Instalação + Title Spanish=Comenzar la Instalación + Title Italian=Avvia Installazione + Title Danish=Start installationen + Title Dutch=Start de installatie. + Title Norwegian=Start installeringen + Title Swedish=Starta installationen + Width=280 + Height=224 + Font Name=Helv + Font Size=8 + item: Push Button + Rectangle=172 185 214 199 + Variable=DIRECTION + Value=N + Create Flags=01010000000000010000000000000001 + Text=&Next > + Text French=&Suivant> + Text German=&Weiter> + Text Portuguese=&Próximo> + Text Spanish=&Siguiente > + Text Italian=&Avanti > + Text Danish=&Næste> + Text Dutch=&Volgende> + Text Norwegian=&Neste> + Text Swedish=&Nästa > + end + item: Push Button + Rectangle=130 185 172 199 + Variable=DIRECTION + Value=B + Create Flags=01010000000000010000000000000000 + Text=< &Back + Text French=<&Retour + Text German=<&Zurück + Text Portuguese=<&Retornar + Text Spanish=<&Retroceder + Text Italian=< &Indietro + Text Danish=<&Tilbage + Text Dutch=<&Terug + Text Norwegian=<&Tilbake + Text Swedish=< &Tillbaka + end + item: Push Button + Rectangle=222 185 264 199 + Action=3 + Create Flags=01010000000000010000000000000000 + Text=Cancel + Text French=Annuler + Text German=Abbrechen + Text Portuguese=Cancelar + Text Spanish=Cancelar + Text Italian=Annulla + Text Danish=Annuller + Text Dutch=Annuleren + Text Norwegian=Avbryt + Text Swedish=Avbryt + end + item: Static + Rectangle=9 177 263 178 + Action=3 + Create Flags=01010000000000000000000000000111 + end + item: Static + Rectangle=90 10 260 70 + Create Flags=01010000000000000000000000000000 + Text=You are now ready to install %APPTITLE%. + Text= + Text=Press the Next button to begin the installation or the Back button to reenter the installation information. + Text French=Vous êtes maintenant prêt à installer %APPTITLE% + Text French= + Text French=Cliquez sur Suivant pour commencer l'installation ou Retour pour entrer à nouveau les informations d'installation + Text German=Sie sind jetzt zur Installation von %APPTITLE% bereit. + Text German= + Text German=Auf die Schaltfläche Weiter klicken, um mit dem Start der Installation zu beginnen, oder auf die Schaltfläche Zurück, um die Installationsinformationen nochmals aufzurufen. + Text Portuguese=Está agora pronto para instalar %APPTITLE% + Text Portuguese= + Text Portuguese=Pressione o botão Próximo para começar a instalação ou o botão Retornar para introduzir novamente a informação sobre a instalação + Text Spanish=Ahora estará listo para instalar %APPTITLE%. + Text Spanish= + Text Spanish=Pulse el botón de Próximo para comenzar la instalación o el botón Retroceder para volver a introducir la información sobre la instalación. + Text Italian=Sei pronto ad installare %APPTITLE%. + Text Italian= + Text Italian=Premi il tasto Avanti per iniziare l’installazione o il tasto Indietro per rientrare nuovamente nei dati sull’installazione + Text Danish=Du er nu klar til at installere %APPTITLE%. + Text Danish= + Text Danish=Klik på Næste for at starte installationen eller på Tilbage for at ændre installationsoplysningerne. + Text Dutch=U bent nu klaar om %APPTITLE% te installeren. + Text Dutch= + Text Dutch=Druk op Volgende om met de installatie te beginnen of op Terug om de installatie-informatie opnieuw in te voeren. + Text Norwegian=Du er nå klar til å installere %APPTITLE% + Text Norwegian= + Text Norwegian=Trykk på Neste-tasten for å starte installeringen, eller Tilbake-tasten for å taste inn installasjonsinformasjonen på nytt. + Text Swedish=Du är nu redo att installera %APPTITLE%. + Text Swedish= + Text Swedish=Tryck på Nästa för att starta installationen eller på Tillbaka för att skriva in installationsinformationen på nytt. + end + end +end +item: If/While Statement + Variable=DISPLAY + Value=Select Destination Directory +end +item: Set Variable + Variable=BACKUP + Value=%MAINDIR%\BACKUP +end +item: End Block +end +item: End Block +end +item: If/While Statement + Variable=DOBACKUP + Value=A +end +item: Set Variable + Variable=BACKUPDIR + Value=%BACKUP% +end +item: End Block +end +item: Open/Close INSTALL.LOG +end +item: Check Disk Space + Component=COMPONENTS +end +item: Display Graphic + Pathname=<<<dirs.source>>>\nt\Wise\xemacs-beta.bmp + X Position=32784 + Y Position=16 +end +item: Include Script + Pathname=%_WISE_%\INCLUDE\uninstal.wse +end +<<<ifblock("COMPONENTS","X")>>> +<<<string.join(map(lambda x:install_file(x[0],x[1],x[2]),filelist.all),"")>>> +<<<endblock()>>> +<<<map(do_category,packages.category_names)>>> +item: Set Variable + Variable=COMMON + Value=%COMMON% + Flags=00010100 +end +item: Set Variable + Variable=MAINDIR + Value=%MAINDIR% + Flags=00010100 +end +item: Check Configuration + Flags=10111011 +end +item: Get Registry Key Value + Variable=STARTUPDIR + Key=Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders + Default=%WIN%\Start Menu\Programs\StartUp + Value Name=StartUp + Flags=00000010 +end +item: Get Registry Key Value + Variable=DESKTOPDIR + Key=Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders + Default=%WIN%\Desktop + Value Name=Desktop + Flags=00000010 +end +item: Get Registry Key Value + Variable=STARTMENUDIR + Key=Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders + Default=%WIN%\Start Menu + Value Name=Start Menu + Flags=00000010 +end +item: Get Registry Key Value + Variable=GROUPDIR + Key=Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders + Default=%WIN%\Start Menu\Programs + Value Name=Programs + Flags=00000010 +end +item: Get Registry Key Value + Variable=CSTARTUPDIR + Key=Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders + Default=%STARTUPDIR% + Value Name=Common Startup + Flags=00000100 +end +item: Get Registry Key Value + Variable=CDESKTOPDIR + Key=Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders + Default=%DESKTOPDIR% + Value Name=Common Desktop + Flags=00000100 +end +item: Get Registry Key Value + Variable=CSTARTMENUDIR + Key=Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders + Default=%STARTMENUDIR% + Value Name=Common Start Menu + Flags=00000100 +end +item: Get Registry Key Value + Variable=CGROUPDIR + Key=Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders + Default=%GROUPDIR% + Value Name=Common Programs + Flags=00000100 +end +item: Set Variable + Variable=CGROUP_SAVE + Value=%GROUP% +end +item: Set Variable + Variable=GROUP + Value=%GROUPDIR%\%GROUP% +end +item: Create Shortcut + Source=%MAINDIR%\<<<dirs.dst>>>\i386-pc-win32\runemacs.exe + Destination=%GROUP%\XEmacs.lnk + Working Directory=\ + Icon Number=0 +end +item: Create Shortcut + Source=%MAINDIR%\<<<dirs.dst>>>\i386-pc-win32\runemacs.exe + Destination=%DESKTOPDIR%\XEmacs.lnk + Working Directory=\ + Icon Number=0 +end +item: Else Statement +end +item: Add ProgMan Icon + Group=%GROUP% + Icon Name=XEmacs + Command Line=%MAINDIR%\<<<dirs.dst>>>\i386-pc-win32\runemacs.exe + Default Directory=\ + Flags=01000000 +end +item: End Block +end +item: Edit Registry + Total Keys=16 + item: Key + Key=SOFTWARE\GNU\XEmacs + New Value=%MAINDIR% + Value Name=emacs_dir + Root=2 + end + item: Key + Key=SOFTWARE\GNU\XEmacs + New Value=%MAINDIR%\xemacs-packages + Value Name=EMACSPACKAGEPATH + Root=2 + end + item: Key + Key=SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\runemacs.exe + New Value=%MAINDIR%\<<<dirs.dst>>>\i386-pc-win32 + Value Name=Path + Root=2 + end + item: Key + Key=SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\xemacs.exe + New Value=%MAINDIR%\<<<dirs.dst>>>\i386-pc-win32 + Value Name=Path + Root=2 + end + item: Key + Key=.el + New Value=elfile + end + item: Key + Key=.el + New Value=text/plain + Value Name=Content Type + end + item: Key + Key=elfile + New Value=Emacs lisp + end + item: Key + Key=elfile + New Value=00 00 01 00 + Value Name=EditFlags + Data Type=4 + end + item: Key + Key=elfile\DefaultIcon + New Value=%MAINDIR%\<<<dirs.dst>>>\i386-pc-win32\runemacs.exe,2 + end + item: Key + Key=elfile\QuickView + New Value=* + end + item: Key + Key=elfile\Shell + New Value= + end + item: Key + Key=elfile\Shell\open + end + item: Key + Key=elfile\Shell\open\command + New Value=%MAINDIR%\<<<dirs.dst>>>\i386-pc-win32\runemacs.exe "%%1" + end + item: Key + Key=elfile\Shell\open\ddeexec + New Value=open("%%1") + end + item: Key + Key=elfile\Shell\open\ddeexec\Application + New Value=XEmacs + New Value= + end + item: Key + Key=elfile\Shell\open\ddeexec\topic + New Value=System + end +end +item: Wizard Block + Direction Variable=DIRECTION + Display Variable=DISPLAY + Bitmap Pathname=<<<dirs.source>>>\nt\Wise\gnu.bmp + X Position=9 + Y Position=10 + Filler Color=8421440 + Flags=00000011 +end +item: Custom Dialog Set + Name=Finished + Display Variable=DISPLAY + item: Dialog + Title=Installation Complete + Title French=Installation en cours + Title German=Installation abgeschlossen + Title Portuguese=Instalação Completa + Title Spanish=Se ha completado la Instalación + Title Italian=Installazione completata + Title Danish=Installation gennemført + Title Dutch=Installatie afgerond + Title Norwegian=Installasjonen er fullført + Title Swedish=Installationen klar + Width=280 + Height=224 + Font Name=Helv + Font Size=8 + item: Push Button + Rectangle=170 185 212 199 + Variable=DIRECTION + Value=N + Create Flags=01010000000000010000000000000001 + Text=&Finish > + Text French=&Terminer> + Text German=&Fertigstellen> + Text Portuguese=&Terminar > + Text Spanish=&Finalizar> + Text Italian=&Fine > + Text Danish=&Afslut > + Text Dutch=&Klaar> + Text Norwegian=&Avslutt> + Text Swedish=&Sluta> + end + item: Push Button + Control Name=CANCEL + Rectangle=222 185 264 199 + Action=3 + Create Flags=01010000000000010000000000000000 + Text=Cancel + Text French=Annuler + Text German=Abbrechen + Text Portuguese=Cancelar + Text Spanish=Cancelar + Text Italian=Annulla + Text Danish=Annuller + Text Dutch=Annuleren + Text Norwegian=Avbryt + Text Swedish=Avbryt + end + item: Static + Rectangle=9 177 263 178 + Action=3 + Create Flags=01010000000000000000000000000111 + end + item: Static + Rectangle=90 10 260 63 + Enabled Color=00000000000000001111111111111111 + Create Flags=01010000000000000000000000000000 + Text=%APPTITLE% has been successfully installed. + Text= + Text= + Text=Press the Finish button to exit this installation. + Text= + Text French=L'installation de %APPTITLE% est réussie + Text French= + Text French= + Text French=Cliquez sur Terminer pour quitter cette installation + Text French= + Text German=%APPTITLE% wurde erfolgreich installiert. + Text German= + Text German= + Text German=Zum Beenden dieser Installation Fertigstellen anklicken. + Text German= + Text Portuguese=%APPTITLE% foi instalado com êxito + Text Portuguese= + Text Portuguese= + Text Portuguese=Pressionar o botão Terminar para sair desta instalação + Text Portuguese= + Text Spanish=%APPTITLE% se ha instalado con éxito. + Text Spanish= + Text Spanish= + Text Spanish=Pulse el botón de Finalizar para salir de esta instalación. + Text Spanish= + Text Italian=%APPTITLE% è stato installato. + Text Italian= + Text Italian= + Text Italian=Premi il pulsante Fine per uscire dal programma di installazione + Text Italian= + Text Danish=%APPTITLE% er nu installeret korrekt. + Text Danish= + Text Danish= + Text Danish=Klik på Afslut for at afslutte installationen. + Text Danish= + Text Dutch=%APPTITLE% is met succes geïnstalleerd. + Text Dutch= + Text Dutch= + Text Dutch=Druk op Klaar om deze installatie af te ronden. + Text Dutch= + Text Norwegian=Installasjonen av %APPTITLE% er suksessfull. + Text Norwegian= + Text Norwegian= + Text Norwegian=Trykk på Avslutt-tasten for å avslutte denne installasjonen. + Text Norwegian= + Text Swedish=Installationen av %APPTITLE% har lyckats. + Text Swedish= + Text Swedish= + Text Swedish=Tryck på Sluta för att gå ur installationsprogrammet. + Text Swedish= + end + item: Push Button + Control Name=BACK + Rectangle=128 185 170 199 + Variable=DIRECTION + Value=B + Create Flags=01010000000000010000000000000000 + Text=< &Back + Text French=<&Retour + Text German=<&Zurück + Text Portuguese=<&Retornar + Text Spanish=<&Retroceder + Text Italian=< &Indietro + Text Danish=<&Tilbage + Text Dutch=<&Terug + Text Norwegian=<&Tilbake + Text Swedish=< &Tillbaka + end + item: Set Control Attribute + Control Name=BACK + Operation=1 + end + item: Set Control Attribute + Control Name=CANCEL + Operation=1 + end + end +end +item: End Block +end +item: New Event + Name=Cancel +end +item: Include Script + Pathname=%_WISE_%\INCLUDE\rollback.wse +end diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/minitar.c --- a/nt/minitar.c Mon Aug 13 11:12:06 2007 +0200 +++ b/nt/minitar.c Mon Aug 13 11:13:30 2007 +0200 @@ -13,7 +13,7 @@ #include <stdio.h> -#include <Errno.h> +#include <errno.h> #include <zlib.h> @@ -43,7 +43,6 @@ { char tmp[MAXNAMELEN]; char *cp; - extern int errno; for (cp=path; cp; cp = (char*)strchr(cp+1,'/')){ if (!*cp) @@ -204,6 +203,7 @@ in_block = 0; } } + exit (0); } diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/minitar.mak --- a/nt/minitar.mak Mon Aug 13 11:12:06 2007 +0200 +++ b/nt/minitar.mak Mon Aug 13 11:13:30 2007 +0200 @@ -1,10 +1,12 @@ ZLIB=\path\to\zlib +LIB_SRC=. +NT=. -all: minitar.exe +all: $(LIB_SRC)\minitar.exe -minitar.exe: minitar.obj - cl -o minitar.exe minitar.obj $(ZLIB)\zlib.lib +$(LIB_SRC)\minitar.exe: $(LIB_SRC)\minitar.obj + cl -o $@ $(LIB_SRC)\minitar.obj $(ZLIB)\zlib.lib -minitar.obj: minitar.c - cl -c minitar.c -I $(ZLIB) +$(LIB_SRC)\minitar.obj: $(NT)\minitar.c + cl -Fo$@ -c $(NT)\minitar.c -I $(ZLIB) diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/puresize-adjust.h --- a/nt/puresize-adjust.h Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,3 +0,0 @@ -/* Do not edit this file! - Automatically generated by XEmacs */ -# define PURESIZE_ADJUSTMENT (0) diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/xemacs.mak --- a/nt/xemacs.mak Mon Aug 13 11:12:06 2007 +0200 +++ b/nt/xemacs.mak Mon Aug 13 11:13:30 2007 +0200 @@ -24,15 +24,15 @@ # Synched up with: Not in FSF. # -# Shell escape character. Used for escaping ', ` and " in commands. -ESC=^ - XEMACS=.. LISP=$(XEMACS)\lisp MODULES=$(XEMACS)\modules NT=$(XEMACS)\nt OUTDIR=$(NT)\obj +# Define a variable for the 'del' command to use +DEL=-del + # Program name and version !include "..\version.sh" @@ -120,26 +120,46 @@ !if !defined(HAVE_NATIVE_SOUND) HAVE_NATIVE_SOUND=1 !endif +!if !defined(HAVE_WIDGETS) +HAVE_WIDGETS=1 +!endif !if !defined(DEBUG_XEMACS) DEBUG_XEMACS=0 !endif !if !defined(USE_UNION_TYPE) USE_UNION_TYPE=0 !endif +!if !defined(USE_MINITAR) +USE_MINITAR=1 +!endif !if !defined(USE_MINIMAL_TAGBITS) USE_MINIMAL_TAGBITS=0 !endif !if !defined(USE_INDEXED_LRECORD_IMPLEMENTATION) USE_INDEXED_LRECORD_IMPLEMENTATION=0 !endif +!if !defined(USE_PORTABLE_DUMPER) +USE_PORTABLE_DUMPER=0 +!endif +!if !defined(GUNG_HO) +GUNG_HO=0 +!endif + +# A little bit of adhockery. Default to use system malloc and +# DLL version of the C runtime library when using portable +# dumping. These are the optimal settings. +!if !defined(USE_SYSTEM_MALLOC) +USE_SYSTEM_MALLOC=$(USE_PORTABLE_DUMPER) +!endif +!if !defined(USE_CRTDLL) +USE_CRTDLL=$(USE_PORTABLE_DUMPER) +!endif # # System configuration # !if !defined(OS) OS=Windows_95/98 -# command.com doesn't like or need '^' as an escape character -ESC= EMACS_CONFIGURATION=i586-pc-win32 !else if "$(PROCESSOR_ARCHITECTURE)" == "x86" EMACS_CONFIGURATION=i586-pc-win32 @@ -161,6 +181,19 @@ !message Cannot build InfoDock without InfoDock sources CONFIG_ERROR=1 !endif +!if !$(USE_PORTABLE_DUMPER) && $(USE_SYSTEM_MALLOC) +!message Cannot use system allocator when dumping old way, use portable dumper. +CONFIG_ERROR=1 +!endif +!if !$(USE_PORTABLE_DUMPER) && $(USE_CRTDLL) +!message Cannot use C runtime DLL when dumping old way, use portable dumper. +CONFIG_ERROR=1 +!endif +!if !$(USE_SYSTEM_MALLOC) && $(USE_CRTDLL) +!message GNU malloc currently cannot be used with CRT DLL. +!message [[[Developer note: If you want to fix it, read Q112297 first]]] #### +CONFIG_ERROR=1 +!endif !if !$(HAVE_MSW) && !$(HAVE_X) !message Please specify at least one HAVE_MSW=1 and/or HAVE_X=1 CONFIG_ERROR=1 @@ -238,80 +271,7 @@ !endif # -# Small configuration report -# -!if !defined(CONF_REPORT_ALREADY_PRINTED) -!if [set CONF_REPORT_ALREADY_PRINTED=1] -!endif -!message ------------------------------------------------ -!message XEmacs $(XEMACS_VERSION_STRING) $(xemacs_codename) configured for "$(EMACS_CONFIGURATION)". -!message -!message Installation directory is "$(INSTALL_DIR)". -!message Package path is "$(PACKAGE_PATH)". -!message -!if $(INFODOCK) -!message Building InfoDock. -!endif -!if $(HAVE_MSW) -!message Compiling in support for native GUI. -!endif -!if $(HAVE_X) -!message Compiling in support for X-Windows. -!endif -!if $(HAVE_MULE) -!message Compiling in MULE. -!endif -!if $(HAVE_XPM) -!message Compiling in support for XPM images. -!endif -!if $(HAVE_GIF) -!message Compiling in support for GIF images. -!endif -!if $(HAVE_PNG) -!message Compiling in support for PNG images. -!endif -!if $(HAVE_TIFF) -!message Compiling in support for TIFF images. -!endif -!if $(HAVE_JPEG) -!message Compiling in support for JPEG images. -!endif -!if $(HAVE_XFACE) -!message Compiling in support for X-Face message headers. -!endif -!if $(HAVE_TOOLBARS) -!message Compiling in support for toolbars. -!endif -!if $(HAVE_DIALOGS) -!message Compiling in support for dialogs. -!endif -!if $(HAVE_NATIVE_SOUND) -!message Compiling in support for native sounds. -!endif -!if $(HAVE_MSW_C_DIRED) -# Define HAVE_MSW_C_DIRED to be non-zero if you want XEmacs to use C -# primitives to significantly speed up dired, at the expense of an -# additional ~4KB of code. -!message Compiling in fast dired implementation. -!endif -!if $(USE_MINIMAL_TAGBITS) -!message Using minimal tagbits. -!endif -!if $(USE_INDEXED_LRECORD_IMPLEMENTATION) -!message Using indexed lrecord implementation. -!endif -!if $(USE_UNION_TYPE) -!message Using union type for Lisp object storage. -!endif -!if $(DEBUG_XEMACS) -!message Compiling in extra debug checks. XEmacs will be slow! -!endif -!message ------------------------------------------------ -!message -!endif # !defined(CONF_REPORT_ALREADY_PRINTED) - -# -# Compiler command echo control. Define VERBOSECC=1 to get vebose compilation. +# Compiler command echo control. Define VERBOSECC=1 to get verbose compilation. # !if !defined(VERBOSECC) VERBOSECC=0 @@ -328,7 +288,20 @@ OPT=-O2 -G5 !endif -CFLAGS=-nologo -W3 $(OPT) +!if $(USE_CRTDLL) +!if $(DEBUG_XEMACS) +C_LIBFLAG=-MDd +LIBC_LIB=msvcrtd.lib +!else +C_LIBFLAG=-MD +LIBC_LIB=msvcrt.lib +!endif +!else +C_LIBFLAG=-ML +LIBC_LIB=libc.lib +!endif + +CFLAGS=-nologo -W3 $(OPT) $(C_LIBFLAG) !if $(HAVE_X) X_DEFINES=-DHAVE_X_WINDOWS @@ -386,6 +359,9 @@ MSW_DIALOG_SRC=$(XEMACS)\src\dialog.c $(XEMACS)\src\dialog-msw.c MSW_DIALOG_OBJ=$(OUTDIR)\dialog.obj $(OUTDIR)\dialog-msw.obj !endif +!if $(HAVE_WIDGETS) +MSW_DEFINES=$(MSW_DEFINES) -DHAVE_WIDGETS +!endif !if $(HAVE_NATIVE_SOUND) MSW_DEFINES=$(MSW_DEFINES) -DHAVE_NATIVE_SOUND !endif @@ -410,6 +386,16 @@ UNION_DEFINES=-DUSE_UNION_TYPE !endif +!if $(USE_PORTABLE_DUMPER) +DUMPER_DEFINES=-DPDUMP +!endif + +!if $(USE_SYSTEM_MALLOC) +MALLOC_DEFINES=-DSYSTEM_MALLOC +!else +MALLOC_DEFINES=-DGNU_MALLOC +!endif + # Hard-coded paths !if $(INFODOCK) @@ -426,46 +412,10 @@ DEFINES=$(X_DEFINES) $(MSW_DEFINES) $(MULE_DEFINES) \ $(TAGBITS_DEFINES) $(LRECORD_DEFINES) $(UNION_DEFINES) \ + $(DUMPER_DEFINES) $(MALLOC_DEFINES) \ -DWIN32 -D_WIN32 -DWIN32_LEAN_AND_MEAN -DWINDOWSNT -Demacs \ -DHAVE_CONFIG_H $(PROGRAM_DEFINES) $(PATH_DEFINES) -# -# Creating simplified versions of Installation and Installation.el -# -# Some values cannot be written on the same line with -# their key, since they cannot be put inside an echo command. -# Macro substitution (:"=\", :\=\\) can be performed on values in order -# to create a legal string in LISP for Installation.el. -# -!if [echo OS: $(OS)>Installation] ||\ -[echo XEmacs $(XEMACS_VERSION_STRING) $(xemacs_codename:"=\") configured for $(ESC)`$(EMACS_CONFIGURATION)$(ESC)'.>>Installation] ||\ -[echo Where should the build process find the source code?>>Installation] ||\ -[echo $(MAKEDIR:\=\\)>>Installation] -!endif -# Compiler Information -!if defined(CCV) &&\ -[echo What compiler should XEmacs be built with?>>Installation] &&\ -[echo $(CC) $(CFLAGS)>>Installation] -!endif -# Window System Information -!if [echo What window system should XEmacs use?>>Installation] -!endif -!if (defined (HAVE_X) && $(HAVE_X) == 1) -!if [echo X11>>Installation] -!endif -!endif -!if (defined (HAVE_MSW) && $(HAVE_MSW) == 1) -!if [echo MS Windows>>Installation] -!endif -!endif -# Creation of Installation.el -!if [type Installation] ||\ -[echo (setq Installation-string $(ESC)">Installation.el] ||\ -[type Installation >>Installation.el] ||\ -[echo $(ESC)")>>Installation.el] -!endif - - #------------------------------------------------------------------------------ default: $(OUTDIR)\nul all @@ -476,8 +426,7 @@ XEMACS_INCLUDES=\ $(XEMACS)\src\config.h \ $(XEMACS)\src\Emacs.ad.h \ - $(XEMACS)\src\paths.h \ - $(XEMACS)\src\puresize-adjust.h + $(XEMACS)\src\paths.h $(XEMACS)\src\config.h: config.h copy config.h $(XEMACS)\src @@ -488,9 +437,6 @@ $(XEMACS)\src\paths.h: paths.h copy paths.h $(XEMACS)\src -$(XEMACS)\src\puresize-adjust.h: puresize-adjust.h - copy puresize-adjust.h $(XEMACS)\src - #------------------------------------------------------------------------------ # lib-src programs @@ -505,17 +451,18 @@ !if [echo Creating $(CONFIG_VALUES) && echo ;;; Do not edit this file!>$(CONFIG_VALUES)] !endif # MAKEDIR has to be made into a string. -!if [echo blddir>>$(CONFIG_VALUES) && echo $(ESC)"$(MAKEDIR:\=\\)\\..$(ESC)">>$(CONFIG_VALUES)] +#!if [echo blddir>>$(CONFIG_VALUES) && echo $(ESC)"$(MAKEDIR:\=\\)\\..$(ESC)">>$(CONFIG_VALUES)] +!if [echo blddir>>$(CONFIG_VALUES) && echo "$(MAKEDIR:\=\\)\\..">>$(CONFIG_VALUES)] !endif -!if [echo CC>>$(CONFIG_VALUES) && echo $(ESC)"$(CC:\=\\)$(ESC)">>$(CONFIG_VALUES)] -!endif -!if [echo CFLAGS>>$(CONFIG_VALUES) && echo $(ESC)"$(CFLAGS:\=\\)$(ESC)">>$(CONFIG_VALUES)] +!if [echo CC>>$(CONFIG_VALUES) && echo "$(CC:\=\\)">>$(CONFIG_VALUES)] !endif -!if [echo CPP>>$(CONFIG_VALUES) && echo $(ESC)"$(CPP:\=\\)$(ESC)">>$(CONFIG_VALUES)] +!if [echo CFLAGS>>$(CONFIG_VALUES) && echo "$(CFLAGS:\=\\)">>$(CONFIG_VALUES)] +!endif +!if [echo CPP>>$(CONFIG_VALUES) && echo "$(CPP:\=\\)">>$(CONFIG_VALUES)] !endif -!if [echo CPPFLAGS>>$(CONFIG_VALUES) && echo $(ESC)"$(CPPFLAGS:\=\\)$(ESC)">>$(CONFIG_VALUES)] +!if [echo CPPFLAGS>>$(CONFIG_VALUES) && echo "$(CPPFLAGS:\=\\)">>$(CONFIG_VALUES)] !endif -!if [echo LISPDIR>>$(CONFIG_VALUES) && echo $(ESC)"$(MAKEDIR:\=\\)\\$(LISP:\=\\)$(ESC)">>$(CONFIG_VALUES)] +!if [echo LISPDIR>>$(CONFIG_VALUES) && echo "$(MAKEDIR:\=\\)\\$(LISP:\=\\)">>$(CONFIG_VALUES)] !endif # PATH_PACKAGEPATH is already a quoted string. !if [echo PACKAGE_PATH>>$(CONFIG_VALUES) && echo $(PATH_PACKAGEPATH)>>$(CONFIG_VALUES)] @@ -523,17 +470,19 @@ # Inferred rule {$(LIB_SRC)}.c{$(LIB_SRC)}.exe : - @cd $(LIB_SRC) + cd $(LIB_SRC) $(CCV) -I. -I$(XEMACS)/src -I$(XEMACS)/nt/inc $(LIB_SRC_DEFINES) $(CFLAGS) -Fe$@ $** -link -incremental:no - @cd $(NT) + cd $(NT) # Individual dependencies ETAGS_DEPS = $(LIB_SRC)/getopt.c $(LIB_SRC)/getopt1.c $(LIB_SRC)/../src/regex.c $(LIB_SRC)/etags.exe : $(LIB_SRC)/etags.c $(ETAGS_DEPS) $(LIB_SRC)/movemail.exe: $(LIB_SRC)/movemail.c $(LIB_SRC)/pop.c $(ETAGS_DEPS) - @cd $(LIB_SRC) + cd $(LIB_SRC) $(CCV) -I. -I$(XEMACS)/src -I$(XEMACS)/nt/inc $(LIB_SRC_DEFINES) $(CFLAGS) -Fe$@ $** wsock32.lib -link -incremental:no - @cd $(NT) + cd $(NT) +$(LIB_SRC)/minitar.exe : $(NT)/minitar.mak $(NT)/minitar.c + nmake -nologo -f minitar.mak ZLIB="$(ZLIB_DIR)" NT="$(NT)" LIB_SRC="$(LIB_SRC)" LIB_SRC_TOOLS = \ $(LIB_SRC)/make-docfile.exe \ @@ -543,6 +492,14 @@ $(LIB_SRC)/sorted-doc.exe \ $(LIB_SRC)/wakeup.exe \ $(LIB_SRC)/etags.exe +!if $(USE_MINITAR) +LIB_SRC_TOOLS = \ + $(LIB_SRC_TOOLS) \ + $(LIB_SRC)/minitar.exe +!endif + +# Shorthand target +minitar: $(LIB_SRC)/minitar.exe #------------------------------------------------------------------------------ @@ -560,6 +517,8 @@ # LASTFILE Library +!if !$(USE_SYSTEM_MALLOC) || !$(USE_PORTABLE_DUMPER) + LASTFILE=$(OUTDIR)\lastfile.lib LASTFILE_SRC=$(XEMACS)\src LASTFILE_FLAGS=$(CFLAGS) $(INCLUDES) -Fo$@ -Fd$* -c @@ -572,6 +531,8 @@ $(OUTDIR)\lastfile.obj: $(LASTFILE_SRC)\lastfile.c $(CCV) $(LASTFILE_FLAGS) $** +!endif + #------------------------------------------------------------------------------ !if $(HAVE_X) @@ -661,13 +622,12 @@ DOC_SRC3=\ $(XEMACS)\src\font-lock.c \ $(XEMACS)\src\frame.c \ - $(XEMACS)\src\free-hook.c \ $(XEMACS)\src\general.c \ $(XEMACS)\src\glyphs.c \ $(XEMACS)\src\glyphs-eimage.c \ $(XEMACS)\src\glyphs-widget.c \ - $(XEMACS)\src\gmalloc.c \ $(XEMACS)\src\gui.c \ + $(XEMACS)\src\gutter.c \ $(XEMACS)\src\hash.c \ $(XEMACS)\src\imgproc.c \ $(XEMACS)\src\indent.c \ @@ -684,7 +644,6 @@ $(XEMACS)\src\menubar.c \ $(XEMACS)\src\minibuf.c \ $(XEMACS)\src\nt.c \ - $(XEMACS)\src\ntheap.c \ $(XEMACS)\src\ntplay.c \ $(XEMACS)\src\ntproc.c \ $(XEMACS)\src\objects.c \ @@ -700,6 +659,7 @@ $(XEMACS)\src\regex.c \ $(XEMACS)\src\scrollbar.c \ $(XEMACS)\src\search.c \ + $(XEMACS)\src\select.c \ $(XEMACS)\src\signal.c \ $(XEMACS)\src\sound.c DOC_SRC5=\ @@ -711,8 +671,6 @@ $(XEMACS)\src\termcap.c \ $(XEMACS)\src\tparam.c \ $(XEMACS)\src\undo.c \ - $(XEMACS)\src\unexnt.c \ - $(XEMACS)\src\vm-limit.c \ $(XEMACS)\src\window.c \ $(XEMACS)\src\widget.c @@ -738,7 +696,7 @@ $(XEMACS)\src\balloon-x.c \ $(XEMACS)\src\xgccache.c \ $(XEMACS)\src\xmu.c \ - $(XEMACS)\src\xselect.c + $(XEMACS)\src\select-x.c !endif !if $(HAVE_MSW) @@ -764,8 +722,7 @@ DOC_SRC8=\ $(XEMACS)\src\mule.c \ $(XEMACS)\src\mule-charset.c \ - $(XEMACS)\src\mule-ccl.c \ - $(XEMACS)\src\mule-coding.c + $(XEMACS)\src\mule-ccl.c ! if $(HAVE_X) DOC_SRC8=$(DOC_SRC8) $(XEMACS)\src\input-method-xlib.c ! endif @@ -773,7 +730,21 @@ !if $(DEBUG_XEMACS) DOC_SRC9=\ - $(XEMACS)\src\debug.c + $(XEMACS)\src\debug.c \ + $(XEMACS)\src\tests.c +!endif + +!if !$(USE_SYSTEM_MALLOC) +DOC_SRC10=\ + $(XEMACS)\src\free-hook.c \ + $(XEMACS)\src\gmalloc.c \ + $(XEMACS)\src\ntheap.c \ + $(XEMACS)\src\vm-limit.c +!endif + +!if !$(USE_PORTABLE_DUMPER) +DOC_SRC11=\ + $(XEMACS)\src\unexnt.c !endif #------------------------------------------------------------------------------ @@ -785,18 +756,22 @@ EMACS_BETA_VERSION=-DEMACS_BETA_VERSION=$(emacs_beta_version) !ENDIF +!if !$(USE_PORTABLE_DUMPER) +TEMACS_ENTRYPOINT=-entry:_start +!endif + TEMACS_DIR=$(XEMACS)\src TEMACS=$(TEMACS_DIR)\temacs.exe TEMACS_BROWSE=$(TEMACS_DIR)\temacs.bsc TEMACS_SRC=$(XEMACS)\src TEMACS_LIBS=$(LASTFILE) $(LWLIB) $(X_LIBS) $(MSW_LIBS) \ - kernel32.lib user32.lib gdi32.lib advapi32.lib \ - shell32.lib wsock32.lib winmm.lib libc.lib + oldnames.lib kernel32.lib user32.lib gdi32.lib advapi32.lib \ + shell32.lib wsock32.lib winmm.lib winspool.lib $(LIBC_LIB) TEMACS_LFLAGS=-nologo $(LIBRARIES) $(DEBUG_FLAGS) -base:0x1000000\ - -stack:0x800000 -entry:_start -subsystem:console\ + -stack:0x800000 $(TEMACS_ENTRYPOINT) -subsystem:console\ -pdb:$(TEMACS_DIR)\temacs.pdb -map:$(TEMACS_DIR)\temacs.map \ - -heap:0x00100000 -out:$@ -TEMACS_CPP_FLAGS=-ML -c \ + -heap:0x00100000 -out:$@ -nodefaultlib +TEMACS_CPP_FLAGS=-c \ $(CFLAGS) $(INCLUDES) $(DEFINES) $(DEBUG_DEFINES) \ -DEMACS_MAJOR_VERSION=$(emacs_major_version) \ -DEMACS_MINOR_VERSION=$(emacs_minor_version) \ @@ -827,7 +802,7 @@ $(OUTDIR)\scrollbar-x.obj \ $(OUTDIR)\xgccache.obj \ $(OUTDIR)\xmu.obj \ - $(OUTDIR)\xselect.obj + $(OUTDIR)\select-x.obj !endif !if $(HAVE_MSW) @@ -853,8 +828,7 @@ TEMACS_MULE_OBJS=\ $(OUTDIR)\mule.obj \ $(OUTDIR)\mule-charset.obj \ - $(OUTDIR)\mule-ccl.obj \ - $(OUTDIR)\mule-coding.obj + $(OUTDIR)\mule-ccl.obj ! if $(HAVE_X) TEMACS_MULE_OBJS=\ $(TEMACS_MULE_OBJS) $(OUTDIR)\input-method-xlib.obj @@ -863,7 +837,21 @@ !if $(DEBUG_XEMACS) TEMACS_DEBUG_OBJS=\ - $(OUTDIR)\debug.obj + $(OUTDIR)\debug.obj \ + $(OUTDIR)\tests.obj +!endif + +!if !$(USE_SYSTEM_MALLOC) +TEMACS_ALLOC_OBJS=\ + $(OUTDIR)\free-hook.obj \ + $(OUTDIR)\gmalloc.obj \ + $(OUTDIR)\ntheap.obj \ + $(OUTDIR)\vm-limit.obj +!endif + +!if !$(USE_PORTABLE_DUMPER) +TEMACS_DUMP_OBJS=\ + $(OUTDIR)\unexnt.obj !endif TEMACS_OBJS= \ @@ -872,6 +860,8 @@ $(TEMACS_CODING_OBJS)\ $(TEMACS_MULE_OBJS)\ $(TEMACS_DEBUG_OBJS)\ + $(TEMACS_ALLOC_OBJS)\ + $(TEMACS_DUMP_OBJS)\ $(OUTDIR)\abbrev.obj \ $(OUTDIR)\alloc.obj \ $(OUTDIR)\alloca.obj \ @@ -909,13 +899,12 @@ $(OUTDIR)\fns.obj \ $(OUTDIR)\font-lock.obj \ $(OUTDIR)\frame.obj \ - $(OUTDIR)\free-hook.obj \ $(OUTDIR)\general.obj \ $(OUTDIR)\glyphs.obj \ $(OUTDIR)\glyphs-eimage.obj \ $(OUTDIR)\glyphs-widget.obj \ - $(OUTDIR)\gmalloc.obj \ $(OUTDIR)\gui.obj \ + $(OUTDIR)\gutter.obj \ $(OUTDIR)\hash.obj \ $(OUTDIR)\indent.obj \ $(OUTDIR)\imgproc.obj \ @@ -931,7 +920,6 @@ $(OUTDIR)\md5.obj \ $(OUTDIR)\minibuf.obj \ $(OUTDIR)\nt.obj \ - $(OUTDIR)\ntheap.obj \ $(OUTDIR)\ntplay.obj \ $(OUTDIR)\ntproc.obj \ $(OUTDIR)\objects.obj \ @@ -947,6 +935,7 @@ $(OUTDIR)\regex.obj \ $(OUTDIR)\scrollbar.obj \ $(OUTDIR)\search.obj \ + $(OUTDIR)\select.obj \ $(OUTDIR)\signal.obj \ $(OUTDIR)\sound.obj \ $(OUTDIR)\specifier.obj \ @@ -956,8 +945,6 @@ $(OUTDIR)\sysdep.obj \ $(OUTDIR)\tparam.obj \ $(OUTDIR)\undo.obj \ - $(OUTDIR)\unexnt.obj \ - $(OUTDIR)\vm-limit.obj \ $(OUTDIR)\widget.obj \ $(OUTDIR)\window.obj \ $(OUTDIR)\xemacs.res @@ -965,7 +952,7 @@ # Rules .SUFFIXES: -.SUFFIXES: .c +.SUFFIXES: .c .obj .texi .info # nmake rule !if $(DEBUG_XEMACS) @@ -982,7 +969,7 @@ $(OUTDIR)\TransientEmacsShell.obj: $(TEMACS_SRC)\EmacsShell-sub.c $(CCV) $(TEMACS_CPP_FLAGS) -DDEFINE_TRANSIENT_EMACS_SHELL $** -Fo$@ -$(OUTDIR)\alloc.obj: $(TEMACS_SRC)\alloc.c $(TEMACS_SRC)\puresize-adjust.h +$(OUTDIR)\alloc.obj: $(TEMACS_SRC)\alloc.c #$(TEMACS_SRC)\Emacs.ad.h: $(XEMACS)\etc\Emacs.ad # !"sed -f ad2c.sed < $(XEMACS)\etc\Emacs.ad > $(TEMACS_SRC)\Emacs.ad.h" @@ -994,7 +981,10 @@ !if $(DEBUG_XEMACS) @dir /b/s $(OUTDIR)\*.sbr > bscmake.tmp bscmake -nologo -o$(TEMACS_BROWSE) @bscmake.tmp - @del bscmake.tmp + @$(DEL) bscmake.tmp +!endif +!if $(USE_PORTABLE_DUMPER) + @if exist $(TEMACS_DIR)\xemacs.dmp del $(TEMACS_DIR)\xemacs.dmp !endif link.exe @<< $(TEMACS_LFLAGS) $(TEMACS_OBJS) $(TEMACS_LIBS) @@ -1003,14 +993,244 @@ $(OUTDIR)\xemacs.res: xemacs.rc rc -Fo$@ xemacs.rc +# Section handling automated tests starts here + +SRCDIR=$(MAKEDIR)\..\src +PROGNAME=$(SRCDIR)\xemacs.exe +blddir=$(MAKEDIR:\=\\)\\.. +temacs_loadup=$(TEMACS) -batch -l $(SRCDIR)/../lisp/loadup.el +dump_temacs = $(temacs_loadup) dump +run_temacs = $(temacs_loadup) run-temacs +## We have automated tests!! +testdir=../tests/automated +batch_test_emacs=-batch -l $(testdir)/test-harness.el -f batch-test-emacs $(testdir) + +# .PHONY: check check-temacs + +check: + cd $(SRCDIR) + $(PROGNAME) $(batch_test_emacs) + +check-temacs: + cd $(SRCDIR) + set EMACSBOOTSTRAPLOADPATH=$(LISP) + set EMACSBOOTSTRAPMODULEPATH=$(MODULES) + $(run_temacs) $(batch_test_emacs) + +# Section handling automated tests ends here + +# Section handling info starts here + +!if !defined(MAKEINFO) +MAKEINFO=$(PROGNAME) -vanilla -batch -l texinfmt -f batch-texinfo-format +!endif + +MANDIR = $(XEMACS)\man +INFODIR = $(XEMACS)\info +INFO_FILES= \ + $(INFODIR)\cl.info \ + $(INFODIR)\custom.info \ + $(INFODIR)\emodules.info \ + $(INFODIR)\external-widget.info \ + $(INFODIR)\info.info \ + $(INFODIR)\standards.info \ + $(INFODIR)\term.info \ + $(INFODIR)\termcap.info \ + $(INFODIR)\texinfo.info \ + $(INFODIR)\widget.info \ + $(INFODIR)\xemacs-faq.info \ + $(INFODIR)\xemacs.info \ + $(INFODIR)\lispref.info \ + $(INFODIR)\new-users-guide.info \ + $(INFODIR)\internals.info + +{$(MANDIR)}.texi{$(INFODIR)}.info: + cd $(MANDIR) + $(MAKEINFO) $** + +XEMACS_SRCS = \ + $(MANDIR)\xemacs\abbrevs.texi \ + $(MANDIR)\xemacs\basic.texi \ + $(MANDIR)\xemacs\buffers.texi \ + $(MANDIR)\xemacs\building.texi \ + $(MANDIR)\xemacs\calendar.texi \ + $(MANDIR)\xemacs\cmdargs.texi \ + $(MANDIR)\xemacs\custom.texi \ + $(MANDIR)\xemacs\display.texi \ + $(MANDIR)\xemacs\entering.texi \ + $(MANDIR)\xemacs\files.texi \ + $(MANDIR)\xemacs\fixit.texi \ + $(MANDIR)\xemacs\frame.texi \ + $(MANDIR)\xemacs\glossary.texi \ + $(MANDIR)\xemacs\gnu.texi \ + $(MANDIR)\xemacs\help.texi \ + $(MANDIR)\xemacs\indent.texi \ + $(MANDIR)\xemacs\keystrokes.texi \ + $(MANDIR)\xemacs\killing.texi \ + $(MANDIR)\xemacs\m-x.texi \ + $(MANDIR)\xemacs\major.texi \ + $(MANDIR)\xemacs\mark.texi \ + $(MANDIR)\xemacs\menus.texi \ + $(MANDIR)\xemacs\mini.texi \ + $(MANDIR)\xemacs\misc.texi \ + $(MANDIR)\xemacs\mouse.texi \ + $(MANDIR)\xemacs\mule.texi \ + $(MANDIR)\xemacs\new.texi \ + $(MANDIR)\xemacs\packages.texi \ + $(MANDIR)\xemacs\picture.texi \ + $(MANDIR)\xemacs\programs.texi \ + $(MANDIR)\xemacs\reading.texi \ + $(MANDIR)\xemacs\regs.texi \ + $(MANDIR)\xemacs\search.texi \ + $(MANDIR)\xemacs\sending.texi \ + $(MANDIR)\xemacs\startup.texi \ + $(MANDIR)\xemacs\text.texi \ + $(MANDIR)\xemacs\trouble.texi \ + $(MANDIR)\xemacs\undo.texi \ + $(MANDIR)\xemacs\windows.texi \ + $(MANDIR)\xemacs\xemacs.texi + +LISPREF_SRCS = \ + $(MANDIR)\lispref\abbrevs.texi \ + $(MANDIR)\lispref\annotations.texi \ + $(MANDIR)\lispref\back.texi \ + $(MANDIR)\lispref\backups.texi \ + $(MANDIR)\lispref\buffers.texi \ + $(MANDIR)\lispref\building.texi \ + $(MANDIR)\lispref\commands.texi \ + $(MANDIR)\lispref\compile.texi \ + $(MANDIR)\lispref\consoles-devices.texi \ + $(MANDIR)\lispref\control.texi \ + $(MANDIR)\lispref\customize.texi \ + $(MANDIR)\lispref\databases.texi \ + $(MANDIR)\lispref\debugging.texi \ + $(MANDIR)\lispref\dialog.texi \ + $(MANDIR)\lispref\display.texi \ + $(MANDIR)\lispref\dragndrop.texi \ + $(MANDIR)\lispref\edebug-inc.texi \ + $(MANDIR)\lispref\edebug.texi \ + $(MANDIR)\lispref\errors.texi \ + $(MANDIR)\lispref\eval.texi \ + $(MANDIR)\lispref\extents.texi \ + $(MANDIR)\lispref\faces.texi \ + $(MANDIR)\lispref\files.texi \ + $(MANDIR)\lispref\frames.texi \ + $(MANDIR)\lispref\functions.texi \ + $(MANDIR)\lispref\glyphs.texi \ + $(MANDIR)\lispref\hash-tables.texi \ + $(MANDIR)\lispref\help.texi \ + $(MANDIR)\lispref\hooks.texi \ + $(MANDIR)\lispref\index.texi \ + $(MANDIR)\lispref\internationalization.texi \ + $(MANDIR)\lispref\intro.texi \ + $(MANDIR)\lispref\keymaps.texi \ + $(MANDIR)\lispref\ldap.texi \ + $(MANDIR)\lispref\lispref.texi \ + $(MANDIR)\lispref\lists.texi \ + $(MANDIR)\lispref\loading.texi \ + $(MANDIR)\lispref\locals.texi \ + $(MANDIR)\lispref\macros.texi \ + $(MANDIR)\lispref\maps.texi \ + $(MANDIR)\lispref\markers.texi \ + $(MANDIR)\lispref\menus.texi \ + $(MANDIR)\lispref\minibuf.texi \ + $(MANDIR)\lispref\modes.texi \ + $(MANDIR)\lispref\mouse.texi \ + $(MANDIR)\lispref\mule.texi \ + $(MANDIR)\lispref\numbers.texi \ + $(MANDIR)\lispref\objects.texi \ + $(MANDIR)\lispref\os.texi \ + $(MANDIR)\lispref\positions.texi \ + $(MANDIR)\lispref\processes.texi \ + $(MANDIR)\lispref\range-tables.texi \ + $(MANDIR)\lispref\scrollbars.texi \ + $(MANDIR)\lispref\searching.texi \ + $(MANDIR)\lispref\sequences.texi \ + $(MANDIR)\lispref\specifiers.texi \ + $(MANDIR)\lispref\streams.texi \ + $(MANDIR)\lispref\strings.texi \ + $(MANDIR)\lispref\symbols.texi \ + $(MANDIR)\lispref\syntax.texi \ + $(MANDIR)\lispref\text.texi \ + $(MANDIR)\lispref\tips.texi \ + $(MANDIR)\lispref\toolbar.texi \ + $(MANDIR)\lispref\tooltalk.texi \ + $(MANDIR)\lispref\variables.texi \ + $(MANDIR)\lispref\windows.texi \ + $(MANDIR)\lispref\x-windows.texi + +INTERNALS_SRCS = \ + $(MANDIR)\internals\internals.texi \ + $(MANDIR)\internals\index.texi + +NEW_USERS_GUIDE_SRCS = \ + $(MANDIR)\new-users-guide\custom1.texi \ + $(MANDIR)\new-users-guide\custom2.texi \ + $(MANDIR)\new-users-guide\edit.texi \ + $(MANDIR)\new-users-guide\enter.texi \ + $(MANDIR)\new-users-guide\files.texi \ + $(MANDIR)\new-users-guide\help.texi \ + $(MANDIR)\new-users-guide\modes.texi \ + $(MANDIR)\new-users-guide\new-users-guide.texi \ + $(MANDIR)\new-users-guide\region.texi \ + $(MANDIR)\new-users-guide\search.texi \ + $(MANDIR)\new-users-guide\xmenu.texi + +$(INFODIR)\xemacs.info: $(XEMACS_SRCS) + cd $(MANDIR)\xemacs + $(MAKEINFO) xemacs.texi + cd .. + + +$(INFODIR)\lispref.info: $(LISPREF_SRCS) + cd $(MANDIR)\lispref + $(MAKEINFO) lispref.texi + cd .. + +$(INFODIR)\internals.info: $(INTERNALS_SRCS) + cd $(MANDIR)\internals + $(MAKEINFO) internals.texi + cd .. + +$(INFODIR)\new-users-guide.info: $(NEW_USERS_GUIDE_SRCS) + cd $(MANDIR)\new-users-guide + $(MAKEINFO) new-users-guide.texi + cd .. + +info: makeinfo-test $(INFO_FILES) + +makeinfo-test: + @<<makeinfo_test.bat +@echo off +if exist "$(MAKEINFO)" goto test_done +@"$(PROGNAME)" -batch -vanilla -eval "(condition-case nil (require (quote texinfo)) (t (kill-emacs 1)))" +@if not errorlevel 1 goto suggest_makeinfo +@echo XEmacs `info' cannot be built! +@echo Install XEmacs package `texinfo' (see README.packages). +:suggest_makeinfo +@echo Consider specifying path to makeinfo program: MAKEINFO=path +@echo as this will build info docs faster than XEmacs using `texinfo'. +@if errorlevel 1 exit 1 +:test_done +<<NOKEEP + +# Section handling info ends here + #------------------------------------------------------------------------------ # LISP bits 'n bobs LOADPATH=$(LISP) +# Rebuild docfile target +docfile :: + if exist $(DOC) del $(DOC) +docfile :: $(DOC) + $(DOC): $(LIB_SRC)\make-docfile.exe - -del $(DOC) + if exist $(DOC) del $(DOC) + set EMACSBOOTSTRAPLOADPATH=$(LISP);$(PACKAGE_PATH) + set EMACSBOOTSTRAPMODULEPATH=$(MODULES) $(TEMACS) -batch -l $(TEMACS_DIR)\..\lisp\make-docfile.el -- -o $(DOC) -i $(XEMACS)\site-packages $(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC1) $(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC2) @@ -1021,97 +1241,232 @@ $(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC7) $(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC8) $(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC9) + $(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC10) + $(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC11) -$(LISP)\Installation.el: Installation.el - copy Installation.el $(LISP) - -update-elc: $(LISP)\Installation.el +update-elc: set EMACSBOOTSTRAPLOADPATH=$(LISP);$(PACKAGE_PATH) set EMACSBOOTSTRAPMODULEPATH=$(MODULES) $(TEMACS) -batch -l $(TEMACS_DIR)\..\lisp\update-elc.el # This rule dumps xemacs and then possibly spawns sub-make if PURESPACE -# requirements has changed. -dump-xemacs: $(TEMACS) +# requirements have changed. +dump-xemacs: temacs @echo >$(TEMACS_DIR)\SATISFIED cd $(TEMACS_DIR) set EMACSBOOTSTRAPLOADPATH=$(LISP);$(PACKAGE_PATH) + set EMACSBOOTSTRAPMODULEPATH=$(MODULES) -1 $(TEMACS) -batch -l $(TEMACS_DIR)\..\lisp\loadup.el dump - @cd $(NT) +!if $(USE_PORTABLE_DUMPER) + copy temacs.exe xemacs.exe +!endif + cd $(NT) @if not exist $(TEMACS_DIR)\SATISFIED nmake -nologo -f xemacs.mak $@ - #------------------------------------------------------------------------------ # use this rule to build the complete system -all: $(OUTDIR)\nul $(LASTFILE) $(LWLIB) $(LIB_SRC_TOOLS) $(RUNEMACS) \ - $(TEMACS) update-elc $(DOC) dump-xemacs +all: $(XEMACS)\Installation $(OUTDIR)\nul $(LASTFILE) $(LWLIB) \ + $(LIB_SRC_TOOLS) $(RUNEMACS) $(TEMACS) update-elc $(DOC) dump-xemacs \ + $(LISP)/auto-autoloads.el $(LISP)/custom-load.el info -temacs: $(TEMACS) +temacs: $(LASTFILE) $(TEMACS) # use this rule to install the system install: all + cd $(NT) @echo Installing in $(INSTALL_DIR) ... @echo PlaceHolder > PlaceHolder @xcopy /q PROBLEMS "$(INSTALL_DIR)\" @xcopy /q PlaceHolder "$(INSTALL_DIR)\lock\" - @del "$(INSTALL_DIR)\lock\PlaceHolder" + @$(DEL) "$(INSTALL_DIR)\lock\PlaceHolder" @xcopy /q $(LIB_SRC)\*.exe "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)\" @copy $(LIB_SRC)\DOC "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)" @copy $(CONFIG_VALUES) "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)" @copy $(XEMACS)\src\xemacs.exe "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)" +!if $(USE_PORTABLE_DUMPER) + @copy $(XEMACS)\src\xemacs.dmp "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)" +!endif @copy $(RUNEMACS) "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)" @xcopy /e /q $(XEMACS)\etc "$(INSTALL_DIR)\etc\" @xcopy /e /q $(XEMACS)\info "$(INSTALL_DIR)\info\" @xcopy /e /q $(XEMACS)\lisp "$(INSTALL_DIR)\lisp\" @echo Making skeleton package tree in $(PACKAGE_PREFIX) ... @xcopy /q PlaceHolder "$(PACKAGE_PREFIX)\site-packages\" - @del "$(PACKAGE_PREFIX)\site-packages\PlaceHolder" + @$(DEL) "$(PACKAGE_PREFIX)\site-packages\PlaceHolder" @xcopy /q PlaceHolder "$(PACKAGE_PREFIX)\mule-packages\" - @del "$(PACKAGE_PREFIX)\mule-packages\PlaceHolder" + @$(DEL) "$(PACKAGE_PREFIX)\mule-packages\PlaceHolder" @xcopy /q PlaceHolder "$(PACKAGE_PREFIX)\xemacs-packages\" - @del "$(PACKAGE_PREFIX)\xemacs-packages\PlaceHolder" - @del PlaceHolder + @$(DEL) "$(PACKAGE_PREFIX)\xemacs-packages\PlaceHolder" + @$(DEL) PlaceHolder distclean: - del *.bak - del *.orig - del *.rej - del *.tmp - del Installation - del Installation.el + $(DEL) *.bak + $(DEL) *.orig + $(DEL) *.rej + $(DEL) *.tmp + $(DEL) $(XEMACS)\Installation cd $(OUTDIR) - del *.lib - del *.obj - del *.pdb - del *.res - del *.sbr + $(DEL) *.lib + $(DEL) *.obj + $(DEL) *.pdb + $(DEL) *.res + $(DEL) *.sbr cd $(XEMACS)\$(TEMACS_DIR) - del puresize-adjust.h - del config.h - del paths.h - del Emacs.ad.h - del *.bak - del *.orig - del *.rej - del *.exe - del *.map - del *.bsc - del *.pdb + $(DEL) config.h + $(DEL) paths.h + $(DEL) Emacs.ad.h + $(DEL) *.bak + $(DEL) *.orig + $(DEL) *.rej + $(DEL) *.exe + $(DEL) *.map + $(DEL) *.bsc + $(DEL) *.pdb cd $(LIB_SRC) - del DOC - del *.bak - del *.orig - del *.rej - del *.exe - del *.obj - del *.pdb - del *.res - del $(CONFIG_VALUES) + $(DEL) DOC + $(DEL) *.bak + $(DEL) *.orig + $(DEL) *.rej + $(DEL) *.exe + $(DEL) *.obj + $(DEL) *.pdb + $(DEL) *.res + $(DEL) $(CONFIG_VALUES) cd $(LISP) - -del /s /q *.bak *.elc *.orig *.rej + $(DEL) /s /q *.bak *.elc *.orig *.rej + cd $(INFODIR) + $(DEL) *.info* depend: - mkdepend -f xemacs.mak -p$(OUTDIR)\ -o.obj -w9999 -- $(TEMACS_CPP_FLAGS) -- $(DOC_SRC1) $(DOC_SRC2) $(DOC_SRC3) $(DOC_SRC4) $(DOC_SRC5) $(DOC_SRC6) $(DOC_SRC7) $(DOC_SRC8) $(DOC_SRC9) $(LASTFILE_SRC)\lastfile.c $(LIB_SRC)\make-docfile.c $(LIB_SRC)\run.c + cd $(SRCDIR) + perl ./make-src-depend > depend.tmp + perl -MFile::Compare -e "compare('depend.tmp', 'depend') && rename('depend.tmp', 'depend') or unlink('depend.tmp')" + +installation:: + @if exist $(XEMACS)\Installation del $(XEMACS)\Installation + +installation:: $(XEMACS)\Installation + +$(XEMACS)\Installation: + @type > $(XEMACS)\Installation << +!if defined(OS) +OS: $(OS) +!endif + +XEmacs $(XEMACS_VERSION_STRING) $(xemacs_codename:"=\") configured for `$(EMACS_CONFIGURATION)'. + + Building XEmacs in \"$(MAKEDIR:\=\\)\". +!if defined(CCV) + Using compiler \"$(CC) $(CFLAGS)\". +!endif + Installing XEmacs in \"$(INSTALL_DIR:\=\\)\". + Package path is $(PATH_PACKAGEPATH:"=\"). +!if $(INFODOCK) + Building InfoDock. +!endif +!if $(HAVE_MSW) + Compiling in support for Microsoft Windows native GUI. +!endif +!if $(HAVE_X) + Compiling in support for X-Windows. +!endif +!if $(HAVE_MULE) + Compiling in MULE. +!endif +!if $(HAVE_XPM) + Compiling in support for XPM images. +!else + -------------------------------------------------------------------- + WARNING: Compiling without XPM support. + WARNING: You should strongly consider installing XPM. + WARNING: Otherwise toolbars and other graphics will look suboptimal. + WARNING: (a copy may be found in ftp://ftp.xemacs.org/pub/xemacs/aux) + -------------------------------------------------------------------- +!endif +!if $(HAVE_GIF) + Compiling in support for GIF images. +!endif +!if $(HAVE_PNG) + Compiling in support for PNG images. +!else + -------------------------------------------------------------------- + WARNING: Compiling without PNG image support. + WARNING: You should strongly consider installing the PNG libraries. + WARNING: Otherwise certain images and glyphs may not display. + WARNING: (a copy may be found in ftp://ftp.xemacs.org/pub/xemacs/aux + -------------------------------------------------------------------- +!endif +!if $(HAVE_TIFF) + Compiling in support for TIFF images. +!endif +!if $(HAVE_JPEG) + Compiling in support for JPEG images. +!endif +!if $(HAVE_XFACE) + Compiling in support for X-Face message headers. +!endif +!if $(HAVE_TOOLBARS) + Compiling in support for toolbars. +!endif +!if $(HAVE_DIALOGS) + Compiling in support for dialogs. +!endif +!if $(HAVE_WIDGETS) + Compiling in support for widgets. +!endif +!if $(HAVE_NATIVE_SOUND) + Compiling in support for native sounds. +!endif +!if $(HAVE_MSW_C_DIRED) + Compiling in fast dired implementation. +!else + -------------------------------------------------------------------- + WARNING: Define HAVE_MSW_C_DIRED to be non-zero if you want XEmacs + WARNING: to use C primitives to significantly speed up dired, at the + WARNING: expense of an additional ~4KB of code. + -------------------------------------------------------------------- +!endif +!if $(USE_MINIMAL_TAGBITS) + Using minimal tagbits. +!endif +!if $(USE_INDEXED_LRECORD_IMPLEMENTATION) + Using indexed lrecord implementation. +!endif +!if $(USE_UNION_TYPE) + Using union type for Lisp object storage. +!endif +!if $(USE_PORTABLE_DUMPER) + Using portable dumper. +!endif +!if $(USE_SYSTEM_MALLOC) + Using system malloc. +!endif +!if $(USE_CRTDLL) + Using DLL version of C runtime library +!endif +!if $(DEBUG_XEMACS) + Compiling in extra debug checks. XEmacs will be slow! +!endif +<<NOKEEP + @echo -------------------------------------------------------------------- + @type $(XEMACS)\Installation + @echo -------------------------------------------------------------------- + +# Update auto-autoloads.el and custom-load.el similar to what +# XEmacs.rules does for xemacs-packages. +VANILLA=-vanilla +FORCE: +$(LISP)\auto-autoloads.el: FORCE + @$(DEL) $(LISP)\auto-autoloads.el + $(PROGNAME) $(VANILLA) -batch \ + -l autoload -f batch-update-directory $(LISP) + $(PROGNAME) $(VANILLA) -batch \ + -f batch-byte-compile $@ + @$(DEL) $(LISP)\auto-autoloads.el~ + +$(LISP)\custom-load.el: FORCE + $(PROGNAME) $(VANILLA) -batch -l cus-dep \ + -f Custom-make-dependencies $(LISP) # DO NOT DELETE THIS LINE -- make depend depends on it. diff -r f4aeb21a5bad -r 74fd4e045ea6 nt/xpm.mak --- a/nt/xpm.mak Mon Aug 13 11:12:06 2007 +0200 +++ b/nt/xpm.mak Mon Aug 13 11:13:30 2007 +0200 @@ -1,21 +1,44 @@ # # XPM Makefile for Microsoft NMAKE without X libraries # +!if !defined(DEBUG) +!if defined(DEBUG_XEMACS) +DEBUG=$(DEBUG_XEMACS) +!else +DEBUG=0 +!endif +!endif -!if !defined(DEBUG_XEMACS) -DEBUG_XEMACS=0 +!if !defined(USE_CRTDLL) +USE_CRTDLL=0 !endif -!if $(DEBUG_XEMACS) +!if $(DEBUG) OPT=-Od -Zi +LINK_DEBUG=-debug !else -OPT=-O2 -G5 -Zi +OPT=-Ox +!endif + +!if $(USE_CRTDLL) +!if $(DEBUG) +C_LIBFLAG=-MDd +!else +C_LIBFLAG=-MD +!endif +!else +!if $(DEBUG) +C_LIBFLAG=-MLd +!else +C_LIBFLAG=-ML +!endif !endif WARN_CPP_FLAGS = -W3 CC=cl -CFLAGS=-nologo -DFOR_MSW $(WARN_CPP_FLAGS) $(OPT) $(INCLUDES) -Fo$@ -c +CFLAGS=-nologo -DFOR_MSW $(C_LIBFLAG) $(WARN_CPP_FLAGS) \ + $(OPT) $(INCLUDES) -c OBJS= data.obj create.obj misc.obj rgb.obj scan.obj parse.obj hashtab.obj \ WrFFrI.obj RdFToI.obj CrIFrDat.obj CrDatFrI.obj \ @@ -29,8 +52,8 @@ .SUFFIXES: .SUFFIXES: .c -.c.obj: - $(CC) $(CFLAGS) $< -Fo$@ +.c.obj:: + $(CC) $(CFLAGS) $< # targets @@ -44,4 +67,9 @@ mkdir ..\X11 Xpm.lib: $(OBJS) - link.exe -lib -nologo -out:$@ $(OBJS) +!if $(USE_CRTDLL) +# Target is ok, link builds lib as a side effect. + link -nologo -dll -def:xpm.def -out:Xpm.dll gdi32.lib $(OBJS) +!else + lib -nologo -out:$@ $(OBJS) +!endif diff -r f4aeb21a5bad -r 74fd4e045ea6 src/.cvsignore --- a/src/.cvsignore Mon Aug 13 11:12:06 2007 +0200 +++ b/src/.cvsignore Mon Aug 13 11:13:30 2007 +0200 @@ -8,5 +8,8 @@ sheap-adjust.h temacs xemacs +xemacs.dmp SATISFIED update-elc.stamp +*.so.* +gmon.out diff -r f4aeb21a5bad -r 74fd4e045ea6 src/.dbxrc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/.dbxrc Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,394 @@ +# -*- ksh -*- +# Copyright (C) 1998 Free Software Foundation, Inc. + +# This file is part of XEmacs. + +# XEmacs is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any +# later version. + +# XEmacs is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. + +# You should have received a copy of the GNU General Public License +# along with XEmacs; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +# Author: Martin Buchholz + +# You can use this file to debug XEmacs using Sun WorkShop's dbx. + +# Some functions defined here require a running process, but most +# don't. Considerable effort has been expended to this end. + +# Since this file is called `.dbxrc', it will be read by dbx +# automatically when dbx is run in the build directory, which is where +# developers usually debug their xemacs. + +# See also the comments in .gdbinit. + +# See also the question of the XEmacs FAQ, titled +# "How to Debug an XEmacs problem with a debugger". + +# gdb sources the ./.gdbinit in _addition_ to ~/.gdbinit. +# But dbx does _not_ source ~/.dbxrc if it found ./.dbxrc. +# So we simulate the gdb algorithm by doing it ourselves here. +if test -r $HOME/.dbxrc; then . $HOME/.dbxrc; fi + +dbxenv language_mode ansic + +ignore POLL +ignore IO + +document lbt << 'end' +Usage: lbt +Print the current Lisp stack trace. +Requires a running xemacs process. +end + +function lbt { + call debug_backtrace() +} + +document ldp << 'end' +Usage: ldp lisp_object +Print a Lisp Object value using the Lisp printer. +Requires a running xemacs process. +end + +function ldp { + call debug_print ($1); +} + +# A bug in dbx prevents string variables from having values beginning with `-'!! +function XEmacsInit { + function ToInt { eval "$1=\$[(int) \`alloc.c\`$1]"; } + ToInt dbg_USE_UNION_TYPE + ToInt Lisp_Type_Int + ToInt Lisp_Type_Char + ToInt Lisp_Type_Cons + ToInt Lisp_Type_String + ToInt Lisp_Type_Vector + ToInt Lisp_Type_Symbol + ToInt Lisp_Type_Record + ToInt dbg_valbits + ToInt dbg_gctypebits + function ToLong { eval "$1=\$[(\`alloc.c\`unsigned long) \`alloc.c\`$1]"; } + ToLong dbg_valmask + ToLong dbg_typemask + xemacs_initted=yes +} + +function printvar { + for i in $*; do eval "echo $i=\$$i"; done +} + +document decode_object << 'end' +Usage: decode_object lisp_object +Extract implementation information from a Lisp Object. +Defines variables $val, $type and $imp. +end + +# Various dbx bugs cause ugliness in following code +function decode_object { + if test -z "$xemacs_initted"; then XEmacsInit; fi; + if test $dbg_USE_UNION_TYPE = 1; then + # Repeat after me... dbx sux, dbx sux, dbx sux... + # Allow both `pobj Qnil' and `pobj 0x82746834' to work + case $(whatis $1) in + *Lisp_Object*) obj="$[(`alloc.c`unsigned long)(($1).i)]";; + *) obj="$[(`alloc.c`unsigned long)($1)]";; + esac + else + obj="$[(`alloc.c`unsigned long)($1)]"; + fi + if test $[(int)($obj & 1)] = 1; then + # It's an int + val=$[(long)(((unsigned long long)$obj) >> 1)] + type=$Lisp_Type_Int + else + type=$[(int)(((void*)$obj) & $dbg_typemask)] + if test $type = $Lisp_Type_Char; then + val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)] + else + # It's a record pointer + val=$[(void*)$obj] + if test "$val" = "(nil)"; then type=null_pointer; fi + fi + fi + + if test $type = $Lisp_Type_Record; then + typeset lheader="((struct lrecord_header *) $val)" + imp=$[(void*)(`alloc.c`lrecord_implementations_table[$lheader->type])] + else + imp="0xdeadbeef" + fi + # printvar obj val type imp +} + +function xint { + decode_object "$*" + print (long) ($val) +} + +document xtype << 'end' +Usage: xtype lisp_object +Print the Lisp type of a lisp object. +end + +function xtype { + decode_object "$*" + if test $type = $Lisp_Type_Int; then echo "int" + elif test $type = $Lisp_Type_Char; then echo "char" + elif test $type = $Lisp_Type_Symbol; then echo "symbol" + elif test $type = $Lisp_Type_String; then echo "string" + elif test $type = $Lisp_Type_Vector; then echo "vector" + elif test $type = $Lisp_Type_Cons; then echo "cons" + elif test $type = null_pointer; then echo "null_pointer" + else + echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]" + fi +} + +function lisp-shadows { + run -batch -vanilla -f list-load-path-shadows +} + +function environment-to-run-temacs { + unset EMACSLOADPATH + export EMACSBOOTSTRAPLOADPATH=../lisp/:.. + export EMACSBOOTSTRAPMODULEPATH=../modules/:.. +} + +document run-temacs << 'end' +Usage: run-temacs +Run temacs interactively, like xemacs. +Use this with debugging tools (like purify) that cannot deal with dumping, +or when temacs builds successfully, but xemacs does not. +end + +function run-temacs { + environment-to-run-temacs + run -batch -l ../lisp/loadup.el run-temacs -q ${1+"$@"} +} + +document check-xemacs << 'end' +Usage: check-xemacs +Run the test suite. Equivalent to 'make check'. +end + +function check-xemacs { + run -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated +} + +document check-temacs << 'end' +Usage: check-temacs +Run the test suite on temacs. Equivalent to 'make check-temacs'. +Use this with debugging tools (like purify) that cannot deal with dumping, +or when temacs builds successfully, but xemacs does not. +end + +function check-temacs { + run-temacs -q -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated +} + +document update-elc << 'end' +Usage: update-elc +Run the core lisp byte compilation part of the build procedure. +Use when debugging temacs, not xemacs! +Use this when temacs builds successfully, but xemacs does not. +end + +function update-elc { + environment-to-run-temacs + run -batch -l ../lisp/update-elc.el +} + +document dump-temacs << 'end' +Usage: dump-temacs +Run the dumping part of the build procedure. +Use when debugging temacs, not xemacs! +Use this when temacs builds successfully, but xemacs does not. +end + +function dump-temacs { + environment-to-run-temacs + run -batch -l ../lisp/loadup.el dump +} + +function pstruct { + xstruct="((struct $1 *) $val)" + print $xstruct + print *$xstruct +} + +function lrecord_type_p { + if eval test -z \"\$lrecord_$1\" && test $imp = $[(void*)(&lrecord_$1)]; then return 0; else return 1; fi +} + +document pobj << 'end' +Usage: pobj lisp_object +Print the internal C representation of a Lisp Object. +end + +function pobj { + decode_object $1 + if test $type = $Lisp_Type_Int; then + print -f"Integer: %d" $val + elif test $type = $Lisp_Type_Char; then + if test $[$val > 32 && $val < 128] = 1; then + print -f"Char: %c" $val + else + print -f"Char: %d" $val + fi + elif test $type = $Lisp_Type_String || lrecord_type_p string; then + pstruct Lisp_String + elif test $type = $Lisp_Type_Cons || lrecord_type_p cons; then + pstruct Lisp_Cons + elif test $type = $Lisp_Type_Symbol || lrecord_type_p symbol; then + pstruct Lisp_Symbol + echo "Symbol name: $[(char *)($xstruct->name->data)]" + elif test $type = $Lisp_Type_Vector || lrecord_type_p vector; then + pstruct Lisp_Vector + echo "Vector of length $[$xstruct->size]" + elif lrecord_type_p bit_vector; then + pstruct Lisp_Bit_Vector + elif lrecord_type_p buffer; then + pstruct buffer + elif lrecord_type_p char_table; then + pstruct Lisp_Char_Table + elif lrecord_type_p char_table_entry; then + pstruct Lisp_Char_Table_Entry + elif lrecord_type_p charset; then + pstruct Lisp_Charset + elif lrecord_type_p coding_system; then + pstruct Lisp_Coding_System + elif lrecord_type_p color_instance; then + pstruct Lisp_Color_Instance + elif lrecord_type_p command_builder; then + pstruct command_builder + elif lrecord_type_p compiled_function; then + pstruct Lisp_Compiled_Function + elif lrecord_type_p console; then + pstruct console + elif lrecord_type_p database; then + pstruct Lisp_Database + elif lrecord_type_p device; then + pstruct device + elif lrecord_type_p event; then + pstruct Lisp_Event + elif lrecord_type_p extent; then + pstruct extent + elif lrecord_type_p extent_auxiliary; then + pstruct extent_auxiliary + elif lrecord_type_p extent_info; then + pstruct extent_info + elif lrecord_type_p face; then + pstruct Lisp_Face + elif lrecord_type_p float; then + pstruct Lisp_Float + elif lrecord_type_p font_instance; then + pstruct Lisp_Font_Instance + elif lrecord_type_p frame; then + pstruct frame + elif lrecord_type_p glyph; then + pstruct Lisp_Glyph + elif lrecord_type_p hash_table; then + pstruct Lisp_Hash_Table + elif lrecord_type_p image_instance; then + pstruct Lisp_Image_Instance + elif lrecord_type_p keymap; then + pstruct Lisp_Keymap + elif lrecord_type_p lcrecord_list; then + pstruct lcrecord_list + elif lrecord_type_p lstream; then + pstruct lstream + elif lrecord_type_p marker; then + pstruct Lisp_Marker + elif lrecord_type_p opaque; then + pstruct Lisp_Opaque + elif lrecord_type_p opaque_ptr; then + pstruct Lisp_Opaque_Ptr + elif lrecord_type_p popup_data; then + pstruct popup_data + elif lrecord_type_p process; then + pstruct Lisp_Process + elif lrecord_type_p range_table; then + pstruct Lisp_Range_Table + elif lrecord_type_p specifier; then + pstruct Lisp_Specifier + elif lrecord_type_p subr; then + pstruct Lisp_Subr + elif lrecord_type_p symbol_value_buffer_local; then + pstruct symbol_value_buffer_local + elif lrecord_type_p symbol_value_forward; then + pstruct symbol_value_forward + elif lrecord_type_p symbol_value_lisp_magic; then + pstruct symbol_value_lisp_magic + elif lrecord_type_p symbol_value_varalias; then + pstruct symbol_value_varalias + elif lrecord_type_p toolbar_button; then + pstruct toolbar_button + elif lrecord_type_p tooltalk_message; then + pstruct Lisp_Tooltalk_Message + elif lrecord_type_p tooltalk_pattern; then + pstruct Lisp_Tooltalk_Pattern + elif lrecord_type_p weak_list; then + pstruct weak_list + elif lrecord_type_p window; then + pstruct window + elif lrecord_type_p window_configuration; then + pstruct window_config + elif test "$type" = "null_pointer"; then + echo "Lisp Object is a null pointer!!" + else + echo "Unknown Lisp Object type" + print $1 + fi +} + +function pproc { + print *(`process.c`struct Lisp_Process*)$1 ; + ldp "(`process.c`struct Lisp_Process*)$1->name" ; + ldp "(`process.c`struct Lisp_Process*)$1->command" ; +} + +dbxenv suppress_startup_message 4.0 +dbxenv mt_watchpoints on + +function dp_core { + print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core +} + +# Barf! +function print_shell { + print *(`frame-x.c`TopLevelShellRec*) (((struct `frame-x.c`x_frame*) (((struct `frame-x.c`frame*) (Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget) +} + +# ------------------------------------------------------------- +# functions to test the debugging support itself. +# If you change this file, make sure the following still work... +# ------------------------------------------------------------- +function test_xtype { + function doit { echo -n "$1: "; xtype "$1"; } + test_various_objects +} + +function test_pobj { + function doit { echo '==============================='; echo -n "$1: "; pobj "$1"; } + test_various_objects +} + +function test_various_objects { + doit Vemacs_major_version + doit Vhelp_char + doit Qnil + doit Qunbound + doit Vobarray + doit Vall_weak_lists + doit Vxemacs_codename +} diff -r f4aeb21a5bad -r 74fd4e045ea6 src/.gdbinit --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/.gdbinit Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,507 @@ +# -*- ksh -*- +# Copyright (C) 1998 Free Software Foundation, Inc. + +# This file is part of XEmacs. + +# XEmacs is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any +# later version. + +# XEmacs is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. + +# You should have received a copy of the GNU General Public License +# along with XEmacs; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +# Author: Martin Buchholz + +# Some useful commands for debugging emacs with gdb 4.16 or better. +# +# Since this file is called `.gdbinit', it will be read by gdb +# automatically when gdb is run in the build directory, which is where +# developers usually debug their xemacs. You can also source this +# file from your ~/.gdbinit, if you like. +# +# Configure xemacs with --debug, and compile with -g. +# +# See also the question of the XEmacs FAQ, titled +# "How to Debug an XEmacs problem with a debugger". +# +# This can be used to debug XEmacs no matter how the following are +# specified: + +# USE_UNION_TYPE + +# (the above all have configure equivalents) + +# Some functions defined here require a running process, but most +# don't. Considerable effort has been expended to this end. + +# See the dbg_ C support code in src/alloc.c that allows the functions +# defined in this file to work correctly. + +set print union off +set print pretty off + +define decode_object + set $obj = (unsigned long) $arg0 + if $obj & 1 + # It's an int + set $val = $obj >> 1 + set $type = Lisp_Type_Int + else + set $type = $obj & dbg_typemask + if $type == Lisp_Type_Char + set $val = ($obj & dbg_valmask) >> dbg_gctypebits + else + # It's a record pointer + set $val = $obj + end + end + + if $type == Lisp_Type_Record + set $lheader = (struct lrecord_header *) $val + set $imp = lrecord_implementations_table[$lheader->type] + else + set $imp = -1 + end +end + +document decode_object +Usage: decode_object lisp_object +Extract implementation information from a Lisp Object. +Defines variables $val, $type and $imp. +end + +define xint +decode_object $arg0 +print ((long) $val) +end + +define xtype + decode_object $arg0 + if $type == Lisp_Type_Int + echo int\n + else + if $type == Lisp_Type_Char + echo char\n + else + if $type == Lisp_Type_Symbol + echo symbol\n + else + if $type == Lisp_Type_String + echo string\n + else + if $type == Lisp_Type_Vector + echo vector\n + else + if $type == Lisp_Type_Cons + echo cons\n + else + printf "record type: %s\n", $imp->name + # barf + end + end + end + end + end + end +end + +document xtype +Usage: xtype lisp_object +Print the Lisp type of a lisp object. +end + +define lisp-shadows + run -batch -vanilla -f list-load-path-shadows +end + +document lisp-shadows +Usage: lisp-shadows +Run xemacs to check for lisp shadows +end + +define environment-to-run-temacs + unset env EMACSLOADPATH + set env EMACSBOOTSTRAPLOADPATH=../lisp/:.. + set env EMACSBOOTSTRAPMODULEPATH=../modules/:.. +end + +define run-temacs + environment-to-run-temacs + run -batch -l ../lisp/loadup.el run-temacs -q +end + +document run-temacs +Usage: run-temacs +Run temacs interactively, like xemacs. +Use this with debugging tools (like purify) that cannot deal with dumping, +or when temacs builds successfully, but xemacs does not. +end + +define check-xemacs + run -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated +end + +document check-xemacs +Usage: check-xemacs +Run the test suite. Equivalent to 'make check'. +end + +define check-temacs + environment-to-run-temacs + run -batch -l ../lisp/loadup.el run-temacs -q -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated +end + +document check-temacs +Usage: check-temacs +Run the test suite on temacs. Equivalent to 'make check-temacs'. +Use this with debugging tools (like purify) that cannot deal with dumping, +or when temacs builds successfully, but xemacs does not. +end + +define update-elc + environment-to-run-temacs + run -batch -l ../lisp/update-elc.el +end + +document update-elc +Usage: update-elc +Run the core lisp byte compilation part of the build procedure. +Use when debugging temacs, not xemacs! +Use this when temacs builds successfully, but xemacs does not. +end + +define dump-temacs + environment-to-run-temacs + run -batch -l ../lisp/loadup.el dump +end + +document dump-temacs +Usage: dump-temacs +Run the dumping part of the build procedure. +Use when debugging temacs, not xemacs! +Use this when temacs builds successfully, but xemacs does not. +end + +# if you use Purify, do this: +# export PURIFYOPTIONS='-pointer-mask=0x0fffffff' + +define ldp + printf "%s", "Lisp => " + call debug_print($arg0) +end + +document ldp +Usage: ldp lisp_object +Print a Lisp Object value using the Lisp printer. +Requires a running xemacs process. +end + +define lbt +call debug_backtrace() +end + +document lbt +Usage: lbt +Print the current Lisp stack trace. +Requires a running xemacs process. +end + + +define leval +ldp Feval(Fcar(Fread_from_string(build_string($arg0),Qnil,Qnil))) +end + +document leval +Usage: leval "SEXP" +Eval a lisp expression. +Requires a running xemacs process. + +Example: +(gdb) leval "(+ 1 2)" +Lisp ==> 3 +end + + +define wtype +print $arg0->core.widget_class->core_class.class_name +end + +define xtname +print XrmQuarkToString(((Object)($arg0))->object.xrm_name) +end + +# GDB's command language makes you want to ... + +define pstruct + set $xstruct = (struct $arg0 *) $val + print $xstruct + print *$xstruct +end + +define pobj + decode_object $arg0 + if $type == Lisp_Type_Int + printf "Integer: %d\n", $val + else + if $type == Lisp_Type_Char + if $val > 32 && $val < 128 + printf "Char: %c\n", $val + else + printf "Char: %d\n", $val + end + else + if $type == Lisp_Type_String || $imp == &lrecord_string + pstruct Lisp_String + else + if $type == Lisp_Type_Cons || $imp == &lrecord_cons + pstruct Lisp_Cons + else + if $type == Lisp_Type_Symbol || $imp == &lrecord_symbol + pstruct Lisp_Symbol + printf "Symbol name: %s\n", $xstruct->name->data + else + if $type == Lisp_Type_Vector || $imp == &lrecord_vector + pstruct Lisp_Vector + printf "Vector of length %d\n", $xstruct->size + #print *($xstruct->data) @ $xstruct->size + else + if $imp == &lrecord_bit_vector + pstruct Lisp_Bit_Vector + else + if $imp == &lrecord_buffer + pstruct buffer + else + if $imp == &lrecord_char_table + pstruct Lisp_Char_Table + else + if $imp == &lrecord_char_table_entry + pstruct Lisp_Char_Table_Entry + else + if $imp == &lrecord_charset + pstruct Lisp_Charset + else + if $imp == &lrecord_coding_system + pstruct Lisp_Coding_System + else + if $imp == &lrecord_color_instance + pstruct Lisp_Color_Instance + else + if $imp == &lrecord_command_builder + pstruct command_builder + else + if $imp == &lrecord_compiled_function + pstruct Lisp_Compiled_Function + else + if $imp == &lrecord_console + pstruct console + else + if $imp == &lrecord_database + pstruct Lisp_Database + else + if $imp == &lrecord_device + pstruct device + else + if $imp == &lrecord_event + pstruct Lisp_Event + else + if $imp == &lrecord_extent + pstruct extent + else + if $imp == &lrecord_extent_auxiliary + pstruct extent_auxiliary + else + if $imp == &lrecord_extent_info + pstruct extent_info + else + if $imp == &lrecord_face + pstruct Lisp_Face + else + if $imp == &lrecord_float + pstruct Lisp_Float + else + if $imp == &lrecord_font_instance + pstruct Lisp_Font_Instance + else + if $imp == &lrecord_frame + pstruct frame + else + if $imp == &lrecord_glyph + pstruct Lisp_Glyph + else + if $imp == &lrecord_hash_table + pstruct Lisp_Hash_Table + else + if $imp == &lrecord_image_instance + pstruct Lisp_Image_Instance + else + if $imp == &lrecord_keymap + pstruct Lisp_Keymap + else + if $imp == &lrecord_lcrecord_list + pstruct lcrecord_list + else + if $imp == &lrecord_lstream + pstruct lstream + else + if $imp == &lrecord_marker + pstruct Lisp_Marker + else + if $imp == &lrecord_opaque + pstruct Lisp_Opaque + else + if $imp == &lrecord_opaque_ptr + pstruct Lisp_Opaque_Ptr + else + if $imp == &lrecord_popup_data + pstruct popup_data + else + if $imp == &lrecord_process + pstruct Lisp_Process + else + if $imp == &lrecord_range_table + pstruct Lisp_Range_Table + else + if $imp == &lrecord_specifier + pstruct Lisp_Specifier + else + if $imp == &lrecord_subr + pstruct Lisp_Subr + else + if $imp == &lrecord_symbol_value_buffer_local + pstruct symbol_value_buffer_local + else + if $imp == &lrecord_symbol_value_forward + pstruct symbol_value_forward + else + if $imp == &lrecord_symbol_value_lisp_magic + pstruct symbol_value_lisp_magic + else + if $imp == &lrecord_symbol_value_varalias + pstruct symbol_value_varalias + else + if $imp == &lrecord_toolbar_button + pstruct toolbar_button + else + if $imp == &lrecord_tooltalk_message + pstruct Lisp_Tooltalk_Message + else + if $imp == &lrecord_tooltalk_pattern + pstruct Lisp_Tooltalk_Pattern + else + if $imp == &lrecord_weak_list + pstruct weak_list + else + if $imp == &lrecord_window + pstruct window + else + if $imp == &lrecord_window_configuration + pstruct window_config + else + echo Unknown Lisp Object type\n + print $arg0 + # Barf, gag, retch + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end + # Repeat after me... gdb sux, gdb sux, gdb sux... + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end + # Are we having fun yet?? + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end +end + +document pobj +Usage: pobj lisp_object +Print the internal C representation of a Lisp Object. +end + +# ------------------------------------------------------------- +# functions to test the debugging support itself. +# If you change this file, make sure the following still work... +# ------------------------------------------------------------- +define test_xtype + printf "Vemacs_major_version: " + xtype Vemacs_major_version + printf "Vhelp_char: " + xtype Vhelp_char + printf "Qnil: " + xtype Qnil + printf "Qunbound: " + xtype Qunbound + printf "Vobarray: " + xtype Vobarray + printf "Vall_weak_lists: " + xtype Vall_weak_lists + printf "Vxemacs_codename: " + xtype Vxemacs_codename +end + +define test_pobj + printf "Vemacs_major_version: " + pobj Vemacs_major_version + printf "Vhelp_char: " + pobj Vhelp_char + printf "Qnil: " + pobj Qnil + printf "Qunbound: " + pobj Qunbound + printf "Vobarray: " + pobj Vobarray + printf "Vall_weak_lists: " + pobj Vall_weak_lists + printf "Vxemacs_codename: " + pobj Vxemacs_codename +end + diff -r f4aeb21a5bad -r 74fd4e045ea6 src/ChangeLog --- a/src/ChangeLog Mon Aug 13 11:12:06 2007 +0200 +++ b/src/ChangeLog Mon Aug 13 11:13:30 2007 +0200 @@ -1,4438 +1,1363 @@ -1999-03-12 XEmacs Build Bot <builds@cvs.xemacs.org> - - * XEmacs 21.2.13 is released - -1999-03-12 SL Baur <steve@xemacs.org> +2000-02-16 Martin Buchholz <martin@xemacs.org> - * file-coding.c: Guard ucs table initialization with ifdef MULE. - -1999-03-10 Stephen J. Turnbull <turnbull@sk.tsukuba.ac.jp> - - * file-coding.c: docstring and comment improvements. - (decode_ucs4) flag possible data loss with comment. - -1999-03-10 Martin Buchholz <martin@xemacs.org> + * XEmacs 21.2.29 is released. - * file-coding.c (Fset_ucs_char): add CHECK_INT, CHECK_CHAR - (ucs_to_char): - (Fucs_char): - (Fset_char_ucs): - (decode_coding_ucs4): - (encode_coding_ucs4): - (detect_coding_utf8): - (decode_coding_utf8): - (encode_utf8): - (encode_coding_utf8): - Add CHECK_* macros where needed to avoid crashes. - #ifdef out all composite character support using - #ifdef ENABLE_COMPOSITE_CHARS - Use normal XEmacs coding standards. - Fix docstrings. - Remove CODING_STREAM_COMPOSE, CODING_STREAM_DECOMPOSE. +2000-02-15 Olivier Galibert <galibert@pobox.com> -1998-09-08 MORIOKA Tomohiko <morioka@jaist.ac.jp> + * fns.c (size_bit_vector): Fix computation of the size. + +2000-02-15 Martin Buchholz <martin@xemacs.org> - * file-coding.c (make-coding-system): Add description about - `ucs-4' and `utf-8'. - (detection_state): Modify to implement ucs-4 and utf-8. - (detect_coding_type): Likewise. - (detect_coding_ucs4): New implementation. - (detect_coding_utf8): New implementation. - (encode_utf8): fixed. - (syms_of_mule_coding): Rename `ucs4' and `utf8' to `ucs-4' and - `utf-8'. + * *.[ch]: Change CONST to const globally. + find -name '*.[ch]' | \ + xargs global-replace \ + 's/(^|(?<=[^A-Za-z0-9_]))CONST((?=[^A-Za-z0-9_])|$)/const/g' + - Remove vestigial references to CONST_IS_LOSING -1998-09-08 MORIOKA Tomohiko <morioka@jaist.ac.jp> - - * file-coding.c (mule_char_to_ucs4): Encode 94x94 chars in ISO - 2022 registry to private area. - -1998-09-07 MORIOKA Tomohiko <morioka@jaist.ac.jp> - - * file-coding.c (encode_utf8): New function. - (encode_coding_utf8): New implementation. - -1998-09-07 MORIOKA Tomohiko <morioka@jaist.ac.jp> +2000-02-13 Jonathan Harris <jhar@tardis.ed.ac.uk> - * file-coding.c (ucs_to_mule_table): New variable; abolish - `Vucs_to_mule_table' - (mule_to_ucs_table): renamed from `Vmule_to_ucs_table'. - (set-ucs-char): New function. - (ucs_to_char): New function. - (ucs-char): New function. - (set-char-ucs): New function. - (char-ucs): New function. - (decode_ucs4): Use `ucs_to_char'. - (complex_vars_of_mule_coding): Abolish `ucs-to-mule-table' and - `mule-to-ucs-table'. + * event-msw.c (mswindows_drain_windows_queue): Remove hack to + bailout early on quit. Enqueue WM_PAINT events as XEmacs magic + events instead of dispatching them directly. + (mswindows_handle_paint): New function to do repainting. + (mswindows_wnd_proc): + (emacs_mswindows_handle_magic_event): Call above function. -1998-09-06 MORIOKA Tomohiko <morioka@jaist.ac.jp> - - * chartab.h: EXFUN `Fget_char_table'. - - * file-coding.c (encode_ucs4): New function. - (encode_coding_ucs4): Use `encode_ucs4'. - -1998-09-06 MORIOKA Tomohiko <morioka@jaist.ac.jp> - - * file-coding.c (decode_coding_ucs4): New implementation. +2000-02-13 Jonathan Harris <jhar@tardis.ed.ac.uk> -1998-09-06 MORIOKA Tomohiko <morioka@jaist.ac.jp> - - * file-coding.c (decode_coding_ucs4): fixed. - - * file-coding.c (Vmule_to_ucs_table): New variable. - (mule_char_to_ucs4): New function. - (encode_coding_ucs4): New implementation. - (complex_vars_of_mule_coding): Define variable - `mule-to-ucs-table'. - -1998-09-06 MORIOKA Tomohiko <morioka@jaist.ac.jp> + * objects-msw.c (mswindows_create_font_variant): Return the new + font handle. + (initialize_font_instance): Get font metrics from the underlined + variant of the font to cope with the case where the underlined + font has a bigger descent. - * file-coding.c (decode_coding_utf8): New implementation. - -1998-09-06 MORIOKA Tomohiko <morioka@jaist.ac.jp> - - * file-coding.c (decode_coding_utf8): fixed. +2000-02-08 Daiki Ueno <ueno@ueda.info.waseda.ac.jp> -1998-09-06 MORIOKA Tomohiko <morioka@jaist.ac.jp> + * gui.c (gui_item_accelerator): Return the first underlined + character in item name. - * file-coding.c (Vucs_to_mule_table): New variable. - (decode_ucs4): Refer `Vucs_to_mule_table'. - (complex_vars_of_mule_coding): Define variable - `ucs-to-mule-table'. - -1998-09-04 MORIOKA Tomohiko <morioka@jaist.ac.jp> +2000-02-11 Kirill 'Big K' Katsnelson <kkm@dtmx.com> - * file-coding.c (detect_coding_ucs4): New function (not - implemented yet). - (decode_coding_ucs4): New function. - (encode_coding_ucs4): New function (not implemented yet). - (detect_coding_utf8): New function (not implemented yet). - (decode_coding_utf8): New function. - (encode_coding_utf8): New function (not implemented yet). - (make-coding-system): New type `ucs4' and `utf8'. - (coding-system-type): Likewise. - (detection_state): Add `ucs4' and `utf8'. - (detect_coding_type): Likewise. - (mule_decode): Use `decode_coding_ucs4' and `decode_coding_utf8'. - (mule_encode): Use `encode_coding_ucs4' and `encode_coding_utf8'. - (decode_ucs4): New function (very incomplete). - (syms_of_mule_coding): Add `ucs4' and `utf8'. + * lisp.h: Added Qprinter. - * file-coding.h: Add definitions for UCS-4 and UTF-8. - -1999-03-08 Martin Buchholz <martin@xemacs.org> + * general.c (syms_of_general): Initialized it. - * mule-charset.c: - (non_ascii_valid_char_p): - (lookup_composite_char): - (composite_char_string): - (make-composite-char): - (composite-char-string): - (syms_of_mule_charset): - (complex_vars_of_mule_charset): - * mule-charset.h (LEADING_BYTE_COMPOSITE): - (CHAR_LEADING_BYTE): - (MAKE_CHAR): - * file-coding.h (CODING_STATE_COMPOSITE): - (CODING_STATE_ISO2022_LOCK): - (iso_esc_flag): - (LEADING_BYTE_COMPOSITE): - * file-coding.c (struct iso2022_decoder): - (decoding_closer): - (reset_iso2022): - (parse_iso2022_esc): - (encode_coding_iso2022): - #ifdef out all composite character support using - #ifdef ENABLE_COMPOSITE_CHARS + * redisplay-msw.c (get_frame_dc): Conditionally start a new page. + (get_frame_dc): + (get_frame_compdc): Made inline. - * alloc.c: Define lrecord_coding_system only if ! FILE_CODING - -1999-03-04 Takeshi YAMADA <yamada@cslab.kecl.ntt.co.jp> + * console.h (struct console_methods): Added eject_page method. - * fns.c (Fbase64_encode_string): Calculate `allength' in the same - way of `Fbase64_encode_region'. - -1999-02-18 Katsumi Yamaoka <yamaoka@jpl.org> - - * fns.c (base64_encode_1): Don't add a newline at the tail. + * frame.h: Added FRAME_DISPLAY_P and friends. + Aligned backslahes in many macros in more readable fashion. + Added page_number to struct frame, and an accessor macro + for it. -1999-03-08 Andy Piper <andy@xemacs.org> + * defice.h: Added DEVICE_DISPLAY_P and friends. - * menubar-msw.c (displayable_menu_item): correct off-by-one & - handling. - -1999-03-07 Martin Buchholz <martin@xemacs.org> + * device.c (Fdevice_printer_p): Used these. - * console-stream.h (struct stream_console): - * event-unixoid.c (event_stream_unixoid_select_console): - (event_stream_unixoid_unselect_console): - * print.c (Fexternal_debugging_output): - * sysdep.c (reset_one_device): - * console-stream.c (stream_init_console): - (stream_delete_console): - (allocate_stream_console_struct): move into stream_init_console. - (free_stream_console_struct): move into stream_delete_console. - Use `fd' only for file descriptors. - Therefore, rename members of struct stream_console. + * frame.c (allocate_frame_core): Initialize page number. + (Fprint_job_page_number): + (Fprint_job_eject_page): Implemented. - * systime.h: Unix98 says sys/time.h should define select(), but - some systems define that in unistd.h. So include that file always. - - * glyphs.h (MAYBE_IIFORMAT_METH): Don't use leading `_'. Avoid - multiple evaluation of first arg. Do proper do {} while (0) wrapping. - (HAS_IIFORMAT_METH_P): Prevent macro from being used in - non-boolean context - (MAYBE_IIFORMAT_DEVMETH): Use standard internal macro naming convention. - - * EmacsShell.c: - * balloon_help.c: - Add #include <stdio.h>. - Some versions of assert.h use printf() without #include'ing stdio.h + * frame-msw.c (msprinter_eject_page): Added method. + (msprinter_start_page): Added. - * free-hook.c (blocktype): Add gcpro5_type to blocktype. - (log_gcpro): Remove unused variable FRAME. - (show_gcprohist): Ansify. - Comment the #endif's - - * frame-x.c (x_delete_frame): Don't use FRAME_X_SHELL_WIDGET(f) - after it's just been XtDestroy'ed! + * window.c (Fwindow_truncated_p): Fixed docstring. + (Fwindow_last_line_visible_height): Implemented. -1999-02-18 Martin Buchholz <martin@xemacs.org> +2000-02-09 Yoshiki Hayashi <yoshiki@xemacs.org> - * opaque.c (print_opaque): - (sizeof_opaque): - (equal_opaque): - (hash_opaque): - Egcs 1.1.1 seems to have a bug where - INTP (p->size_or_chain) - will crash XEmacs. Fix by introducing intermediate variable. + * frame.c (change_frame_size_1): Undo 2000-02-03 change. - * sound.c (Fdevice_sound_enabled_p): Fix compiler warning. +1999-12-20 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp> - * dired.c (Fdirectory_files): - (Ffile_name_completion): - (Ffile_name_all_completions): - (file_name_completion): - - Use `directory' instead of `dirname' to sync with FSF Emacs and - avoid compiler warnings. - - Fix up docstrings so that C variables match documentation. + * syntax.c (scan_words): Always advance at least one character. -1999-03-05 Martin Buchholz <martin@xemacs.org> - - * alloc.c: (garbage_collect_1): Reorg code to make scope of local - variables as small as possible to help out the compiler and the maintainer. +2000-02-13 Andy Piper <andy@xemacs.org> - * alloc.c: (disksave_object_finalization): - Set all the *-load-path variables to - nil, not just load-path itself. This gets the locate-file hash - tables garbage collected BEFORE dump, and has the side effect of - preventing crashes on OSF4.0+egcs. + * redisplay.c (add_glyph_rune): call get_glyph_cachel_index here + to make sure the glyph is in the cachels. - * alloc.c: - * gdbinit: - * dbxrc: - - Clean up gdb/dbx debugging support. - - Storing an EMACS_INT in an enum is not 64-bit clean! - - So change the enum to a set of separate variables. - - Add test cases to help debug the debugging support! - - Add `lisp-shadows' and `run-temacs' targets for dbx. - - Both dbx and gdb have been tested now. - -1999-03-05 XEmacs Build Bot <builds@cvs.xemacs.org> - - * XEmacs 21.2.12 is released - -1999-02-16 Kazuyuki IENAGA <ienaga@jsys.co.jp> - - * device-x.c: Support to find best visual without flashing. - -1999-03-02 Paul Keusemann <pkeusem@visi.com> - - * database.c (berkdb_map): Add flags argument to cursor call (must - be 0 according to docs) required for Berkeley DB 2.6.4 and later. - -1999-03-03 Martin Buchholz <martin@xemacs.org> - - * hash.c: - * hash.h: - General cleanup. Get free-hook.c working again. - Remove unused functions: - make_strings_hash_table, copy_hash, expand_hash_table. - - * malloc.c: - * mem-limits.h: - Always use new ANSI-style function prototypes. - - * unexalpha.c (unexec): Never use implicit int. + * glyphs.h (struct Lisp_Image_Instance): make layout_changed a + global image instance flag. + (IMAGE_INSTANCE_NEEDS_LAYOUT): new macro. + (XIMAGE_INSTANCE_NEEDS_LAYOUT): ditto. - * sgiplay.c (close_sound_file): - (play_sound_file): - (restore_audio_port): - (play_sound_data): - (audio_initialize): - (play_internal): - (drain_audio_port): - (write_mulaw_8_chunk): - (write_linear_chunk): - (write_linear_32_chunk): - (initialize_audio_port): - (open_audio_port): - (set_channels): - (set_output_format): - (adjust_audio_volume): - (get_current_volumes): - (parse_snd_header): - Always use new ANSI-style function prototypes. - Use unistd.h for missing prototypes. - - * unexelfsgi.c (round_up): - (find_section): - (unexec): Always use new ANSI-style function prototypes - - * elhash.c (struct Lisp_Hash_Table): rename golden to golden_ratio + * glyphs.c (allocate_image_instance): set dirty bits correctly. + (Fset_image_instance_property): mark layout as changed. + (invalidate_glyph_geometry_maybe): mark layout as changed. + (glyph_width): use new NEEDS_LAYOUT macro. + (glyph_ascent): ditto. + (glyph_descent): ditto. + (glyph_height): ditto. + (image_instance_layout): mark layout as clean after laying out. + (update_subwindow): don't mark layout as clean here. - * console.h (struct console_methods): Always use full ANSI prototypes - - * emacs.c (__sti__iflPNGFile_c___): Always use full ANSI prototypes + * glyphs-x.h (IMAGE_INSTANCE_X_WIDGET_ID): undo C++ changes, they + should no longer be needed. -1999-03-02 Andy Piper <andy@xemacs.org> - - * event-stream.c (init_event_stream): make sure native mswindows - gets an appropriate event loop. - -1999-02-22 Andy Piper <andy@xemacs.org> + * glyphs-x.c (x_update_widget): sanitize asserts. + (x_finalize_image_instance): sanitize assignment to widgets. - * frame-msw.c (mswindows_make_frame_visible): use SW_SHOW rather - than SW_SHOWNORMAL to prevent resizing of maximised frames. - (mswindows_raise_frame): remove comment. - -1999-03-01 XEmacs Build Bot <builds@cvs.xemacs.org> - - * XEmacs 21.2.11 is released + * glyphs-widget.c (widget_instantiate): don't need to clear the + layout flag here. -1999-02-25 SL Baur <steve@xemacs.org> +2000-02-13 Martin Buchholz <martin@xemacs.org> - * mule-charset.c (Qleading_byte): New variable to implement - charset-leading-byte function. - (Fcharset_property): Use it. - (syms_of_mule_charset): Initialize it. - From Kazuyuki IENAGA <ienaga@jsys.co.jp> + * sysdep.c (getcwd): Use standard prototype. + * sysdep.h (getcwd): Use standard prototype. -1999-02-17 Kazuo Oishi <oishi@ae.agr.yamaguchi-u.ac.jp> - - * glyphs-x.c (cononvert_EImage_to_XImage): correct - bytes per pixel counting. - -1999-02-15 Andy Piper <andy@xemacs.org> - - * s/cygwin32.h (BROKEN_SIGIO): don't define this as it causes - major lockups. - -1999-02-16 MORIOKA Tomohiko <morioka@jaist.ac.jp> - - * fns.c (Fbase64_encode_string): New optional argument - `NO_LINE_BREAK'. - -1999-02-16 Martin Buchholz <martin@xemacs.org> + * fns.c (Fsubseq): Change parameters to more natural ANSI Lisp + (sequence, start, end). + Remove redundant type checking. + (Fmapconcat): Remove useless GCPRO, a wrong-headed attempt (in + view of `caller-protects') to avoid a crash where the real fix was + found elsewhere. - * gdbinit: Fix up commands to run temacs. Add lisp-shadows command. - * alloc.c (xcalloc): undef xcalloc, just like xmalloc - -1999-02-10 Martin Buchholz <martin@xemacs.org> - - * s/bsdos4.h: New file. Port to BSDI BSD/OS 4.0. - * xintrinsic.h: Redo CONST support for X11 R4 compatibility. - -1999-02-05 XEmacs Build Bot <builds@cvs.xemacs.org> +2000-02-12 Martin Buchholz <martin@xemacs.org> - * XEmacs 21.2.10 is released - -1999-02-02 Gleb Arshinov <gleb@cs.stanford.edu> - - * process-nt.c (nt_send_process): - Fix for process-send-region/process-send-string breaking when size - of the input > 128 chars: change maximum chunk size for process - stream from 512 to 128, thus guaranteeing that ntpipe_shove_writer - succeeds. - -1999-02-02 XEmacs Build Bot <builds@cvs.xemacs.org> + * glyphs-x.c (x_finalize_image_instance): Compile error fixes. - * XEmacs 21.2.9 is released - -1999-01-30 Martin Buchholz <martin@xemacs.org> - - * bytecode.c (funcall_compiled_function): Call - UNBIND_TO_GCPRO instead of UNBIND_TO_GCPRO_VARIABLES_ONLY. + * s/sol2.h: Remove feature macro initialization. - * backtrace.h (UNBIND_TO_GCPRO_VARIABLES_ONLY): - #ifdef 0 out unused macro. - -1999-01-27 Martin Buchholz <martin@xemacs.org> - - * gui.c (gui_parse_item_keywords_internal): Make static. - -1999-01-21 Andy Piper <andy@xemacs.org> + * alloc.c (alloc_lcrecord): Add more type checking assertions. + (vector_hash): New. Code from internal_hash. + * lrecord.h: + Fix up allocation subsystem comments. - * glyphs-msw.c: add xface support. - (mswindows_xface_instantiate): new function copied from glyphs-x.c - (image_instantiator_format_create_glyphs_mswindows): do device - specific initialisation for xfaces. - (xbm_create_bitmap_from_data): line data must be padded to a word - boundary. + * config.h.in: Add __EXTENSIONS__ for Solaris. - * glyphs-x.c (xface_validate): moved to glyphs.c - (xface_normalize): ditto. - (xface_possible_dest_types): ditto. - (image_instantiator_format_create_glyphs_x): do device specific - initialisation for xfaces. - - * glyphs.h: declare xface symbol. - - * glyphs.c: move generic xface support here. - (xface_validate): moved from glyphs-x.c - (xface_normalize): ditto. - (xface_possible_dest_types): ditto. - (image_instantiator_format_create): xface declarations moved from - glyphs-x.c. - -1999-01-14 Adrian Aichner <aichner@ecf.teradyne.com> + * systime.h (EMACS_GETTIMEOFDAY): New. + (EMACS_GET_TIME): Use EMACS_GETTIMEOFDAY. + Remove Solaris-specific code. + Use void* for the (ignored) second arg for gettimeofday(). - * event-stream.c (vars_of_event_stream): Fixing documentation. - -1999-01-17 Gunnar Evermann <ge204@eng.cam.ac.uk> - - * glyphs-eimage.c (gif_instantiate): Correct handling of - interlaced gifs to avoid writing past the end of the eimage - buffer. + * elhash.c (hash_table_hash): Implement it, finally. + * elhash.c: Use hashcode_t. -1999-01-13 Hrvoje Niksic <hniksic@srce.hr> - - * search.c (Freplace_match): Handle single backslash at end of - NEWTEXT correctly. - -1999-01-12 William M. Perry <wmperry@aventail.com> - - * eldap.c (Fldap_open): slow down interrupts around ldap_open to - avoid connection errors. + * linuxplay.c (sighandler): Fix prototypes to use SIGTYPE. + * sunplay.c (sighandler): Fix prototype to use SIGTYPE. -1999-01-12 Andy Piper <andy@xemacs.org> - - * redisplay-output.c (redisplay_update_line): backout change that - shouldn't have gone ine. - -1999-01-09 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> - - * eldap.c (vars_of_ldap): Do no provide `ldap' here since it may - collide with ldap.el - -1999-01-11 Andy Piper <andy@xemacs.org> - - * redisplay.h (DISPLAY_LINE_HEIGHT): new macro. - (DISPLAY_LINE_YPOS): new macro. - - * redisplay-msw.c (mswindows_output_string): use it. - (mswindows_output_pixmap): ditto. - (mswindows_output_display_block): ditto. + * lisp.h (STRETCHY_STRUCT_SIZEOF): Delete. + * fns.c (size_bit_vector): + * alloc.c (size_vector): + (make_vector_internal): + (make_bit_vector_internal): + (sweep_bit_vectors_1): + Replace calls to STRETCHY_STRUCT_SIZEOF with offsetof expression. - * redisplay-output.c (redisplay_output_display_block): new - function. just call the devmeth, maybe insert some generic code - here later. - (compare_display_blocks): use it. - (output_display_line): ditto. - (redisplay_unmap_subwindows_maybe): new function. potentially - unmap subwindows in the given area. - - * glyphs.c (reset_subwindow_cachels): unmap subwindows that we are - resetting. +2000-02-10 Martin Buchholz <martin@xemacs.org> -1999-01-10 J. Kean Johnston <jkj@sco.com> + * s/aix4.h: #define MAP_FAILED if sys/mman.h didn't. + Include strings.h to avoid warnings for bzero and strcasecmp. - * Makefile.in.in: Set value of moduledir - - Changed DUMPENV to include $(MODULEPATH) - - Added install rule to install header files for use by ellcc. - - * config.h.in: Added INHIBIT_SITE_MODULES - - Added HAVE__DLERROR - - Added HAVE_DLFCN_H - - Added DLSYM_NEEDS_UNDERSCORE +2000-02-10 Olivier Galibert <galibert@pobox.com> - * dll.c: Removed. - - * emodules.c: New file containing dynamic loading code. - - * emodules.h: New file. + * alloc.c: Move STRETCHY_STRUCT_SIZEOF from here... + * lisp.h (STRETCHY_STRUCT_SIZEOF): ...to here - * emacs.c: Added variables Vmodule_directory, - Vsite_module_directory, Vconfigure_module_directory and - Vconfigure_site_module_directory. - - (main_1): Added new variable inhibit_site_modules and command - line options `-no-site-modules' and `--no-site-modules'. - - (main_1): Call syms_of_module() instead of syms_of_dll(). - - (main_1): Call vars_of_module(). - - (vars_of_emacs): Introduce inhibit-site-modules, - module-directory, configure-module-directory, - site-module-directory, and configure-site-module-directory to the - Lisp reader. + * fns.c (size_bit_vector): New. Declare bit vectors as a + sequence. - * lisp.h: Declare load_module and list_modules, as well as - Vmodule_directory, Vsite_module_directory, - Vconfigure_module_directory and Vconfigure_site_module_directory. +2000-02-10 Olivier Galibert <galibert@pobox.com> - * paths.h.in: Added PATH_MODULESEARCH and PATH_SITE_MODULES. - - Added correct support for site-lisp directory. - - * symbols.c (defsubr): Modified to allow modules to add new subrs - after dump time. - - (defsubr_macro): Same. - - (defvar_magick): Only use purespace when not initialized, so - that loaded modules can still add symbols. - - * symsinit.h: Add definitions for syms_of_module(), - vars_of_module(). Removed syms_of_dll(). - - * sysdll.c: Include dlfcn.h if HAVE_DLFCN_H is defined. - - (dll_variable): Take DLSYM_NEEDS_UNDERSCORE into account. - - (dll_error): use _dlerror() if HAVE__DLERROR is defined. - - * s/sco5-shr.h (C_SWITCH_SYSTEM): Correct for modern gcc and - explicitly pass -belf for native cc. - - * s/sco5.h (LIB_GCC): Use -print-libgcc-file-name instead of - hard-coding the library name. - -1999-01-01 <martin@xemacs.org> - - * device-x.c (Fx_set_font_path): - Add proper cast to permit compilation under C++. - - * buffer.c (directory_is_current_directory): - Add proper casts to permit compilation under C++. - -1998-12-30 Damon Lipparelli <lipp@primus.com> - - * event-msw.c (mswindows_wnd_proc): - Fixed failure when building with MSVC 5. - -1998-12-29 Martin Buchholz <martin@xemacs.org> + * symeval.h (struct symbol_value_magic): Remove "next" kludge and + use a value field instead. + (symbol_value_forward_forward): Use value field. + (DEFVAR_SYMVAL_FWD): Use value field. + (DEFVAR_SYMVAL_FWD_INT): Added. Dumps the int with dumpopaque. + (DEFVAR_INT): Use DEFVAR_SYMVAL_FWD_INT. + (DEFVAR_CONST_INT): Ditto. + (DEFVAR_BOOL): Ditto. + (DEFVAR_CONST_BOOL): Ditto. + (DEFVAR_INT_MAGIC): Ditto. + (DEFVAR_BOOL_MAGIC): Ditto. - * file-coding.c (decode_coding_iso2022): - - Prevent crash when decoding ISO7/Lock detected files - - the usual martin fiddling - -1998-12-29 Jonathan Harris <jhar@tardis.ed.ac.uk> + * symbols.c (guts_of_unbound_marker): Use value field. + * console.c (DEFVAR_CONSOLE_LOCAL_1): Ditto. + * buffer.c (DEFVAR_BUFFER_LOCAL_1): Ditto. - * event-msw.c: - glyphs-msw.c: - Fixed failures when building with MSVC. - * unexnt.c (dump_bss_and_heap): - Removed compiler warning by removing bss_data variable. - -1998-12-18 Jim Radford <radford@robby.caltech.edu> - - * device-x.c (Fx_set_font_path, Fx_get_font_path): New functions - so that packages that distribute their own fonts can access them. - -1998-12-28 Andy Piper <andy@xemacs.org> + * lisp.h: Declare dumpopaque and noninteractive1. - * glyphs-msw.c (mswindows_button_instantiate): cope with buttons - that have an image provided. - - * glyphs.h: add Q_image decl. + * alloc.c (dumpopaque): Added. + (pdump_dump_opaquevec): Added. + (pdump): Call pdump_dump_opaquevec to dump opaque data. + (pdump_load): Reload opaque data. Sync noninteractive1 with + noninteractive. - * glyphs-widget.c new functionality allowing images in - widgets. - (check_valid_glyph_or_image): new function to validate - glyphs passed in through :image. - (widget_normalize): new function. convert :image parameters into - real glyphs if not already so. - (widget_instantiate_1): mess with size parameters to be similar to - :image if provided. - (syms_of_glyphs_widget): new keyword :image. - (image_instantiator_format_create_glyphs_widget): normalize - buttons and allow :image. +2000-02-10 Andy Piper <andy@xemacs.org> -1998-12-27 Andy Piper <andy@xemacs.org> - - * frame-msw.c (mswindows_init_frame_1): warning elimination. + * glyphs.c (image_instance_layout): if the size changes, mark it + as such. - * glyphs-widget.c (check_valid_anything): no-op function. - (check_valid_callback): check callbacks in gui_items. - (check_valid_symbol): as it sounds. - (check_valid_string_or_vector): ditto. - (widget_validate): modified for descriptors that are vectors or - sequences of keyword/val pairs. - (widget_instantiate_1): ditto. - (image_instantiator_format_create_glyphs_widget): allow gui_item - keywords in the instantiator. + * redisplay-output.c (redisplay_output_layout): Update the + subwindow here. + (redisplay_output_subwindow): ditto. - * gui.c (gui_parse_item_keywords_internal): renamed from - gui_parse_item_keywords but taking error behaviour. - (gui_parse_item_keywords): use it. - (gui_parse_item_keywords_no_errors): ditto. - (gui_item_add_keyval_pair): add Error_behavior flag and only - signal invalid keywords if required. - - * gui.h: new gui signatures. + * glyphs.c (update_subwindow): make sure we reset flags for + layouts as well as everything else. - * menubar.c (menu_parse_submenu_keywords): use new - gui_item_add_keyval_pair signature. - - * s/cygwin32.h: modify PTY_ITERATION to eliminate warnings. - -1998-12-28 Martin Buchholz <martin@xemacs.org> - - * XEmacs 21.2.8 is released. - -1998-12-28 Martin Buchholz <martin@xemacs.org> + * glyphs-widget.c (layout_layout): don't need to set the instances + dimensions here. - * editfns.c (get_home_directory): - (user-home-directory): Simplify. - +2000-02-09 Martin Buchholz <martin@xemacs.org> - * callproc.c (child_setup): - - Environment variables were being passed to inferior processes - using internal encoding. - - Convert to external encoding. - - Rename local var `tem' to better name `tail'. - - Use Flength instead of `manual' calculation. + * device-x.c (x_init_device): Wrap calls to dll_* in HAVE_SHLIB, + not HAVE_DLOPEN, which is a lower-level thing. - * buffer.c (kill-buffer): - (record-buffer): - (set-buffer-major-mode): - (current-buffer): - - Fix up parameter names to correspond to docstrings. - - Don't use `bufname' when a buffer will do as well. - - Remove one unneeded GCPRO. + * .cvsignore: Ignore gmon.out - * buffer.h (initial_directory): - * buffer.c (init_initial_directory): - - use correct conversions between internal and external format. - (directory_is_current_directory): new function - (init_buffer): convert initial_directory to internal format. - - solve crashes when current working directory is non-ASCII. +2000-02-09 Hamish Macdonald <hamishm@lucent.com> - * alloc.c (xmalloc): - (xcalloc): - (xrealloc): - - remove stupid casts, since XEmacs requires an ANSI C system. - (lrecord_type_index): replace abort() with more readable assert(). + * .cvsignore: Ignore portable dumper xemacs.dmp file - (reset_lcrecord_stats): remove. - (sweep_lcrecords_1): - - replace call to reset_lcrecord_stats() with call to xzero(). - -1998-12-27 Martin Buchholz <martin@xemacs.org> +2000-02-09 Andy Piper <andy@xemacs.org> - * process-unix.c (unix_create_process): - - Fix crash invoking program with non-ASCII name. - Try invoking xemacs with SHELL=/bin/sh, then M-x shell. - - Remove unused variable `env'. - - Rename `temp' to better name `save_errno'. - - Reorganize code for clarity. But still too chicken to nuke the - BSD 4.2 support. + * redisplay-output.c (redisplay_output_layout): be more clever + about when we output based on the changed flags. -1998-12-24 Martin Buchholz <martin@xemacs.org> - - * XEmacs 21.2.7 is released. - -1998-12-23 Martin Buchholz <martin@xemacs.org> - - * glyphs.c (decode_device_ii_format): - - Fix indentation. - - Use GET_C_STRING_FILENAME_DATA_ALLOCA with char *, not Extbyte *. + * glyphs.h (struct image_instantiator_methods): add update_method. + (struct Lisp_Image_Instance): add changed flags. Declare new + macros for manipulating them. - * glyphs-x.c (x_subwindow_instantiate): - - A image instance mask was being assigned to a image instance type! - - X_SUBWINDOW_INSTANCE_DATA (ii) is not an lvalue in C++. - - * glyphs-msw.c (mswindows_initialize_dibitmap_image_instance): - Fix indentation. - * glyphs-x.h: Make indentation consistent. - - * emacs.c (Fdump_emacs): Remove Steve Martin merge artifacts. - - * glyphs-widget.c (check_valid_glyph): Warning suppression. - - Make it static - - #ifdef it out, since it's not actually used yet (FIX THIS!) - - * glyphs-widget.c: - * glyphs.h: - Move declarations of decode_device_ii_format and - decode_image_instantiator_format into glyphs.h where they belong. - -1998-12-22 Martin Buchholz <martin@xemacs.org> - - * frame-x.c (x_delete_frame): Revert part of my changes at the - suggestion of Gunnar Evermann - unfortunately no one really - understands this code. - - * callproc.c (init_callproc): code cleanup. + * glyphs.c (allocate_image_instance): renamed glyph -> parent. + (image_instance_parent_glyph): find an image_instance's parent + glyph or image_instance. + (image_instance_layout): mark the size as changed. + (set_image_instance_dirty_p): new function. mark an image + instance, plus all of its parents, as dirty. + (Fset_image_instance_property): use it. + (Fglyph_animated_timeout_handler): use it. + (update_subwindow): call update_widget and device methods for + update_subwindow. Mark all changed flags as clean. + (Fresize_subwindow): mark size as changed. - * free-hook.c (malloc): - (check_malloc): - (__free_hook): - (__malloc_hook): - (__realloc_hook): - (block_input_malloc): - (block_input_realloc): - * device-x.c (x_delete_device): - * emacs.c (voodoo_free_hook): - * events.c (print_event): - (CHECK_EVENT_TYPE): - (CHECK_EVENT_TYPE2): - (CHECK_EVENT_TYPE3): - Use proper prototypes. - Make C_E_T macros a little faster. - Pedantic fiddly little changes. You really don't care. - -1998-12-22 Andy Piper <andy@xemacs.org> - - * redisplay-output.c (redisplay_clear_region): make sure that - fg/bg colors get set even when we are in the border area. - -1998-12-13 Martin Buchholz <martin@xemacs.org> - - * console-msw.c: Function definitions follow coding standards - - This prevents e.g. find-tag on Lisp_Event finding DEVENT - -1998-12-11 Martin Buchholz <martin@xemacs.org> - - * events.h (struct timeout_data): - * event-tty.c (tty_timeout_to_emacs_event): - * event-msw.c (mswindows_wm_timer_callback): - * event-Xt.c (Xt_timeout_to_emacs_event): - * event-msw.c (mswindows_cancel_dispatch_event): - Make sure Lisp_Objects inside events are initialized to Qnil, not - Qnull_pointer, which is now illegal. - -1998-12-10 Martin Buchholz <martin@xemacs.org> - - * lisp.h: Fix up prototypes to match alloc.c - -1998-12-08 Martin Buchholz <martin@xemacs.org> - - * windowsnt.h: Remove `support' for using index and rindex - - * filelock.c (current_lock_owner): - - Change uses of index -> strchr, rindex -> strrchr - -1998-12-07 Martin Buchholz <martin@xemacs.org> + * glyphs-x.c (x_finalize_image_instance): try and detect gc + failures. + (x_update_subwindow): only resize subwindows here. + (x_update_widget): new function. Update all changed properties of + a widget. + (x_resize_subwindow): deleted. + (x_widget_set_property): deleted. + (x_progress_gauge_set_property): deleted. + (x_progress_gauge_update): new function. Implement recorded + changes. + (x_tab_control_update): ditto. + (x_tab_control_set_property): deleted. + (console_type_create_glyphs_x): declare new functions. + (image_instantiator_format_create_glyphs_x): ditto. - * sysdep.c (set_descriptor_non_blocking): - Since O_NONBLOCK is now always #defined, make use of fcntl - conditional on F_SETFL being defined. - - * console-msw.c (DHEADgER): - (DOPAQUE_DATA): - (DEVENT): - (DCONS): - (DCONSCDR): - (DSTRING): - (DVECTOR): - (DSYMBOL): - (DSYMNAME): - - max_align_t should not be visible to the user of the - XOPAQUE_DATA macro. - - use Bufbyte instead of char - - parens around (FOOP (obj)) are always redundant. - If they were necessary, we should fix the macro instead. - - Always use string_data(foo) instead of foo->data. - - -1998-12-06 Martin Buchholz <martin@xemacs.org> - - * frame-msw.c (mswindows_init_frame_1): - - use make_lisp_hash_table, not Fmake_hash_table - - include elhash.h - - * lisp.h: - * alloc.c (make_vector): remove travesty - (Fmake_vector): - (make_pure_vector): - (pure_cons): - (make_bit_vector_internal): - (make_bit_vector): - (make_bit_vector_from_byte_vector): - (Fmake_bit_vector): - - make vector_equal a little faster. - - Don't use variable name `new'. - - Use size_t instead of EMACS_INT. - - usual Martin-style pointless bit-twiddling. + * glyphs-widget.c (widget_set_property): mark text changed. + (update_widget): new function. Update properties of a widget. + (widget_instantiate): for layouts make sure we set their + children's parent correctly. + (tab_control_set_property): new function. Record changes that will + take place under redisplay's control. + (progress_gauge_set_property): ditto. + (image_instantiator_progress_guage): declare new functions. + (image_instantiator_tab_control): ditto. - * fns.c (mapcar1): - (Fmapconcat): - (Fmapcar): - (Fmapvector): - Make mapcar faster. In particular, make - (mapc #'identity long-string) - MUCH faster under Mule. - * tests/automated/lisp-tests.el: Test 'em! - - * bytecode.c (Ffetch_bytecode): Fix crash when loading lazy-loaded - bytecode. - -1998-12-01 Martin Buchholz <martin@xemacs.org> - - * menubar-x.c (menu_item_descriptor_to_widget_value_1): Always use - Qnil, not NULL, to initialize `null' Lisp_Objects. - -1998-11-29 Hrvoje Niksic <hniksic@srce.hr> - - * specifier.c (display_table_validate): Update. + * glyphs-msw.c (mswindows_update_subwindow): just do resizing here + now. + (mswindows_update_widget): new function. Update all properties on + a widget that have changed. + (mswindows_button_update): new function. Update a button's set + state. + (mswindows_tab_control_update): new function. Update the items in + a tab. + (mswindows_tab_control_set_property): deleted. + (mswindows_progress_gauge_update): new function. Update the + progress gauge's progress. + (mswindows_widget_set_property): deleted. This is all done + asynchronously now. + (mswindows_progress_gauge_set_property): ditto. + (console_type_create_glyphs_mswindows): declare new methods. + (image_instantiator_format_create_glyphs_mswindows): ditto. - * redisplay.c (create_text_block): Use them. - - * glyphs.c (display_table_entry): New function. - (get_display_tables): Ditto. - -1998-12-15 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> + * frame-msw.c (msprinter_init_frame_1): Remove unused variables. + (msprinter_set_frame_properties): ditto. - * eldap.c (toplevel): Mention that eldap.c compiles with - OpenLDAP libs - (Fldap_open): Use `GET_C_STRING_OS_DATA_ALLOCA' - (Fldap_search_internal): Ditto - -1998-12-11 Martin Buchholz <martin@xemacs.org> - - * event-msw.c (mswindows_cancel_dispatch_event): - Gratuitous code prettification - - -1998-12-07 Hrvoje Niksic <hniksic@srce.hr> - - * fns.c (Fnconc): Fix use of wrong_type_argument(). + * console.h (struct console_methods): Add update_widget_method. - * floatfns.c (Ffloat): Fix docstring. - (Ffloat): Fix use of wrong_type_argument(). - (Fabs): Ditto. - (extract_float): Ditto. - (Fceiling): Ditto. - (Fround): Ditto. - (Ftruncate): Ditto. - -1998-12-06 Martin Buchholz <martin@xemacs.org> - - * frame-msw.c (mswindows_init_frame_1): - - use make_lisp_hash_table, not Fmake_hash_table - - include elhash.h +2000-02-09 Andy Piper <andy@xemacs.org> - * lisp.h: - * alloc.c (make_vector): remove travesty - (Fmake_vector): - (make_pure_vector): - (pure_cons): - (make_bit_vector_internal): - (make_bit_vector): - (make_bit_vector_from_byte_vector): - (Fmake_bit_vector): - - make vector_equal a little faster. - - Don't use variable name `new'. - - Use size_t instead of EMACS_INT. - - usual Martin-style pointless bit-twiddling. + * gui-msw.c (Fmswindows_shell_execute): Make + mswindows-shell-execute industrial strength. - * fns.c (mapcar1): - (Fmapconcat): - (Fmapcar): - (Fmapvector): - Make mapcar faster. In particular, make - (mapc #'identity long-string) - MUCH faster under Mule. - * tests/automated/lisp-tests.el: Test 'em! - - * bytecode.c (Ffetch_bytecode): Fix crash when loading lazy-loaded - bytecode. +2000-02-08 Martin Buchholz <martin@xemacs.org> -1998-12-02 Didier Verna <verna@inf.enst.fr> - - * menubar-x.c (menu_item_descriptor_to_widget_value_1): set the - accelerator field to nil for labels. - -1998-12-16 Jonathan Harris <jhar@tardis.ed.ac.uk> - - * menubar-msw.c (displayable_menu_item): - Escape occurrences of '&' and support occurrences of the - '%_' accelerator indicator in menus. - -1998-11-26 Didier Verna <verna@inf.enst.fr> - - * dired.c (Fdirectory_files): use make_string instead of - make_ext_string on the filename. The conversion external->internal - format is already done in sys_readdir. - -1998-12-15 Gunnar Evermann <ge204@eng.cam.ac.uk> - - * glyphs.c (normalize_image_instantiator): GCPRO instantiator + * lrecord.h: Make macro argument `props' match member function `plist'. + * fns.c (Fget): + * fns.c (Fput): + * fns.c (Fremprop): + * fns.c (Fobject_plist): + * alloc.c: + * symbols.c: + Object property list frobbing cleanup. + - Allow any lisp object (compared with `eq'), not just symbols, as + keys in object plists. + - Move symbol plist frobbing into symbols.c, where it belongs. + - Move string plist frobbing into alloc.c, where it belongs. + - Everything's an lrecord now, so no need to test for symbolp, etc. + - Fix up doc strings to refer to PROPERTY, not PROPNAME. -1998-12-16 Jonathan Harris <jhar@tardis.ed.ac.uk> - - * event-msw.c - (Belatedly) added Kirill to list of file's authors. - emacs_mswindows_quit_p: Don't process WM_PAINT messages in - quit checking. WM_PAINT messages cause redisplay, but - windows' states are not necessarily stable when this function - gets called. + * extents.c: Reorder code to remove declarations. -1998-12-17 Andy Piper <andy@xemacs.org> - - * strftime.c (zone_name): CONSTify. - -1998-12-15 Andy Piper <andy@xemacs.org> + * frame.h (store_in_alist): Remove useless declaration. - * glyphs-msw.c (mswindows_combo_instantiate): ditto. - (mswindows_widget_property): return Qunbound when no property available. - (mswindows_button_property): ditto. - (mswindows_combo_property): ditto. - (mswindows_widget_set_property): ditto. +2000-02-07 Martin Buchholz <martin@xemacs.org> - * glyphs-widget.c (check_valid_item_list): use properties. - - * glyphs.h (struct Lisp_Image_Instance): we have properties now. - - * glyphs.c (Fset_image_instance_property): allow setting of arbitrary properties. - (Fimage_instance_property): ditto. - * glyphs-widget.c (widget_property): ditto. - (widget_set_property): ditto. - - * frame-msw.c (mswindows_set_frame_pointer): SetCursor() as well - as setting the class cursor so that GC actually changes the - cursor. - - * config.h: don't undef MAIL_USE_POP. - -1998-12-13 Andy Piper <andy@xemacs.org> + * event-Xt.c (x_has_keysym): Use XConvertCase only if available. + * config.h.in: Add HAVE_XCONVERTCASE. - * glyphs-msw.c - (image_instantiator_format_create_glyphs_mswindows): line -> - label. - (mswindows_label_instantiate): ditto. Play with window flags. - (image_instantiator_format_create_glyphs_mswindows): ditto. - (vars_of_glyphs_mswindows): provide Qlabel as we support it now. +2000-02-07 Andy Piper <andy@xemacs.org> + + * glyphs.c (image_instance_layout): undo 2000-01-29 change since + it breaks many things. - * glyphs-widget.c (widget_instantiate_1): re-jig autosizing to - cope with lines and labels. - (static_instantiate): use widget_instantiate_1. - line -> label. - (image_instantiator_format_create_glyphs_widget): ditto. - -1998-12-10 Andy Piper <andy@xemacs.org> +2000-02-07 Jan Vroonhof <vroonhof@math.ethz.ch> - * Makefile.in.in (objs): add gui.o - -1998-12-10 Andy Piper <andy@xemacs.org> - - * gui.c: adjust defines of HAVE_POPUPS so that we can build with - no window system. - -1998-12-09 Andy Piper <andy@xemacs.org> + * src/syntax.h (SYNTAX_START_P): Check whether the two chars + actually can start a common comment type. + * src/syntax.h (SYNTAX_END_P): ditto for end. - * glyphs.c (finalize_image_instance): mark glyphs changed when an - image instance is removed so that the subwindow cache gets reset - and thus destroyed images get GC'd. - -1998-12-08 Andy Piper <andy@xemacs.org> - - * gui-msw.c (mswindows_handle_gui_wm_command): call - MARK_SUBWINDOWS_CHANGED. +2000-02-07 Martin Buchholz <martin@xemacs.org> - * glyphs-msw.c (mswindows_finalize_image_instance): make sure - subwindows really get deleted. + * XEmacs 21.2.28 is released. - * redisplay.c: new variable subwindows_changed[_set]. - (redisplay_window): use it. - (redisplay_frame): ditto. - (redisplay_device): ditto. - (redisplay_without_hooks): ditto. +2000-02-06 Martin Buchholz <martin@xemacs.org> - * device.h (MARK_DEVICE_SUBWINDOWS_CHANGED): new macro for - subwindows redisplay as per glyphs equivalent. - * redisplay.h: ditto. - (MARK_SUBWINDOWS_CHANGED): ditto. - (RESET_CHANGED_SET_FLAGS): ditto. - * frame.h (MARK_FRAME_SUBWINDOWS_CHANGED): ditto. - -1998-12-07 Andy Piper <andy@xemacs.org> - - * frame.c (Fmake_frame): reset subwindow cachels on non-stream - frames. + * event-Xt.c (x_keysym_to_character): New. + (maybe_define_x_key_as_self_inserting_character): New. + (x_has_keysym): New. + Auto-define all keys on the keyboard as self-insert-key. - * redisplay.c (redisplay_frame): invalidate subwindow cachels. - - * event-msw.c (mswindows_wnd_proc): catch the various WM_CTLCOLOR* - messages and paint widget glyphs as appropriate with their face fg - & bg. +2000-02-02 Martin Buchholz <martin@xemacs.org> -1998-12-06 Andy Piper <andy@xemacs.org> + * menubar.c (vars_of_menubar): A small code simplification. - * glyphs-msw.c (vars_of_glyphs_mswindows): provide widget types - here rather than in glyphs-widget - do this because we only want - to provide what is really available. + * minibuf.c (echo_area_append): Workaround egcs-20000131 c++ compiler bug - * glyphs.c (Fimage_instance_property): new function to get the - properties of image instances. wires through to console specific - methods and then to widget specific methods. - (Fset_image_instance_property): ditto but for setting widget properties. - (check_valid_face): make extern so that it can be used elsewhere. - - * glyphs-widget.c (widget_property): new function. gets the - properties of widgets in general and wires the function through to - widget specific ones. - (widget_set_property): ditto but for setting widget properties. + * ExternalShell.c: + * ExternalClient.c: + * EmacsShell-sub.c: + * EmacsManager.c: + * EmacsFrame.c: + Use consistent style for specifying X resources. - * glyphs-msw.c (mswindows_combo_instantiate): Add functionality to - add items to the list. Play with window styles a bit to get the - desired effect. - (mswindows_widget_property): break out specific widget properties. - (mswindows_button_property): new function. gets the checked state - of a button. - (mswindows_combo_property): new function. gets the current - selection in the combo box. - (mswindows_widget_set_property): new function. sets specific - properties of specific widgets. - - * glyphs-widget.c (check_valid_item_list): new function. check - that items for a combo-box are just a list of strings. - (combo_validate): new function. check there is an item list. - (widget_instantiate_1): new function. renamed from - widget_instantiate so that we can do slightly different things for - other widgets. - (widget_instantiate): call widget_instantiate_1. - (combo_instantiate): new function to instantiate combo boxes, - defaults height to the pixel height of the number of items in the - box. - (syms_of_glyphs_widget): move widget keywords here. - (image_instantiator_format_create_glyphs_widget): use new combo - functions. - -1998-12-04 Andy Piper <andy@xemacs.org> + * symbols.c (Fset): Further implement SYMVAL_LISP_MAGIC. + This makes (dontusethis-set-symbol-value-handler) actually usable. - * event-msw.c (mswindows_wnd_proc): mule-ize. - - * glyphs.c (pixmap_to_lisp_data): mule-ize. - - * glyphs-msw.c (extract_xpm_color_names): mule-ize. - (resource_name_to_resource): ditto. - (mswindows_resource_instantiate): ditto. - (mswindows_widget_instantiate): ditto. - (mswindows_widget_set_property): ditto. - - * redisplay-output.c (redisplay_output_subwindow): don't show - subwindows if they are obscured at the edge of the frame, emacs - gets into some sort of redisplay loop otherwise. - - * gui.h: prototype gui_item_selected_p. - - * gui.c (gui_item_selected_p): new function to determine the - selected state of a gui_item. + * lrecord.h (lrecord_decription_type): + * alloc.c (pdump_register_sub): + (pdump_dump_data): + (pdump_reloc_one): + Add XD_LISP_OBJECT_ARRAY to describe multiple Lisp_Objects. + Comply with XEmacs coding style. + All lrecord descriptions updated to use XD_LISP_OBJECT with 2 + args, and XD_LISP_OBJECT_ARRAY with 3 args. - * frame.h (struct frame): add subwindows_changed flag. - - * redisplay.c (redisplay_frame): call update_frame_subwindows (). - - * glyphs.c (update_subwindow): new function to update a - subwindow's state. - (update_frame_subwindows): new function to update all the - subwindows on a frame. - - * console.h (struct console_methods): add update_subwindow. - - * glyphs-msw.c (mswindows_widget_property): return selected state - for selected property. - (mswindows_update_subwindow): new function. updates widget glyphs - in redisplay as per menubars or toolbars e.g. selected state. - (console_type_create_glyphs_mswindows): add update_subwindow. - -1998-12-03 Andy Piper <andy@xemacs.org> - - * console-tty.c (syms_of_console_tty): MULE -> FILE_CODING since - tty coding system things are such. + * keymap.c (Faccessible_keymaps): + Make (accessible-keymaps map "\C-h") do the Right Thing. + Make (accessible-keymaps map []) do the Right Thing. + Make (accessible-keymaps map "") do the Right Thing. + (check_keymap_definition_loop): New function. + (keymap_store_internal): Keep luser from shooting self in foot, + via (define-key ctl-x-4-map "p" global-map). + Remove fullness slot from struct Lisp_Keymap, since hash tables + are now reliable. + (print_keymap): Remove 'Yuck' factor by simply printing "size %d". - * glyphs-widget.c (widget_face_font_info): new function for - pulling out height and width metrics for a widget's face. - (widget_text_to_pixel_conversion): calculate pixel sizes of text - for widgets. - - * event-msw.c (mswindows_drain_windows_queue): translate messages - that are destined for subwindows. This makes edit fields interact - with the keyboard correctly. - nuke warnings by #ifndef'ing out stuff not required by msg select(). - - * glyphs.h (INITIALIZE_IMAGE_INSTANTIATOR_FORMAT_NO_SYM): new - macro defining the iiforma without the symbol required by widget. - (INITIALIZE_IMAGE_INSTANTIATOR_FORMAT): use it. - - * general.c (syms_of_general): add Qwidget, Qselected. - - * faces.c (complex_vars_of_faces): add widget face inheriting from - gui-element face. +2000-01-30 Martin Buchholz <martin@xemacs.org> -1998-11-09 Andy Piper <andy@xemacs.org> - - * window.h (struct window): add a cache of subwindows on a - per-window basis. - - * window.c (mark_window): mark the subwindow_instance_cache. - (allocate_window): initialise the subwindow instance_cache. + * redisplay.c (init_redisplay): Fix small memory leak. + * elhash.h: + * elhash.c (pdump_reorganize_hash_table): + Rename from reorganize_hash_table. Change prototype. + Reuse the original memory for hentries. Save 100k. + * alloc.c (PDUMP_READ): new macro. + * alloc.c (pdump_load): Replace LISP_TO_VOID with higher-level macros. + * alloc.c: No need to #ifndef before #undef. - * toolbar-x.c (x_output_toolbar): call redisplay_clear_region - instead of the devmeth. - (x_clear_toolbar): ditto. - - * redisplay-x.c (x_output_display_block): call - redisplay_output_subwindow for subwindows and widgets. - - * redisplay-tty.c (tty_output_display_block): add IMAGE_WIDGET to - types to do nothing for. - - * lisp.h: declare new widget/subwindow symbols. + * print.c: Allow debug_print() to print readably by modifying + debug_print_readably. Use consistent variable names. - * glyphs.c (image_instantiate): cache subwindows on a per-window - basis. - (subwindow_possible_dest_types): new function for subwindow dest - types. - (subwindow_instantiate): generic instantiation of a - subwindow. specialised by device multi-methods. - (Fsubwindowp): moved from glyphs-x.c. adapted for glyph-based - subwindows. - (Fimage_instance_subwindow_id): ditto. - (Fresize_subwindow): ditto. - (Fforce_subwindow_map): ditto. + * .dbxrc: Try to get things to work even if stopped in a function + without source available by explicitly specifying source files. +2000-02-03 Kirill 'Big K' Katsnelson <kkm@dtmx.com> + + * unexnt.c (_start): Removed bogus code which caused loading heap + from differrent executable file. + Removed bogus assignment to _fmode, which caused inconsistencies. - * glyphs-x.c (x_print_image_instance): remove subwindow - stuff. Handled genrically in glyphs.c. - (x_image_instance_equal): ditto. - (x_image_instance_hash): ditto. - (x_finalize_image_instance): delete subwindows when required. - (mark_subwindow) (print_subwindow) (finalize_subwindow) - (subwindow_hash) (Fmake_subwindow): deleted because of new, - glyph-based, subwindow implementation. - (Fsubwindow_height) (Fsubwindow_width) (Fsubwindow_xid): aliased - in glyphs.el - (Fsubwindowp) (Fresize_subwindow) (Fforce_subwindow_map): moved to - glyphs.c. - (x_unmap_subwindow): new function to unmap X subwindows. - (x_map_subwindow): new function to map X subwindows. - (x_subwindow_instantiate): new function to instantiate X - subwindows. - (x_resize_subwindow): new function to resize X subwindows. - (console_type_create_glyphs_x): add subwindow functions. - (image_instantiator_format_create_glyphs_x): add device - multi-methods for xpm, xbm and subwindow. +2000-02-03 Kirill 'Big K' Katsnelson <kkm@dtmx.com> - * glyphs.el (subwindow-xid): old alias for new subwindow functions. - (subwindow-width): ditto. - (subwindow-height): ditto. + * s\windowsnt.h: Removed lots of #if 0 blocks of Emacs heritage. + Have spawnve encapsulation regard DONT_ENCAPSULATE. + Do not preliminary `#define signal sigset'. - * glyphs-msw.c (mswindows_widget_instantiate): new function for - generally instantiating ms subwindows. Used by - mswindows_*_instantiate. - (mswindows_edit_instantiate): instantiate an edit field on a - mswindows frame. - -1998-11-04 Andy Piper <andy@xemacs.org> + * systime.h: Do not prototype environ on windows nt and cygwin, + this conflicts with system header. - * symsinit.h: declare new functions. + * syssignal.h: Use correct define for WINDOWSNT - * redisplay.h: declare new functions. + * sysdep.h: Do not prototype environ on windows nt, this conflicts + with system header. - * redisplay-x.c (x_output_display_block): call - redisplay_clear_region rather than x_clear_region. - (x_output_string): ditto. - (x_output_pixmap): ditto. - (x_clear_to_window_end): ditto. - (x_output_eol_cursor): ditto. - (x_clear_region): only do X specific things. other duties handled - in redisplay_clear_region. - - * redisplay-tty.c (tty_clear_region): do tty specific things - some - duties moved to redisplay_clear_region. + * sysdep.c (near start of file): Fixed commentary and rearranged + ifdefs in readable order. + (NEED_STARTS): Do not force NEED_STARTS when PDUMPing. + (start_of_text): + (end_of_text): + (end_of_data): Do not compile in if using PDUMP. - * redisplay-output.c (clear_left_border): use - redisplay_clear_region instead of device method. - (clear_right_border): ditto. - (output_display_line): ditto. - (redisplay_output_subwindow): ditto. - (redisplay_clear_top_of_window): ditto. - (redisplay_clear_region): perform duties previously handled by - device methods. call the appropriate device method at the - end. unmap subwindows if necessary. + * symsinit.h: Protptyped vars_of_nt(). - * redisplay-msw.c (mswindows_output_string): use - redisplay_clear_region instead of mswindows_clear_region. - (mswindows_clear_to_window_end): ditto. - (mswindows_output_display_block): output subwindows when required. - (mswindows_clear_region): only do mswindows specific things, - everything else is now handled in redisplay_clear_region. + * ntproc.c (windows9x_p): Added, instead of os_subtype. + (find_child_console): Use it. + (sys_kill): Use it. - * gui.h: add item id hash defines and declare function prototypes. - - * gui.c (mark_gui_item): new function for marking gui_items. - (gui_item_hash): generic hash function for generating command ids - for gui_items. + * ntheap.h: Do not extern os_subtype. - * gui-msw.c: new file. - (mswindows_handle_gui_wm_command): new function to handle widget - callbacks. - - * glyphs.h (MAYBE_IIFORMAT_DEVMETH): new function for device - multi-methods. - (IIFORMAT_HAS_SHARED_METHOD): ditto. - (DEFINE_DEVICE_IIFORMAT): ditto. - (INITIALIZE_DEVICE_IIFORMAT): ditto. - (struct Lisp_Image_Instance): add widget and subwindow data plus - appropriate access functions. + * ntheap.c (cache_system_info): Do not cache unneeded: + nt_major_version, nt_minor_version and os_subtype. + (recreate_heap): Do not compile in when PDUMPing. - * glyphs.c (decode_device_ii_format): new function for decoding - image instantiator functions based on a device type as well as an - image format. - (decode_image_instantiator_format): just call - decode_device_ii_format with nil device. - (add_entry_to_device_ii_format_list): new function for per device - method instances. - (add_entry_to_image_instantiator_format_list): just call - add_entry_to_device_ii_format_list with nil device. - (check_valid_vector): new function. - (instantiate_image_instantiator): instantiate using per-format - method and then per-format-per-device method (device - multi-methods). signal an error if neither is possible. - (mark_image_instance): cope with subwindows and widgets. - (print_image_instance): ditto. - (image_instance_equal): ditto. - (image_instance_hash): ditto. - (allocate_glyph): ditto. - (glyph_width): ditto. - (glyph_height_internal): ditto. - (xpm_instantiate): removed because of device multi-methods. - (mark_subwindow_cachels): new cachel functions for caching - instantiated subwindows on a per-frame basis. mostly copied from - glyph cachel functions. - (update_subwindow_cachel_data): ditto. - (add_subwindow_cachel): ditto. - (get_subwindow_cachel_index): ditto. - (reset_subwindow_cachels): ditto. - (mark_subwindow_cachels_as_not_updated): ditto. - (unmap_subwindow): generic unmapping of subwindows based on cachel - data. - (map_subwindow): ditto. - (initialize_subwindow_image_instance): generic initialisation of - subwindow data. - (syms_of_glyphs): add widget keywords. + * nt.c (geteuid and friends): Use the new varibale + nt_fake_unix_uid, instead of hashing fake uid out of NT RID. + (init_user_info): Removed the above mentioned hackery. + (fstat, stat): Do not compile in if using MSVC 5.0 and above - + stat has been fixed in the C runtime. + (vars_of_nt): Added, defined the nt_fake_unix_uid variable there. + + * file-coding.c (struct file_coding_dump): Do not define + ucs_to_mule_table in the struct if not MULE. + (struct struct lrecord_description fcd_description_1): Do not dump + the above. - * glyphs-x.h (struct x_subwindow_data): convert Lisp_Subwindow to - x_subwindow_data. - -1998-11-04 Andy Piper <andy@xemacs.org> + * emacs.c (main_1): Call vars_of_nt(). + (right before Fdump_emacs_data): Don't need lastfile if using both + portabe dumper and system malloc. - * glyphs-widget.c: new file for instantiating widget type glyphs. - (widget_possible_dest_types): new general dest type function for - widgets. - (widget_validate): ditto. - (initialize_widget_image_instance): ditto - (widget_instantiate): ditto. Sets up fg/bg, gui_item parsing - before handing on control to device multi-methods. - (syms_of_glyphs_widget): new function. - (image_instantiator_format_create_glyphs_widget): new function, - added placeholders for button, edit, combo, scrollbar - (vars_of_glyphs_widget): new function. - - * glyphs-msw.h (WIDGET_INSTANCE_MSWINDOWS_HANDLE): new define for - storing window ids of widgets. + * alloc.c (Fmemory_limit): Conditionalized out. + (pdump): Use OPEN_BINARY for the portable dump file. + (pdump_load): Ditto. - * glyphs-msw.c (mswindows_finalize_image_instance): cope with - deletion of widget and subwindow glyphs. - (mswindows_unmap_subwindow): new device function for unmapping - subwindows on a msw frame. - (mswindows_map_subwindow): ditto. - (mswindows_register_image_instance): register instantiated widgets - with the widget hastable. - (mswindows_button_instantiate): instantiate a button type widget - on an msw frame. - (mswindows_subwindow_instantiate): instanttiate a subwindow on a - mswindows frame. - (image_instantiator_format_create_glyphs_mswindows): add device - multi-methods for xbm, xpm, subwindow, edit and button. +2000-02-02 Mike Alexander <mta@arbortext.com> - * frame.h (struct frame): add subwindow_cachels dynarr for caching - information about subwindows visible on the current frame. used by - redisplay_clear_region to unmap subwindows as required. + * nt.c (convert_time): Set tm_isdst before calling mktime and + avoid calling it at all if the compiler supports 64 bit integers. + Also initialize utc_base_ft before using it. - * frame.c (mark_frame): mark subwindow_cachels. - (allocate_frame_core): instantiate subwindow_cachels. - - * frame-msw.c (mswindows_init_frame_1): instntiate and mark the - widget hashtable. - - * event-msw.c (mswindows_wnd_proc): add call to - mswindows_handle_gui_wm_command to handle widget callbacks. +2000-02-03 Daiki Ueno <ueno@ueda.info.waseda.ac.jp> - * emacs.c (main_1): add calls to glyphs-widget initialisation - routines. + * frame.c (change_frame_size_1): Take f->internal_border_width + into consideration when calculating the width of the frame. - * console.h (struct console_methods): add - unmap/map_subwindow_method for use be redisplay_clear_region to - map and unmap subwindows. Remove xpm and xbm stuff - now dealt - with by image instantiator multi-methods. Add - resize_subwindow_method. - - * console-stream.c (stream_clear_region): change signature to - match new generic clear region function. - - * Makefile.in.in: add glyphs-widget.o to list of objects. +2000-02-01 Kirill 'Big K' Katsnelson <kkm@dtmx.com> - * console-msw.h (struct mswindows_frame): add widget hashtable for - wiring command ids to callbacks. - -1998-12-16 Andy Piper <andy@xemacs.org> - - * XEmacs 21.2.6 is released + * window.c (frame_min_height): + (frame_size_valid_p): + (frame_pixsize_valid_p): Added. + (check_frame_size): Generalized. -1998-12-08 Hrvoje Niksic <hniksic@srce.hr> - - * md5.c (Fmd5): Correctly initiate string input stream. - - * Makefile.in.in (tests): Add md5-tests.el. - -1998-12-06 Martin Buchholz <martin@xemacs.org> + * window.h: Prototyped the above. * lisp.h: - * alloc.c (make_vector): remove travesty - (Fmake_vector): - (make_pure_vector): - (pure_cons): - (make_bit_vector_internal): - (make_bit_vector): - (make_bit_vector_from_byte_vector): - (Fmake_bit_vector): - - make vector_equal a little faster. - - Don't use variable name `new'. - - Use size_t instead of EMACS_INT. - - usual Martin-style pointless bit-twiddling. + * general.c: Added Qbottom_margin, Qduplex, Qlandscape, + Qleft_margin, Qorientation, Qportrait, Qright_margin, Qtop_margin. + Deleted Vwin32_* and Vbinary_process_* unused variables. + + * device-msw.c (msprinter_init_device): Do not get printer font + list; Added DEVMODE functions. + + * frame-msw.c: Added lots of printer code. - * fns.c (mapcar1): - (Fmapconcat): - (Fmapcar): - (Fmapvector): - Make mapcar faster. In particular, make - (mapc #'identity long-string) - MUCH faster under Mule. - * tests/automated/lisp-tests.el: Test 'em! + * faces.c: Moved 'left-margin and 'right-margin defsymbols to + general.c. + + * console-msw.h: Added more msprinter device private slots. -1998-12-06 Martin Buchholz <martin@xemacs.org> +2000-02-01 Kirill 'Big K' Katsnelson <kkm@dtmx.com> + + * event-msw.c (key_needs_default_processing_p): Added. + (mswindows_wnd_proc, WM_KEYUP, KEYDOWN): Call it. + +2000-01-29 Kirill 'Big K' Katsnelson <kkm@dtmx.com> - * bytecode.c (Ffetch_bytecode): Fix crash when loading lazy-loaded - bytecode. - -1998-12-13 Martin Buchholz <martin@xemacs.org> + * glyphs.c (image_instance_layout): Mark image instance as clean + after layout. + (glyph_dirty_p): Removed redundant function. + (invalidate_glyph_geometry_maybe): Added. + (update_glyph_cachel_data): Call it. - * console-msw.c: Function definitions follow coding standards - - This prevents e.g. find-tag on Lisp_Event finding DEVENT - -1998-12-11 Martin Buchholz <martin@xemacs.org> + * glyphs.h: Prototyped it. - * events.h (struct timeout_data): - * event-tty.c (tty_timeout_to_emacs_event): - * event-msw.c (mswindows_wm_timer_callback): - * event-Xt.c (Xt_timeout_to_emacs_event): - * event-msw.c (mswindows_cancel_dispatch_event): - Make sure Lisp_Objects inside events are initialized to Qnil, not - Qnull_pointer, which is now illegal. + * redisplay.c (add_glyph_rune): Call it. + (redisplay_window): Reset glyphs cachels when frame faces has + changed, thus forcing recomputation of built-in border glyphs. + +2000-01-30 Martin Buchholz <martin@xemacs.org> -1998-12-10 Martin Buchholz <martin@xemacs.org> - - * lisp.h: Fix up prototypes to match alloc.c + * Makefile.in.in: Make portable dumper and purify play well together. + Add imperfect, but better than nothing, support for pdump. + Remove xemacs.dmp when temacs is re-generated. + Don't ignore errors when dumping xemacs. -1998-12-09 Andy Piper <andy@xemacs.org> + * symbols.c (maybe_call_magic_handler): Remove one magic number. - * glyphs-msw.c (init_image_instance_from_xbm_inline): don't use - XSETINT for assigning lisp objects. +2000-01-28 Andy Piper <andy@xemacs.org> -1998-12-07 Martin Buchholz <martin@xemacs.org> + * frame.c (allocate_frame_core): Use new Fset_window_buffer signature. + (setup_normal_frame): ditto. + (setup_frame_without_minibuffer): ditto. + (setup_minibuffer_frame): ditto. + (delete_frame_internal): ditto. + (Fmake_frame_invisible): ditto. + (Ficonify_frame): ditto. + + * window.h: change Fset_window_buffer signature. - * opaque.h: - * console-msw.c (DHEADER): - (DOPAQUE_DATA): - (DEVENT): - (DCONS): - (DCONSCDR): - (DSTRING): - (DVECTOR): - (DSYMBOL): - (DSYMNAME): - - max_align_t should not be visible to the user of the - XOPAQUE_DATA macro. - - use Bufbyte instead of char - - parens around (FOOP (obj)) are always redundant. - If they were necessary, we should fix the macro instead. - - Always use string_data(foo) instead of foo->data. + * window.c (Fsplit_window): Use new Fset_window_buffer signature. + (Fset_window_buffer): allow recording of buffer if the window is + the selected window. + (window_loop): Use new Fset_window signature. + +2000-01-23 Daniel Pittman <daniel@danann.net> -1998-12-07 Martin Buchholz <martin@xemacs.org> + * config.h.in: Added template for `HAVE_ATHENA_3D' + +2000-01-29 Andy Piper <andy@xemacs.org> - * sysdep.c (set_descriptor_non_blocking): - Since O_NONBLOCK is now always #defined, make use of fcntl - conditional on F_SETFL being defined. + * glyphs-x.c (x_resize_subwindow): Try and catch bogus resizes. -1998-12-09 Andy Piper <andy@xemacs.org> + * gutter.c (output_gutter): Don't output if the window isn't live. - * menubar-msw.c (mswindows_handle_wm_command): add back in checks - that got removed in the merge +2000-01-28 Kirill 'Big K' Katsnelson <kkm@dtmx.com> -1998-11-30 Greg Klanderman <greg@alphatech.com> + * glyphs-msw.c (mswindows_unmap_subwindow): Fix of corrupted patch + of 01/12/00: Moved SetFocus back here where it belongs. - * dired.c (vars_of_dired): bugfix for previous conditionalization - of user-name-completion on non- Windows NT. +2000-01-23 Andy Piper <andy@xemacs.org> -1998-12-08 Martin Buchholz <martin@xemacs.org> + * s/cygwin32.h: declare printer things. - * windowsnt.h: Remove `support' for using index and rindex +2000-01-26 Andy Piper <andy@xemacs.org> - * filelock.c (current_lock_owner): - - Change uses of index -> strchr, rindex -> strrchr + * select.c (Fown_selection_internal): GCPRO bug fix from Mike + Alexander. -1998-12-06 Martin Buchholz <martin@xemacs.org> +2000-01-24 Andy Piper <andy@xemacs.org> - * frame-msw.c (mswindows_init_frame_1): - - use make_lisp_hash_table, not Fmake_hash_table - - include elhash.h + * glyphs-msw.c (mswindows_locate_pixmap_file): Expand filename. + (mswindows_button_instantiate): Make sure glyph is a pixmap. -1998-12-05 XEmacs Build Bot <builds@cvs.xemacs.org> + * glyphs-widget.c (widget_instantiate): Avoid shadows. - * XEmacs 21.2.5 is released + * frame-msw.c (msprinter_init_frame_3): Nuke warning. -1998-11-30 Martin Buchholz <martin@xemacs.org> + * glyphs-msw.c: (mswindows_string_to_color): remove declaration. - * xselect.c (receive_incremental_selection): - * xselect.c (x_get_window_property): - * xmu.c (XmuReadBitmapDataFromFile): - * xmu.c (XmuCursorNameToIndex): - * xgccache.c (describe_gc_cache): - * xgccache.c (gc_cache_lookup): - * xgccache.c (free_gc_cache): - * xgccache.c (make_gc_cache): - * window.h: - * window.c (map_windows_1): - * window.c (Fother_window_for_scrolling): - * window.c (window_scroll): - * window.c (change_window_height): - * window.c (Fsplit_window): - * window.c (window_left_gutter_width): - * window.c (window_modeline_height): - * window.c (invalidate_vertical_divider_cache_in_window): - * window.c (window_needs_vertical_divider_1): - * window.c (update_mirror_internal): - * window.c (SET_LAST_FACECHANGE): - * widget.c (Fwidget_plist_member): - * unexec.c (copy_text_and_data): - * unexcw.c (copy_executable_and_dump_data_section): - * tooltalk.doc: - * tooltalk.c (struct Lisp_Tooltalk_Pattern): - * tooltalk.c (struct Lisp_Tooltalk_Message): - * toolbar.h (struct toolbar_button): - * toolbar.c (default_toolbar_visible_p_changed_in_window): - * toolbar.c (recompute_overlaying_specifier): - * toolbar.c (toolbar_validate): - * toolbar.c (toolbar_button_at_pixpos): - * toolbar.c (get_toolbar_coords): - * toolbar.c (update_frame_toolbars): - * toolbar-x.c: - * toolbar-msw.c (mswindows_handle_toolbar_wm_command): - * toolbar-msw.c (mswindows_find_toolbar_pos): - * toolbar-msw.c (mswindows_output_toolbar): - * toolbar-msw.c (mswindows_clear_toolbar): - * toolbar-msw.c: - * systty.h: - * syssignal.h: - * sysproc.h: - * sysfile.h: - * sysdll.c: - * sysdep.h: - * sysdep.c (rmdir): - * sysdep.c (sys_fopen): - * sysdep.c (sys_open): - * sysdep.c (tty_init_sys_modes_on_device): - * sysdep.c (get_eof_char): - * sysdep.c (child_setup_tty): - * sysdep.c (set_descriptor_non_blocking): - * syntax.h: - * syntax.c (scan_words): - * syntax.c: - * symsinit.h: - * symeval.h (struct symbol_value_varalias): - * symeval.h (struct symbol_value_forward): - * symbols.c (syms_of_symbols): - * symbols.c (init_symbols_once_early): - * symbols.c (Fbuilt_in_variable_type): - * symbols.c (Fsymbol_value_in_buffer): - * symbols.c (default_value): - * symbols.c (Fset): - * symbols.c (find_symbol_value_quickly): - * symbols.c (store_symval_forwarding): - * symbols.c (set_default_console_slot_variable): - * symbols.c (set_default_buffer_slot_variable): - * symbols.c (verify_ok_for_buffer_local): - * symbols.c (symbol_is_constant): - * symbols.c (oblookup): - * symbols.c (Funintern): - * symbols.c (Fintern): - * symbols.c (check_obarray): - * sunplay.c: - * specifier.h (struct specifier_methods): - * specifier.h: - * specifier.c (specifier_instance): - * specifier.c (specifier_instance_from_inst_list): - * specifier.c (decode_locale_type): - * specifier.c (specifier_equal): - * specifier.c (finalize_specifier): - * specifier.c (prune_specifiers): - * specifier.c (kill_specifier_buffer_locals): - * sound.c (init_native_sound): - * sound.c: - * signal.c (alarm): - * search.c (Fmatch_data): - * search.c (match_limit): - * search.c (Freplace_match): - * search.c (skip_chars): - * search.c (scan_buffer): - * search.c: - * scrollbar.c (specifier_vars_of_scrollbar): - * scrollbar.c (Fscrollbar_set_hscroll): - * scrollbar.c (vertical_scrollbar_changed_in_window): - * scrollbar.c (release_window_mirror_scrollbars): - * scrollbar.c (free_scrollbar_instance): - * scrollbar-x.c: - * scrollbar-msw.c: - * s/msdos.h (O_BINARY): - * s/linux.h: - * s/freebsd.h (LIBS_TERMCAP): - * regex.c (re_match_2_internal): - * regex.c (compile_extended_range): - * regex.c (POP_FAILURE_POINT): - * regex.c (PUSH_FAILURE_POINT): - * redisplay.h (RESET_CHANGED_SET_FLAGS): - * redisplay.h: - * redisplay.h (struct display_line): - * redisplay.h (struct rune): - * redisplay.c (vars_of_redisplay): - * redisplay.c (redisplay_variable_changed): - * redisplay.c (UPDATE_CACHE_RETURN): - * redisplay.c (validate_line_start_cache): - * redisplay.c (mark_redisplay_structs): - * redisplay.c (mark_glyph_block_dynarr): - * redisplay.c (window_line_number): - * redisplay.c (redisplay_frame): - * redisplay.c (redisplay_window): - * redisplay.c (generate_modeline): - * redisplay.c (create_right_glyph_block): - * redisplay.c (create_left_glyph_block): - * redisplay.c (create_text_block): - * redisplay.c: - * redisplay-x.c (x_output_hline): - * redisplay-x.c (x_output_vertical_divider): - * redisplay-tty.c (tty_output_display_block): - * redisplay-output.c (output_display_line): - * redisplay-output.c: - * redisplay-msw.c (mswindows_output_vertical_divider): - * redisplay-msw.c (mswindows_ring_bell): - * redisplay-msw.c (mswindows_output_cursor): - * redisplay-msw.c: - * rangetab.c: - * ralloc.c: - * puresize.h (RAW_PURESIZE): - * profile.c (syms_of_profile): - * profile.c (Fstart_profiling): - * profile.c (sigprof_handler): - * profile.c: - * procimpl.h: - * process.c (vars_of_process): - * process.c (read_process_output): - * process.c (get_process): - * process.c: - * process-unix.c (unix_open_multicast_group): - * process-unix.c (unix_get_tty_name): - * process-unix.c (unix_send_process): - * process-unix.c (unix_reap_exited_processes): - * process-unix.c (unix_create_process): - * process-unix.c (unix_init_process_io_handles): - * process-unix.c (allocate_pty): - * process-unix.c: - * process-nt.c (nt_open_network_stream): - * process-nt.c (nt_update_status_if_terminated): - * process-nt.c (nt_finalize_process_data): - * process-nt.c: - * print.c (debug_short_backtrace): - * print.c (debug_backtrace): - * print.c (print_symbol): - * print.c (print_internal): - * print.c (print_cons): - * print.c (Fwrite_char): - * print.c (print_prepare): - * print.c (canonicalize_printcharfun): - * print.c (output_string): - * print.c: - * opaque.h: - * opaque.c (allocate_managed_opaque): - * opaque.c: - * offix.c (DndSetData): - * objects.c (face_boolean_create): - * objects.c (font_instantiate): - * objects.c (font_create): - * objects.c (color_create): - * objects.c (finalize_font_instance): - * objects.c (finalize_color_instance): - * objects.c: - * objects-x.c (x_font_instance_truename): - * objects-x.c: - * objects-x.c (x_initialize_font_instance): - * objects-x.c (allocate_nearest_color): - * objects-tty.c (tty_initialize_font_instance): - * objects-tty.c (tty_initialize_color_instance): - * objects-msw.c (mswindows_initialize_color_instance): - * ntproc.c (syms_of_ntproc): - * ntproc.c (Fwin32_set_process_priority): - * ntproc.c (sys_spawnve): - * ntproc.c: - * ntheap.c (get_data_end): - * nt.c (period): - * nt.c: - * nt.c (stat): - * nt.c (generate_inode_val): - * nt.c (sys_rename): - * nas.c: - * mule-wnnfns.c (Fwnn_hinsi_number): - * mule-wnnfns.c (Fwnn_yuragi): - * mule-wnnfns.c (Fwnn_common_learn): - * mule-wnnfns.c (Fwnn_suffix_learn): - * mule-wnnfns.c (Fwnn_prefix_learn): - * mule-wnnfns.c (Fwnn_okuri_learn): - * mule-wnnfns.c (Fwnn_complex_conv): - * mule-wnnfns.c (Fwnn_last_is_first): - * mule-wnnfns.c (Fwnn_bmodify_dict_add): - * mule-wnnfns.c (Fwnn_notrans_dict_add): - * mule-wnnfns.c (Fwnn_fiusr_dict_add): - * mule-wnnfns.c (Fwnn_fisys_dict_add): - * mule-wnnfns.c (Fwnn_hinsi_list): - * mule-wnnfns.c (Fwnn_fuzokugo_set): - * mule-wnnfns.c (Fwnn_dict_search): - * mule-wnnfns.c (Fwnn_word_toroku): - * mule-wnnfns.c (Fwnn_hindo_update): - * mule-wnnfns.c (Fwnn_bunsetu_henkou): - * mule-wnnfns.c (Fwnn_kakutei): - * mule-wnnfns.c (Fwnn_begin_henkan): - * mule-wnnfns.c (Fwnn_dict_comment): - * mule-wnnfns.c (Fwnn_dict_add): - * mule-wnnfns.c (Fwnn_open): - * mule-mcpath.c (mc_getcwd): - * mule-coding.c (vars_of_mule_coding): - * mule-coding.c (convert_to_external_format): - * mule-coding.c (encoding_marker): - * mule-coding.c (decoding_marker): - * mule-coding.c (Fcopy_coding_system): - * mule-coding.c (Fmake_coding_system): - * mule-coding.c (Fcoding_system_list): - * mule-coding.c (Ffind_coding_system): - * mule-coding.c (symbol_to_eol_type): - * mule-coding.c: - * mule-charset.c (complex_vars_of_mule_charset): - * mule-charset.c (vars_of_mule_charset): - * mule-charset.c (Fset_charset_ccl_program): - * mule-charset.c (struct charset_list_closure): - * mule-charset.c (Ffind_charset): - * mule-charset.c (make_charset): - * mule-charset.c (non_ascii_valid_char_p): - * mule-charset.c: - * mule-ccl.c (ccl_driver): - * mule-canna.c (c2mu): - * mule-canna.c (Fcanna_henkan_begin): - * mule-canna.c (Fcanna_parse): - * mule-canna.c (Fcanna_store_yomi): - * mule-canna.c (Fcanna_touroku_string): - * mule-canna.c (Fcanna_initialize): - * minibuf.c: - * menubar.c (menu_parse_submenu_keywords): - * menubar-x.c (make_dummy_xbutton_event): - * menubar-x.c (set_frame_menubar): - * menubar-x.c (menu_item_descriptor_to_widget_value_1): - * menubar-x.c: - * menubar-msw.h: - * menubar-msw.c (mswindows_popup_menu): - * menubar-msw.c (mswindows_update_frame_menubars): - * menubar-msw.c (mswindows_handle_wm_command): - * menubar-msw.c (unsafe_handle_wm_initmenu_1): - * menubar-msw.c (unsafe_handle_wm_initmenupopup_1): - * menubar-msw.c (update_frame_menubar_maybe): - * menubar-msw.c (populate_or_checksum_helper): - * menubar-msw.c (empty_menu): - * menubar-msw.c: - * md5.c: - * marker.c (set_marker_internal): - * marker.c (print_marker): - * malloc.c: - * make-src-depend: - * lstream.c (lisp_buffer_rewinder): - * lstream.c (mark_lstream): - * lrecord.h: - * lrecord.h (struct lrecord_header): - * lread.c (readevalloop): - * lread.c (locate_file): - * lread.c (locate_file_in_directory): - * lread.c (Flocate_file): - * lread.c (load_force_doc_string_unwind): - * lread.c (ebolify_bytecode_constants): - * lread.c: - * lisp.h: - * lisp-union.h: - * lisp-disunion.h: - * linuxplay.c (linux_play_data_or_file): - * linuxplay.c (audio_init): - * line-number.c: - * keymap.h: - * keymap.c (describe_map): - * keymap.c (describe_map_mapper): - * keymap.c (Fdescribe_bindings_internal): - * keymap.c (Fsingle_key_description): - * keymap.c (map_keymap_sorted): - * keymap.c (get_relevant_keymaps): - * keymap.c (Flookup_key): - * keymap.c (raw_lookup_key_mapper): - * keymap.c (Fdefine_key): - * keymap.c (Fevent_matches_key_specifier_p): - * keymap.c (key_desc_list_to_event): - * keymap.c (define_key_parser): - * keymap.c (define_key_check_and_coerce_keysym): - * keymap.c (keymap_submaps): - * keymap.c (keymap_store_internal): - * keymap.c (keymap_delete_inverse_internal): - * keymap.c (keymap_store_inverse_internal): - * keymap.c (print_keymap): - * keymap.c (Lisp_Keymap): - * keymap.c: - * intl.c: - * insdel.c (convert_bufbyte_string_into_emchar_dynarr): - * insdel.c (make_gap): - * input-method-xlib.c (get_XIM_input): - * input-method-xlib.c (XIM_init_frame): - * imgproc.c: - * hash.h: - * hash.c: - * gui.c: - * gui-x.c (button_item_to_widget_value): - * gui-x.c (popup_selection_callback): - * glyphs.h (struct image_instantiator_methods): - * glyphs.c (mark_glyph_cachels): - * glyphs.c (Fglyph_type): - * glyphs.c (image_instantiate): - * glyphs.c (image_create): - * glyphs.c (make_image_instance_1): - * glyphs.c (finalize_image_instance): - * glyphs.c: - * glyphs-x.c (finalize_subwindow): - * glyphs-x.c (xface_validate): - * glyphs-x.c (x_locate_pixmap_file): - * glyphs-x.c (convert_EImage_to_XImage): - * glyphs-msw.c: - * glyphs-msw.c (mswindows_resource_instantiate): - * glyphs-msw.c (xpm_to_eimage): - * glyphs-msw.c (convert_EImage_to_DIBitmap): - * glyphs-eimage.c (tiff_instantiate): - * glyphs-eimage.c (png_instantiate): - * glyphs-eimage.c (struct png_error_struct): - * glyphs-eimage.c (gif_memory_storage): - * glyphs-eimage.c: - * gifrlib.h: - * getloadavg.c (getloadavg): - * getloadavg.c: - * gdbinit: - * free-hook.c (log_gcpro): - * free-hook.c (check_malloc): - * free-hook.c (check_free): - * free-hook.c (ROUND_UP_TO_PAGE): - * free-hook.c: - * frame.h (struct frame): - * frame.h: - * frame.c (change_frame_size_1): - * frame.c (allocate_frame_core): - * frame.c: - * frame-x.c (x_focus_on_frame): - * frame-x.c (x_init_frame_2): - * frame-x.c (x_popup_frame): - * frame-x.c (xemacs_XtPopup): - * frame-x.c: - * frame-x.c (Foffix_start_drag_internal): - * frame-x.c (x_cde_destroy_callback): - * frame-x.c (x_wm_hack_wm_protocols): - * frame-tty.c (tty_frame_visible_p): - * frame-msw.c (mswindows_make_frame_invisible): - * frame-msw.c (mswindows_after_init_frame): - * frame-msw.c (mswindows_init_frame_1): - * fns.c (syms_of_fns): - * fns.c (Fbase64_decode_string): - * fns.c (Fnconc): - * fns.c (Ffillarray): - * fns.c (Fobject_plist): - * fns.c (Fget): - * fns.c (Fcanonicalize_lax_plist): - * fns.c (Fcanonicalize_plist): - * fns.c (Fplist_remprop): - * fns.c (Fplist_get): - * fns.c (advance_plist_pointers): - * fns.c (internal_plist_put): - * fns.c (Fnreverse): - * fns.c (Fremassq): - * fns.c (Felt): - * fns.c (Fsubstring): - * fns.c (Fbvconcat): - * fns.c (Flength): - * fns.c (length_with_bytecode_hack): - * fns.c (print_bit_vector): - * fns.c: - * floatfns.c (Ffloor): - * floatfns.c: - * floatfns.c (in_float_error): - * fileio.c (Ffile_modes): - * fileio.c (Fexpand_file_name): - * fileio.c (Fmake_temp_name): - * fileio.c (Ffile_name_nondirectory): - * fileio.c (Ffile_name_directory): - * file-coding.h: - * file-coding.c (vars_of_mule_coding): - * file-coding.c (convert_to_external_format): - * file-coding.c (encoding_marker): - * file-coding.c (decoding_marker): - * file-coding.c (Fcopy_coding_system): - * file-coding.c (Fmake_coding_system): - * file-coding.c (struct coding_system_list_closure): - * file-coding.c (Ffind_coding_system): - * file-coding.c (symbol_to_eol_type): - * file-coding.c: - * faces.h (struct face_cachel): - * faces.c (vars_of_faces): - * faces.c (face_property_was_changed): - * faces.c (mark_face_cachels): - * faces.c (temporary_faces_list): - * faces.c (struct face_list_closure): - * faces.c: - * extents.h (struct extent): - * extents.c (vars_of_extents): - * extents.c (struct copy_string_extents_1_arg): - * extents.c (add_string_extents_mapper): - * extents.c (Fextent_property): - * extents.c (Fset_extent_property): - * extents.c (symbol_to_glyph_layout): - * extents.c (properties_equal): - * extents.c (print_extent): - * extents.c (print_extent_1): - * extents.c (extent_in_region_p): - * extents.c (gap_array_make_gap): - * extents.c: - * events.h (struct Lisp_Event): - * events.h: - * events.c (Fevent_properties): - * events.c (format_event_object): - * events.c (Fmake_event): - * events.c (event_equal): - * events.c (print_event): - * events.c (mark_event): - * event-stream.c ((read-char) - * event-stream.c (vars_of_event_stream): - * event-stream.c (syms_of_event_stream): - * event-stream.c (Fset_recent_keys_ring_size): - * event-stream.c (Fsit_for): - * event-stream.c (Fnext_event): - * event-stream.c (execute_help_form): - * event-stream.c (maybe_kbd_translate): - * event-stream.c: - * event-msw.c (vars_of_event_mswindows): - * event-msw.c (mswindows_wnd_proc): - * event-msw.c (mswindows_need_event): - * event-msw.c (mswindows_drain_windows_queue): - * event-msw.c (mswindows_pump_outstanding_events): - * event-msw.c: - * event-msw.c (slurp_thread): - * event-msw.c (struct ntpipe_slurp_stream): - * event-msw.c (HANDLE_TO_USID): - * event-Xt.c (emacs_Xt_handle_magic_event): - * event-Xt.c (x_event_to_emacs_event): - * event-Xt.c (x_reset_modifier_mapping): - * event-Xt.c (x_reset_key_mapping): - * event-Xt.c: - * eval.c (syms_of_eval): - * eval.c (warn_when_safe): - * eval.c (warn_when_safe_lispobj): - * eval.c (Fbacktrace_frame): - * eval.c (Fbacktrace): - * eval.c (top_level_set): - * eval.c (unbind_to_hairy): - * eval.c (specbind_magic): - * eval.c (specbind_unwind_wasnt_local): - * eval.c (call2_trapping_errors): - * eval.c (call1_trapping_errors): - * eval.c (catch_them_squirmers_call2): - * eval.c (call0_trapping_errors): - * eval.c (run_hook_trapping_errors): - * eval.c (catch_them_squirmers_eval_in_buffer): - * eval.c (call4_in_buffer): - * eval.c (call3_in_buffer): - * eval.c (call2_in_buffer): - * eval.c (call1_in_buffer): - * eval.c (call0_in_buffer): - * eval.c (run_hook): - * eval.c (run_hook_with_args_in_buffer): - * eval.c (Fapply): - * eval.c (Feval): - * eval.c (do_autoload): - * eval.c (un_autoload): - * eval.c (Fautoload): - * eval.c (Finteractive_p): - * eval.c (Fcommand_execute): - * eval.c (signal_quit): - * eval.c (call_with_suspended_errors): - * eval.c (signal_error): - * eval.c (return_from_signal): - * eval.c (Fcall_with_condition_handler): - * eval.c (run_condition_case_handlers): - * eval.c (condition_case_1): - * eval.c (Funwind_protect): - * eval.c (unwind_to_catch): - * eval.c (internal_catch): - * eval.c (Fmacroexpand_internal): - * eval.c (Fuser_variable_p): - * eval.c (Fdefconst): - * eval.c (Fdefvar): - * eval.c (Ffunction): - * eval.c (signal_call_debugger): - * eval.c (call_debugger): - * eval.c: - * emacs.c (main): - * emacs.c (sort_args): - * emacs.c (main_1): - * elhash.h: - * elhash.c: - * editfns.c (Fencode_time): - * editfns.c (Fdecode_time): - * editfns.c (Fuser_full_name): - * editfns.c: - * editfns.c (save_excursion_restore): - * ecrt0.c: - * dynarr.c: - * doprnt.c (emacs_doprnt_1): - * doc.c (verify_doc_mapper): - * doc.c (Fsnarf_documentation): - * doc.c (Fdocumentation): - * dll.c: - * dired.c (user_name_completion): - * dired.c (Fdirectory_files): - * dialog-x.c: - * dialog-msw.c: - * dgif_lib.c (FreeSavedImages): - * dgif_lib.c (DGifGetImageDesc): - * device.h: - * device.h (struct device): - * device.c (Fselect_device): - * device.c (allocate_device): - * device.c: - * device-x.c (Fx_keysym_on_keyboard_p): - * device-x.c (Fx_valid_keysym_name_p): - * device-x.c (x_IO_error_handler): - * device-x.c (x_delete_device): - * device-x.c (x_finish_init_device): - * device-x.c (x_init_device): - * device-x.c: - * device-msw.c (mswindows_init_device): - * dbxrc: - * database.c (vars_of_database): - * database.c (Fput_database): - * database.c (Fopen_database): - * database.c (berkdb_remove): - * database.c (berkdb_put): - * database.c (Fdatabasep): - * database.c (print_database): - * database.c: - * data.c (vars_of_data): - * data.c (syms_of_data): - * data.c (init_errors_once_early): - * data.c (prune_weak_lists): - * data.c (finish_marking_weak_lists): - * data.c (print_weak_list): - * data.c (Fmod): - * data.c (Fstring_to_number): - * data.c (Fnumber_to_string): - * data.c (Findirect_function): - * data.c (Fsetcdr): - * data.c (Ffloatp): - * data.c (Fsubr_interactive): - * data.c (Farrayp): - * data.c (Fkeywordp): - * data.c (Fnull): - * data.c: - * console.h (CONSOLE_NAME): - * console.h: - * console.c (vars_of_console): - * console.c (Fselect_console): - * console.c: - * console-x.h (DEVICE_X_COLORMAP): - * console-x.h (struct x_device): - * console-x.c (x_device_to_console_connection): - * console-tty.h (CONSOLE_TTY_FINAL_CURSOR_Y): - * console-tty.c (tty_init_console): - * console-tty.c: - * console-msw.h (struct mswindows_frame): - * conslots.h: - * config.h.in: - * cmds.c (internal_self_insert): - * cmds.c (Fforward_line): - * cmds.c (Fforward_char): - * cmds.c: - * cmdloop.c: - * chartab.c (mark_char_table_entry): - * chartab.c: - * casefiddle.c (casify_word): - * callproc.c (child_setup): - * callproc.c (Fcall_process_internal): - * callproc.c: - * callint.c (Fcall_interactively): - * bytecode.h: - * bytecode.c (execute_rare_opcode): - * bytecode.c (execute_optimized_program): - * bytecode.c: - * bufslots.h: - * buffer.h (BUFFER_REALLOC): - * buffer.h (GET_CHARPTR_INT_DATA_ALLOCA): - * buffer.h (GET_CHARPTR_EXT_DATA_ALLOCA): - * buffer.h: - * buffer.h (MAP_INDIRECT_BUFFERS): - * buffer.h (CHECK_LIVE_BUFFER): - * buffer.c (init_initial_directory): - * buffer.c (complex_vars_of_buffer): - * buffer.c (vars_of_buffer): - * buffer.c (finish_init_buffer): - * buffer.c (Fget_file_buffer): - * buffer.c (Fbuffer_list): - * buffer.c (mark_buffer): - * balloon_help.c (balloon_help_move_to_pointer): - * balloon_help.c (show_help): - * balloon_help.c: - * backtrace.h: - * alloc.c (garbage_collect_1): - * alloc.c (sweep_strings): - * alloc.c (sweep_compiled_functions): - * alloc.c (sweep_bit_vectors_1): - * alloc.c (sweep_vectors_1): - * alloc.c (sweep_lcrecords_1): - * alloc.c (tick_lcrecord_stats): - * alloc.c (pure_string_sizeof): - * alloc.c (mark_conses_in_list): - * alloc.c (mark_object): - * alloc.c (report_pure_usage): - * alloc.c (make_pure_float): - * alloc.c (make_pure_string): - * alloc.c (free_managed_lcrecord): - * alloc.c (mark_string): - * alloc.c (noseeum_make_marker): - * alloc.c (allocate_event): - * alloc.c (Fbit_vector): - * alloc.c (Fvector): - * alloc.c (make_float): - * alloc.c (Fmake_list): - * alloc.c (Flist): - * alloc.c (FREE_FIXED_TYPE_WHEN_NOT_IN_GC): - * alloc.c (PUT_FIXED_TYPE_ON_FREE_LIST): - * alloc.c (DECLARE_FIXED_TYPE_ALLOC): - * alloc.c (dbg_constants): - * alloc.c (gc_record_type_p): - * alloc.c (free_lcrecord): - * alloc.c (xmalloc): - * alloc.c (NOSEEUM_INCREMENT_CONS_COUNTER): - * abbrev.c: - * Makefile.in.in (mostlyclean): - * Makefile.in.in (external_client_xlib_objs_nonshared): - * Makefile.in.in (temacs_link_args): - * Makefile.in.in (release): - * Makefile.in.in (dnd_objs): - * Makefile.in.in (objs): - * Makefile.in.in (PROGNAME): - * EmacsShell.c: cast strings to (XtPointer) - * EmacsFrame.c: cast strings to (XtPointer) - - mega patch - - rewrite basic lisp functions for speed - - rewrite bytecode interpreter for speed - - rewrite list looping constructs for speed and safety using - tortoise/hare. - - use size_t where appropriate. - - new hashtable implementation - - cleanup implementation of opaques - - opaques can now be purecopy'ed - - move some cl functionality into C for speed. - - remove last remaining VMS support - - spelling fixes - - improve gdb/dbx debugger support - - move pure.c back into alloc.c for performance - - enable report_pure_usage() if --memory-usage-stats - - remove remnants of Energize support (EMACS_BTL, cadillac...) - - don't use symbols with leading `_' or embedded `__' - - globally cleanup duplicated semicolons `;;' - - I give in on %p vs %lx - we use printf("%lx",(long) p) - globally. - - globally replace O_NDELAY with O_NONBLOCK. - - globally replace CDISABLE with _POSIX_VDISABLE. - - use O_RDONLY and O_RDWR instead of magic `0' and `2'. - - define (and maybe use!) STDERR_FILENO and friends. - - add support for macros defined in C - - `when', `unless', `not' and `defalias' now defined in C, - so that they are universally available. - - rename defvar_mumble to defvar_magic - - rename RETURN__ to RETURN_SANS_WARNINGS - - use consistent style of initial caps in error messages - - implement last, butlast, nbutlast, copy-list in C. - - provide typedefs for all struct Lisp_foo types - - Lisp_Objects must be initialized to Qnil rather than 0. - - make sure XEmacs runs (slowly) with always_gc == 1; - - fast and safe LOOP_* macros - - change calls to XSETOBJ to XSETFOO - - replace calls to XSETINT by make_int() - - plug up memory leaks - - use style markobj (foo), not silly ((markobj) (foo)) - - use XFLOAT_DATA (obj) instead of float_data (XFLOAT (obj)) + * redisplay-msw.c (mswindows_output_cursor): Avoid shadows. + (mswindows_output_display_block): Avoid local shadows. + + * event-msw.c (mswindows_enqueue_magic_event): Avoid shadows. + (mswindows_enqueue_mouse_button_event): ditto. + (mswindows_handle_gui_wm_command): remove declaration. + + * console-msw.c (mswindows_canonicalize_console_connection): Avoid + warnings. + + * console-msw.h: Avoid shadows. + (mswindows_get_toolbar_button_text): + (emacs_mswindows_create_stream_pair): + (emacs_mswindows_delete_stream_pair): + (mswindows_handle_toolbar_wm_command): declare. + + * device-msw.c (build_syscolor_string): Avoid shadows. + +2000-01-23 Andy Piper <andy@xemacs.org> + + * glyphs-widget.c (widget_instantiate): reverse the items for + layouts so that children are in the expected order. + +2000-01-28 Martin Buchholz <martin@xemacs.org> + + * ralloc.c: safe_bcopy ==> memmove + * gmalloc.c: Remove MEMMOVE_MISSING conditional code. + * s/msdos.h: Remove BCOPY macros. + * insdel.c (gap_right): Remove BCOPY conditional code. + * insdel.c (gap_left): Remove BCOPY conditional code. + XEmacs demands a working ANSI C compiler - hence memmove. + + * regex.c (regex_compile): Remove accidental use of trigraphs. + +2000-01-27 Kirill 'Big K' Katsnelson <kkm@dtmx.com> + + * event-msw.c (mswindows_enqueue_misc_user_event): Initialize + event timestamp. + +2000-01-26 Kirill 'Big K' Katsnelson <kkm@dtmx.com> + + * event-msw.c (mswindows_drain_windows_queue): Added the + parameter. + (mswindows_need_event): Commented the call to + mswindows_drain_windows_queue(). + (emacs_mswindows_quit_p): Lookup the windows for keyboard messages + only. -1998-12-02 P. E. Jareth Hein <jareth@camelot.co.jp> - - * unexec.c: Changed a #ifndef statement to fix XEmacs on BSDI 3.0 - -1998-11-28 SL Baur <steve@altair.xemacs.org> - - * XEmacs 21.2-beta4 is released. - -1998-11-27 SL Baur <steve@altair.xemacs.org> - - * mule-charset.c (complex_vars_of_mule_charset): Fix graphic - property in control-1 charset. - From Julian Bradfield <jcb@daimi.au.dk> - -1998-11-26 Jan Vroonhof <vroonhof@math.ethz.ch> - - * gui-x.c (button_item_to_widget_value): Ignore :key-sequence - keyword. - Add stub for :label. - - * gui.c (gui_item_add_keyval_pair): ditto. + * console-msw.h: Moved a few function prototypes here from + event-msw.c. - * menubar-x.c (menu_item_descriptor_to_widget_value_1): Ignore - :key-sequence keyword. - Add stub for:label. - Support :active for submenus like the Windows code and FSF Emacs. - -1998-11-27 Hrvoje Niksic <hniksic@srce.hr> - - * dired.c (make_directory_hash_table): make_string() is OK because - readdir() Mule-encapsulates. - -1998-11-26 Hrvoje Niksic <hniksic@srce.hr> + * gui-msw.c (mswindows_handle_gui_wm_command): Changed the ID + parameter from unsigned short to unsigned long. + (Fmswindows_shell_execute): Added return value. - * fns.c (Fbase64_encode_string): Fix docstring. - (Fbase64_decode_string): Ditto. - -1998-11-26 Hrvoje Niksic <hniksic@srce.hr> - - * editfns.c (Ftranslate_region): Use - convert_bufbyte_string_into_emchar_string(). - -1998-11-25 Hrvoje Niksic <hniksic@srce.hr> - - * editfns.c (Ftranslate_region): Accept vectors and char-tables as - well as strings. - (Ftranslate_region): Turn table into an array of Emchars for - larger regions. - -1998-11-25 Hrvoje Niksic <hniksic@srce.hr> +2000-01-27 URA Hiroshi <ura@hiru.aoba.yokohama.jp> - * chartab.c (Freset_char_table): Fix wrong placement of #endif. - -1998-11-24 Hrvoje Niksic <hniksic@srce.hr> - - * chartab.c (Freset_char_table): Don't blindly fill chartables of - type `char' with nils. - - * chartab.c (canonicalize_char_table_value): Coerce ints to chars - for tables of type `char'. - -1998-11-26 Didier Verna <verna@inf.enst.fr> + * sysdep.c (init_system_name): + process-unix.c (unix_canonicalized_host_name): + Don't call freeaddrinfo() if getaddrinfo() fails. - * input-method-xlib.c (Initialize_Locale): don't call - XtSetLanguageProc. We've done the whole work here. - * input-method-xfs.c (Initialize_Locale): ditto. - * input-method-motif.c (Initialize_Locale): ditto. - -1998-11-26 Didier Verna <verna@inf.enst.fr> - - * process-unix.c (unix_create_process): handle properly - Vfile_name_coding_system for converting the program and directory - names. - -1998-11-27 SL Baur <steve@altair.xemacs.org> + * process-unix.c (unix_open_unix_network_stream): + Moved the code to get a port # into address loop. - * m/arm.h: New file. - From James LewisMoss <dres@ioa.com> - -1998-11-27 Takeshi Hagiwara <hagiwara@ie.niigata-u.ac.jp> - - * m/mips-nec.h: - Fix the realpath() problem of UnixWare2.1.3. - Patches for NEC's sysv4.2 machine. - -1998-11-25 Hrvoje Niksic <hniksic@srce.hr> - - * dired.c (Fdirectory_files): Remove redundant code. +2000-01-27 Martin Buchholz <martin@xemacs.org> -1998-11-25 Hrvoje Niksic <hniksic@srce.hr> + * buffer.c (reinit_vars_of_buffer): + The right place to initialize conversion_in_dynarr and + conversion_out_dynarr. - * fns.c (free_malloced_ptr): New function. - (XMALLOC_OR_ALLOCA): New macro. - (XMALLOC_UNBIND): Ditto. - (Fbase64_encode_region): Use malloc() for large blocks; arrange it - to be freed in case of non-local exit. - (Fbase64_encode_string): Ditto. - (Fbase64_decode_region): Ditto. - (Fbase64_decode_string): Ditto. - (STORE_BYTE): New macro. - (base64_decode_1): Use it. + * alloc.c (pdump): Use the real open() till sys_open() is functional. -1998-11-25 Hrvoje Niksic <hniksic@srce.hr> - - * fns.c (base64_value_to_char): Base64 stuff. - -1998-11-24 Hrvoje Niksic <hniksic@srce.hr> - - * editfns.c (Fbuffer_substring): New function. - - * lisp.h: Declare make_string_from_buffer_no_extents(). - - * insdel.c (make_string_from_buffer_1): New function. - (make_string_from_buffer_no_extents): Ditto. - -1998-11-15 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de> - - * linuxplay.c: Including <fcntl.h> instead of <sys/fcntl.h> makes - sound work on AIX with OSS installed. Linux should still work. - -1998-11-03 Andy Piper <andyp@parallax.co.uk> - - * config.h.in: name change for cygwin/version.h - - * configure.in: check for cygwin/version.h now. + * process-unix.c (unix_canonicalize_host_name): Muleize. + (unix_open_network_stream): Muleize. - * cygwin32.h: track CYGWIN_DLL_VERSION_MAJOR -> - CYGWIN_VERSION_DLL_MAJOR name change in cygwin b20. - move cygwin32/version.h to cygwin/version.h - -1998-11-03 Olivier Galibert <galibert@pobox.com> - - * lisp.h (struct Lisp_Bit_Vector): Fix declaration of bits from - int to long. - -1998-10-22 Andy Piper <andyp@parallax.co.uk> - - * cygwin32.h: track CYGWIN_DLL_VERSION_MAJOR -> - CYGWIN_VERSION_DLL_MAJOR name change in cygwin b20. - enable BROKEN_SIGIO under b20 to make QUIT work. - -1998-10-22 Andy Piper <andyp@parallax.co.uk> - - * frame-msw.c (mswindows_size_frame_internal): force frame sizing - to fit within the constraints of the screen size. I.e. make the - frame small enough to fit and move it if some of it will be - off-screen. - -1998-10-19 Greg Klanderman <greg@alphatech.com> - - * dired.c: conditionalize inclusion of user-name-completion - primitives on non-Windows NT. The needed functions don't exist on NT. + * buffer.h: Fix up prototypes for ralloc.c functions. -1998-11-24 SL Baur <steve@altair.xemacs.org> - - * gifrlib.h: Clean up types for 64 bit compile. - * dgif_lib.c (DGifInitRead): Ditto. - (MakeSavedImage): Ditto. - * emacs.c (decode_path): Ditto. - From Steve Carney <carney@pa.dec.com> - -1998-10-16 William M. Perry <wmperry@aventail.com> +2000-01-27 URA Hiroshi <ura@hiru.aoba.yokohama.jp> + * config.h.in: added HAVE_GETADDRINFO and HAVE_GETNAMEINFO + * sysdep.c: In init_system_name(), add code to use getaddrinfo() + instead of gethostbyname() + * process-unix.c: In unix_canonicalize_host_name() and + unix_open_network_stream(), add code to use getaddrinfo() + instead of gethostbyname(). - * glyphs-msw.c (bitmap_table): Fixed typo in builtin bitmaps - (cehckboxes instead of checkboxes). - -1998-10-15 SL Baur <steve@altair.xemacs.org> - - * XEmacs 21.2-beta3 is released. - -1998-10-13 Raymond Toy <toy@rtp.ericsson.se> - - * runemacs.c (WinMain): If the basename is "rungnuclient.exe", run - gnuclient. Otherwise, we run xemacs as we always did. This gets - rid of the annoying DOS window when running gnuclient. - -1998-10-13 Andy Piper <andyp@parallax.co.uk> +2000-01-27 Daniel Pittman <daniel@danann.net> - * dragdrop.c (vars_of_dragdrop): rename HAVE_MSWINDOWS -> - HAVE_MS_WINDOWS typo. - -1998-10-13 SL Baur <steve@altair.xemacs.org> + * device-x.c (x_init_device): Warn at run-time if using Athena 3d + libs when built with flat Athena. - * process-unix.c (unix_send_process): Set closed flag on writable - pipe after SIGPIPE is received and before we call deactivate_process. - -1998-10-03 Gunnar Evermann <ge204@eng.cam.ac.uk> +2000-01-27 Martin Buchholz <martin@xemacs.org> - * window.c (Fset_window_start): respect narrowing when - checking wheter start is at the beginning of a line. - (Fset_window_buffer): Ditto - Fixes repeatable crash in VM. - -1998-10-09 SL Baur <steve@altair.xemacs.org> + * ralloc.c: Replace SIZE (conflicts with Windows headers) with size_t. + Use coding standards for function prototypes. - * window.c (specifier_vars_of_window): Set default vertical - divider width to 1 on ttys. - -1998-10-08 Martin Buchholz <martin@xemacs.org> - - * alloc.c: - * unexec.c: - * malloc.c: - Add <stddef.h> to get ptrdiff_t declaration - -1998-10-07 Jonathan Harris <jhar@tardis.ed.ac.uk> +2000-01-25 Martin Buchholz <martin@xemacs.org> - * scrollbar-msw.c: Use the same vertical scrollbar drag hack as - is used for Motif or Lucid scrollbars under X. - -1998-10-08 Pierre Wendling <pw@ebc.vbe.dec.com> - - * m/alpha.h (UNEXEC): quoted to avoid bad expansion when running - `configure' - -1998-10-06 Takeshi Hagiwara <hagiwara@ie.niigata-u.ac.jp> - - * frame-x.c (x_delete_frame): Fix an argument of XtDestroyWidget. - -1998-10-05 Andy Piper <andyp@parallax.co.uk> - - * s/cygwin32.h: more cygwin b20 reorganisation. - -1998-10-03 Gunnar Evermann <ge204@eng.cam.ac.uk> - - * window.c (Fset_window_start): Document me. - (Fset_window_buffer): Document me. - Fixes some sort of repeatable crash. - -1998-10-01 Raymond Toy <toy@rtp.ericsson.se> - - * nas.c: Added necessary support functions to be able to handle - WAVE files in memory, just like the support for SND files in - memory. - -1998-09-30 SL Baur <steve@altair.xemacs.org> - - * callproc.c (child_setup): Fix spelling typo. - -1998-09-29 SL Baur <steve@altair.xemacs.org> - - * XEmacs 21.2-beta2 is released. - -1998-09-27 P. E. Jareth Hein <jareth@camelot.co.jp> - - * regex.c (re_match_2_internal): Add in code to reset lowest_active_reg - to prevent memory corruption in the case of jumping out of a series of - nested match patterns. This is a rather brute force approach, though. - -1998-09-02 Andy Piper <andyp@parallax.co.uk> - - * config.h.in: ditto. - - * s/cygwin32.h: rearrange declarations to cope with cygwin - b20. Include cygwin32/version.h if it exists. - -1998-09-20 Jonathan Harris <jhar@tardis.ed.ac.uk> - - * device-msw.c (mswindows_init_device): Call new - mswindows_enumerate_fonts() function in objects-msw.c instead - of font_enum_callback_1() to enumerate fonts. - - font_enum_callback_1() and _2() moved to objects-msw.c. - - * faces.c (complex_vars_of_faces): Make the mswindows default - face font fully specified and provide some fallbacks. - - * objects-msw.c: font_enum_callback_1() and _2() moved here - from objects-msw.c. Obtain the enumerated font's character - sets by table lookup instead of using the locale-specific - string provided by Windows. - - New public non-method mswindows_enumerate_fonts() that fills - in the supplied mswindows device's font list. - - mswindows_initialize_font_instance: Use the supplied name - variable instead of f->name when signalling errors. Match font - weights and character sets using lookup tables which handle - spaces instead of by frobbing. - -1998-09-20 Jonathan Harris <jhar@tardis.ed.ac.uk> - - * process-nt.c: Define an arbitrary limit, FRAGMENT_CODE_SIZE, - on the size of code fragments passed to run_in_other_process. - - run_in_other_process(): Use FRAGMENT_CODE_SIZE to determine - the amount of memory to allocate in the other process. - - Removed sigkill_code_end(), sigint_code_end() and - sig_enable_code_end() since they are now redundant. - - send_signal() and enable_child_signals(): Don't try to work - out the end of the code fragments passed to - run_in_other_process() - -1998-09-10 Kazuyuki IENAGA <ienaga@jsys.co.jp> - - * src/s/freebsd.h: Added __ELF__ and compiler/liker flags for - FreeBSD-current. - - * src/unexelf.c: Partially synched with FSF's 20.3. - -1998-09-10 Hrvoje Niksic <hniksic@srce.hr> - - * insdel.c (signal_after_change): Map across indirect buffers - here, and not in the upper-level functions. - (signal_first_change): Don't check for Armageddon. - (signal_before_change): Map across indirect buffers here. - (prepare_to_modify_buffer): ...and here. - -1998-09-09 Hrvoje Niksic <hniksic@srce.hr> - - * insdel.c (signal_after_change): Add return value. - (buffer_insert_string_1): Use it. - (buffer_delete_range): Ditto. - (buffer_replace_char): Ditto. - (cancel_multiple_change): Map the indirect buffers. - -1998-09-06 Hrvoje Niksic <hniksic@srce.hr> - - * insdel.c (init_buffer_text): Remove INDIRECT_P parameter. - (uninit_buffer_text): Ditto. - - * buffer.c (Fmake_indirect_buffer): Implement stricter - error-checking. - -1998-09-04 Hrvoje Niksic <hniksic@srce.hr> - - * insdel.c (change_function_restore): Reverse order of - function-call and assignment. - (first_change_hook_restore): Ditto. - - * extents.c (mark_extent_auxiliary): Mark them. - (Fset_extent_property): Set them. - (Fextent_property): Get them. - (Fextent_properties): Ditto. - (vars_of_extents): Set their default. - - * extents.h (struct extent_auxiliary): Add before_change_functions - and after_change_functions. - - * insdel.c (signal_before_change): Use it. - (signal_after_change): Ditto. - - * extents.c (report_extent_modification): New function. - - * insdel.c (signal_before_change): Don't check for Armageddon. - (signal_after_change): Ditto. - -1998-09-11 Gunnar Evermann <Gunnar.Evermann@nats.informatik.uni-hamburg.de> - - * redisplay.c (redisplay_window): make sure a new starting point - is chosen if it somehow got moved from the beginning of the line - -- this can happen because Fwiden was called recently. - - * window.c (Fset_window_start): set start_at_line_beg correctly - (Fset_window_buffer): Ditto - -1998-09-06 Hrvoje Niksic <hniksic@srce.hr> - - * insdel.c (init_buffer_text): Remove INDIRECT_P parameter. - (uninit_buffer_text): Ditto. - - * buffer.c (Fmake_indirect_buffer): Implement stricter - error-checking. - -1998-05-14 Jan Vroonhof <vroonhof@math.ethz.ch> - - * emacs.c (main_1): Removed references to *vars_of_filelock. - - * lisp.h: Added Fsystem_name. - - * filelock.c: Replaced by version from FSF 20.2. Now implements - locking by using symlinks which is NFS safe. However keep the - GCPRO's in lock_file and the calls to callx_in_buffer like our old - version (and of course use ansi C, acessor macros, etc). - -1998-09-06 Jan Vroonhof <vroonhof@math.ethz.ch> - - * process-unix.c (unix_create_process): Reset SIGHUP handler to - SIG_DFL. We now try to conserve any inherted SIG_IGN settings - in init_signals_very_early. However these should not be passed - on to children attached to the new pty. - -1998-08-28 Andy Piper <andyp@parallax.co.uk> - - * glyphs-eimage.c (png_instantiate_unwind): clean up eimage after use. - -1998-09-07 Jonathan Harris <jhar@tardis.ed.ac.uk> - - * fileio.c (file-name-directory, file_name_as_directory): - Don't call CORRECT_DIR_SEPS, even when #defined WINDOWSNT. - -1998-09-02 Andy Piper <andyp@parallax.co.uk> - - * emacs.c (main_1): init_ralloc() if initialised and we have REL_ALLOC - - * ralloc.c: uncomment __morecore. - -1998-09-92 Jonathan Harris <jhar@tardis.ed.ac.uk> - - * event-msw.c(winsock_writer): Supply a dummy 4th argument to - WriteFile() to fix a winsock 1.x bug on Win95. - -1998-08-28 Hrvoje Niksic <hniksic@srce.hr> - - * event-Xt.c (emacs_Xt_mapping_action): Check for device being - deleted. - (x_event_to_emacs_event): Ditto. - (emacs_Xt_handle_focus_event): Ditto. - (emacs_Xt_handle_magic_event): Ditto. - - * console-x.h (struct x_device): New flag being_deleted. - (DEVICE_X_BEING_DELETED): New macro. - - * device-x.c (x_IO_error_handler): Throw to top-level instead of - returning. Before doing that, set the being_deleted flag on the - device. - -1998-08-27 Hrvoje Niksic <hniksic@srce.hr> - - * device-x.c (x-seppuku-on-epipe): Removed. - -1998-08-26 Gunnar Evermann <Gunnar.Evermann@nats.informatik.uni-hamburg.de> - - * frame-x.c (x_delete_frame): Flush the X output buffer after - calling XtDestroyWidget to ensure that the windows are really - killed right now. - -1998-08-26 Hrvoje Niksic <hniksic@srce.hr> - - * menubar-x.c (my_run_hook): New unused function. - (pre_activate_callback): Use run_hook for Qactivate_menubar_hook, - since we ignore the results of the contained functions anyway. - -1998-08-26 P. E. Jareth Hein <jareth@camelot.co.jp> - - * glyphs-eimage.c (gif_instantiate): Fix a crash in handling - interlaced GIF files that are smaller than 4 lines high... - -1998-08-31 Hrvoje Niksic <hniksic@srce.hr> - - * buffer.c (map_over_sharing_buffers): Deleted. - - * insdel.c (MAP_INDIRECT_BUFFERS): Move to buffer.h. - - * buffer.c (Fkill_buffer): Keep indirect_children updated while - killing them. - -1998-08-31 Hrvoje Niksic <hniksic@srce.hr> + * dialog-msw.c (push_lisp_string_as_unicode): + * doc.c (unparesseuxify_doc_string): + * dired.c (Fuser_name_completion_1): + * dired.c (Fuser_name_all_completions): + * dired.c (free_user_cache): + * dired.c (user_name_completion): + * console-x.c (get_display_arg_connection): + * minibuf.c (clear_echo_area_internal): + * minibuf.c (echo_area_append): + * eldap.c (Fldap_open): + * eldap.c (Fldap_search_internal): + * frame-x.c (x_set_frame_text_value): + * frame-x.c (x_set_frame_properties): + * frame-x.c (x_create_widgets): + * redisplay-tty.c (term_get_fkeys_1): + * objects-x.c (x_parse_nearest_color): + * objects-x.c (x_valid_color_name_p): + * objects-x.c (x_initialize_font_instance): + * objects-x.c (x_list_fonts): + * objects-x.c (x_find_charset_font): + * tooltalk.c (Fadd_tooltalk_message_arg): + * tooltalk.c (Fadd_tooltalk_pattern_attribute): + * tooltalk.c (Fadd_tooltalk_pattern_arg): + * process-unix.c (unix_create_process): + * ntproc.c (sys_spawnve): + * sound.c (Fplay_sound_file): + * sound.c (Fplay_sound): + * buffer.c (init_initial_directory): + * buffer.c (init_buffer): + * editfns.c (init_editfns): + * editfns.c (Ftemp_directory): + * editfns.c (Fuser_full_name): + * editfns.c (uncache_home_directory): + * editfns.c (get_home_directory): + * editfns.c (Fuser_home_directory): + * editfns.c (Fformat_time_string): + * editfns.c (Fcurrent_time_string): + * gui-x.c (button_item_to_widget_value): + * database.c (Fopen_database): + * event-Xt.c (x_to_emacs_keysym): + * event-Xt.c (x_event_to_emacs_event): + * event-Xt.c (describe_event_window): + * event-msw.c (mswindows_wnd_proc): + * glyphs-eimage.c (jpeg_instantiate): + * glyphs-eimage.c (gif_instantiate): + * glyphs-eimage.c (png_instantiate): + * glyphs-eimage.c (tiff_instantiate): + * glyphs-x.c (xbm_instantiate_1): + * glyphs-x.c (x_xbm_instantiate): + * glyphs-x.c (x_xface_instantiate): + * glyphs-x.c (autodetect_instantiate): + * glyphs-x.c (cursor_font_instantiate): + * glyphs-x.c (x_widget_instantiate): + * glyphs-x.c (x_widget_set_property): + * glyphs-x.c (x_widget_property): + * glyphs-x.c (BUILD_GLYPH_INST): + * print.c (write_string_to_stdio_stream): + * print.c (output_string): + * print.c (Falternate_debugging_output): + * print.c (Fexternal_debugging_output): + * glyphs-msw.c (extract_xpm_color_names): + * glyphs-msw.c (mswindows_xpm_instantiate): + * glyphs-msw.c (bmp_instantiate): + * glyphs-msw.c (resource_name_to_resource): + * glyphs-msw.c (mswindows_resource_instantiate): + * glyphs-msw.c (xbm_instantiate_1): + * glyphs-msw.c (mswindows_xbm_instantiate): + * glyphs-msw.c (mswindows_xface_instantiate): + * glyphs-msw.c (mswindows_widget_instantiate): + * glyphs-msw.c (add_tree_item): + * glyphs-msw.c (add_tab_item): + * glyphs-msw.c (mswindows_combo_box_instantiate): + * glyphs-msw.c (mswindows_widget_property): + * glyphs-msw.c (mswindows_combo_box_property): + * glyphs-msw.c (mswindows_widget_set_property): + * console.c (stuff_buffered_input): + * objects-msw.c (mswindows_initialize_color_instance): + * objects-msw.c (mswindows_valid_color_name_p): + * objects-msw.c (mswindows_list_fonts): + * objects-msw.c (mswindows_font_instance_truename): + * bytecode.c (optimize_compiled_function): + * select-x.c (symbol_to_x_atom): + * select-x.c (x_atom_to_symbol): + * select-x.c (hack_motif_clipboard_selection): + * select-x.c (selection_data_to_lisp_data): + * select-x.c (lisp_data_to_selection_data): + * select-x.c (Fx_get_cutbuffer_internal): + * select-x.c (Fx_store_cutbuffer_internal): + * buffer.h (TO_EXTERNAL_FORMAT): New function. + * buffer.h (TO_INTERNAL_FORMAT): New function. + * emacs.c (make_arg_list_1): + * emacs.c (make_argc_argv): + * emacs.c (main_1): + * emacs.c (Fdump_emacs): + * emacs.c (split_string_by_emchar_1): + * file-coding.h: + * lisp.h: + * lstream.h: + * symsinit.h: + * device-x.c (x_init_device): + * device-x.c (Fx_valid_keysym_name_p): + * device-x.c (Fx_get_font_path): + * device-x.c (Fx_set_font_path): + * glyphs.c (bitmap_to_lisp_data): + * glyphs.c (pixmap_to_lisp_data): + * alloc.c (make_ext_string): Use coding system arguments. Update + all callers. + * alloc.c (build_string): + * callproc.c (child_setup): + * callproc.c (init_callproc): + * fileio.c (lisp_strerror): + * fileio.c (directory_file_name): + * fileio.c (Fexpand_file_name): + * fileio.c (Ffile_truename): + * fileio.c (Fsysnetunam): + * fileio.c (Fdo_auto_save): + * sysdep.c (sys_readdir): + * tests.c: New file. Allow adding C tests. + Replace GET_* macros with a more comprehensible and flexible + interface, TO_INTERNAL_FORMAT() and TO_EXTERNAL_FORMAT(). + Modify all calls. + Any coding system can be used to do format conversion. + Eliminate enum external_data_format. + Eliminate convert_to_external_format. + Eliminate convert_to_internal_format. + Make sure file-name, keyboard, terminal, and ctext are always + defined as coding systems or aliases. Make + file-name-coding-system, terminal-coding-system, and + keyboard-coding-system magical variables that are equivalent to + defining the corresponding coding system aliases. + + * file-coding.c (Fcoding_system_canonical_name_p): New function. + * file-coding.c (Fcoding_system_alias_p): New function. + * file-coding.c (Fcoding_system_aliasee): New function. + * file-coding.c (append_suffix_to_symbol): New function. + * file-coding.c (dangling_coding_system_alias_p): New function. + * file-coding.c (Ffind_coding_system): + * file-coding.c (Fcopy_coding_system): + * file-coding.c (encode_coding_no_conversion): + * file-coding.c (syms_of_file_coding): + * file-coding.c (vars_of_file_coding): + Rewrite coding system alias code. + Allow nested aliases, like symbolic links. + Allow redefinition of coding system aliases. + Prevent existence of dangling coding system aliases. - * insdel.c (buffer_insert_string_1): Advance the point bytind in - all the buffers. - (buffer_delete_range): Ditto. - - * marker.c (init_buffer_markers): Set point-marker to the value of - point in an indirect buffer. - -1998-08-30 Hrvoje Niksic <hniksic@srce.hr> - - * undo.c (undo_prelude): Test last-undo-buffer against base - buffer. - - * insdel.c (MAP_INDIRECT_BUFFERS): Use it. - - * buffer.h (BUFFER_BASE_BUFFER): New macro. - -1998-08-30 Hrvoje Niksic <hniksic@srce.hr> - - * insdel.c (init_buffer_text): Initialize it here. - - * line-number.c: Address line_number_cache through buffer->text. - - * buffer.c (mark_buffer): Mark line number cache. - - * bufslots.h (line_number_cache): Move to struct buffer_text. - - * insdel.c (buffer_insert_string_1): Propagate signals and changes - across the children buffers. - (buffer_delete_range): Ditto. - (buffer_replace_char): Ditto. - (gap_left): Ditto. - (gap_right): Ditto. - - * insdel.c (MAP_INDIRECT_BUFFERS): New macro. - - * buffer.c (Fmake_indirect_buffer): Uncomment. - -1998-08-31 Hrvoje Niksic <hniksic@srce.hr> - - * macros.c (Fend_kbd_macro): Remove trailing period from error - message. - (Fexecute_kbd_macro): Ditto. - -1998-08-21 Greg Klanderman <greg@alphatech.com> - - * dired.c (Fuser_name_completion): remove optional 2nd argument. - (Fuser_name_completion_1): new function to return uniqueness - indication in addition to the user name completion. - (user_name_completion): change type of `uniq' argument. - -1998-08-19 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de> - - * lread.c (vars_of_lread): Removed `source-directory' variable. - -1998-08-22 Hrvoje Niksic <hniksic@srce.hr> - - * fileio.c (Ffile_readable_p): Apply the DOS/Windows logic to - Cygwin. - -1998-08-19 SL Baur <steve@altair.xemacs.org> - - * dired.c (vars_of_dired): Fix misapplied patch. - -1998-08-16 Martin Buchholz <martin@xemacs.org> - - * fns.c (Fremrassq, remrassq_no_quit): - A XCAR that should have been an XCDR turned Fremrassq into Fremassq - -1998-07-17 Didier Verna <verna@inf.enst.fr> - - * redisplay-x.c (x_get_gc): returns a GC with a FillStipple fill - style as foreground GC for faces that have the `dim' property. - (x_output_string): when the `dim' face property is set, - ensure the gray pixmap has been created, and get a proper - foreground GC to draw the text. - -1998-08-09 Jonathan Harris <jhar@tardis.ed.ac.uk> - - * event-msw.c (mswindows_wnd_proc): Workaround for a Win95 bug: - Manually track the state of the left and right Ctrl and Alt - modifiers. - -1998-08-07 Matt Stupple <matts@tibco.com> - - * ntproc.c: don't wait on char_consumed at thread entry. - Additionally, to get the 'process' marked as finished, ensure - that the CHILD_ACTIVE macro returns false, so before exiting - close char_avail and set it to NULL, and close other handles - to reduce handle leak problems. - -1998-08-09 Jonathan Harris <jhar@tardis.ed.ac.uk> - - * menubar-msw.c (displayable_menu_item): take account of menu - depth when deciding whether to try to display accelerators. - -1998-08-04 Andy Piper <andyp@parallax.co.uk> - - * event-msw.c: use MsgWaitForMultipleObjects if there are no - subprocesses. - - * glyphs-msw.c: fix a couple of potential handle leaks. - -1998-08-04 P. E. Jareth Hein <jareth@camelot.co.jp> - - * dgif_lib.c gif_io.c gifrlib.h: New files to put GIF - *decoding ONLY* back into the core. - * glyphs-eimage.c: Change referenced header file for GIF - reading to point to the incore version. - -1998-07-20 Martin Buchholz <martin@xemacs.org> - - * casefiddle.c (casify_object): - Change algorithm from O(N**2) to O(N). - Code cleanup. - Doc string cleanup. - -1998-07-22 Greg Klanderman <greg@alphatech.com> - - * dired.c (file_name_completion_unwind): don't leak the cons. - -1998-07-20 Greg Klanderman <greg@alphatech.com> + * dired.c (Fuser_name_completion_1): + * dired.c (Fuser_name_all_completions): + A crash would happen if user did QUIT in the middle of building + user_name_cache. Remove redundant code in mainline and unwind_protect. - * dired.c (Fuser_name_completion): new function. - (Fuser_name_all_completions): new function. - (user_name_completion): new function. - (syms_of_dired): 2 new DEFSUBRs. - (vars_of_dired): initialize user name cache vars. - -1998-07-29 P. E. Jareth Hein <jareth@camelot.co.jp> - - * glyphs-eimage.c (png_instantiate): Add proper handling for background - colors taken from the default face. Also correct a thinko in - transparency (not alpha) handling. - -1998-07-23 Martin Buchholz <martin@xemacs.org> - - * s/decosf4-0.h: Use a perfectly ordinary link. Nuke BSD crap. - * unexalpha.c: ANSI C-ize. Clean compiler warnings. - * lread.c (Fload_internal): Be very careful with printfs of - size_t's - * gui-x.c (menu_name_to_accelerator): tolower wants an `int' - argument. - -1998-07-27 Gunnar Evermann <Gunnar.Evermann@nats.informatik.uni-hamburg.de> - - * callint.c (Fcall_interactively): GCPRO prompt string before - passing it to Fread_key_sequence - -1998-07-27 SL Baur <steve@altair.xemacs.org> - - * keymap.c (vars_of_keymap): Initialize Vkey_translation_map and - Vvertical_divider_map. - - * mule-canna.c (vars_of_mule_canna): Initialize every symbol to - Qnil or 0, none were initialized prior to this change. - - Rename misnamed `V' prefixed integer variables: - Vcanna_empty_info, Vcanna_through_info, Vcanna_underline, - Vcanna_inhibit_hankakukana, Vcanna_henkan_length, Vcanna_henkan_revPos, - Vcanna_henkan_revLen, Vcanna_ichiran_length, Vcanna_ichiran_revPos, - Vcanna_ichiran_revLen. + * lisp.h: + * dynarr.c (Dynarr_min_size): Make static. Increase value to 8. - Rename misnamed `V' prefixed integer variables and initialize - properly in the vars_of routine. - Vcanna_mode_AlphaMode, Vcanna_mode_EmptyMode, Vcanna_mode_KigoMode, - Vcanna_mode_YomiMode, Vcanna_mode_JishuMode, Vcanna_mode_TankouhoMode, - Vcanna_mode_IchiranMode, Vcanna_mode_YesNoMode, Vcanna_mode_OnOffMode, - Vcanna_mode_AdjustBunsetsuMode, Vcanna_mode_ChikujiYomiMode, - Vcanna_mode_ChikujiTanMode, Vcanna_mode_HenkanMode, - Vcanna_mode_HenkanNyuryokuMode, Vcanna_mode_ZenHiraHenkanMode, - Vcanna_mode_HanHiraHenkanMode, Vcanna_mode_ZenKataHenkanMode, - Vcanna_mode_HanKataHenkanMode, Vcanna_mode_HanKataHenkanMode, - Vcanna_mode_ZenAlphaHenkanMode, Vcanna_mode_HanAlphaHenkanMode, - Vcanna_mode_ZenHiraKakuteiMode, Vcanna_mode_HanHiraKakuteiMode, - Vcanna_mode_ZenKataKakuteiMode, Vcanna_mode_HanKataKakuteiMode, - Vcanna_mode_ZenAlphaKakuteiMode, Vcanna_mode_HanAlphaKakuteiMode, - Vcanna_mode_HexMode, Vcanna_mode_BushuMode, Vcanna_mode_ExtendMode, - Vcanna_mode_RussianMode, Vcanna_mode_GreekMode, Vcanna_mode_LineMode, - Vcanna_mode_ChangingServerMode, Vcanna_mode_HenkanMethodMode, - Vcanna_mode_DeleteDicMode, Vcanna_mode_TourokuMode, - Vcanna_mode_TourokuEmptyMode, Vcanna_mode_TourokuHinshiMode, - Vcanna_mode_TourokuDicMode, Vcanna_mode_QuotedInsertMode, - Vcanna_mode_BubunMuhenkanMode, Vcanna_mode_MountDicMode, - Vcanna_fn_SelfInsert, Vcanna_fn_FunctionalInsert, - Vcanna_fn_QuotedInsert, Vcanna_fn_JapaneseMode, Vcanna_fn_AlphaMode, - Vcanna_fn_HenkanNyuryokuMode, Vcanna_fn_Forward, Vcanna_fn_Backward, - Vcanna_fn_Next, Vcanna_fn_Prev, Vcanna_fn_BeginningOfLine, - Vcanna_fn_EndOfLine, Vcanna_fn_DeleteNext, Vcanna_fn_DeletePrevious, - Vcanna_fn_KillToEndOfLine, Vcanna_fn_Henkan, Vcanna_fn_Kakutei, - Vcanna_fn_Extend, Vcanna_fn_Shrink, Vcanna_fn_AdjustBunsetsu, - Vcanna_fn_Quit, Vcanna_fn_ConvertAsHex, Vcanna_fn_ConvertAsBushu, - Vcanna_fn_KouhoIchiran, Vcanna_fn_BubunMuhenkan, Vcanna_fn_Zenkaku, - Vcanna_fn_Hankaku, Vcanna_fn_ExtendMode, Vcanna_fn_ToUpper, - Vcanna_fn_Capitalize, Vcanna_fn_ToLower, Vcanna_fn_Hiragana, - Vcanna_fn_Katakana, Vcanna_fn_Romaji, Vcanna_fn_BaseHiragana, - Vcanna_fn_BaseKatakana, Vcanna_fn_BaseEisu, Vcanna_fn_BaseZenkaku, - Vcanna_fn_BaseHankaku, Vcanna_fn_BaseKana, Vcanna_fn_BaseKakutei, - Vcanna_fn_BaseHenkan, Vcanna_fn_BaseHiraKataToggle, - Vcanna_fn_BaseZenHanToggle, Vcanna_fn_BaseKanaEisuToggle, - Vcanna_fn_BaseKakuteiHenkanToggle, Vcanna_fn_BaseRotateForward, - Vcanna_fn_BaseRotateBackward, Vcanna_fn_Touroku, Vcanna_fn_HexMode, - Vcanna_fn_BushuMode, Vcanna_fn_KigouMode, Vcanna_fn_Mark, - Vcanna_fn_TemporalMode, Vcanna_key_Nfer, Vcanna_key_Xfer, - Vcanna_key_Up, Vcanna_key_Left, Vcanna_key_Right, Vcanna_key_Down, - Vcanna_key_Insert, Vcanna_key_Rollup, Vcanna_key_Rolldown, - Vcanna_key_Home, Vcanna_key_Help, Vcanna_key_KP_Key, - Vcanna_key_Shift_Nfer, Vcanna_key_Shift_Xfer, Vcanna_key_Shift_Up, - Vcanna_key_Shift_Left, Vcanna_key_Shift_Right, Vcanna_key_Shift_Down, - Vcanna_key_Cntrl_Nfer, Vcanna_key_Cntrl_Xfer, Vcanna_key_Cntrl_Up, - Vcanna_key_Cntrl_Left, Vcanna_key_Cntrl_Right, Vcanna_key_Cntrl_Down - -1998-07-16 Jan Vroonhof <vroonhof@math.ethz.ch> - - * event-Xt.c (x_to_emacs_keysym): Return nil for modifier keysyms. - (x_event_to_emacs_event): Let x_to_emacs_keysym check for modifier - keys thus no longer considering all keysyms on a key. - -1998-07-19 SL Baur <steve@altair.xemacs.org> - - * XEmacs 21.2-beta1 is released. - -1998-07-12 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> - - * eldap.c (Fldap_search_internal): When converting the list of - attributes to search Copy the final 0 from Lisp strings to C - strings. - Check base, not Vldap_default_base as a a string - -1998-07-13 Jonathan Harris <jhar@tardis.ed.ac.uk> - - * nt.c: Remove Vstdio_str; already defined in console-stream.c. - - * unexnt.c: Unconditionally define bss_start and bss_size, and - ensure that they don't go in the .bss section. - -1998-07-17 Olivier Galibert <galibert@pobox.com> - - * glyphs-x.c (convert_EImage_to_XImage): Fix previous patch (conv - byte order is dependant of the local byte order). - From Takeshi Hagiwara <hagiwara@ie.niigata-u.ac.jp> - -1998-07-18 SL Baur <steve@altair.xemacs.org> - - * glyphs-msw.c (mswindows_resource_normalize): Qresource -> - Qmswindows_resource. - From Jonathan Harris <jhar@tardis.ed.ac.uk> - -1998-07-12 SL Baur <steve@altair.xemacs.org> - - * general.c (syms_of_general): Add defsymbol for Qresource. + * lstream.c (make_fixed_buffer_input_stream): Take a void *, not + an unsigned char *. Update all callers. - * glyphs-msw.c (vars_of_glyphs_mswindows): Rename Qresource to - Qmswindows_resource. - (TopLevel): Rename 'resource image format to 'mswindows_resource. - (mswindows_resource_validate): Rename. - (mswindows_resource_normalize): Rename. - (mswindows_resource_possible_dest_types): Rename. - (mswindows_resource_instantiate): Rename. - (image_instantiator_format_create_glyphs_mswindows): Replace - `resource' with `mswindows.resource'. - - * XEmacs 21.0-pre5 is released. - -1998-07-10 SL Baur <steve@altair.xemacs.org> +2000-01-26 Kirill 'Big K' Katsnelson <kkm@dtmx.com> - * mule-wnnfns.c (Fwnn_open): Correctly trap on misdefined Wnn - server type in environment. - Use alloca-ed strings instead of tiny fixed size ones. - -1998-07-09 SL Baur <steve@altair.xemacs.org> - - * XEmacs 21.0-pre4 is released. + * callproc.c (Fcall_process_internal): Ignore Vbinary-process_output. -1998-07-01 James N. Potts <jnpotts@plutonium.net> - - * fileio.c: (expand_file_name): under win32: Don't treat names - as UNC names if a drive letter has been specified. If a drive - has been specified, strip out extra directory-seperators that - reportedly cause problems under Win95. - -1998-07-09 Jonathan Harris <jhar@tardis.ed.ac.uk> +2000-01-25 Martin Buchholz <martin@xemacs.org> - * windowsnt.h: Define DUMP_SEPARATE_SECTION when building with - MSVC >= 5.0. Put emacs init and zero-init data in a special - section of the executable when this is defined. - - * unexnt.c, ntheap.h: - Removed unused find_section() and get_section_size(). - - * unexnt.c: - Fix up the executable's checksum after dumping otherwise the - profiler complains. - When DUMP_SEPARATE_SECTION is defined, don't need to dump - zero-init data separately from init data. Dump emacs data - into a special section of the executable. - When DUMP_SEPARATE_SECTION not defined, dump .bss up to - my_ebss instead of up to the end of bss. + * elhash.c (hentry_description): Use more portable definition. + (resize_hash_table): Initialize new hentries using + xnew_array_and_zero, thereby simplifying the code. -1998-07-09 Jonathan Harris <jhar@tardis.ed.ac.uk> - - * filelock.c: Removed Vconfigure_lock_directory - already - defined in emacs.c. - - * frame-msw.c: Removed Qinitially_unmapped and Qpopup - already - defined in frame.c and general.c respectively. + * mule-charset.c (make_charset): Make sure entire object is + intialized, to avoid Purify warnings. - * glyphs-msw.c: Removed Qresource - already defined in - general.c. + * alloc.c (resize_string): Fix unlikely crash with big strings. -1998-07-05 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> - - * eldap.c (Fldap_search_internal): Docstring fixes - -1998-07-04 Jonathan Harris <jhar@tardis.ed.ac.uk> +2000-01-24 Martin Buchholz <martin@xemacs.org> - * nt.c (init_environment): Removed unused PRELOAD_WINSOCK, - EMACSDOC and TERM variables. Added EMACSDEBUGPATHS, - EMACSPACKAGEPATH and INFOPATH variables. - Removed unused get_emacs_configuration function. - - * s/windowsnt.h: Don't define EMACS_CONFIGURATION here because - it is now defined at build-time by the makefile. - -1998-07-01 James N. Potts <jnpotts@plutonium.net> + * realpath.c (xrealpath): + Don't call getwd(). - * fileio.c: (expand_file_name): under win32: Don't treat names as - UNC names if a drive letter has been specified. If a drive has - been specified, strip out extra directory-seperators that - reportedly cause problems under Win95. - -1998-07-05 Andy Piper <andyp@parallax.co.uk> +2000-01-25 Martin Buchholz <martin@xemacs.org> - * faces.c (complex_vars_of_faces): for the gui-element face don't - fallback to the default face, instead provide reasonable default - fallbacks that were previously hardcoded elsewhere. + * lread.c (read_bit_vector): Fix memory leak reading literal bit vectors. -1998-07-06 Olivier Galibert <galibert@pobox.com> - - * glyphs-x.c (convert_EImage_to_XImage): Fix pixel writing problem - when the X server endianness is different than the client's one. - -1998-06-29 Kyle Jones <kyle_jones@wonderworks.com> +1999-12-28 Max Matveev <max@melbourne.sgi.com> - * eval.c (run_hook_with_args_in_buffer): Check - default (non-buffer-local) value of hook for - nil before treating it as a function. Don't initialize - the `globals' variable twice. - -1998-06-24 Jonathan Harris <jhar@tardis.ed.ac.uk> - - * fileio.c: Don't do directory seperator canonicalisation in - substitute-in-file-name because we don't know that the - filename refers to a local file. - -1998-06-24 Adrian Aichner <aichner@ecf.teradyne.com> - - * process-nt.c (nt_create_process): Try appending the standard - executable file extensions to the filename if none supplied. - -1998-06-29 SL Baur <steve@altair.xemacs.org> + * unexelfsgi.c (unexec): Change the way we decide which segment + should be extended. - * fileio.c (Fsubstitute_in_file_name): Enable double slash notation - for cygwin32. - From Keisuke Mori <ksk@ntts.com> - -1998-06-24 Andy Piper <andyp@parallax.co.uk> - - * toolbar-msw.c (mswindows_output_toolbar): only enable masked - images if we have masks. This handles the xbm case (have masks) - and avoids overuse of resources in the xpm case (generally no masks). - Don't output small toolbars. - -1998-06-29 Kyle Jones <kyle_jones@wonderworks.com> - - * eval.c (run_hook_with_args_in_buffer): Don't treat - the default value of a buffer local hook as a list of - hooks unless it is both a cons and the car of that cons - is not Qlambda. + Assumption that .bss section should be outside the PT_LOADable + segment. On IRIX with version 6.2 and above, .bss (or .sbss, if + it's present) is inside the 'data' segment. This would fail the + test which was used to find a segment to grow and cover new + heap. Instead of this assumption, I created another one - on IRIX + the segment to grow should start below .bss and it's address + should extent above the end of .bss. Once this segment is + identified, it's grown to accommodate the new heap and new + zero-length .bss section is added at the end of .data2. -1998-06-29 SL Baur <steve@altair.xemacs.org> - - * extents.c: Email address for Ben Wing is ben@xemacs.org. - * process-unix.c: Ditto. - * mule-coding.h: Ditto. - * mule-coding.c: Ditto. - * mule-charset.c: Ditto. - * mule-charset.h: Ditto. - * file-coding.c: Ditto. - * file-coding.h: Ditto. - -1998-06-22 Jonathan Harris <jhar@tardis.ed.ac.uk> +2000-01-25 Martin Buchholz <martin@xemacs.org> - * event-msw.c: Guard against recursion when freeing - FRAME_MSWINDOWS_TARGET_RECT struture in WM_SIZE processing. - - * frame-msw.c: Don't set WS_VISIBLE attribute on first frame. - Call ShowWindow twice in init_frame_3 to get round runemacs - weirdness. - -1998-06-27 Hrvoje Niksic <hniksic@srce.hr> + * eval.c (Feval): Wrong number of arguments should use original + function, not the indirect_function version of it. - * scrollbar.c (vertical_scrollbar_changed_in_window): Ditto. - - * winslots.h: Rename. - - * window.c (specifier_vars_of_window): Renamed - vertical-divider-draggable-p to vertical-divider-always-visible-p, - as suggested by Ben Wing. - (specifier_vars_of_window): Fix docstrings. +2000-01-24 Yoshiki Hayashi <yoshiki@xemacs.org> -1998-06-22 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de> - - * unexaix.c: Line number information works correctly again. - -1998-06-22 Olivier Galibert <galibert@pobox.com> - - * emacs.c (__sti__iflPNGFile_c___): Added. See comment. Cry. - -1998-06-21 Martin Buchholz <martin@xemacs.org> - - * editfns.c (get_home_directory): ANSIfy. - XEmacs is compilable under C *and* C++. - It's XEmacs, not Xemacs! - -1998-06-19 Jonathan Harris <jhar@tardis.ed.ac.uk> + * glyphs-x.c (x_button_instantiate): Don't add image if + it is not a pixmap. + (x_locate_pixmap_file): Call Fexpand_file_name when file name + is relative. - * console-msw.h: added a list of fonts to device data. - - * device-msw.c: enumerate list of available fonts in - mswindows_init_device. Free list in mswindows_delete_device. - - * objects-msw.c: Added helper function match_font used by - mswindows_initialize_font_instance and mswindows_list_fonts. - Allow a charset to be specified in a font string, even if - previous fields havn't been specified. - -1998-06-23 Greg Klanderman <greg@alphatech.com> - - * indent.c (column_at_point): column cache bugfix. - Set last_known_column_point to the buffer position for - which the column was requested, not buffer's point. +2000-01-21 Yoshiki Hayashi <yoshiki@xemacs.org> - * redisplay.c (decode_mode_spec): for current-column, show - window's point's column, not buffer's point's column. - -1998-06-23 Andy Piper <andyp@parallax.co.uk> - - * menubar-msw.c (mswindows_handle_wm_command): use - enqueue_misc_user event rather than - mswindows_enqueue_msic_user_event to fix customize problems. Add some - checks that X does. - - * console-msw.h: declare mswindows_enqueue_magic_event. - - * event-msw.c (mswindows_enqueue_magic_event): make global. + * symeval.h (DEFVAR_LISP_MAGIC): Remove semicolon after macro + declaration. + (DEFVAR_INT_MAGIC): Ditto. + (DEFVAR_BOOL_MAGIC): Ditto. + * glyphs.h: Reindent backslash. -1998-06-24 Hrvoje Niksic <hniksic@srce.hr> - - * line-number.c (LINE_NUMBER_FAR): Reverted to 16384. - (buffer_line_number): Use EMACS_INT_MAX instead of random LOTS. - (add_position_to_cache): Use EMACS_INT instead of int. - -1998-06-21 Olivier Galibert <galibert@pobox.com> +2000-01-24 Martin Buchholz <martin@xemacs.org> - * lisp-disunion.h (XMARKBIT): Have XMARKBIT return something - suitable for an int used as a boolean (btw, C sucks.). - -1998-06-18 Andy Piper <andyp@parallax.co.uk> - - * object-msw.c: remove warnings. - - * device-msw.c: #define wrongly named cygwin structure elements. + * glyphs-widget.c (layout_query_geometry): + (layout_layout): Use correct types for gheight, gwidth. - * s/cygwin32.h: define DEMI_BOLD - -1998-06-19 Jonathan Harris <jhar@tardis.ed.ac.uk> +2000-01-24 Martin Buchholz <martin@xemacs.org> - * redisplay-msw.c: new function mswindows_apply_face_effects. - This is called by output_string and output_cursor to display - underline and strikeout on faces. + * EmacsManager.c (QueryGeometry): Purified. -1998-06-19 Jonathan Harris <jhar@tardis.ed.ac.uk> - - * console-msw.h: added a list of fonts to device data. - - * device-msw.c: enumerate list of available fonts in - mswindows_init_device. Free list in mswindows_delete_device. +2000-01-23 Martin Buchholz <martin@xemacs.org> - * objects-msw.c: Added helper function match_font used by - mswindows_initialize_font_instance and mswindows_list_fonts. - Allow a charset to be specified in a font string, even if - previous fields havn't been specified. - -1998-06-15 Jonathan Harris <jhar@tardis.ed.ac.uk> + * alloc.c (make_float): Make sure entire object is intialized, to + avoid Purify warnings. + (pdump_register_sub): Remove useless assignment. + (pdump): Use xmalloc, not malloc. + (pdump_load): Use xmalloc, not malloc. - * objects-msw.c: - Removed compilation warnings from mswindows_string_to_color. - mswindows_list_fonts returns a more general bogus font. - New lisp-visible function mswindows-color-list. - -1998-06-19 David Bush <david.bush@adn.alcatel.com> - - * editfns.c (Fuser_login_name): Modify to user new function - user_login_name. - (user_login_name): C only function to avoid Lisp object overhead - Returns "unknown" instead of nil in Cygwin environment +2000-01-23 Kirill 'Big K' Katsnelson <kkm@dtmx.com> - * fileio.c (Fexpand_file_name): Treat "~" and "~user" as - equivalent for current user in Cygwin environment. Use new - function user_login_name to get username. - - * lisp.h: Declare user_login_name - -1998-06-18 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de> - - * unexaix.c (make_hdr): Fixed bias computations so debugging info - works again. - Some other insignificant nitpicks. - -1998-06-18 Andy Piper <andyp@parallax.co.uk> - - * toolbar-msw.c (mswindows_output_toolbar): specify ILC_MASK when - creating the image list and make sure he bk color is transparent. - -1998-06-18 Jan Vroonhof <vroonhof@math.ethz.ch> - - * event-Xt.c (emacs_Xt_remove_timeout): Also remove timeout from - completed_timeouts. The timer could have expired. - -1998-06-17 Andy Piper <andyp@parallax.co.uk> - - * console-msw.h: move XEMACS_RECT_WH inside frame - parameters. define macors to access it. + * callproc.c: + * dired-msw.c: + * fileio.c: + * process-nt.c: + * redisplay-msw.c: + * sysdep.c: Removed redundant #include <windows.h> - * frame-msw.c (mswindows_init_frame_1): use new target_rect - parameter to intialise desired sizing. (mswindows_init_frame_2): - enable and size the frame to something sensible when we get - here. (mswindows_set_frame_properites): use new - mswindows_size_frame_internal function and size frame if frame - parameters not just if init is finished - WM_SIZE happens too - early for some specs. (mswindows_size_frame_internal): new - function abstracted from mswindows_set_frame_properties. - (Vmswindows_use_system_frame_size_defaults): - new variable controls whether to allow the system to pick frame - size defaults, defaults to nil. - - * event-msw.c: in WM_SIZE use mswindows_size_frame_internal rather - than duplicated code. - -1998-06-15 Colin Rafferty <colin@xemacs.org> +2000-01-22 Kirill 'Big K' Katsnelson <kkm@dtmx.com> - * Makefile.in.in: Made EXTW_LINK expand properly. - -1998-06-12 Martin Buchholz <martin@xemacs.org> - - * redisplay.c (vars_of_redisplay): default value of - column-number-start-at-one should be NIL! - -1998-06-11 Martin Buchholz <martin@xemacs.org> + * frame.c (delete_frame_internal): Do not delete device when its + implementation so declares. + (delete_frame_internal): Set device selected frame to nil when + last frame goes away. - * casefiddle.c: - (upcase-initials "fooBar") ==> "FooBar" instead of "Foobar" - -1998-06-05 Hrvoje Niksic <hniksic@srce.hr> - - * eldap.c (Fldap_search_internal): Use build_ext_string instead of - build_string to avoid crashes under Mule. - -1998-06-13 Andy Piper <andyp@parallax.co.uk> + * device-msw.c (msprinter_device_system_metrics): Implemented. + (mswindows_device_system_metrics): Added 'device-dpi property. - * ntplay.c (play_sound_data_1): don't delete the sound data until - the next sound is played and the previous one finished. - -1998-06-10 Samuel Mikes <smikes@alumni.hmc.edu> - - * fileio.c (directory-sep-char): Escape backslashes. - -1998-06-10 Hrvoje Niksic <hniksic@srce.hr> - - * event-stream.c: Fix docstring reference. - -1998-06-12 Hrvoje Niksic <hniksic@srce.hr> + * device.c: (Fdevice_printer_p): Added. + Added 'offset-workspace device metric. - * alloc.c (make_float): Remove useless initialization of `next' - field. - (make_pure_float): Ditto. - - * lisp.h (struct Lisp_Float): Rename `next' to `__unused__next'. + * console.h (device_metrics): Declared DM_offset_workspace. -1998-06-08 Kirill M. Katsnelson <kkm@kis.ru> - - * fileio.c (Fmake_directory_internal): Remove conditionals - on WINDOWSNT when calling mkdir. - - * ntproc.c: Deleted the following unused functions: - register_child, reap_subprocess, sys_wait. +2000-01-23 Martin Buchholz <martin@xemacs.org> - * nt.c (sys_rename): Ifzeroed this implementation. - Deleted the following unused functions: - sys_access, sys_chdir, sys_chmod, sys_creat, sys_link, sys_mkdir, - sys_mktemp, sys_rmdir, sys_unlink, sys_close, sys_dup, sys_dup2, - sys_read, sys_write. - Merger sys_fopen and sys_open with sysdep.c implementation. + * fileio.c (Ffile_truename): Remove pointless and confusing + initialization of elen. - * sysdep.c: Removed MS-DOS code. - (sys_rename): Deal with Microsoft rename weirdness. - (sys_open): Implemented for Windows. - (sys_fopen): Ditto. - (sys_mkdir): Ditto. - -1998-06-08 Kirill M. Katsnelson <kkm@kis.ru> - - * buffer.c (complex_vars_of_buffer): Removed %t description from - the docstring. + * glyphs-widget.c: Compiler warning fixes. -1998-06-04 Rick Rankin <Rick_Rankin-P15254@email.mot.com> - - * scrollbar-msw.c: initialize the cbSize element of the - SCROLLINFO struct before calling SetScrollInfo. WinNT seems - to ignore the value of cbSize, but Win95 (and I presume Win98) - appear to want it set to sizeof(SCROLLINFO). - -1998-06-04 Kirill M. Katsnelson <kkm@kis.ru> +2000-01-23 Gunnar Evermann <ge204@eng.cam.ac.uk> - * event-stream.c: Defined Qcancel_mode_internal. - (syms_of_event_stream): defsymbol'ed it. - - * events.h: Externed it. - - * event-msw.c (mswindows_wnd_proc, WM_CANCELMODE): Added this handler. - -1998-06-04 Oliver Graf <ograf@fga.de> + * process.h (PROCESS_LIVE_P): Modify to take a Lisp_Process + instead of a Lisp_Object as argument to make it consistent with + the other LIVE_P macros. + (CHECK_LIVE_PROCESS): New macro. - * frame-x.c (x_cde_destroy_callback): free the data - (cde-start-drag-internal) corrected root position, 21.1 needs this - hardcoded in Button events - (offix-start-drag-internal) corrected root position - -1998-06-03 Kirill M. Katsnelson <kkm@kis.ru> - - * process-nt.c (signal_cannot_launch): Use signal_simple_error() - instead of error(). - -1998-06-03 Kirill M. Katsnelson <kkm@kis.ru> - - * dialog-msw.c (button_width): Removed `inline' from the function - declaration. - -1998-06-03 Rick Rankin <Rick_Rankin-P15254@email.mot.com> - - * frame-msw.c: add WS_VISIBLE flag to the first frame created. - Note that adding this flag to subsequent frames causes problems. - -1998-06-03 Gunnar Evermann <Gunnar.Evermann@nats.informatik.uni-hamburg.de> - - * glyphs-eimage.c (png_instantiate) move 'struct - png_memory_storage tbr' out of nested block to avoid dangling - reference - -1998-06-02 Andy Piper <andyp@parallax.co.uk> - - * faces.h: - * faces.c: rename 3d-object -> gui-element. add toolbar face which - inherits from gui-element. + * process.c: Declare Qprocess_live_p. + (Fprocess_live_p): New function. + (create_process): Use PROCESS_LIVE_P. + (read_process_output): Ditto. + (set_process_filter): Ditto. + (Fdelete_process): Ditto. + (kill_buffer_processes): Ditto + (process_send_signal): Use CHECK_LIVE_PROCESS. + (Fprocess_input_coding_system): Check whether process is still + alive (fix PR#1061). + (Fprocess_output_coding_system): Ditto. + (Fprocess_coding_system): Ditto. + (Fset_process_input_coding_system): Ditto. + (Fset_process_output_coding_system): Ditto. - * glyphs-msw.c: use DIBitmaps for xbm bitmaps to be consistent - with existing code, generate masks correctly. - -1998-06-03 P. E. Jareth Hein <jareth@camelot-soft.com> - - * glyphs-eimage.c: Changed included header for gifs to use - Gifreader instead of giflib. - - * glyphs-x.c: removed the image-related functions that were - moved into glyphs-eimage. - -1998-06-02 David Bush <david.bush@adnb.alcatel.com> - - * glyphs.c (bitmap_to_lisp_data) Define XFree to be free - if built without X Windows support. +2000-01-23 Andy Piper <andy@xemacs.org> -1998-06-02 Hrvoje Niksic <hniksic@srce.hr> - - * fns.c (Fconcat): Synch docstring with new reality. - -1998-06-03 SL Baur <steve@altair.xemacs.org> - - * frame.c: Remove reference to msdos.h (which is going away). - Suggested by Hrvoje Niksic and Kirill Katsnelson. - -1998-06-02 P. E. Jareth Hein <jareth@camelot-soft.com> - - * glyphs-eimage.c (jpeg_instantiate): Fix handling of - grayscale images/ - - -1998-05-30 Kirill M. Katsnelson <kkm@kis.ru> + * glyphs.h (struct Lisp_Image_Instance): change format by unifying + layout and widget. - * events.h: Fixed commentary about misc-user scrollbar events. - - * scrollbar-x.c (x_update_vertical_scrollbar_callback): Use frame - object as an event channel, instead of window object. - (x_update_horizontal_scrollbar_callback): Ditto. - -1998-05-29 Andy Piper <andyp@parallax.co.uk> - - * ntplay.c (play_sound_data_1) new function. convert alloca data - to malloc if necessary. - (play_sound_file): if the file is not in our path then convert to - data and play. - -1998-06-01 SL Baur <steve@altair.xemacs.org> - - * mule-mcpath.c (mc_chdir): Reverse parameters in call to memcpy. - * msdos.c (Frecent_doskeys): Ditto. - - * unexalpha.c (unexec): Reverse parameters in call to memcpy. - Suggested by Reggie Perry <perry@zso.dec.com> - - * buffer.h: Eliminate size in declaration. - -1998-06-01 Olivier Galibert <galibert@pobox.com> - - * unexelfsgi.c (unexec): Cleanup n/nn and remove useless kludge. - -1998-06-01 Kirill M. Katsnelson <kkm@kis.ru> - - * gui.c (gui_item_init): Changed the default value for config member - from Qunbound to Qnil. + * glyphs.c (mark_image_instance): take into account changed + image_instance format. + (image_instance_equal): ditto. + (image_instance_hash): ditto. -1998-06-01 Greg Klanderman <greg@alphatech.com> - - * indent.c (vmotion_pixels): Don't #define abs(). - -1998-05-30 Kirill M. Katsnelson <kkm@kis.ru> - - * s/windowsnt.h: Defined popen and pclose to be _popen and _pclose - respectively. - -1998-05-30 Andy Piper <andyp@parallax.co.uk> - - * glyphs.h: add xbm declarations. - - * console.h: add xbm_instantiate_method device method. - - * glyphs.c (check_valid_xbm_inline) (xbm_validate) - (bitmap_to_lisp_data) (xbm_mask_file_munging) (xbm_normalize) - (xbm_possible_dest_types): moved here from glyphs-x.c. use - locate_pixmap_file device method and read_bitmap_data_from_file - instead of XmuReadBitmapDataFromFile. - (xbm_instatntiate): make a device method. - - * glyphs-x.c: see glyphs.c changes. (read_bitmap_data_from_file) - new function that just calls XmuReadBitmapDataFromFile. - (x_xbm_instatntiate): device method from xbm_instantiate. - - * glyphs-msw.c (read_bitmap_data) (NextInt) - (read_bitmap_data_from_file): new functions copied from Xmu - sources. - (xbm_create_bitmap_from_data) from Ben <ben@666.com> convert - inline data to an mswindows bitmap. - (init_image_instance_from_xbm_inline) (xbm_instantiate_1) - (mswindows_xbm_instantiate): mswindows-ized versions of the X + * glyphs-widget.c (widget_instantiate): Incorporate layout + instantiation here. Delay layout of the layout until later. + (layout_instantiate): deleted. + (layout_query_geometry): new function. get the geometry of a + layout. + (layout_layout): layout a layout dynamically. + (image_instantiator_widget): New function - splitting up + image_instantiator_format_create_glyphs_widget for netwinder + compilation. + (image_instantiator_buttons): + (image_instantiator_edit_fields): + (image_instantiator_combo_box): + (image_instantiator_scrollbar): + (image_instantiator_progress_guage): + (image_instantiator_tree_view): + (image_instantiator_tab_control): + (image_instantiator_labels): + (image_instantiator_layout): ditto. + (image_instantiator_format_create_glyphs_widget): Call preceeding functions. -1998-05-30 Kirill M. Katsnelson <kkm@kis.ru> - - * window.c (specifier_vars_of_window): Renamed `has_modeline-p' to - `modeline-visible-p'. - Declared specifier lisp variables at the beginning oh the file - as static. - - * procimpl.h (struct process_methods): Changed semantics of - create_process method so it accepts lisp strings instead of - char pointers. +2000-01-22 Martin Buchholz <martin@xemacs.org> - * process.c (Fstart_process_internal): Moved building of - unix style argv from here to process-unix.c, ... - - * process-unix.c (unix_create_process): ... right here. + * process.c (Fset_process_coding_system): + * device-x.c (Fx_keysym_hash_table): + Docstring fixes. - * process-nt.c (nt_create_process): Changed this function to - support new semantics, so avoided a GC problem. - - * events.c (Fmake_event): Document misc-user events properties. - (Fmake_event): Do not allow arbitrary objects for channel property - of misc-user events. - (Fmake_event): Change misc-user event validation: it is function - which is required, not button. + * lstream.c (Lstream_write): Return documented value, not 0. - * event-msw.c (mswindows_user_event_p): Recognize misc user events as - user events. - (mswindows_enqueue_misc_user_event): Added function. - (mswindows_bump_queue): Removed function. - (mswindows_enqueue_magic_event): Support NULL HWND parameter. - (mswindows_wnd_proc, WM_CLOSE): Use mswindows_enqueue_misc_user_event(). - (mswindows_wnd_proc, WM_EXITSIZEMOVE): Ditto. - (emacs_mswindows_handle_magic_event): Handle XM_BUMPQUEUE, by doing - really nothing, which is my personal favorite thing. - - * console-msw.h: Removed prototype for mswindows_bump_queue(). - Added prototype for mswindows_enqueue_misc_user_event(). - - * menubar-msw.c (mswindows_handle_wm_command): Use - mswindows_enqueue_misc_user_event(). - - * toolbar-msw.c (mswindows_handle_toolbar_wm_command): Ditto. - - * dialog-msw.c (dialog_proc): Ditto. + * fileio.c (directory_file_name): + (Fsubstitute_in_file_name): + (Fsubstitute_insert_file_contents_internal): + (Fwrite_region_internal): + * emacs.c: + * sysdep.c: + * getloadavg.c: + * systty.h: + Remove vestigial APOLLO-conditional code. - * scrollbar-msw.c (mswindows_handle_scrollbar_event): Ditto. - (mswindows_handle_scrollbar_event): Use frame, not window, for misc - user events channel. - -1998-05-29 Greg Klanderman <greg@alphatech.com> - - * window.c (Fwindow_displayed_text_pixel_height): was relying on - incorrect semantics of vmotion_pixels which has been fixed. don't - use it anymore as it can't easily be used. - - * indent.c (vmotion_pixels): fix off by one bug moving up. also - the motion was reported incorrectly if you tried to go past end of - buffer. - -1998-05-30 Kirill M. Katsnelson <kkm@kis.ru> - - * toolbar.h: Removed misleading commentary, as Martin suggested. - -1998-05-30 Kirill M. Katsnelson <kkm@kis.ru> - - * lisp.h: Extern Qactivate_menubar_hook. +2000-01-21 Martin Buchholz <martin@xemacs.org> - * menubar-msw.c (unsafe_handle_wm_initmenu_1): Pass correct value to - run_hook (). - -1998-05-29 Andy Piper <andyp@parallax.co.uk> - - * glyphs-msw.c: use BPLINE macro. - - * select-msw.c (mswindows-selection-exists-p) - (mswindows-delete-selection): doc string fixes. - - * toolbar-msw.c (mswindows_output_toolbar): make disabled buttons - unpressable. warning elimination. - -1998-05-28 Martin Buchholz <martin@xemacs.org> - - * alloc.c (dbg_constants): - * dbxrc: - * gdbinit: - Remove toolbar_data debugging code, since that lrecord has - also been removed. - -Wed May 27, 1998 Darryl Okahata <darrylo@sr.hp.com> - - * alloc.c: zap cached value of (user-home-directory), so that - it's not undumped. - - * buffer.c: From init_buffer(), separated out code that - determined the initial directory for the *scratch* buffer, and - put them into a function called "init_initial_directory()". - The initial directory is now available as a global "char *" - called initial_directory. - - * buffer.h: Added extern entries for initial_directory[] and - init_initial_directory(). + * getpagesize.h: Add guard macros. + * libsst.h: Add guard macros. + * libst.h: Add guard macros. + * line-number.h: Add guard macros. + * ndir.h: Add guard macros. + * sysfloat.h: Add guard macros. + * sysfile.h: Add guard macros. + * sysproc.h: Add guard macros. + * syswait.h: Add guard macros. + * xintrinsic.h: Add guard macros. + * xintrinsicp.h: Add guard macros. + * xmmanager.h: Add guard macros. + * xmmanagerp.h: Add guard macros. + * xmprimitive.h: Add guard macros. + * xmu.h: Add guard macros. + * gpmevent.h: Add copyright statement. Add guard macros. + * miscplay.h: Add guard macros. + * *.h: Use consistent C-standards-approved guard macro names. - * editfns.c: added new elisp function "user-home-directory", - which basically returns getenv("HOME"), but attempts to use - other values if $HOME isn't set.This may have to be tweaked in - the future as, under Unix, "/" is used if $HOME isn't set (this - probably should be set to the current directory). To support - this, a new C function, "get_home_directory()", now exists, - which returns the "home directory", as a "char *" string. - - * emacs.c: Rearrange NT initialization order so that - environment/registry variables will be properly entered into - Vprocess_enviroment. - - * fileio.c: replaced egetenv("HOME") with calls to the new - get_home_directory(). + * opaque.c (make_opaque): Switch parameter order. + * opaque.h (make_opaque): Switch parameter order. + Update all callers. + * buffer.h (MAKE_MIRROR_TRT_TABLE): Use symbolic constant OPAQUE_CLEAR. - * lisp.h: Added function prototypes for uncache_home_directory() - and get_home_directory(), along with lisp prototypes for - Fuser_home_directory() and friends. - - * nt.c: replaced getenv("HOME") with calls to the new - get_home_directory(). - - * sysfile.h: for WINDOWSNT, #include <direct.h>, to suppress - warnings about getcwd(), etc. not having prototypes. - -1998-05-28 Kirill M. Katsnelson <kkm@kis.ru> - - * process-nt.c (send_signal): Emulate SIGHUP. - (validate_signal_number): Ditto. - - * event-msw.c (mswindows_wnd_proc, WM_KEYDOWN): Unconditionally - remove MOD_SHIFT from ASCII characters. - (mswindows_wnd_proc, WM_KEYDOWN): Do not activate the menubar when - F10 is pressed. - -1998-05-24 Oliver Graf <ograf@fga.de> + * config.h.in (type_checking_assert): Added. + (bufpos_checking_assert): Added. - * frame-x.c (cde-start-drag-internal): added filename and multi- - data transfers - (x_cde_convert_callback) dito - -1998-05-26 Oliver Graf <ograf@fga.de> - - * frame-x.c: include event-mod.h also with CDE - (x_cde_convert_callback) made the thing working - (cde-start-drag-internal) also debugging - -1998-05-25 Hans Guenter Weigand <hgweigand@wiesbaden.netsurf.de> +2000-01-21 Martin Buchholz <martin@xemacs.org> - * m/sparc.h: - * getloadavg.c: - * malloc.c: - * unexec.c: - * mem-limits.h: - - add __OpenBSD__ where __NetBSD__ was found. - - TODO: replace platform-specific conditional compilation by - feature tests in configure.in. + * alloc.c: Harmless pdump changes. + - Use countof(). + - spell alignment correctly. + * sysdep.c: Use countof() -1998-05-15 Greg Klanderman <greg@alphatech.com> - - * window.c (Fwindow_displayed_text_pixel_height): New function. - (syms_of_window): DEFSUBR it. - - * indent.c (Fvertical_motion_pixels): New function - request - movement in pixels. - (vmotion_pixels): helper. - (syms_of_indent): DEFSUBR. - * lisp.h: declaration for vmotion_pixels(). +2000-01-20 Kirill 'Big K' Katsnelson <kkm@dtmx.com> - * indent.c (Fvertical_motion): Add optional third argument PIXELS, - to request returning motion in pixels. - (Fvertical_motion_pixels): Remove, functionality merged into - Fvertical_motion. - * window.c (window_scroll): call Fvertical_motion with 3 arguments. - (Fmove_to_window_line): ditto. - * lisp.h: Change declaration for Fvertical_motion. - - * window.c: rename window-text-pixel-{height,width,edges} to - window-text-area-pixel-*. - -1998-05-26 Gunnar Evermann <Gunnar.Evermann@nats.informatik.uni-hamburg.de> - - * tooltalk.c (vars_of_tooltalk) added staticpro for - Tooltalk_Message_plist_str and Tooltalk_Pattern_plist_str - -1998-05-27 Andy Piper <andyp@parallax.co.uk> + * console.c (create_console): Use CONMETH_OR_GIVEN when calling + initially_selected_for_input() console method, default to 0. + (semi_canonicalize_console_connection): Try to delegate to + canonicalize_console_connection if no such console method. + (canonicalize_console_connection): Vice versa. + (print_console): Do not print nil connection. - * faces.c: create a new 3d_object_face, make modeline and - vertical_divider faces fallback to this rather than the default. - -1998-05-21 Andy Piper <andyp@parallax.co.uk> - - * s/cygwin32.h: define charsets for cygwin. - -1998-05-25 Andy Piper <andyp@parallax.co.uk> - - * toolbar-msw.c (mswindows_output_toolbar): fix up button sizes - and coordinates. resize bitmaps if we have already settled on a - different size. - - * glyphs-msw.c (xpm_to_eimage): add ';' for mswindows compiler. - -1998-05-25 Hrvoje Niksic <hniksic@srce.hr> - - * toolbar-msw.c (mswindows_handle_toolbar_wm_command): Ditto. + * console.h (XDEVIMPF_IS_A_PRINTER): Added. + (XDEVIMPF_NO_AUTO_REDISPLAY): Added. + (XDEVIMPF_FRAMELESS_OK): Added. + (CONSOLE_INHERITS_METHOD): Added. - * menubar-msw.c (mswindows_handle_wm_command): Ditto. - - * gui.h: Ditto. - - * gui-x.c (popup_selection_callback): Ditto. - - * dialog-msw.c (dialog_proc): get_callback -> get_gui_callback. - - * gui.c (get_callback): Renamed to get_gui_callback. - -1998-05-17 Martin Buchholz <martin@xemacs.org> - - * glyphs.h: order rearrangement. + * console-msw.c (mswindows_canonicalize_console_connection): + Added. + (mswindows_canonicalize_device_connection): Added. - * device-tty.c (tty_asynch_device_change): Warning suppression. - * device-x.c (x_device_system_metrics): Warning suppression. - Make Doc strings consistent with coding standards. - -1998-05-24 Martin Buchholz <martin@xemacs.org> - - * general.c: multiple definition of `Qicon'. general.c seems - like a good home for Qicon. + * console-msw.h (struct msprinter_device): Added this struct and + accessor macros. + (mswindows_device): Made fontlist a lisp object. -1998-05-20 Kirill M. Katsnelson <kkm@kis.ru> - - * This patch is to fix compilation warnings under Windows. - - * s/windowsnt.h: Encapsulate getpid with sys_getpid. - Added prototypes for FSF inherited functions, with which XEmacs is - sprinkled thoroughly. - Removed some #if 0 code. Bracketed some more definitions, probably - related to Visual C versions prior to 4 (we do not support them). - - * sysfloat.h (logb): Finally, get logb() prototyped. + * device.c (semi_canonicalize_device_connection): Try to delegate + to canonicalize_device_connection if no such console method. + (canonicalize_device_connection): Vice versa. + (print_device): Do not print nil connection. - * sysfile.h: Added Windows specific includes. - Removed old Windows specific code bracketed with #if 0. - - * sysdep.h: Added prototype for xrealpath(). - - * sysdep.c (sys_getpid): Added function, to support '95 negative pids. - - * symsinit.h: Added prototypes for syms_of_dired_mswindows, - vars_of_dired_mswindows and init_ntproc (Grrr). - - * realpath.c: Added Windows specific include files. - (xrealpath): Conditionalized declaration of some auto variables on - S_IFLNK, to avoid warnings. + * device-msw.c (mswindows_init_device): Call InitCommonControls + when have widgets. + (mswindows_delete_device): Removed fontlist deallocation. + (mswindows_mark_device): Added. - * ntproc.c: Disabled some compiler warnings. This file is going to - die, so I have not cleaned it up much. - (set_process_dir): Const parameter. - (Fwin32_short_file_name): Down CHECK_* macros to one argument. - (Fwin32_long_file_name): Ditto. - (Fwin32_set_process_priority): Ditto. Why didn't I remove these - three functions? - - * nt.h: Added prototypes for set_process_dir and convert_time. + * events.c (event_equal): Added abort() at unreached code. + (event_hash): Ditto. - * nt.c: More include files. - (getpwnam): Consted char* argument. - (get_emacs_configuration): Const return value. - (opendir): Const argument. - (stat): Casted converstion long->short. - (stat): Removed ad hoc and questionable support for non-MSC compile. - (sys_pipe): Removed unused auto variable. - (_sys_read_ahead): Removed calls to DebPrint. - (sys_read): Ditto, in 2 places. - (term_ntproc): Added unused int parameter to signal handler, to - avoid a warning when compiling a call to signal(). - (msw_sigset): Properly return old signandler or NULL instead of void. + * faces.c (complex_vars_of_faces): Added Qmsprinter to the list of + fallback tags of Windows devices. + + * general.c (syms_of_general): Initialized Qmsprinter. - * floatfns.c (Flogb): Casted arguments to unary minus to signed. - - * gmalloc.c (morecore): Ditto. - (_free_internal): Ditto. - - * lread.c (parse_integer): Ditto. - - * dired-msw.c: Added several include files. - - * cmdloop.c (Fcommand_loop_1): Added Microsoft C to the Big List - of Compilers to Shut Up. - - * callproc.c: Added #includes to suppress warnings under Windows. - (init_callproc): Removed #if0'ed code and unused variables. - -1998-05-25 Andy Piper <andyp@parallax.co.uk> + * gutter.c (complex_vars_of_gutters): Added Qmsprinter to the list + of fallback tags of Windows devices. - * device-msw.c (mswindows_device_system_metrics): do planes in a - way consistent with X. - - * glyphs-msw.c (mswindows_initialize_image_instance_mask): don't - use SetPixel, use DIBits functions. - (xpm_to_eimage): frob colors more closely like xpm deos. - - * toolbar-msw.c: only resize bitmaps when shrinking. Adjust look - to be closer to X version. - - * event-msw.c: use tooltip string directly. - - * redisplay-msw.c: reinstate Kirill's bg pixmap change. - - * objects-msw.c: frob rgb colors that only Kyle uses. - - * dialog-msw.c (button_width): INLINE -> inline. + * lisp.h: Declared Qmsprinter. -1998-05-23 SL Baur <steve@altair.xemacs.org> - - * getloadavg.c (getloadavg): Fix typo. - -1998-05-23 Kirill M. Katsnelson <kkm@kis.ru> - - * objects-msw.c (mswindows_initialize_font_instance): Added support - for font character sets. - Replaced 'XXX' with '####' in comments throughout the file. - -1998-05-23 Kirill M. Katsnelson <kkm@kis.ru> - - * emacs.c (main_1): Added calls to vars_of_dialog_mswindows() and - console_type_create_dialog_mswindows(), to initialize Windows dialog - support. + * objects-msw.c (font_enum_callback_2): Rewrote to build lisp list + of strings. + (mswindows_list_fonts): Ditto. + (mswindows_enumerate_fonts): Removed dependency on XDEVICE, so + that it can be used by both mswindows and msprinter devices. + (initialize_font_instance): Added. + (mswindows_initialize_font_instance): Use it. + (msprinter_initialize_font_instance): Added. - * symsinit.h: Prototyped the above functions. - - * dialog-x.c (x_popup_dialog_box): Moved dialog descriptor consistency - checks to dialog.c... - - * dialog.c (Fpopup_dialog_box): ...right here. Added more checks: a - device must support dialog boxes, and the descriptor must supply at - least one button. - - * dialog-msw.c: New file, dialogs for Windows. - -1998-05-21 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> - - * eldap.c (ldap_search_unwind): Return Qnil instead of nothing - (Fldap_search_internal): Removed unused variable `err' - - * eldap.h: Moved Lisp_LDAP declaration here instead of using a - forward declaration + * redisplay.c (redisplay_device): Added the parameter AUTOMATIC + and implementation flags check. + (redisplay_without_hooks): Changed the call to the above. + (Fredraw_device): Ditto. + (Fredisplay_device): Ditto. -1998-05-17 Martin Buchholz <martin@xemacs.org> - - * eldap.h: eldap.[ch] should never be used unless HAVE_LDAP is - defined. Therefore there is no need to handle the case when - HAVE_LDAP is undefined. Similarily, there is no reason to have - any code wrapped within `#ifdef emacs', since this code is only - useful within an emacs. This simplifies the code significantly. - - * inline.c: Include eldap.h only if HAVE_LDAP. - * inline.c: Don't bother including TT_C_H_PATH, since tooltalk.h - already does that. - -1998-05-21 Kirill M. Katsnelson <kkm@kis.ru> + * redisplay-msw.c (get_frame_dc): Implemented. + (get_frame_compdc): Implemented. + (many functions): Use the two functions above to get device + contexts, ether for a window or a printer. - * unexnt.c (copy_executable_and_dump_data_section): Suppress - printing dump stats when building without DEBUG_XEMACS. - (dump_bss_and_heap): Ditto. - -1998-05-21 Andy Piper <andyp@parallax.co.uk> - - * gnuclient.c: don't suppress window system if there is no display - and we are running under mswindows. send 'mswindows device type if - we are in this situation. +2000-01-21 Olivier Galibert <galibert@pobox.com> -1998-05-20 Andy Piper <andyp@parallax.co.uk> - - * general.c: - * lisp.h: Qbitmap, Qcursor, Qicon moved here from glyphs-msw.c. - - * glyphs-msw.c: change cursor imgae type name to resource. Fix - some nits. - -1998-05-20 Kirill M. Katsnelson <kkm@kis.ru> + * symbols.c (reinit_symbols_once_early): Put Qzero/Qnull_pointer + initialization here. + (init_symbols_once_early): Call it. + * emacs.c (main_1): Call it. + * symsinit.h: Declare it. - * EmacsFrame.c (Xt_StringToScrollBarPlacement): Added support for - {top,bottom}-{left,right} values in addition to - {top,bottom}_{left,right}. - -1998-05-18 Hrvoje Niksic <hniksic@srce.hr> - - * fileio.c (Fmake_temp_name): Remove unreached code. - - * process-nt.c (validate_signal_number): Use - signal_simple_error(). - -1998-05-19 Martin Buchholz <martin@xemacs.org> +2000-01-19 Olivier Galibert <galibert@pobox.com> - * unexhp9k800.c: - * sound.c (vars_of_sound): - * sysdep.c (reset_sigio_on_device): - * window.c (window_bottom_gutter_height): - unexhp9k800.c:258: warning: implicit declaration of function - `calculate_checksum' - sound.c:604: warning: implicit declaration of function `vars_of_hpplay' - sysdep.c:1012: warning: unused variable `owner' - window.c:993: warning: `window_right_toolbar_width' defined but not used - -1998-05-19 Andy Piper <andyp@parallax.co.uk> - - * glyphs-msw.c (mswindows_create_resized_mask) - (mswindows_create_resized_bitmap): new funnctions split out from - mswindows_resize_dibitmap_instance. - - * glyphs-msw.h: declare new resize functions. - - * toolbar-msw.c (mswindows_output_toolbar): use new bitmap resize - functions so that the original bitmaps are preserved. - - * sheap.c: fixup static heap exhausted error to avoid FAQs. + * alloc.c: Use a lrecord_header * in the backtrace instead of a + Lisp_Object. + (pdump_backtrace): Ditto. + (pdump_register_object): Ditto. Cleanup use of the pointers. + (pdump_get_entry): Abort if trying to register a null pointer. + (pdump_dump_data): Cleanup types when relocating. + (pdump_dump_staticvec): Cleanup types w.r.t the reloc table. + (pdump_dump_rtables): Remove bad casts. + (pdump_load): Cleanup relocation w.r.t union type. Use a + Lisp_Object instead of a EMACS_INT for the hashtable + reorganization. - * redisplay-msw.c (mswindows_output_blank): fixup brush from bg - color if we are trying to output 0 depth bg pixmap. - - * scrollbar-msw.c: warning elimination. - -1998-05-18 Martin Buchholz <martin@xemacs.org> +2000-01-20 Martin Buchholz <martin@xemacs.org> - * frame-x.c (x_update_frame_external_traits): Start preprocessor - directives in column 1. + * emacs.c (main_1): Rearrange morass of #ifdef's for correctness. - * search.c (skip_chars): Avoid using xzero with arrays, since some - compilers get confused by the construct &array. - -1998-05-18 Kirill M. Katsnelson <kkm@kis.ru> + * callproc.c (call_process_cleanup): Isolate WINDOWSNT code for clarity. - * objects-msw.h: - * objects-msw.c: Changed the charset value for a new font from - "don't care" to "ansi". - - * glyphs-msw.c (convert_EImage_to_DIBitmap): Warnings fix. - -1998-05-18 Kirill M. Katsnelson <kkm@kis.ru> + * EmacsManager.c (GeometryManager): Avoid use of CPP for clarity. - * event-msw.c (mswindows_wnd_proc, WM_KEYDOWN): Do not clear shift - modifier on control chars. - Use IsCharAlpha() instead of isaplha(). + * *.[ch]: global-replace 's/_of_xselect/_of_select_x/g' *.[ch] -1998-05-19 Kazuyuki IENAGA <ienaga@jsys.co.jp> - - * s/freebsd.h: FreeBSD 2.2.6 now supports setlocale(LC_ALL, ""). - -1998-05-18 Kirill M. Katsnelson <kkm@kis.ru> +2000-01-17 Kirill 'Big K' Katsnelson <kkm@dtmx.com> - * objects-msw.c (mswindows_initialize_font_instance): Use ANSI - charset when creating font. - (mswindows_initialize_color_instance): Do not create brush along - with a color. - (mswindows_finalize_color_instance): Do not delete it then. + * faces.h (FACE_STRIKETHRU_P): Added. - * objects-msw.h (struct mswindows_color_instance_data): Removed - brush slot, and corresponding accessor macro. - -1998-05-18 Kirill M. Katsnelson <kkm@kis.ru> + * glyphs-msw.c (mswindows_widget_hfont): Implemented, to take care + of font variants. - * toolbar.c: Removed toolbar_data lrecord implementation. - (mark_frame_toolbar_buttons_dirty): Replase usage of toolbar_data - with toolbar_buttons (via FRAME_TOOLBAR_BUTTONS). - (compute_frame_toolbar_buttons): Ditto. - (CHECK_TOOLBAR): Ditto. - (set_frame_toolbar): Removed allocation of toolbar_data lrecord. - (update_frame_toolbars): Do not check for changed buffer - here. Toolbar information is provided by cached specs in - windows. The check for buffer is eliminated becuase toolbars are - marked changed in set_frame_selected_window() in frame.c - Added check for changed toolbars geometry. - (compute_frame_toolbars_data): Removed unused second parameter; - Adjusted callers of this static function throughout the file. - (init_frame_toolbars): Initialize current_toolbar_size. - (update_frame_toolbars): Use DEVICE_SUPPORTS_TOOLBARS_P instead of - what is its current expansion, for clarity. - (init_frame_toolbars): Ditto. - (init_device_toolbars): Ditto. - (init_global_toolbars): Ditto. + * redisplay-msw.c (mswindows_apply_face_effects): Deleted. + (mswindows_set_dc_font): New function, aware of font variants, + separated from mswindows_update_dc. - * toolbar.h: Removed definition of toolbar_data lrecord. - Added accessor macros FRAME_TOOLBAR_BUTTONS and - FRAME_CURRENT_TOOLBAR_SIZE. - Added macro DEVICE_SUPPORTS_TOOLBARS_P. + * objects-msw.h (struct mswindows_font_instance_data): Added + definition. - * toolbar-x.c (x_output_toolbar): The same change as in - toolbar-msw.c - (x_output_toolbar): Ditto. - (x_redraw_exposed_toolbar): Ditto. - - * toolbar-msw.c (mswindows_output_toolbar): Retrieve current - buttons from toolbar_buttons using FRAME_TOOLBAR_BUTTONS macro. - (mswindows_output_toolbar): Ditto. - (mswindows_output_toolbar): Ditto. - - * frame.c (mark_frame): Removed marking of arrays, according to - frameslots.h change. - (nuke_all_frame_slots): Ditto. - (set_frame_selected_window): Mark toolbars changed when - last_nonminibuf_window changes. + * objects-msw.c (mswindows_finalize_font_instance): Delete all + cached fonts and the data structure. + (mswindows_initialize_font_instance): Added creation of font data + structure. + (mswindows_print_font_instance): Print at least something. + (mswindows_create_font_variant): Implemented. + (mswindows_get_hfont): Implemented. - * frame.h (struct frame): Moved some slots to frameslots.h. - Added current_toolbar_size array. - Changed references from toolbar_data to toolbar_buttons in macros - FRAME_RAW_THEORETICAL_TOOLBAR_VISIBLE, - FRAME_RAW_THEORETICAL_TOOLBAR_SIZE and - FRAME_RAW_THEORETICAL_TOOLBAR_BORDER_WIDTH. +2000-01-13 Fabrice Popineau <Fabrice.Popineau@supelec.fr> - * frameslots.h: Added macro MARKED_SLOT_ARRAY a la winslots.h - Moved arrays of lisp objects here from frame.h: toolbar_size, - toolbar_visible_p, toolbar_border_width. - Removed toolbar_data slot and added toolbar_buttons. - -1998-05-17 Kirill M. Katsnelson <kkm@kis.ru> - - * symsinit.h: Externed syms_of_process_nt() - - * emacs.c (main_1): Call syms_of_process_nt() + * dired-msw.c: permute "sysdir.h" with "sysfile.h" because of + prototyping problem with msvc. - * process-nt.c: Quote process arguments by a call to Lisp function - `nt-quote-process-args'. - (syms_of_process_nt): New function. - (nt_send_process): Flush data stream after each write, to avoid - leaving buffered data. - (nt_send_process): When blocked on process output, wait for - process to slurp more for progressively increasing time intervals. - -1998-05-17 Martin Buchholz <martin@xemacs.org> + * emacs.c (main_1): added syms_of_gui_mswindows() call - * window.c (have_undivided_common_edge): Make file-local function - static. - (map_windows): Return 0 if all map functions successful. - Fix typos. - - * winslots.h: Use unlikely names for local variables in macros to - avoid shadowing warnings. - -1998-05-17 Andy Piper <andyp@parallax.co.uk> + * gui-msw.c: added "mswindows-shell-execute" lisp subr and + syms_of_gui_mswindows() function - * toolbar-msw.c (mswindows_output_toolbar): hash on toolbar width - so that we re-output if the toolbar size has changed. + * symsinit.h: added the prototype for syms_of_gui_mswindows() -1998-05-17 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de> - - * s/aix4-2.h (ALIGN_DATA_RELOC): Undefined to support new unexaix.c. - - * s/aix3-1.h (ALIGN_DATA_RELOC): Defined to support new unexaix.c. +2000-01-18 Martin Buchholz <martin@xemacs.org> - * unexaix.c: Massive cleanup and support of AIX 4.2 (and hopefully - greater). - -1998-05-16 Kirill M. Katsnelson <kkm@kis.ru> + * XEmacs 21.2.27 is released. - * glyphs-msw.c: Defined OEMRESOURCE before including windows.h to - get bitmap manifest constants defined. - - * console-msw.h: Include system files in angle brackets, not in - quotes. +2000-01-18 Martin Buchholz <martin@xemacs.org> - * window.c (specifier_vars_of_window): Fixed a typo in - `vertical-divider-line-width' docstirng. - -1998-05-16 Olivier Galibert <galibert@pobox.com> - - * line-number.c (delete_invalidate_line_number_cache): Use an - EMACS_INT. - (buffer_line_number): Remove dangerous, plain wrong when using - 64bits emacs ints, cast. - - * insdel.c (buffer_delete_range): Use an EMACS_INT. - - * cmds.c (Fforward_line): Use EMACS_INTs. - - * search.c (bi_scan_buffer): Change to use EMACS_INTs. - (scan_buffer): Ditto. - (bi_find_next_newline_no_quit): Remove useless cast. - (find_next_newline_no_quit): Ditto. - (find_next_newline): Ditto. - (find_before_next_newline): Use an EMACS_INT. - - * lisp.h: Change scan_buffer to pass EMACS_INTs. - -1998-05-16 Hrvoje Niksic <hniksic@srce.hr> - - * menubar-msw.c (mswindows_handle_wm_command): Ditto. - - * toolbar-msw.c (mswindows_handle_toolbar_wm_command): Ditto. - - * gui-x.c (popup_selection_callback): Use it. + * glyphs-eimage.c (struct tiff_error_struct): + (tiff_error_func): + (tiff_warning_func): + #if HAVE_VSNPRINTF ==> #ifdef HAVE_VSNPRINTF - * gui.h (get_callback): Declare it. - - * gui.c (get_callback): New function. - -1998-05-15 SL Baur <steve@altair.xemacs.org> - - * window.c (have_undivided_common_edge): Guard scrollbar specific - stuff. - (window_needs_vertical_divider_1): Ditto. - -1998-05-16 Hrvoje Niksic <hniksic@srce.hr> - - * emacs.c (decode_path): Eliminate compiler warning. - (Fdecode_path): Renamed to Fsplit_path. - (Fsplit_string_by_char): New function. + * unexmips.c: + * unexhp9k3.c: + * unexfreebsd.c: + * unexec.c: Remove vestigial Lucid C code. + * unexalpha.c: + * unexaix.c: + * termcap.c: + * libsst.c: Ansify. + Remove declarations of errno and strerror(). -1998-05-14 Damon Lipparelli <lipp@primus.com> - - * winslots.h: close comment + * eval.c (Fbacktrace): Small Purify-cation. Fix docstring. -1998-05-16 Kirill M. Katsnelson <kkm@kis.ru> - - * callproc.c: Removed declared and unused variable Qbuffer_file_type. + * .dbxrc (run-temacs): Use the horrible ${1+"$@"} instead of "$@". - * bufslots.h: Removed buffer_file_type slot. +2000-01-16 Martin Buchholz <martin@xemacs.org> - * buffer.c (complex_vars_of_buffer): Removed buffer_file_type from - buffer local flags. - (complex_vars_of_buffer): Removed buffer-file-type variable and - its default reference. - -1998-05-15 Kirill M. Katsnelson <kkm@kis.ru> + * mule-charset.c (Fchar_octet): Resurrect from earlier in 1999. + Optimize. - * faces.c (complex_vars_of_faces): Defined - Vvertical_divider_face. - (vars_of_faces): Staticpro it. - - * faces.h: Externed Vvertical_divider_face. - - * redisplay-x.c (x_output_vertical_divider): Use - Vvertical_divider_face to draw the divider instead of modeline - face. - - * redisplay-msw.c (mswindows_output_vertical_divider): Draw - divider face using Vvertical_divider_face background. - Fix drawing spacing gaps around the divider. - -1998-05-14 Didier Verna <verna@inf.enst.fr> +2000-01-14 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp> - * redisplay-x.c (x_output_vertical_divider): removed hard-wired - values for the vertical divider line width and spacing. Use the - cached values from the window structure instead. - (x_divider_width): ditto. + * md5.c: + * file-coding.c: + * file-coding.h: + Change enum eol_type to eol_type_t. - * window.c (specifier_vars_of_window): new specifiers: - vertical-divier -line-width and -spacing. - (vertical_divider_global_width_changed): formerly known as - vertical_divider_shadow_thickness_changed. +2000-01-17 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp> - * winslots.h: new slots: vertical_specifier _line_width and - _spacing. Plus corrected a comment typo. - -1998-05-15 Kirill M. Katsnelson <kkm@kis.ru> - - * window.h: Declared window_divider_width(). + * gui.c (get_gui_callback): Check cons before accessing car. - * console-stream.c (stream_divider_width): Removed method. - (console_type_create_stream): And declaration for it. - - * redisplay.c (pixel_to_glyph_translation): Use - window_divider_width() instead of divider_width redisplay method. - (pixel_to_glyph_translation): Fix top divider edge calculation - when scrollbar is on top. +2000-01-17 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp> - * window.c (window_divider_width): New function, an outphaser for - divider_width redisplay method. - (window_right_gutter_width): Use it. - (specifier_vars_of_window): For vertical-divider-{spacing,line-width} - specifiers, set fallback values differently on TTYs, and document - the behavior of these on TTYs in the docstrings. + * specifier.h (XSPECIFIER_TYPE): Add error checking version. + (XSETSPECIFIER_TYPE): Ditto. - * scrollbar.c (update_scrollbar_instance): Use - window_divider_width() instead of divider_width redisplay method. +2000-01-17 Didier Verna <didier@xemacs.org> - * console.h (struct console_methods): Removed divider_width_method. - - * redisplay-tty.c (tty_divider_width): Removed device method. - (console_type_create_redisplay_tty): Removed definition for it. - (tty_output_vertical_divider): Respect the value returned by - window_divider_width thus divider line width specification. + * redisplay.c (generate_fstring_runes): compute string size in + characters, not bytes. - * redisplay-msw.c (mswindows_divider_width): Removed device method. - (console_type_create_redisplay_mswindows): Removed definition for it. - (mswinodws_output_vertical_divider): Respect the value returned by - window_divider_width thus divider line width specification. +2000-01-09 Hrvoje Niksic <hniksic@iskon.hr> -1998-05-15 Andy Piper <andyp@parallax.co.uk> - - * toolbar-msw.c: guess toolbar frame size a bit more accurately. - -1998-05-15 Andy Piper <andyp@parallax.co.uk> + * window.c (Fwindow_minibuffer_p): Make WINDOW optional. - * glyphs-msw.c: resource loading implementation. - (cursor_normalize): new function. - (cursor_validate): ditto. - (cursor_instantiate): ditto. - (cursor_name_to_resource): ditto. - (cursor_possible_dest_types): ditto. - (check_valid_symbol): ditto. - (check_valid_string_or_int): ditto. +2000-01-14 Hrvoje Niksic <hniksic@iskon.hr> -1998-05-14 Martin Buchholz <martin@xemacs.org> - - * sysdep.c (tty_init_sys_modes_on_device): Treat VSUSP just like - VINTR and VQUIT. + * print.c (print_error_message): Call print_prepare(). - * process-unix.c (process_signal_char): Use VSUSP instead of - non-standard VSWTCH. Always prefer VSUSP to VSWTCH. - -1998-05-14 Kirill M. Katsnelson <kkm@kis.ru> +2000-01-14 Martin Buchholz <martin@xemacs.org> - * specifier.c (specifier_instance): Change locale precedence of - instantiation so window locale has higher priority than buffer - locale. - (Fspecifier_instance): Reflect this in docstring. - (Fadd_spec_list_to_specifier): Ditto. - (Fadd_spec_to_specifier): Ditto. - (Fremove_specifier): Ditto. + * .dbxrc: Renamed from dbxrc. -1998-05-15 Kirill M. Katsnelson <kkm@kis.ru> - - ** Dialog separation into a device method from Andy Piper - - * emacs.c (main_1): Call console_type_create_dialog_x(). + * events.c (event_to_character): + Use `assert (foo)' instead of `if (!foo) abort()' - * dialog-x.c (x_popup_dialog_box): Old Fpopup_dialog_box converted - into this device method. - (console_type_create_dialog_x): New function. - - * dialog.c (Fpopup_dialog_box): New function. - (syms_of_dialog): Defsubr it. - - * console.h (struct console_methods): Declared - popup_dialog_box_method(). - - * symsinit.h: Defined console_type_create_dialog_{x,mswindows} - -1998-05-14 Oliver Graf <ograf@fga.de> - - * dragdrop.c (vars_of_dragdrop): dragdrop-protocols created - * frame-x.c (x_cde_transfer_callback): checked for merge errors + * .gdbinit (xtype): Add documentation. + * .gdbinit (check-temacs): New function. + * .gdbinit (check-xemacs): New function. + * dbxrc (check-xemacs): New function. + * dbxrc (check-xemacs): New function. -1998-05-13 Oliver Graf <ograf@fga.de> - - * dragdrop.c (vars_of_dragdrop): provide dragdrop-api - -1998-05-15 Kirill M. Katsnelson <kkm@kis.ru> - - * console.h (device_metrics): Removed dbcs, input-method-editor - and right-to-left metrics. +2000-01-14 Andy Piper <andy@xemacs.org> - * device.c (Fdevice_system_metric): Ditto. - (Fdevice_system_metrics): Ditto. - (syms_of_device): Ditto. - (Fdevice_system_metric): Swapped DEVICE and METRIC parameters back - again. + * glyphs-widget.c (widget_query_geometry): Make sure that we + calculate default dimensions correctly. -1998-05-14 Hrvoje Niksic <hniksic@srce.hr> - - * line-number.h (mark_line_number_cache): Remove unused - declaration. +2000-01-13 Kirill 'Big K' Katsnelson <kkm@dtmx.com> - * line-number.c (LINE_NUMBER_FAR): Increase to 32768. - (get_nearest_line_number): Simplify. - (add_position_to_cache): Make the old marker point nowhere. - -1998-05-14 Kirill M. Katsnelson <kkm@kis.ru> + * symsinit.h: Added prototype for reinit_vars_of_frame_mswindows. - ** Renamed window-divider-map => vertical-divider-map - and event-over-divider-p => event-over-vertical-divider-p, - in the following files/functions: - * events.h: - * events.c (Fevent_over_divider_p): - * keymap.c (get_relevant_keymaps): - (vars_of_keymap): - - * redisplay.h (OVER_V_DIVIDER): Renamed so from OVER_DIVIDER. - - * redisplay.c (pixel_to_glyph_translation): Use OVER_V_DIVIDER. + * event-msw.c (vars_of_event_mswindows): Fixed a mistyped + pdump_wire'd variable. -1998-05-14 Kirill M. Katsnelson <kkm@kis.ru> + * emacs.c: (main_1): Conditionalized calls to + reinit_vars_of_scrollbar_x and reinit_vars_of_module. - * window.c (vertical_divider_changed_in_window): Renamed so. - (specifier_vars_of_window): Defined Vvertical_divider_draggable_p. - (window_needs_vertical_divider_1): Decide whether we need it based - on the value of the above specifier. If separators are unwanted, - put them only if there's no scrollbar between this window and its - right neighbor. - (have_undivided_common_edge): New function, helper for the above. - (window_needs_vertical_divider): Return either a cached value, - or clauclate and cache one. - (invalidate_vertical_divider_cache_in_window): Implemented. - (map_windows): Changed return type to int, return the value from - MAPFUN. - - * window.h: Prototype invalidate_vertical_divider_cache_in_window. - (struct window): Added need_vertical_divider_p and - need_vertical_divider_valid_p. +2000-01-13 Martin Buchholz <martin@xemacs.org> - * winslots.h: Added vertical_divider_draggable_p slot. - - * scrollbar.c (vertical_scrollbar_changed_in_window): Implemented. - (specifier_vars_of_scrollbar): Used it in all vertical specifiers. - - * frame.c (invalidate_vertical_divider_cache_in_frame): New function. - - * frame.h (MARK_FRAME_WINDOWS_STRUCTURE_CHANGED): Call - invalidate_vertical_divider_cache_in_frame(). - Prototype it. - -1998-05-14 Andy Piper <andyp@parallax.co.uk> - - * toolbar-msw.c: provide correct parameters to TB_SETROWS. - - * glyphs-msw.c (mswindows_initialize_image_instance_mask): size - masks correctly and don't select 0. + * window.c (Fset_window_configuration): + * sysdep.c (_start): + * input-method-motif.c (res): + * event-Xt.c (Xt_process_to_emacs_event): + Simple compiler warning fixes. -1998-05-14 Kirill M. Katsnelson <kkm@kis.ru> - - * winslots.h: New file, declaration of some struct window and - struct saved_window members. - - * window.h (struct window): Include it, with required preprocessor - magic. + * bytecode.c (funcall_compiled_function): Use the original + function symbol on the backtrace list in preference to the + compiled_function object in error messages. - * window.c (mark_window): Ditto. - (allocate_window): Ditto. - (struct saved_window): Ditto. - (mark_window_config): Ditto. - (saved_window_equal): Ditto. - (Fset_window_configuration): Ditto. +2000-01-13 Andy Piper <andy@xemacs.org> -1998-05-14 Kirill M. Katsnelson <kkm@kis.ru> - - * redisplay-msw.c (mswindows_output_vertical_divider): Syntax fix. - -1998-05-12 Didier Verna <verna@inf.enst.fr> + * glyphs-x.c (update_widget_face): Make sure we update the widget + background as well as foreground. - * redisplay-x.c (x_output_vertical_divider): draw shadows around - the divider line. The shadow thickness is currently - hard-wired. This will probably be turned into a specifier soon. - -1998-05-12 Didier Verna <verna@inf.enst.fr> - - * console.h (struct console_methods): the divider_width console - method now requires a struct window * argument. - - * redisplay-x.c (x_divider_width): ditto. Plus remove - X_DIVIDER_WIDTH, X_DIVIDER_SHADOW_THICKNESS. - (x_output_vertical_divider): give a depressed look when the shadow - thickness is negative. +2000-01-13 Andy Piper <andy@xemacs.org> - * console-stream.c (stream_divider_width): pass a struct window * - argument. - - * redisplay-tty.c (tty_divider_width): ditto. - - * window.c (window_right_gutter_width): totdi. - - * redisplay.c (generate_modeline): ittod. - - * scrollbar.c (update_scrollbar_instance): ttido. - - * redisplay-msw.c (mswindows_divider_width): ottid. - WARNING: this enables to compile, but the feature is not functional. - - * window.h (struct window): new field - vertical_divider_shadow_thickness. + * glyphs.h (struct Lisp_Image_Instance): Move justify and orient + fields to subwindow. + (IMAGE_INSTANCE_SUBWINDOW_JUSTIFY): new macro. + (XIMAGE_INSTANCE_SUBWINDOW_JUSTIFY): ditto. + (IMAGE_INSTANCE_SUBWINDOW_ORIENT): ditto. + (XIMAGE_INSTANCE_SUBWINDOW_ORIENT): ditto. - * window.c (specifier_vars_of_window): new specifier - vertical-divider-shadow-thickness. - (vertical_divider_shadow_thickness_changed): new function to - inform redisplay that the window has changed. - (mark_window): handle new field vertical_divider_shadow_thickness - from struct window. - (allocate_window): ditto. - (saved_window_equal): toddi. - (Fset_window_configuration): totid. - (save_window_save): ttdio. - (struct saved_window): new field vertical_divider_shadow_thickness. - -1998-05-14 Kirill M. Katsnelson <kkm@kis.ru> - - * device-msw.c (mswindows_device_system_metrics): Support a deluge - of metrics. + * glyphs-widget.c (check_valid_tab_orientation): new function. + (initialize_widget_image_instance): zero orientation and + justification. + (widget_instantiate): pick up orientation. + (tab_control_query_geometry): return appropriate values for + vertical tabs. -1998-05-12 Oliver Graf <ograf@fga.de> - - * frame-x.c (x_cde_transfer_callback): fixed for the new protocol - * event-Xt.c (x_event_to_emacs_event): C++ compability - -1998-05-14 Hrvoje Niksic <hniksic@srce.hr> + * glyphs-msw.c: (mswindows_tab_control_instantiate): assign + appropriate creation flags for left, right and bottom tabs. - * emacs.c (Fdecode_path): Default SEPCHAR to value of - path-separator. - -1998-05-14 Hrvoje Niksic <hniksic@srce.hr> + * s/cygwin32.h: add tab definitions. - * emacs.c (vars_of_emacs): Do it here; change the meaning of - Vpath_separator. - - * fileio.c (vars_of_fileio): Don't define Vpath_separator here. - -1998-05-14 Hrvoje Niksic <hniksic@srce.hr> +2000-01-12 Kirill 'Big K' Katsnelson <kkm@dtmx.com> - * emacs.c (decode_path_1): New function. - (decode_path): Use it. - (Fdecode_path): Renamed from Fdecode_path_internal; use - decode_path_1. - -1998-05-12 Hrvoje Niksic <hniksic@srce.hr> - - * macros.c (Fzap_last_kbd_macro_event): New function. - (Fend_kbd_macro): Remove REMOVE_LAST kludge. - -1998-05-10 Andy Piper <andyp@parallax.co.uk> - - * redisplay-msw.c (mswindows_output_dibitmap_region): make sure - multiple bitmaps are output vertically as well as horizontally. - * (mswindows_output_dibitmap): don't cope with bitmap boundaries - crossing lines this is handled by - mswindows_output_dibitmap_region. - -1998-05-12 Martin Buchholz <martin@xemacs.org> - - * inline.c: Include eldap.h - - * menubar-x.c (x_update_frame_menubar_internal): - Remove: unused variable `container' - -1998-05-11 Martin Buchholz <martin@xemacs.org> - - * s/aix4.h: Allow AIX 4.3 XEmacs to compile cleanly. - Unfortunately, the resulting temacs still cannot dump. - - * symbols.c (symbol_is_constant): - (verify_ok_for_buffer_local): - -Wswitch Warning suppression - add default case to switches. - - * redisplay.c (decode_mode_spec): Remove unused variables, - Replace Fcoding_system_property (codesys, Qmnemonic) with - XCODING_SYSTEM_MNEMONIC (codesys); - Fcoding_system_property is for users. - - * buffer.c: - * fileio.c: - * lread.c: - * xselect.c: - Change empty docstrings into no doc strings at all. - Fix bogus FSF-format docstrings. - - * extents.c: - Standardize docstrings. - - * floatfns.c: - Explain problems with matherr. - - * glyphs.c: make DEFUNs etags-readable, i.e. single-line - - * syssignal.h: - if BROKEN_SIGIO, then SIGIO wants to be undefined. - if SIGIO and not SIGPOLL, SIGPOLL wants to be SIGIO.\ - Fix the weird resultant interaction (causes windows problems) - - * gdbinit: - * dbxrc: - Take new EMACSBOOTSTRAPLOADPATH into account. - Update documentation strings - - * Makefile.in.in: - - Adjust for luser's CDPATH being set to something weird. - - Take into account bash 2.02's tendency to print the cwd when - using CDPATH. Always use `cd ./foo' instead of `cd foo'. - - fix the run-temacs target to use $(DUMPENV) - - fix the run-puremacs target to use $(DUMPENV) - - fix the `depend' target to properly $(RM) the right files - - Generate a better TAGS file for XEmacs' lisp code using - hand-crafted regexps. - - Use standard coding conventions for modules/Makefile.in + * glyphs-msw.c (mswindows_unmap_subwindow): Set focus back to the + frame upon hiding a subwindow. + (mswindows_button_instantiate): Changed the push button style to + BS_PUSHBUTTON. + (mswindows_button_instantiate): Removed button BS_NOTIFY + style. + (mswindows_button_instantiate): Removed redundant check for + a disabled gui item. + (mswindows_button_instantiate): Made use of WS_TABSTOP + consistent: "operable" controls (edit, button, tree, scroll) have + this style, "display-only" ones (static, progress gauge) do + not. This style is currently ignored by XEmacs though. Also, + removed the WS_EX_CONTROLPARENT style - it is not for children, + it is for their parents! + (mswindows_edit_field_instantiate): Ditto. + (mswindows_progress_gauge_instantiate): Ditto. + (mswindows_tree_view_instantiate): Ditto. + (mswindows_tab_control_instantiate): Ditto. + (mswindows_scrollbar_instantiate): Ditto. + (mswindows_combo_box_instantiate): Ditto. + (mswindows_widget_instantiate): Added the WS_EX_CONTROLPARENT + style to the "clip" window. + (mswindows_button_instantiate): Removed compilation warning by + equally typing terms of the ?: operator. -1998-05-12 Didier Verna <verna@inf.enst.fr> - - * redisplay.c: removed the scrolling modeline code that didn't - make it for 21.0. To be continued ... - -1998-05-13 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de> - - * emacs.c (Fdecode_path_internal): Removed bogus handling of nil - and empty string inputs. - -1998-05-12 Hrvoje Niksic <hniksic@srce.hr> - - * redisplay-x.c (x_output_vertical_divider): Fixed typo. - -1998-05-10 Oliver Graf <ograf@fga.de> +2000-01-12 Didier Verna <didier@xemacs.org> - * event-stream.c (enqueue_misc_user_event_pos): created - * lisp.h (enqueue_misc_user_event_pos): prototype added - * frame-x.c (x_cde_transfer_callback): debug code plus API changes - * emacs.c: call vars_of_dragdrop - * dragdrop.c (vars_of_dragdrop): provide dragdrop - -1998-05-11 Oliver Graf <ograf@fga.de> + * redisplay.c (generate_fstring_runes): new parameter holding the + last modeline-format extent. + (add_glyph_to_fstring_db_runes): new parameter holding the glyph + extent, fill the glyph block with it. + (generate_fstring_runes): handle these parameters. + (generate_formatted_string_db): ditto. - * frame-x.c (x_cde_transfer_callback): return at correct pos - * event-Xt.c (x_event_to_emacs_event): changed format of drop - object for MIME (see comment in dragdrop.c) - * dragdrop.c: API change documented in comment - removed provide of dragdrop [is provided by dragdrop.el] - -1998-05-12 Kirill M. Katsnelson <kkm@kis.ru> + * keymap.c (get_relevant_keymaps): retreive the keymaps from the + glyphs'extents in the modeline. - * window.c (window_needs_vertical_divider): Enable vertical - dividers for every non-rightmost window. - (window_left_gutter_width): Left gutter consists of mythical - toolbar and a virtual scrollbar. - (window_right_gutter_width): The right one may have a divider - also. +1999-01-11 Mike Woolley <mike@bulsara.com> - * scrollbar.c (update_scrollbar_instance): Position vertical - scrollbar left to divider if the latter present. - - * redisplay.h: Declared OVER_DIVIER constant. - - * redisplay.c (pixel_to_glyph_translation): Handle OVER_DIVIDER - case. - - * redisplay-x.c (x_output_vertical_divider): Output divider along - the right side of the window, down to window bottom. Swapped - foreground and background colors so it is visible by default. + * ntheap.c: Reduced the reserved heap space from 1Gb down to + 256Mb, as a workaround for the non-starting problem many people + have experienced. - * redisplay-tty.c (tty_output_vertical_divider): Uncondiionally - stick the divider to the right window side. - - * redisplay-msw.c (mswindows_redisplay_deadbox_maybe): Fixed - deadbox painting. - (mswindows_divider_width): Ask system for user preferred value. - (mswindows_output_vertical_divider): Always output the divider on - the right side of a window, down to bottom. +2000-01-06 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp> - * keymap.c (get_relevant_keymaps): Route mouse button events which - happened over a window divider through window-divider-map. - (Fkey_binding): Documented that in the docstring. - Defined the variable Vwindow_divider_map. + * console-tty.c (Fset_console_tty_output_coding_system): + Force redrawing tty frame. - * events.c (Fevent_over_divider_p): Added this function. - - * events.h: EXFUNed it. - -1998-05-12 Kirill M. Katsnelson <kkm@kis.ru> +2000-01-10 Didier Verna <didier@xemacs.org> - * toolbar.c (update_frame_toolbars): Re-layout frame windows if - toolbar geometry is suspected to change. - -1998-05-11 Jonathan Harris <jhar@tardis.ed.ac.uk> + * redisplay.c (generate_fstring_runes): fix size computation bug. - * src/device-msw.c - * src/event-msw.c - Condition dnd and dde code on HAVE_DRAGNDROP. +2000-01-09 William M. Perry <wmperry@aventail.com> -1998-05-11 Hrvoje Niksic <hniksic@srce.hr> - - * events.c (format_event_object): Print space as SPC etc. - -1998-05-11 Hrvoje Niksic <hniksic@srce.hr> + * gpmevent.c: (gpm_next_event_cb): Don't return value from void function. - * print.c (print_internal): In the default case, abort() if - ERROR_CHECK_TYPECHECK. - - * fileio.c (Fmake_temp_name): Doc fix. - -1998-05-10 Hrvoje Niksic <hniksic@srce.hr> - - * xgccache.c (describe_gc_cache): Define only if DEBUG_XEMACS. +2000-01-09 Andy Piper <andy@xemacs.org> - * undo.c (Fprimitive_undo): Fixed typo. - -1998-05-11 Hrvoje Niksic <hniksic@srce.hr> - - * fns.c (concat): Signal error on integer argument. - -1998-05-10 Kirill M. Katsnelson <kkm@kis.ru> - - * console.h (device_metrics): Prefixed each constatnt with DM_ + * glyphs-msw.c: index -> i to avoid shadows. + (xbm_create_bitmap_from_data): make static. + (check_valid_string_or_int): deleted. + (mswindows_control_wnd_proc): message -> msg to avoid shadows. - * device.c: (Fdevice_system_metric): Renamed so from plural form - (metrics); Changed parameters order and added DEFAULT parameter; - Unabbreviated some metric constants; Fixed and untabified doc string. - (Fdevice_system_metrics): Added. Returns a plist of all provided - metrics. - - * device-msw.c (mswindows_device_system_metrics): Renamed - device_metrics enum constants. - Return Qunbound instead of Qnil. - - * device-tty.c (tty_device_system_metrics): Ditto. - - * device-x.c (x_device_system_metrics): Ditto. - -1998-05-10 Andy Piper <andyp@parallax.co.uk> + * glyphs-x.c (x_update_subwindow): remove unused args. - * redisplay-msw.c: implement background pixmaps (really!). Make - sure bg color is transparent if we have bg pmaps. - * (mswindows_output_string) (mswindows_clear_region): output bg - pmap if required. - * (mswindows_output_dibitmap_region): new function. - * (mswindows_output_dibitmap): output offset pixmaps, blt masks in - the bg color rather than transparently. - - * toolbar-msw.c: use masks if they exist. + * glyphs.c (glyph_image_instance): return the thing. Don't set the + back pointer - this is done in allocate_image_instance. + (query_string_font): return Qnil to make the compiler happy. + (unmap_subwindow): set to ~0 to make the compiler happy. + (glyph_query_geometry): comment out until used. + (glyph_layout): ditto. - * glyphs-msw.c: set up masks correctly. - - * event-msw.c: typedef SOCKET if cygwin and not msg select(). - -1998-05-10 Hrvoje Niksic <hniksic@srce.hr> +2000-01-09 Hrvoje Niksic <hniksic@iskon.hr> - * regex.c (re_match_2_internal): Check for quit. - -1998-05-10 Hrvoje Niksic <hniksic@srce.hr> - - * frame.c (Ffocus_frame): New function. - + * insdel.c (signal_after_change): Remove extraneous unbind_to(). diff -r f4aeb21a5bad -r 74fd4e045ea6 src/ChangeLog.2 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/ChangeLog.2 Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,8737 @@ +2000-01-09 Norbert Koch <norbert@s.netic.de> + + * sysfile.h: Remove definition of HAVE_FSYNC. It's tested for + in configure. + +2000-01-09 Martin Buchholz <martin@xemacs.org> + + * lisp.h (xfree_1): Make non-public. + * (xzero): Use '\0' in memset call for clarity. + * (ALIGNOF): Use __alignof__ instead of undocumented __alignof. + * alloc.c (allocate_string_chars_struct): + (make_uninit_string): + (resize_string): + (verify_string_chars_integrity): + (compact_string_chars): Now only called for small strings. + (sweep_strings): + String allocation rewrite. + Properly handle resizing big strings. + Fixes crash when evaluating: + (aset (make-string 9003 ??) 1 (make-char 'latin-iso8859-1 57)) + Use consistent coding convention. + Never use xfree_1() directly. + General cleanup. + (CHARS_TO_STRING_CHAR): Remove. No longer needed. + Big strings had unused space at beginning. + + * scrollbar.c (specifier_vars_of_scrollbar): + * scrollbar.c (complex_vars_of_scrollbar): + * gutter.c (specifier_vars_of_gutter): + * menubar.c (specifier_vars_of_menubar): + * toolbar.c (specifier_vars_of_toolbar): + * glyphs.c (specifier_vars_of_glyphs): + * redisplay.c (specifier_vars_of_redisplay): + * window.c (specifier_vars_of_window): + * lisp.h (slot_offset): Remove slot_offset. + Replace all calls to `slot_offset' with the standard name, `offsetof'. + + * menubar-x.c (compute_menubar_data): + Remove Fset_buffer(), always called by unwind_protect. + * menubar-x.c (menu_item_descriptor_to_widget_value_1): Fiddling. + * menubar-x.c (set_frame_menubar): comment fix. + + * keymap.c (lookup_keys): Remove extra parens. + * keymap.c (lookup_events): Remove extra parens. + + * dbxrc (run-temacs): Allow function to take arguments. + + * Makefile.in.in (PURIFY_FLAGS): No longer need pointer-mask. + +2000-01-08 Andy Piper <andy@xemacs.org> + + * event-msw.c (mswindows_wnd_proc): don't need to check for widget + face anymore. + + * frame.c (change_frame_size_1): use new glyph_* signatures. + (frame_conversion_internal): ditto. + + * toolbar-x.c (x_get_button_size): Use modified glyph_* + signatures. + + * redisplay.c (add_glyph_rune): Use modified glyph_* signatures. + (add_glyph_rune): dittto. + (add_margin_runes): ditto. + (create_left_glyph_block): ditto. + (create_right_glyph_block): ditto. + (redisplay_window): ditto. + + * redisplay-output.c (redisplay_output_layout): Use modified + glyph_* signatures. + + * glyphs.h: (struct image_instantiator_methods): change signature + of query_geometry and layout. + (struct Lisp_Image_Instance): Clean up fields for dynamic geometry + calculations. + (struct expose_ignore): change field types. + (struct subwindow_cachel): ditto. declare new functions and + accessor macros. + + * glyphs.c: (instantiate_image_instantiator): assign glyph when + creating the image instance. + (image_instance_hash): fixup for new and deleted fields. + (image_instance_equal): ditto. + (mark_image_instance): ditto. + (print_image_instance): ditto. + (allocate_image_instance): zero width and height. assign attached + glyph. mark as dirty for future layout. + (make_image_instance_1): pass Qnil as the glyph its attached to. + (Fimage_instance_height): simply return the height. + (Fimage_instance_width): simply return the width. + (image_instance_query_geometry): new function. query the image + instance's geometry by wiring through to format and device + specific methods. fallback on the existing geometry. + (image_instance_layout): new function. layout the image instance + by querying its geometry and then wiring through to format and + device specific methods. + (query_string_geometry): new function to decide the bounding box + of a string. text glyph geometry calculations moved here. + (query_string_font): new function. find out the font for a given + string in a given face. + (text_query_geometry): return geometry based on + quert_string_geometry. + (formatted_string_instantiate): call string_instantiate. + (image_instantiate): put strings in the per-window cache. Feed the + glyph to the instantiated image instance. + (glyph_height_internal): deleted. + (glyph_width): simply return the required dimension. re-layout if + the instance is dirty. Remove references to face_index and + frame_face which were only used for strings. + (glyph_ascent): ditto. + (glyph_descent): ditto. + (glyph_height): ditto. + (Fglyph_width): use new glyph_width function. + (Fglyph_ascent): use new glyph_ascent function. + (Fglyph_descent): use new glyph_descent function. + (Fglyph_height): use new glyph_height function. + (glyph_property_was_changed): + (glyph_image_instance_maybe): new function to possible create an + image instance from a glyph if we don't have one already. + (glyph_dirty_p): use it. + (glyph_layout): new function for laying out a glyph. + (glyph_query_geometry): new function for finding out the desired + geometry of a glyph. + (update_glyph_cachel_data): use new glyph_* signatures. + (update_subwindow): call resize_subwindow. + (map_subwindow): call update_subwindow if the image is dirty. + (subwindow_instantiate): add comment. + (Fresize_subwindow): don't actually resize the window, just record + the values and let update_subwindow handle it. + (Fglyph_animated_timeout_handler): use + MARK_IMAGE_INSTANCE_CHANGED. + (image_instantiator_format_create): declare things with + query_geometry and layout functions. + + * glyphs-x.c: (x_update_subwindow): remove widget sizing. + (update_widget_face): use query_string_font. + (x_widget_set_property): don't return Qt when setting is + succesful. + (x_combo_box_instantiate): call widget_instantiate rather than + widget_instantiate_1. + + * glyphs-widget.c: (widget_face_font_info): deleted. + (widget_text_to_pixel_conversion): deleted. + (widget_set_property): make sure the new text gets propagated to + the image instance. + (widget_layout): new function. wire through to device and format + specific methods. + (widget_query_geometry): new function. wire through to device and + format specific methods. fallback on geometry of widget text. + (initialize_widget_image_instance): fixup new fields. + (widget_instantiate_1): deleted. + (tree_view_instantiate): deleted. + (tree_view_query_geometry): new function. returns desired sizing + of tree view. + (tab_control_instantiate): deleted. + (tab_control_query_geometry): new function. returns desired sizing + of tab. + (widget_instantiate): subsume widget_instantiate_1. Fixup geometry + things in the light of dynamic layout. + (static_instantiate): deleted. + (layout_instantiate): use new glyph_* signatures. + (image_instantiator_format_create_glyphs_widget): fixup + query_geometry and layout declarations for various widgets. + + * glyphs-msw.c: (mswindows_widget_instantiate): add comment. + (mswindows_button_instantiate): use query_string_font for geometry + calculations. + (mswindows_update_subwindow): ditto. + (mswindows_combo_box_instantiate): fixup for new geometry + management. + (mswindows_widget_set_property): Don't return Qt so that other + methods can be called. + +2000-01-08 Martin Buchholz <martin@xemacs.org> + + * gdbinit: rename to .gdbinit so that gdb will automatically source it. + +2000-01-09 Hrvoje Niksic <hniksic@iskon.hr> + + * insdel.c (signal_before_change): Make sure START and END are + within the buffer before calling report_extent_modification(). + (signal_after_change): Ditto for START, NEW_END, and ORIG_END. + +2000-01-09 Hrvoje Niksic <hniksic@iskon.hr> + + * extents.h: Correct prototype of report_extent_modification(). + + * insdel.c (signal_before_change): Place record_unwind_protect() + outside MAP_INDIRECT_BUFFERS loops. + (signal_after_change): Ditto. + + * extents.c (report_extent_modification): Don't expect pointer to + inside_change_hook. + (report_extent_modification_mapper): Explain why + closure->speccount is almost unused. + + * insdel.c (change_function_restore): Call Fset_buffer only if + necessary. + (signal_before_change): Don't propagate inside_change_hook to + report_extent_modification(). + +2000-01-07 Martin Buchholz <martin@xemacs.org> + + * elhash.c (make_general_lisp_hash_table): Remove purify UMR. + (hash_table_rehash_threshold): Removed. Update all callers. + +2000-01-03 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de> + + * s/windowsnt.h: Fix mail locking stuff. + + * s/aix3-2.h: Remove HAVE_FSYNC which is now autodetected. + + * emacs.c (vars_of_emacs): Added `mail-lock-methods' and + `configure-mail-lock-method' variables. + + * config.h.in: Fix mail locking stuff. + +2000-01-04 Martin Buchholz <martin@xemacs.org> + + * mule-charset.h (REP_BYTES_BY_FIRST_BYTE): + Remove macro, always use inline function. + * mule-charset.c (make_charset): Don't assign to rep_bytes_by_first_byte. + (rep_bytes_by_first_byte): Make const. + +2000-01-03 Didier Verna <didier@xemacs.org> + + * redisplay.c (generate_fstring_runes): new parameter `offset'. + Take offset into account when outputting strings or glyphs. + (generate_formatted_string_db): call generate_fstring_runes with + an offset of 0 if generating a frame or icon title, or the + modeline hscroll if generating a modeline. + + * redisplay.h: remove prototype of `generate_formatted_string' and + add prototype for `generate_formatted_string_db', now used in + "frame.c". + + * frame.c: `title_string_display_line' and + `title_string_emchar_dynarr', formerly known as + `format_string_display_line' and `format_string_emchar_dynarr' + moved here from "redisplay.c". + (generate_title_string): formerly known as + `generate_format_string', moved here from "redisplay.c". + (update_frame_title): take these name changes into account. + (init_frame): new function. Initialize here the variables that + were previously in "redisplay.c" and initialized in + `init_redisplay'. + + * frame.h: prototype for `init_frame'. + + * window.c (Fmodeline_hscroll): restore the definition (remove the + MODELINE_IS_SCROLLABLE #ifdef). + (Fset_modeline_hscroll): ditto, docstring improvement, and return + the actual value that was set. + (struct saved_window): turn the `modeline_hscroll' field into a + Charcount. + (syms_of_window): restore the declaration of + `[set-]modeline-hscroll' (remove the MODELINE_IS_SCROLLABLE #ifdef). + + * window.h (struct window): turn the `modeline_hscroll field' into + a Charcount. + + * emacs.c: include "frame.h" to get `init_frame'. + (main_1): call `init_frame'. + +1999-12-31 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.26 is released. + +1999-12-31 Andy Piper <andy@xemacs.org> + + * glyphs-x.c (x_widget_instantiate): Avoid X errors calling + XMapWindow() on a NULL pointer X window. + +1999-12-31 Martin Buchholz <martin@xemacs.org> + + * data.c (indirect_function): Use signal_void_function_error(). + + * lisp.h: Modify prototypes for signal_*(). Add SUBR_FUNCTION macro. + + * eval.c (PRIMITIVE_FUNCALL): Optimize. + (signal_void_function_error): return result of Fsignal(). + (signal_invalid_function_error): return result of Fsignal(). + (signal_wrong_number_of_arguments_error): return result of Fsignal(). + (signal_malformed_list_error): Add DOESNT_RETURN. + (signal_malformed_property_list_error): Add DOESNT_RETURN. + (signal_circular_list_error): Add DOESNT_RETURN. + (signal_circular_property_list_error): Add DOESNT_RETURN. + (Feval): Use returned results of signal_*(). Avoids a crash! + (Ffuncall): Use returned results of signal_*(). Avoids the crash: + (setq debug-on-error t) (funcall 'foo) kbd{r42} kbd{RET} + - Only check for fun_nargs < subr_min_args if fun_nargs != max_args. + (function_argcount): Use signal_invalid_function_error(). + (funcall_lambda): Use signal_wrong_number_of_arguments_error(). + Use signal_invalid_function_error(). + +1999-12-28 Andy Piper <andy@xemacs.org> + + * debug.c: rename debug_loop elements to X_ to avoid name clashes. + + * menubar-x.c (menu_item_descriptor_to_widget_value_1): strdup + string_chars. + (menu_item_descriptor_to_widget_value_1): strdup name. + (pre_activate_callback): strdup name. + + * scrollbar-x.c (scrollbar_instance_to_widget_value): strdup name. + (x_update_scrollbar_instance_status): use free_widget_value_tree. + + * dialog-x.c (maybe_run_dbox_text_callback): strdup name. use + free_widget_value_tree. + (dbox_descriptor_to_widget_value): ditto. + + * gui-x.c (widget_value_unwind): use free_widget_value_tree. + (gui_items_to_widget_values_1): ditto. + (gui_items_to_widget_values): ditto. + (free_popup_widget_value_tree): free name. + +1999-12-27 Andy Piper <andy@xemacs.org> + + * nt.c (fstat): use get_osfhandle rather than the handle + directly. From Fabrice Popineau. + + * process-nt.c (nt_open_network_stream): take types into account + when warning. From Fabrice Popineau. + +1999-12-24 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.25 is released. + +1999-12-22 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp> + + * syntax.c (vars_of_syntax): Initialize parse-sexp_ignore_comments. + +1999-12-21 Martin Buchholz <martin@xemacs.org> + + * editfns.c (Fpoint_min): + (Fpoint_min_marker): + (Fpoint_max): + (Fpoint_max_marker): + (Fchar_after): + (Fchar_before): + Docstring fixes. What's a `buffer pointer' anyways? + + * editfns.c (char=): Remove unused and undocumented optional + third BUFFER argument. + + * toolbar.h (DEVICE_SUPPORTS_TOOLBARS_P): + * fns.c (plists_differ): + * elhash.c (HASH_CODE): + * elhash.c (KEYS_EQUAL_P): + * redisplay-output.c (redisplay_move_cursor): + * redisplay.c (create_text_block): + * floatfns.c (Flogb): + * glyphs-msw.c (mswindows_initialize_image_instance_mask): + * glyphs-msw.c (xpm_to_eimage): + * buffer.h (POINT_MARKER_P): + * syntax.c (scan_lists): + * cmdloop.c (Fcommand_loop_1): + * widget.c (Fwidget_apply): + * regex.c (STREQ): + Remove extra parens, esp. of the form ((expr)) + + * floatfns.c (Flogb): Make 64-bit clean. + +1999-12-12 Daniel Pittman <daniel@danann.net> + + * configure.in: + * configure.usage: + Clean up Athena widget support: + - Add `with-athena' to select a variant. + - Remove all `athena3d' options. + - Robust detection of Athena libraries and headers. + - Refuse to build with mismatched library and headers. + - Only build a 3d Athena if the user asks for it. + +1999-12-21 Andy Piper <andy@xemacs.org> + + * redisplay.c (redisplay_frame): check for faces changed when + reseting subwindow caches. + + * glyphs.h (struct ii_keyword_entry): add copy_p. + (struct image_instantiator_methods): add query_geometry_method and + layout_children_method. + (IIFORMAT_VALID_GENERIC_KEYWORD): new macro to take into account + copying characteristics of keywords. + (IIFORMAT_VALID_NONCOPY_KEYWORD): new macro for defining keywords + whose arguments should not be copied by the specifier code. + (image_instance_geometry): new enum for layouts. + (struct Lisp_Image_Instance): re-jig for layouts and update + macros. + + * glyphs.c (string_instantiate): rename variables. + (image_instantiate): add strings to those widgets that are + instantiated per-window. + (image_copy_vector_instantiator): new function for copying glyph + specifier instantiators. + (image_copy_instantiator): ditto. + + * glyphs-x.c (x_update_subwindow): use new face update functions. + (update_widget_face): update to use new lwlib arg functions. + (update_tab_widget_face): new function for updating tab control + label faces. + (x_widget_instantiate): use new face update functions and new + lwlib arg functions. + (x_tab_control_instantiate): ditto. + (x_tab_control_set_property): ditto. + + * glyphs-widget.c (VALID_GUI_KEYWORDS): use NONCOPY keyword for + callbacks and other things that could recurse. + (VALID_GUI_KEYWORDS): + + * event-msw.c: fix cpp stuff for cygwin < b20. + + * config.h.in: move uid_t and friends to before the s&m files so + that they can be used there. + + * Makefile.in.in (debug-temacs): new target that adds emacs + environment before invoking gdb. + + * lwlib.h (_widget_args): new structure for holding widget + args. It is reference counted so that we don't have to copy Xt + args. + (_widget_value): remove widget args. Add reference to widget_args. + + * lwlib.c (free_widget_value_contents): free widget args using + free_widget_value_args. + + * lwlib-Xaw.c (xaw_update_one_widget): use new arg packet. + (xaw_update_one_widget): use XtIsSubclass for determining labels. + + * lwlib.c (lw_add_value_args_to_args): modify to use our reference + counted arg packet. + (lw_add_widget_value_arg): new function. Add an arg to the arg + packet. + (free_widget_value_args): new function. Remove a reference counted + arg packet. + (lw_copy_widget_value_args): new function. Copy reference counted + arg packet. + (merge_widget_value_args): new function. Do a merge of widget + args. + (merge_widget_value): use it. + (copy_widget_value_tree): copy widget args using reference + counting, since we can't easily copy the args we have been given. + + * specifier.h (struct specifier_methods): add copy_instantiator_method. + + * specifier.c (build_up_processed_list): use + copy_instantiator_method if defined. + +1999-12-19 Martin Buchholz <martin@xemacs.org> + + * fns.c (Ffillarray): Use O(N), not O(N^2) algorithm for strings. + +1999-12-19 Hrvoje Niksic <hniksic@iskon.hr> + + * profile.c (sigprof_handler): FUN retrieved from the backtrace + can also be a cons representing anonymous interpreted function. + +1999-12-18 Martin Buchholz <martin@xemacs.org> + + * fns.c (mapcar1): + (Fmapconcat): + (Fmapcar): + (Fmapvector): + Docstring fixes. Make them consistent with the lispref and ANSI Lisp. + +1999-12-17 Martin Buchholz <martin@xemacs.org> + + * print.c (print_internal): print ?+ instead of ?\+, etc... + Make printing a little more efficient. + Prevent buffer overflow if sizeof EMACS_INT > 8. + My first 128-bit fix! + +1999-12-14 Karl M. Hegbloom <karlheg@inetarena.com> + + * filelock.c (unlock_all_files): GC_CONSP should be CONSP + +1999-12-17 Martin Buchholz <martin@xemacs.org> + + * database.c: + * window.c: + * event-stream.c: + Remove last vestigial uses of GC_* + + * fns.c (mapcar1): Fix ***THREE*** obscure crashes in one function! + - Two of those involve evil mapping functions that destructively + modify a list being mapped over. + - Any garbage collection when mapping over a string could cause a + crash (typically in mapconcat). + +1999-12-08 Adrian Aichner <adrian@xemacs.org> + + * s\windowsnt.h (DIRECTORY_SEP): Initialize from + `Vdirectory_sep_char'. + + * lisp.h: Add declaration for `Vdirectory_sep_char' to allow + customization of `DIRECTORY_SEP' under native Windows NT. + +1999-12-14 Katsumi Yamaoka <yamaoka@jpl.org> + + * buffer.c (Fbury_buffer): Add directions to the docstring. + +1999-12-14 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.24 is released. + +1999-12-13 Martin Buchholz <martin@xemacs.org> + + * sound.c (vars_of_sound): Provide esd-sound if HAVE_ESD_SOUND + + * nas.c: Fix compiler warnings. Ansify. C++ compilation support. + +1999-12-13 Kazuyuki IENAGA <ienaga@jsys.co.jp> + + * input-method-xlib.c: Make sure src/ does not use Athena, except + indirectly through lwlib. + +1999-12-13 Gunnar Evermann <ge204@eng.cam.ac.uk> + + * dbxrc (pobj): Add opaque_ptr, remove opaque_list. + +1999-12-10 Shenghuo ZHU <zsh@cs.rochester.edu> + + * file-coding.c (add_coding_system_to_list_mapper): + - (coding-system-list) should list aliases correctly. + +1999-12-07 Andy Piper <andy@xemacs.org> + + * fileio.c (vars_of_fileio): directory separator fix from Mike Alexander. + * windowsnt.h (ditto): + +1999-11-27 Adrian Aichner <adrian@xemacs.org> + + * sysfile.h: Encapsulate `fstat' for Windows NT just like stat to + get consistent file modification times. + + * sysdep.h: Declare `wait_for_termination' to use process handle, + not PID, on Windows NT native. + + * sysdep.c (wait_for_termination): Use process handle, not PID, on + Windows NT native. Set exit code correctly on Windows NT. + (sys_subshell): Use process handle, not PID, + on Windows NT native. + (sys_fstat): Add ENCAPSULATE_FSTAT for Windows NT. + + * process-nt.c (nt_create_process): Remove negative pid hack for + Windows 95. + (nt_send_process): Declare vol_proc volatile. + (get_internet_address): warn_when_safe if IP address cannot be + found. + (nt_open_network_stream): warn_when_safe if network stream fails + to open. + + * ntproc.c (create_child): Remove negative pid hack for Windows + 95. Remove incorrect and unnecessary USE_UNION_TYPE handling. + + * nt.c (fstat): Encapsulate for Windows NT just like stat to get + consistent file modification times. + + * callproc.c (call_process_cleanup): Use process handle, not PID, + on Windows NT native. + (Fcall_process_internal): Ditto. Close fd_error in parent. Don't + check for negative pid on Windows NT/9[58]. + +1999-12-07 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.23 is released. + +1999-12-06 Martin Buchholz <martin@xemacs.org> + + * events.c (Fcopy_event): Don't copy the lrecord_header. + + * lisp.h (DO_REALLOC): + Optimize. + Remove redundant parens. + Remove generic hygienic macro comment. + + * lrecord.h (set_lheader_implementation): Remove redundant parens. + +1999-12-05 Martin Buchholz <martin@xemacs.org> + + * lstream.c (Lstream_adding): + - Never compare a size_t and a possibly negative number. + - Optimize. + +1999-12-05 Kyle Jones <kyle_jones@wonderworks.com> + + * lisp/itimer.el: (require 'lisp-float-type). Use + floats directly in itimer-time-difference. + +1999-12-05 Andy Piper <andy@xemacs.org> + + * redisplay-output.c (redisplay_output_layout): avoid name hiding. + + * gui.h: declare gui_add_item_keywords_to_plist. + + * window.c (Fdelete_window): mark subwindows as changed so that + they can be GC'd if necessary. + +1999-12-02 Jan Vroonhof <vroonhof@math.ethz.ch> + + * src/callproc.c (Fcall_process_internal): Be careful in writing + terminating null when copying args. nargs can be < 4. + Idea from Klaus Frank <klausf@i3.informatik.rwth-aachen.de> + +1999-11-29 Kyle Jones <kyle_jones@wonderworks.com> + + * src/sound.c (Fding): Remove zero initialization of + static variables to avoid crashes on systems that dump + the initialized data segment read-only. + +1999-12-05 Jan Vroonhof <vroonhof@math.ethz.ch> + + * glyphs-x.c (convert_EImage_to_XImage): Guard against other + visual classes. From Rasmus Borup Hansen <rbh@math.ku.dk> + +1999-12-04 Martin Buchholz <martin@xemacs.org> + + * lstream.c: (filedesc_reader): + (filedesc_writer): Try number 2: Support broken systems where + return type of read() and write() is different from ssize_t. + + * systty.h: + * sysdep.h: + * sysdep.c: + - Replace macro calls to EMACS_GET_TTY and EMACS_SET_TTY with + function equivalents emacs_get_tty() and emacs_set_tty(). + - Moved prototypes to systty.h, where struct event_tty is defined. + - Renamed bogus `waitp' parameter to `flushp'. + + * lstream.c (filedesc_reader): Support broken systems where return + type of read() is different from ssize_t. + + * events.c (Fcopy_event): Avoid redundant EQ test if event2 is nil. + + * event-stream.c (menu_move_up): Remove redundant if block. + (menu_move_down): Gratuitous rewriting. + (menu_move_left): Work around Cygnus codefusion-990706 compiler bug. + (menu_move_right): Ditto. + + * lrecord.h (copy_lcrecord): + (zero_lcrecord): + Always add parentheses around uses of macro arguments. + + * sysdll.c: #include <stdlib.h> for exit(). + * unexhp9k800.x: #include <stdlib.h> for malloc(). + Use proper prototype for Save_Shared_Data(void). + +1999-12-04 Jan Vroonhof <vroonhof@math.ethz.ch> + + * src/redisplay.c (point_would_be_visible): Correct for topclip. + +1999-12-02 Hrvoje Niksic <hniksic@iskon.hr> + + * lisp.h: Declare Qself_insert_defer_undo. + + * event-stream.c (Fdispatch_event): Get the magic undo thing from + a symbol property, so commands other than self-insert-command can + install it. + (syms_of_event_stream): Define Qself_insert_defer_undo. + +1999-11-30 Martin Buchholz <martin@xemacs.org> + + * floatfns.c (emacs_rint): Rename rint to emacs_rint, so that + `#undef HAVE_RINT' works. + + * sysdep.h: Fix up prototypes for sys_read_1(), sys_write_1() + +1999-11-25 Andy Piper <andy@xemacs.org> + + * select-msw.c (Fmswindows_set_clipboard): selection fixes from + Mike Alexander. + (Fmswindows_delete_selection): ditto. + + * redisplay.h (CLASS_REDISPLAY_FLAGS_CHANGEDP): add size_changed. + (GLOBAL_REDISPLAY_FLAGS_CHANGEDP): ditto. + + * redisplay.c (redisplay_device): move size changed to macros in + redisplay.h + (redisplay_without_hooks): ditto. + + * redisplay-output.c (redisplay_output_layout): rename to avoid + name hiding. + + * process-nt.c (struct nt_process_data): mks toolkit fixes from + Mike Alexander. + (nt_create_process): ditto. + (nt_send_process): ditto. + + * nt.c (init_environment): make sure mingw32 gets the cached + system info. + + * gui.h: declare gui_add_item_keywords_to_plist. + + * event-msw.c (mswindows_wnd_proc): Clipboard fixes from Mike + Alexander. + + * console-msw.h: fix cygwin define/header 1.0 problems. + * glyphs-msw.c: ditto. + * ntplay.c: ditto. + * unexcw.c: ditto. + * s/cygwin32/h: ditto. + +1999-11-29 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.22 is released + +1999-11-28 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.21 is released. + +1999-11-26 Martin Buchholz <martin@xemacs.org> + + * callproc.c (Fcall_process_internal): + * config.h.in: + * esd.c: + * event-msw.c (ntpipe_slurp_reader): + * event-msw.c (ntpipe_shove_writer): + * event-msw.c (winsock_reader): + * event-msw.c (winsock_writer): + * event-stream.c (dribble_out_event): + * fileio.c: + * fileio.c (Fexpand_file_name): + * glyphs-x.c (write_lisp_string_to_temp_file): + * gpmevent.c (tty_get_foreign_selection): + * lisp.h: Update prototypes. + * lstream.c (Lstream_flush_out): + * lstream.c (Lstream_write_1): + * lstream.c (Lstream_was_blocked_p): + * lstream.c (Lstream_read_more): + * lstream.c (Lstream_read): + * lstream.c (Lstream_fputc): + * lstream.c (make_stdio_output_stream): + * lstream.c (stdio_flusher): + * lstream.c (stdio_closer): + * lstream.c (make_filedesc_output_stream): + * lstream.c (errno_would_block_p): + * lstream.c (filedesc_writer): + * lstream.c (make_lisp_string_input_stream): + * lstream.c (make_fixed_buffer_output_stream): + * lstream.c (fixed_buffer_reader): + * lstream.c (make_resizing_buffer_output_stream): + * lstream.c (make_dynarr_output_stream): + * lstream.c (make_lisp_buffer_output_stream): + * lstream.c (lisp_buffer_reader): + * lstream.h (lstream_implementation): + * md5.c (Fmd5): + * miscplay.h (reset_parsestate): + * process-nt.c (nt_send_process): + * process-unix.c (unix_send_process): + * sound.c: + * sysdep.c (sys_close): + * sysdep.c (sys_read_1): + * sysdep.c (sys_write_1): + * sysfile.h: + * file-coding.c (determine_real_coding_system): + * file-coding.c (Fdetect_coding_region): + * file-coding.c (struct decoding_stream): + * file-coding.c (decoding_reader): + * file-coding.c (Fdecode_coding_region): + * file-coding.c (struct encoding_stream): + * file-coding.c (encoding_reader): + * file-coding.c (Fencode_coding_region): + * file-coding.c (convert_to_external_format): + * file-coding.c (convert_from_external_format): + - Lstream functions mirror Unix98 read(),write(). Therefore use + Unix98 types size_t and ssize_t. + - Try to make Lstream* functions 64-bit clean. Someday someone + may actually want to read from a Lstream with more than 2**32 bytes. + - Add configure support for ssize_t. + - Update all callers of Lstream_read and Lstream_write to + use the new types. + - Fix esd* initiated C++ compile errors. + - Remove comments referring to `fpurge' - we don't want to call it + even if it's there. + + * lisp.h + - Remove some lingering Lucid compiler support. + + * lisp.h + - Add prototype for Fdelete_process. + + * gpmevent.c (Freceive_gpm_event): Remove unused variables. + +1999-11-27 Martin Buchholz <martin@xemacs.org> + + * Makefile.in.in (depend): Only update `depend' if there were changes. + +1999-11-26 Martin Buchholz <martin@xemacs.org> + + * editfns.c (get_system_name): Remove. + +1999-11-26 Martin Buchholz <martin@xemacs.org> + + * device-x.c (x_init_device): + - Replace magic number `17' with equivalent expn using sizeof. + - Replace strcmp with marginally more efficient memcmp. + - Avoid using C++ reserved word `class'. + + * file-coding.c (determine_real_coding_system): + - Look for both initial and final -*- cookies. + - Replace EQ (foo, Qnil) with NILP (foo) + - Make searching for cookies more efficient. + - Recognize only rfc 1521 characters in charset names. + +1999-11-22 Kazuyuki IENAGA <kazz@imasy.or.jp> + + * input-method-xlib.c (IMDestroyCallback): #ifdef'd by + "THIS_IS_X11R6", because it shouldn't be evaluated unless X11R6. + * input-method-xlib.c (IMInstantiateCallback): Ditto. + * input-method-xlib.c (XIM_init_device): Revive XOpenIM function + call for X11R5 systems. + * input-method-xlib.c (XIM_delete_frame): Enabled XDestroyIC() + again because XIM doesn't concern with frame deletion itself. + The XIC will be cleared by XIM when XIM is closing (at XIM destroy + callback). + +1999-10-25 Kazuyuki IENAGA <kazz@imasy.or.jp> + + * input-method-xlib.c: Added new lisp object Qxim_xlib. + New macro xim_warn(str), xim_warn1(fmt,str) and xim_info(str). + All the valid stderr_out were changed to those macros. + (IMDestroyCallback): Don't test the XIC if the frame is not X + frame. + (IMInstantiateCallback): Treat the client_data as "device" not + "frame" because the caller changed from frame to device. + Here initializes XIM and activates XICs for each frame which + doesn't have XIC. + (XIM_init_device): Register the XIM instantiation callback which + had been performed by XIM_init_frame() before. + (XIM_delete_frame): Added a test for the XIM before clearing XIC. + (XIM_init_frame): Placed an actual code for XIC activation which + was moved from IMInstantiateCallback. + (syms_of_input_method_xlib): New function which includes a symbol + Qxim_xlib that uses in emacs.c. + + * emacs.c: Added a function entry "syms_of_input_method_xlib" for + input_method_xlib. + + * symsinit.h: Added a declaration of "syms_of_input_method_xlib". + +1999-11-05 Robert Pluim <rpluim@bigfoot.com> + + * emacs.c (shut_down_emacs): Point users to PROBLEMS file + +1999-11-16 Jan Vroonhof <vroonhof@math.ethz.ch> + + * redisplay-output.c (compare_runes): Add comments about + results from profiling. + + * redisplay.h (struct rune): Do not use bitfields for members. + (struct rune): Add various comments about further optimizations. + +1999-11-19 Eric Darve <darve@crocco.stanford.edu> + + * abbrev.c (abbrev_oblookup): Check whether wordend <= wordstart + if Vabbrev_start_location is used too. + +1999-10-27 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp> + + * file-coding.c (detect_eol_type): Return CR when two + sequential CR are found. + (determine_real_coding_system): Check EOL type when coding: + cookie is found and EOL type is not specified. + Don't assume 8bit char as part of coding: cookie. + +1999-10-26 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp> + + * file-coding.c (determine_real_coding_system): Check if + '-*-' exists. End searching for coding: cookie at the end + of line. Check whether character before coding: is space, + tab or ';'. + +1999-11-07 William M. Perry <wmperry@aventail.com> + + * gpmevent.c: Completely rewrote GPM mouse support for linux + console. The TTY console and event stream are modified at run + time, so this code can now be used as a module. + (tty_get_foreign_selection): New function to allow pasting from + other virtual consoles. + (Fgpm_enable): New lisp-visible function to turn GPM on or off + at run time. + + * device-tty.c (tty_asynch_device_change): No longer need to + notify GPM code of window/console height/width changes. + + * console-tty.c (tty_init_console): Removed outdated GPM support + that was part of the console/event code. + + * event-Xt.c (emacs_Xt_select_console): Ditto + + * event-Xt.c (emacs_Xt_unselect_console): Ditto + + * event-unixoid.c (read_event_from_tty_or_stream_desc): Ditto + + * frame-tty.c (console_type_create_frame_tty): Ditto + +1999-11-17 Martin Buchholz <martin@xemacs.org> + + * nt.c: + * sysdep.c: + * s/mingw32.h: + * s/windowsnt.h: + - Use Unix 98 types uid_t, gid_t, pid_t. + - Define them. + +1999-11-01 Olivier Galibert <galibert@pobox.com> + + * alloc.c (reinit_alloc_once_early): Move purify_flag init... + * emacs.c (main_1): ...here, to get the correct value even with + the portable dumper. + +1999-11-17 Martin Buchholz <martin@xemacs.org> + + * lisp.h (BIT_VECTOR_LONG_STORAGE): Add extra parens. It's a macro! + + * tooltalk.c (tt_build_string): Remove extra parens. + * process.c (print_process): Remove extra parens. + * buffer.h (BI_BUF_PTR_BYTE_POS): + (BUF_PTR_BYTE_POS): + (BI_BUF_BYTE_ADDRESS): + (BI_BUF_BYTE_ADDRESS_BEFORE): + (valid_memind_p): + (bytind_to_memind): + (memind_to_bytind): + Remove extra parens. Inline functions are not macros. + + * editfns.c (Fuser_login_name): + (user_login_name): + Use proper type uid_t. + +1999-11-15 Martin Buchholz <martin@xemacs.org> + + * syntax.c (complex_vars_of_syntax): Make more readable. + (define_standard_syntax): New function. + + * syntax.c (forward-comment): Gradually make XEmacs 64-bit-clean. + +1999-11-14 Martin Buchholz <martin@xemacs.org> + + * mule-ccl.c (CCL_WRITE_STRING): Fix compiler warnings. + +1999-11-12 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp> + + * mule-charset.h (LEADING_BYTE_OFFICIAL_1, LEADING_BYTE_OFFICIAL_2): + New enum type to make sure no gap in the leading byte definition. + +1999-11-11 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp> + + * mule-charset.h (LEADING_BYTE_CYRILLIC_ISO_8859_5, + LEADING_BYTE_LATIN_ISO8859_9): Moved to 0x8B and 0x8C + to remove a hole in leading byte definition. + +1999-11-10 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp> + + * mule-charset.c (non_ascii_valid_charptr_p): Check if + private charset is defined. + +1999-11-09 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp> + + * mule-ccl.c (ccl_driver): Make sure generated sequences + are valid when doing `CCL_WRITE_STRING'. + (ccl-execute-on-string): Pass CCL_MODE_DECODING to ccl_driver. + +1999-11-10 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.20 is released + +1999-11-04 Martin Buchholz <martin@xemacs.org> + + * mule-ccl.c (ccl_driver): Warning suppression + +1999-11-01 SL Baur <steve@miho.m17n.org> + + * emacs.c (main_1): Guard call to reinit_vars_of_debug when not + building a debugged XEmacs. + +1999-10-28 Andreas Jaeger <aj@suse.de> + + * src/emacs.c (main_1): Don't set the malloc hooks if using + DOUG_LEA_MALLOC. + +1999-10-30 Olivier Galibert <galibert@pobox.com> + + * alloc.c (pdump_dump_rtables): Don't forget to dump the last + registered type. + (pdump): Ditto. + +1999-10-25 Olivier Galibert <galibert@pobox.com> + + * emacs.c (main_1): Call reinit_vars_of_scrollbar_x. + + * symsinit.h: Declare reinit_vars_of_scrollbar_x. + +1999-10-25 Martin Buchholz <martin@xemacs.org> + + * redisplay.h (CLASS_RESET_CHANGED_FLAGS): + (GLOBAL_RESET_CHANGED_FLAGS): + (CLASS_REDISPLAY_FLAGS_CHANGEDP): + (RESET_CHANGED_SET_FLAGS): + Fix C++ compile errors/warnings. + These macros were just a tad too clever. + + * process-unix.c (unix_open_network_stream): + * objects-x.c (allocate_nearest_color): + * mule-charset.c (vars_of_mule_charset): + * fileio.c (Ffile_truename): + * file-coding.c (vars_of_file_coding): + Fix compile errors/warnings. + + * alloc.c (xstrdup): Use fact that memcpy returns its first arg. + (allocate_lisp_storage): Simplify. + +1999-10-24 Olivier Galibert <galibert@pobox.com> + + * conslots.h: Add defines with first and last slot names. + * bufslots.h: Add defines with first and last slot names. + + * buffer.c (common_init_complex_vars_of_buffer): Renamed from + reinit_complex_vars_of_buffer + (reinit_complex_vars_of_buffer): Reset the slots to the dumped + value. + (complex_vars_of_buffer): Dump the slots values. + + * console.c (common_init_complex_vars_of_console): Renamed from + reinit_complex_vars_of_console + (reinit_complex_vars_of_console): Reset the slots to the dumped + value. + (complex_vars_of_console): Dump the slots values. + + * alloc.c: Rename reloc_table to pdump_reloc_table, rt_list to + pdump_rt_list and move them at the beginning of the file. + (gc_sweep): Unmark pdumped objects after the sweep phase. + (pdump_dump_rtables): Change a bare 256 to + last_lrecord_type_index_assigned. Add a separator between the + adresses or lrecords and the ones of C structs in the dump file. + (pdump_load): Cope with the new separator and the renamings. Stop + looking for the hash tables list after it has been found (duh!). + +1999-10-24 Robert Bihlmeyer <robbe@orcus.priv.at> + + * sound.c: support HAVE_ESD_SOUND + + * miscplay.c: + * miscplay.h: + * linuxplay.c: Move large part of linuxplay to generalized file + miscplay. Make it platform independent. + + * esd.c: New file + +1999-10-24 Adrian Aichner <adrian@xemacs.org> + + * lisp.h (Dynarr_declare): Fix boo-boo. + +1999-10-24 Olivier Galibert <galibert@pobox.com> + + * process-unix.c (allocate_pty): Fix HAVE_GETPT. + * process.h: Ditto. + +1999-10-24 Jan Vroonhof <vroonhof@math.ethz.ch> + + * redisplay.c (start_with_line_at_pixpos): Remove assert(cur_elt + >=0). Handle the cur_elt == 0 case. + +1999-10-24 Jan Vroonhof <vroonhof@math.ethz.ch> + + * unexelf.c: Merge Martin's c++ fixes back in + +1999-10-20 Jan Vroonhof <vroonhof@math.ethz.ch> + + * unexelf.c (unexec): Only copy the global offset + table from memory on sgi machines. + +1999-08-13 Alexandre Oliva <oliva@dcc.unicamp.br>, Vin Shelton <acs@xemacs.org> + + * unexelf.c: Enable GNU/Linux/alpha to build with gcc 2.95 by + adding support for an sbss section. Get IRIX 5.2 to build using + unexelf.c. + + * m/iris4d.h: Use unexelf.o for unexec. + + * m/iris5d.h: Use unexelf.o for unexec. + +1999-10-24 Jan Vroonhof <vroonhof@math.ethz.ch> + + * unexelf.c: Revert to 21.1 version + +1999-08-28 Jan Vroonhof <vroonhof@math.ethz.ch> + + * window.c (Fwindow_truncated_p): New function. + +1999-08-25 Jonathan Marten <jonathan.marten@uk.sun.com> + + * window.c (window_truncation_on): Always return 0 for minibuffer + windows, to enable auto scrolling. + +1999-10-24 Neal Becker <nbecker@fred.net> + * process.h: Unix98 PTY support + +1999-10-17 Jan Vroonhof <vroonhof@math.ethz.ch> + + * fileio.c (Ffile_truename): Do proper mule decoding on + the argument to xrealpath() + +1999-08-19 Stephen Tse <stephent@sfu.ca> + + * process-unix.c (unix_open_network_stream): Add udp network + support; rename variable Qtcpip to Qtcp, parameter family to + protocol for consistency with Qudp. + + * process-nt.c (nt_open_network_stream): Rename variable Qtcpip to + Qtcp, parameter family to protocol for consistency with Qudp. + + * process.c (global_variables): Add a new variable Qudp for udp + network support; rename variable Qtcpip to Qtcp for consistency + with Qudp. + (Fopen_network_stream_internal): Rename parameter FAMILY to + PROTOCOL for consistency; fix a minor typo and add an explanation + in docstring for udp programming. + (Fopen_multicast_group_internal): Fix a minor typo in docstring. + (syms_of_process): Add a new variable Qudp for udp network + support; rename variable Qtcpip to Qtcp for consistency with Qudp. + + * process.h (extern_variables): Add a new variable Qudp for udp + network support; rename variable Qtcpip to Qtcp for consistency + with Qudp. + + * procimpl.h: Add a new variable Qudp for udp network support; + rename variable Qtcpip to Qtcp for consistency with Qudp. + (struct process_methods): Rename parameter family to protocol. + + +1999-10-24 Olivier Galibert <galibert@pobox.com> + + * alloc.c (pdump_make_hash): Divide pointers by 8 for a better hash. + +1999-10-23 Olivier Galibert <galibert@pobox.com> + + * lrecord.h (struct lrecord_header): Removed dumped flags. + + * dynarr.c: Use DUMPEDP instead of dumped flag. + + * lisp.h (DUMPEDP): Added. Removed dumped flag from dynarr. + + * alloc.c: Removed hash_next linked list pointer. + + * *.c *.h: Removed markobj and mark_object parameters, removed GC_ + and XGC macros. + +1999-10-14 Andy Piper <andy@xemacs.org> + + * redisplay-x.c (x_output_shadows): fix dodgy maths for border + calculations. + + * gutter.c (output_gutter): be more accurate about the area to be + cleared since X seems to manage to do the clear after drawing the + border. + + * redisplay.h (RESET_CHANGED_FLAGS): new macro for setting + redisplay flags as a group. + (RESET_CHANGED_SET_FLAGS): ditto. + (CLASS_RESET_CHANGED_FLAGS): ditto. + (GLOBAL_RESET_CHANGED_FLAGS): ditto. + (REDISPLAY_FLAGS_CHANGEDP): new macro for testing redisplay flags + as a group. + (CLASS_REDISPLAY_FLAGS_CHANGEDP): ditto. + (GLOBAL_REDISPLAY_FLAGS_CHANGEDP): ditto. + + * redisplay.c (redisplay_frame): use CLASS_RESET_CHANGED_FLAGS + instead of setting flags individually. + (redisplay_device): ditto CLASS_REDISPLAY_FLAGS_CHANGEDP. + (redisplay_device): ditto. + (redisplay_device): ditto CLASS_RESET_CHANGED_FLAGS. + (redisplay_without_hooks): ditto GLOBAL_REDISPLAY_FLAGS_CHANGEDP. + (redisplay_without_hooks): ditto CLASS_REDISPLAY_FLAGS_CHANGEDP. + (redisplay_without_hooks): ditto. + (redisplay_without_hooks): ditto GLOBAL_RESET_CHANGED_FLAGS. + + * redisplay-x.c (x_output_string): unmap subwindows in the area. + (x_output_blank): ditto. + + * redisplay-output.c (redisplay_output_display_block): don't unmap + subwindows in case layout optimization can avoid it. + (redisplay_output_subwindow): unmap subwindows in the area. + (redisplay_output_layout): optimize the output of layouts - only + output glyphs that have changed if nothing else of redisplay + significance has occurred. + (redisplay_output_pixmap): change args to + redisplay_clear_clipped_region. + (redisplay_clear_clipped_region): allow the clipped region to be + cleared of all subwindows except the one passed in. + + * redisplay-msw.c (mswindows_output_blank): unmap subwindows in + the area. + (mswindows_output_cursor): ditto. + (mswindows_output_string): ditto. + + * gutter.c (calculate_gutter_size): if the window buffer is nil + then don't continue. + (update_frame_gutters): be more lenient about when we actually + update the gutter. Layout optimization makes this + non-costly. Cache redisplay flags that we want to temporarily + ignore. + + * glyphs.c (Fglyph_animated_timeout_handler): handle image + specific timeouts rather than iterating over the instance cache. + (glyph_animated_timeout_mapper): deleted. + (add_glyph_animated_timeout): use a weak list to hold onto the + image so that it can be GC'ed. + (disable_glyph_animated_timeout): disable a specific timeout. + (vars_of_glyphs): disable-animated-pixmaps is a new boolean for + controlling whether pixmaps are animated or not. + + * glyphs-msw.c (mswindows_finalize_image_instance): make sure the + image timeout gets disabled when the image gets freed. + + * glyphs-eimage.c (gif_instantiate): remove meaningless + comment. Cope with timeouts specified in the gif extension block. + + * event-msw.c (vars_of_event_mswindows): new variable + mswindows-meta-activates-menu. + (mswindows_wnd_proc): only goto defproc with VK_MENU if the user + wants it. + + * glyphs-x.c (x_finalize_image_instance): delete mask first so + that we can compare with image. + +1999-10-14 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * event-msw.c (mswindows_key_to_emacs_keysym): + Recognise keypad keys as different from normal keys. + +1999-10-14 Didier Verna <didier@xemacs.org> + + * glyphs-x.c (x_finalize_image_instance): avoid freeing null pixmaps. + +1999-10-10 Olivier Galibert <galibert@pobox.com> + + * symbols.c (init_symbols_once_early): dump Vquit_flag. + + * symsinit.h: Updated. + + * ntproc.c (vars_of_ntproc): Use defsymbol. + + * emacs.c (main_1): Updated reinit calls. + + * lisp.h: Removed Fpurecopy and pure_put declarations. + * fns.c: Removed pure_put. + + * eval.c (Fdefvar): pure_put -> Fput + (Fdefconst): Ditto. + * frame-x.c (init_x_prop_symbols): Ditto. + * symbols.c (deferror): Ditto. + + * alloc.c (Fmake_byte_code): Remove Fpurecopy call. + * buffer.c (vars_of_buffer): Ditto. + * bytecode.c (Ffetch_bytecode): Ditto. + (optimize_compiled_function): Ditto. + * emacs.c (vars_of_emacs): Ditto. + * emodules.c (vars_of_module): Ditto. + * eval.c (define_function): Ditto. + (Fautoload): Ditto. + * frame.c (vars_of_frame): Ditto. + * intl.c (Fset_domain): Ditto. + * lread.c (load_force_doc_string_unwind): Ditto. + * menubar.c (vars_of_menubar): Ditto. + * minibuf.c (reinit_complex_vars_of_minibuf): Ditto. + + * debug.c (reinit_vars_of_debug): Extracted. + * device-x.c (reinit_vars_of_device_x): Ditto. + * emodules.c (reinit_vars_of_module): Ditto. + * font-lock.c (reinit_vars_of_font_lock): Ditto. + * glyphs-widget.c (reinit_vars_of_glyphs_widget): Ditto. + * glyphs.c (reinit_vars_of_glyphs): Ditto. + * gui-x.c (reinit_vars_of_gui_x): Ditto. + * insdel.c (reinit_vars_of_insdel): Ditto. + * menubar-x.c (reinit_vars_of_menubar_x): Ditto. + * minibuf.c (reinit_complex_vars_of_minibuf): Ditto. + * mule-wnnfns.c (reinit_vars_of_mule_wnn): Ditto. + * print.c (reinit_vars_of_print): Ditto. + * redisplay.c (reinit_vars_of_redisplay): Ditto. + * select-x.c (reinit_vars_of_xselect): Ditto. + * undo.c (reinit_vars_of_undo): Ditto. + +1999-10-10 Olivier Galibert <galibert@pobox.com> + + * symsinit.h: Updated declarations, see other ChangeLog entries. + + * redisplay.c (init_redisplay): Ensure proper reinitialisation. + + * lrecord.h (XD_DYNARR_DESC): Introduce XD_INT_RESET and use it. + + * glyphs.c: Add the ii_keyword_entry and related descriptions. + Fix the image_instantiator_methods one. + + * file-coding.c: Plonk all data that needs to be dumped in a + dynamically allocated structure. + + * extents.c (reinit_vars_of_extents): Extracted from + vars_of_extents. + + * event-stream.c (vars_of_event_stream): Don't staticpro when + pdump_wire is enough. + + * event-msw.c (reinit_vars_of_event_mswindows): Extracted from + vars_of_event_mswindows. + + * event-Xt.c (reinit_vars_of_event_Xt): Extracted from + vars_of_event_Xt. + + * eval.c (vars_of_eval): Don't staticpro when pdump_wire is enough. + + * emacs.c (main_1): Added some reinit calls. + + * device-x.c (reinit_console_type_create_device_x): Extracted from + console_type_create_device_x. + + * console.h: Declare the console_type_entry_dynarr description. + + * console.c: Unstatic the console_type_entry_dynarr description. + + * alloc.c: Removed some dubious comments. Handle XD_INT_RESET. + +1999-10-07 Olivier Galibert <galibert@pobox.com> + + * symsinit.h: Updated declarations, see other ChangeLog entries. + + * minibuf.c (reinit_complex_vars_of_minibuf): Extracted from + complex_vars_of_minibuf. + + * lrecord.h: Removed XD_PARENT_INDIRECT (unused and + unimplemented), added XD_LO_LINK. + + * lisp.h (pdump_wire_list): Add declaration. + + * glyphs.h (INITIALIZE_DEVICE_IIFORMAT): Fix bug found by Andy. + (INITIALIZE_IMAGE_INSTANTIATOR_FORMAT): Fix stupid bug. + (REINITIALIZE_IMAGE_INSTANTIATOR_FORMAT): Remove, useless once the + stupid bug fixed. + + * glyphs.c (reinit_image_instantiator_format_create): Remove. + + * glyphs-x.c (reinit_image_instantiator_format_create_glyphs_x): + Remove. + + * glyphs-widget.c + (reinit_image_instantiator_format_create_glyphs_widget): Remove. + + * glyphs-msw.c + (reinit_image_instantiator_format_create_glyphs_mswindows): + Remove. + + * glyphs-eimage.c + (reinit_image_instantiator_format_create_glyphs_eimage): Remove. + + * frame.c (Fmake_frame): Don't reset the face cache when using the + stream device. + + * file-coding.c: Dumped the_codesys_prop_dynarr and added all + relevant descriptions. + + * events.c (reinit_vars_of_events): Extracted from vars_of_events. + + * eval.c: The subr is _not_ a lcrecord. + + * emacs.c (main_1): Call vars_of_specifier early before any + specifier creation (e.g in vars_of_glyphs, at least). Remove the + useless reinit_image_instantiator_format*. Add + reinit_vars_of_events and reinit_complex_vars_of_minibuf. Add + calls to lstream_type_create* and process_type_create*. + + * elhash.c: Dump Vall_weak_hash_tables correctly. + + * data.c: Dump Vall_weak_lists correctly. + + * console.c: Fix description. + + * console-stream.c (init_console_stream): Do initializations + correctly in the pdump case. + + * chartab.c: Fix description. Dump Vall_syntax_tables correctly. + (Fcopy_char_table): Link into Vall_syntax_tables. + + * alloc.c (pdump_wire_list): Added. + (Fgarbage_collect): Fix loop in stats couting missing the last + lrecord type. + (pdump_register_sub): Added XD_LO_LINK. + (pdump_dump_data): Ditto. Fixed XD_LO_RESET_NIL forgttting the + counter. + (pdump_reloc_one): Ditto. + (pdump_scan_by_alignement): Use last_lrecord_type_index_assigned + instead of 256. + (pdump_dump_wired): Added lists. + (pdump): Use last_lrecord_type_index_assigned instead of 256. + Dump last_lrecord_type_index_assigned value. Fix minor bugs. + +1999-10-07 Andy Piper <andy@xemacs.org> + + * glyphs-msw.c (mswindows_finalize_image_instance): zero out + bitmap slices. + + * glyphs-x.c (x_finalize_image_instance): fix FMW problem. + +1999-10-06 Andy Piper <andy@xemacs.org> + + * elhash.c (resize_hash_table): Correct reference to lrecord_header. + +1999-10-06 Damon Lipparelli <lipp@primus.com> + + * elhash.h: forward declare Lisp_Hash_Table. + +1999-10-06 Andy Piper <andy@xemacs.org> + + * glyphs.c (Fset_image_instance_property): mark glyphs as dirty + after setting an image instance property. + +1999-10-05 Andy Piper <andy@xemacs.org> + + * gutter.c (update_frame_gutters): output gutters if + windows_changed is set. This is the only way of catching changes + in selected window which obviously can affect the specifiers. + + * redisplay.c: new state flags, subwindows_state_changed and + subwindows_state_changed set. + (redisplay_window): use them. + (redisplay_device): ditto. + (redisplay_without_hooks): ditto. + (redisplay_frame): ditto. Reset subwindow cachels if + subwindows_changed is set. + (redisplay_window): call mark_glyph_cachels_as_clean after + redisplaying. + + * redisplay-x.c (x_output_x_pixmap): select correct + pixmap image for display depending on the currently selected + slice. + + * redisplay-output.c (compare_runes): check dirtiness when + checking RUNE_DGLYPH runes. + (compare_display_blocks): relax invalidation of display blocks + since we can now detect whether individual glyphs have changed or + not. + + * redisplay-msw.c (mswindows_output_dibitmap): select correct + bitmap image for display depending on the currently selected + slice. + + * glyphs.h (struct Lisp_Image_Instance): add a dirty flag. + (IMAGE_INSTANCE_DIRTYP): new macro. + (XIMAGE_INSTANCE_DIRTYP): ditto. + (MARK_IMAGE_INSTANCE_CHANGED): ditto. + (GLYPH_DIRTYP): ditto. + (XGLYPH_DIRTYP): ditto. + (MARK_GLYPH_CHANGED): ditto. + (GLYPH_CACHEL_DIRTYP): ditto. + (struct glyph_cachel): add a dirty flag. + + * glyphs.c (update_frame_subwindows): Don't update on + glyphs_changed. + (glyph_animated_timeout_mapper): new function. Map over the + instance cache lookinng for animated images to update. + (Fglyph_animated_timeout_handler): new function. Lisp callback for + handling animated image timeout events. + (disable_glyph_animated_timeout): new function. Add the animated + image timeout. + (disable_glyph_animated_timeout): new function. Remove the + animated image timeout. + (syms_of_glyphs): initialize Qglyph_animated_timeout_handler and + friends. + (vars_of_glyphs): initialize Vglyph_animated_ticker. + (image_instance_equal): add the currently displayed slice. + (image_instance_hash): ditto. + (allocate_glyph): initialize dirty flag. + (glyph_width): rename glyph -> glyph_or_image. + (glyph_height_internal): ditto. + (glyph_dirty_p): new function. Determine whether the image + instance in the domain and/or glyph is dirty. + (set_glyph_dirty_p): set the dirtiness. + (update_glyph_cachel_data): take dirtiness into account. Pass the + image instance we are interested in to glyph_width and friends. + (get_glyph_cachel_index): make non-static. Always call + update_glyph_cachel_data. + (mark_glyph_cachels_as_not_updated): meaningless formatting + change. + (mark_glyph_cachels_as_clean): new function. Clean dirtiness from + glyph cachels. + + * glyphs-x.h (struct x_image_instance_data): change + pixmap to a list of pixmaps. + (IMAGE_INSTANCE_X_PIXMAP_SLICE): new macro. + (IMAGE_INSTANCE_X_PIXMAP_SLICES): ditto. + (XIMAGE_INSTANCE_X_PIXMAP_SLICE): ditto. + (XIMAGE_INSTANCE_X_PIXMAP_SLICES): ditto. + + * glyphs-x.c (x_finalize_image_instance): make sure multi pixmap + images get deleted properly. + (init_image_instance_from_x_image): add slices paramater and use + it to initialize x_image_instance_data correctly. + (image_instance_add_x_image): new function. Add new pixmaps to our + set of instantiated pixmaps for an image. Used by animated images. + (x_init_image_instance_from_eimage): add a slices + parameter. Instantiate all images from the eimage. + (x_xpm_instantiate): update use of + init_image_instance_from_x_image. + (init_image_instance_from_xbm_inline): ditto. + (x_initialize_pixmap_image_instance): add slices paramater and use + it to allocate x_image_instance_data correctly. + + * glyphs-msw.h (struct mswindows_image_instance_data): change + bitmap to a list of bitmaps. + (IMAGE_INSTANCE_MSWINDOWS_BITMAP_SLICE): new macro. + (IMAGE_INSTANCE_MSWINDOWS_BITMAP_SLICES): ditto. + (XIMAGE_INSTANCE_MSWINDOWS_BITMAP_SLICE): ditto. + (XIMAGE_INSTANCE_MSWINDOWS_BITMAP_SLICES): ditto. + + * glyphs-msw.c (init_image_instance_from_dibitmap): add slices + paramater and use it to initialize mswindows_image_instance_data + correctly. + (image_instance_add_dibitmap): new function. Add new bitmaps to + our set of instantiated bitmaps for an image. Used by animated + images. + (mswindows_init_image_instance_from_eimage): add a slices + parameter. Instantiate all images from the eimage. + (mswindows_xpm_instantiate): update use of + init_image_instance_from_dibitmap. + (bmp_instantiate): ditto. + (init_image_instance_from_xbm_inline): ditto. + (mswindows_finalize_image_instance): make sure all the bitmap + slices get deleted. + (mswindows_initialize_dibitmap_image_instance): add slices + paramater and use it to allocate mswindows_image_instance_data + correctly. + + * glyphs-eimage.c (jpeg_instantiate): give extra paramter to + init_image_instance_from_eimage. + (png_instantiate): ditto. + (tiff_instantiate): ditto. + (gif_instantiate): allocate bitmaps for all gif slices not just + the first one. + + * device.h (struct device): add subwindows_state_changed flag. + (MARK_DEVICE_SUBWINDOWS_STATE_CHANGED): new macro. + (MARK_DEVICE_FRAMES_GLYPHS_CHANGED): ditto. + + * console.h (struct console_methods): add a slice parameter to + init_image_instance_from_eimage_method. + + * redisplay.c (create_string_text_block): Allow buffer to be nil + without crashing. + +1999-09-24 Andy Piper <andy@xemacs.org> + + * glyphs-x.c: only include gui-x.h if we are building with + widgets. + + * gui-x.c (vars_of_gui_x): only set popup_up_p if we have popups. + +1999-09-28 Lee Kindness <lkindness@csl.co.uk> + + * objects-x.c (allocate_nearest_color): will return 0 (failure) + when the colormap is full and the color it has computed to be the + 'nearest' has been allocated read/write. + +1999-10-02 Olivier Galibert <galibert@pobox.com> + + * search.c (reinit_vars_of_search): Reinit the search cache + correctly. + + * elhash.h: Make the description visible. Declare + resize_hash_table. + + * elhash.c (resize_hash_table): Extracted from enlarge_hash_table + to generalize the hash table reorganization. + (reorganize_hash_table): Added. + (enlarge_hash_table): Uses resize_has_table. + + * casetab.c (complex_vars_of_casetab): staticpro the mule mirror + tables. + + * alloc.c: Add correct management of blocks of structures. + Reorganize hash tables at reload since the hash values can change + with the pointers. + +1999-10-01 Olivier Galibert <galibert@pobox.com> + + * lisp.h: Add pdump_wire declaration + + * elhash.c (vars_of_elhash): Wire Vall_weak_hash_tables. + * symbols.c (init_symbols_once_early): Wire Qnil and Qunbound. + + * alloc.c (pdump_wire): Added.. + (pdump_load): Support it. + (pdump): Support it + + * glyphs-msw.c + (reinit_image_instantiator_format_create_glyphs_mswindows): Fix + macro calls. + +1999-09-28 Olivier Galibert <galibert@pobox.com> + + * symsinit.h: Added lots of prototypes. + + * symeval.h: Added defsymbol_nodump declaration. + + * symbols.c (find_symbol_value): Lame attempt at making the + startup go further. + (defsymbol_nodump): Added. + + * mule-charset.c: Collapsed global lisp objects arrays in one + dumpable structure. + + * lrecord.h: Added some flags. + + * lisp.h: Added dumped flag to dynarrs. Added dumpstruct + declaration. + + * glyphs.h (INITIALIZE_IMAGE_INSTANTIATOR_FORMAT_NO_SYM): Don't + staticpro dynamic variables. + + * glyphs.c (reinit_specifier_type_create_image): Added. + (image_instantiator_format_create): Dump image instantiator format + dynarr. + (reinit_image_instantiator_format_create): Added. + + * emacs.c (main_1): Added reinits calls. + + * dynarr.c: Protect dumped dynarrays from going berzek in free or + realloc. + + * specifier.h (INITIALIZE_SPECIFIER_TYPE): Don't staticpro dynamic + variables. + * specifier.c (specifier_type_create): Dump the specifier type + dynarr. + (reinit_specifier_type_create): Added. + * console.h (INITIALIZE_CONSOLE_TYPE): Don't staticpro dynamic + variables. + * console.c (console_type_create): Dump the console type dynarr. + (reinit_vars_of_console): Extracted from vars_of_console. + (reinit_complex_vars_of_console): Extracted from + complex_vars_of_console + * window.c (reinit_vars_of_window): Extracted from vars_of_window. + * toolbar.c (reinit_specifier_type_create_toolbar): Added. + * search.c (reinit_vars_of_search): Extracted from vars_of_search. + * objects.c (reinit_specifier_type_create_objects): Added. + (reinit_vars_of_objects): Extracted from vars_of_objects. + * lstream.c (reinit_vars_of_lstream): Extracted from + vars_of_lstream. + * lread.c (reinit_vars_of_lread): Extracted from vars_of_lread. + * gutter.c (reinit_specifier_type_create_gutter): Added. + * glyphs-x.c (reinit_image_instantiator_format_create_glyphs_x): + Added. + * glyphs-widget.c + (reinit_image_instantiator_format_create_glyphs_widget): Added + * glyphs-msw.c + (reinit_image_instantiator_format_create_glyphs_mswindows): Added. + * glyphs-eimage.c + (reinit_image_instantiator_format_create_glyphs_eimage): Added. + * event-stream.c (reinit_vars_of_event_stream): Extracted from + vars_of_event_stream + * eval.c (reinit_vars_of_eval): Extracted from vars_of_eval. + * device.c (reinit_vars_of_device): Extracted from vars_of_device. + * console-x.c (reinit_console_type_create_x): Added. + * console-tty.c (reinit_console_type_create_tty): Added + * console-stream.c (reinit_console_type_create_stream): Added. + (init_console_stream): If PDUMP, always reinitialise basic + devices. + * console-msw.c (reinit_console_type_create_mswindows): Added. + * buffer.c (reinit_vars_of_buffer): Extracted from + init_vars_of_buffer. + (reinit_complex_vars_of_buffer): Extracted from + complex_vars_of_buffer + + * alloc.c: Further with the portable dumping, the revenge. + (dumpstruct): Added. + (reinit_alloc_once_early): Extracted from init_alloc_once_early. + + * specifier.c (sizeof_specifier): Correct size computation. + (make_specifier_internal): Ditto. + +1999-09-27 Olivier Galibert <galibert@pobox.com> + + * alloc.c: Further with the portable dumping. + +1999-09-27 Martin Buchholz <martin@xemacs.org> + + * glyphs-x.c (update_widget_face): Remove bogus cast + + * data.c (sign_extent_lisp): + * data.c (check_int_range): + * data.c (Faref): + * data.c (Faset): + * data.c (number_char_or_marker_to_int): + * data.c (number_char_or_marker_to_double): + * data.c (Frem): + * data.c (Fmod): + * extents.c (print_extent_1): + * fns.c (print_bit_vector): + * fns.c (Flength): + * fns.c (Fsafe_length): + * fns.c (copy_list): + * fns.c (Fsubseq): + * fns.c (Felt): + * fns.c (Flast): + * fns.c (Fnbutlast): + * insdel.h: + * marker.c (print_marker): + * syntax.h: + * bytecode.c (bytecode_arithcompare): + * bytecode.c (bytecode_arithop): + * lisp.h: + * lisp.h (EXTERNAL_LIST_LOOP_DELETE_IF): + * lisp.h (TRUE_LIST_P): + * lisp.h (CHECK_TRUE_LIST): + * lisp.h (bit_vector_length): + * lisp.h (GCPRO4): Make consistent. + * lisp.h (NGCPRO4): Make consistent. + * lisp.h (NNGCPRO4): Make consistent. + * alloc.c (Fmake_list): + * alloc.c (Fmake_string): + Use proper 64-bit types, e.g. EMACS_INT or size_t instead of int. + This should make all arithmetic 64-bit clean. + + Use %ld with (long) casts in print statements of types with sizes + possibly larger than int. + + Following functions had mismatched prototypes!!: + do_marker_adjustment(), fixup_internal_substring(), scan_lists(), + char_quoted(), make_string_from_buffer(), + make_string_from_buffer_no_extents() + + The types of Bufpos, Bytind, Memind, Bytecount, Charcount, + Extcount are all now EMACS_INT. I hope to see the day when I can + create a buffer with more than INT_MAX characters, without having + XEmacs slow down to a crawl. I also hope to be able to create a + list with more than INT_MAX cons cells. + + * redisplay.c (decode_mode_spec): + The %p and %P specs in the mode line were not correct for buffers + larger than MAX_INT/100! The %p spec was off by .5% even for + small buffers! + +1999-09-27 Martin Buchholz <martin@xemacs.org> + + * cmdloop.c (num_input_keys): + * print.c (debug_temp): + * emacs.c (Vinfo_directory): + Delete unused variables + + * console-x.h (x_interline_space): Mark as unimplemented. + * redisplay-x.c (x_interline_space): Mark as unimplemented. + + * event-Xt.c (pending_timeouts): + * linuxplay.c (linuxplay_sndbuf): + * profile.c (QS*): + * search.c (searchbufs): + * specifier.c (specifier_type_entry_dynarr): + * undo.c (pending_boundary): + * event-stream.c (the_low_level_timeout_blocktype): + * extents.c (gap_array_marker_freelist): + * extents.c (extent_list_marker_freelist): + * print.c (being_printed): + * print.c (alternate_do_pointer): + * alloc.c (first_string_chars_block): + * alloc.c (current_string_chars_block): + * emacs.c (initial_argv): + * emacs.c (initial_argc): + * eval.c (lisp_eval_depth): + * free-hook.c (pointer_table): + * free-hook.c (free_queue): + * free-hook.c (current_free): + * free-hook.c (strict_free_check): + * redisplay.c (formatted_string_emchar_dynarr): + * redisplay.c (formatted_string_display_line): + * redisplay.c (formatted_string_extent_dynarr): + * redisplay.c (formatted_string_extent_start_dynarr): + * redisplay.c (formatted_string_extent_end_dynarr): + * redisplay.c (updating_line_start_cache): + * redisplay.c (last_display_warning_tick): + * redisplay.c (display_warning_tick): + * redisplay.c (internal_cache): + * window.c (Vwindow_configuration_free_list): + Make static. + + * redisplay.c (Vinitial_window_system): Make CONST. + +1999-09-24 Martin Buchholz <martin@xemacs.org> + + * redisplay-tty.c (term_get_fkeys_1): Minor aesthetic improvements. + + * doprnt.c (get_doprnt_args): Use int, not short, with va_arg. + +1999-09-24 Andy Piper <andy@xemacs.org> + + * redisplay-output.c (output_display_line): only clear the borders + if we are not displaying the gutter. + +1999-09-24 Jan Vroonhof <vroonhof@math.ethz.ch> + + * frame-x.c (x_any_window_to_frame): Let Xt find the widget and + then use x_any_widget_or_parent_to_frame(). + (x_find_frame_for_window): remove special cases. + +1999-09-24 Andy Piper <andy@xemacs.org> + + * scrollbar-x.c (x_window_is_scrollbar): deleted. + * scrollbar-x.h: ditto. + +1999-09-23 Martin Buchholz <martin@xemacs.org> + + * alloc.c (this_marks_a_marked_record): Remove. + + * buffer.c (mark_buffer): + * buffer.c (nuke_all_buffer_slots): + * console.c (mark_console): + * console.c (nuke_all_console_slots): + * frame.c (mark_frame): + * frame.c (nuke_all_frame_slots): + Treat MARKED_SLOT() macros consistently. + + * device.h (error_check_device_type): + * faces.c (face_getprop): + * fileio.c (DRIVE_LETTER): + * filelock.c (lock_file_1): + * frame-x.c (x_create_widgets): + * frame.h (error_check_frame_type): + * keymap.c (print_keymap): + * keymap.c (Fkey_description): + * keymap.c (where_is_recursive_mapper): + * mule-charset.h (CHARSET_LEADING_BYTE): + * objects-msw.c (mswindows_color_instance_hash): + * objects.c (color_instance_equal): + * objects.h (struct color_specifier): + * objects.h (struct font_specifier): + * objects.h (struct face_boolean_specifier): + * opaque.h (get_opaque_ptr): + * opaque.h (set_opaque_ptr): + * process-unix.c (set_socket_nonblocking_maybe): + * specifier.h (SPECIFIER_TYPE_P): + * symbols.c (store_symval_forwarding): + * syssignal.h (EMACS_KILLPG): + * terminfo.c (emacs_tparam): + * glyphs.c (glyph_putprop): + * glyphs.c (glyph_remprop): + * glyphs.c (Fimage_instance_subwindow_id): + * window.c (mark_window): + * window.c (mark_window_config): + * window.c (Fset_window_configuration): + * window.c (save_window_save): + * eval.c (Fuser_variable_p): + * eval.c (Fcommand_execute): + * eval.c (Feval): + * eval.c (Ffuncall): + * lisp.h (XPNTR): + * lisp.h (INT_OR_FLOATP): + * lisp.h (GC_INT_OR_FLOATP): + * lisp.h (XFLOATINT): + * lisp.h (IS_ANY_SEP): + * mule-ccl.c (Fccl_execute): + * mule-ccl.c (Fccl_execute_on_string): + * redisplay-x.c (x_output_string): + Remove redundant extra parentheses. + +1999-09-22 Martin Buchholz <martin@xemacs.org> + + * chartab.c (word_boundary_p): Add prototype for warning avoidance. + * eval.c (PRIMITIVE_FUNCALL): ANSIfy + * free-hook.c (fun_ptr): ANSIfy + * getloadavg.c: Remove declaration for errno. + * gui.c (allocate_gui_item): ANSIfy + * gui.h (allocate_gui_item): ANSIfy + * mule-ccl.c (resolve_symbol_ccl_program): Make static + * realpath.c: Remove K&R support. + * redisplay-x.c (x_output_display_block): Don't shadow previous local + * glyphs-widget.c (layout_instantiate): Don't shadow previous local + * gutter.c (get_gutter_coords): Make static. + * lread.c (locate_file_map_suffixes): Make static. + * ralloc.c (relinquish): ANSIfy + * redisplay.c: + * lisp.h: + Move prototypes from redisplay.c to lisp.h + +1999-09-22 Martin Buchholz <martin@xemacs.org> + + * glyphs-x.c (x_widget_set_property): + - Remove unnecessary initialization. + - Use char*, not Bufbyte *, with GET_C_STRING_OS_DATA_ALLOCA + * glyphs-x.c (x_widget_instantiate): + - Use char*, not Bufbyte *, with GET_C_STRING_OS_DATA_ALLOCA + * unexelf.c (unexec): + Add cast for C++ compilability. + * redisplay.h: + Fix a typo. + * ralloc.c (r_alloc_reinit): + SET_FUN_PTR was broken wrt ANSI aliasing! + To compensate, use __typeof__ when using gcc, else live with + possible (but rare) warnings. + * ralloc.c (init_ralloc): + Ditto + * ralloc.c: Use the real dlmalloc prototype for __morecore. + * lread.c (locate_file_map_suffixes): + * input-method-xlib.c (XIM_init_frame): + - Xlib functions should use XPointer, not XtPointer. + * input-method-xlib.c (XIM_delete_frame): + - Xlib functions should use XPointer, not XtPointer. + * input-method-xlib.c (IMDestroyCallback): + - Simplify. + - XFRAME (obj) can never be NULL, so don't test for it. + * gutter.h: + Add GUTTER_POS_LOOP for iterating over all gutter_pos'es + * gutter.c (SET_GUTTER_WAS_VISIBLE_FLAG): + Run c-backslash-region on macro body. + * gutter.c (gutter_was_visible): + Remove redundant parens - this is not a macro. + * gutter.c (redraw_exposed_gutters): + Use GUTTER_POS_LOOP. + * gutter.c (gutter_specs_changed): + Use GUTTER_POS_LOOP. + * gutter.c (gutter_geometry_changed_in_window): + Use GUTTER_POS_LOOP. + * gutter.c (update_frame_gutters): + Use GUTTER_POS_LOOP. + * gutter.c (init_frame_gutters): + Use GUTTER_POS_LOOP. + * file-coding.c (determine_real_coding_system): + Fix C++ compile error. + * emodules.c (find_make_module): + Cast return value from xrealloc + * emacs.c (Fkill_emacs): + Use __typeof__, when available. + * emacs.c (voodoo_free_hook): + Use __typeof__, when available. + (Unfortunately, the type of __free_hook is glibc-version-dependent) + * dired.c (user_cache): Use Bufbyte *, not char * + * dired.c (Fuser_name_all_completions): Ditto. + +1999-09-22 Andy Piper <andy@xemacs.org> + + * redisplay.c (redisplay_frame): reset the gutter display lines + when we reset the subwindows. + + * gutter.c (reset_gutter_display_lines): new function. + + * window.c (Flast_nonminibuf_window): new function equivalent to + FRAME_LAST_NONMINIBUF_WINDOW (). + (syms_of_window): declare it. + + * redisplay.c (create_string_text_block): don't add bogus eol + markers to gutter display lines. + + * glyphs.c (reset_subwindow_cachels): make sure we unmap + subwindows using unmap_subwindow so that expose events get + registered correctly. + + * window.c (window_scroll): use Vwindow_pixel_scroll_increment to + determine how much to scroll the window. + (vars_of_window): Vwindow_pixel_scroll_increment is a new + variable. + +1999-09-20 Robert Pluim <rpluim@nortelnetworks.com> + + * glyphs-x.c (update_widget_face): Guard fontList declaration for + non-motif uses. + +1999-09-20 Andy Piper <andy@xemacs.org> + + * glyphs-msw.c (mswindows_update_subwindow): update faces. + +1999-09-19 Andy Piper <andy@xemacs.org> + + * glyphs.c (update_frame_subwindows): update if faces have + changed. + + * glyphs-x.c (x_widget_instantiate): create the clip widget using + lwlib rather than directly. + (x_finalize_image_instance): delete the clip widget using lwlib. + (x_update_subwindow): update widget faces. + (update_widget_face): new function for updating the face + properties of a widget. + (x_widget_set_property): update widget faces. + + * lwlib-Xlw.c (xlw_create_clip_window): new function. We need to + manage the clip widgets using lwlib so that we can delete them in + a safe manner. + +1999-09-16 Martin Buchholz <martin@xemacs.org> + + * lisp-union.h: + * lisp-disunion.h: + Define new, potentially faster INT arithmetic macros + INT_PLUS, INT_MINUS, INT_PLUS1, INT_MINUS1 + * bytecode.c (execute_optimized_function): + Use new macros. + Fix metering code + * bytecode.c (bytecode_negate): + Optimize for integer case. + +1999-08-29 Andreas Jaeger <aj@arthur.rhein-neckar.de> + + * m/mips.h: Support for mips-linux: Add !linux around places + that are not valid for linux, define TEXT_START, DATA_START, + DATA_SEG_BITS. + +1999-09-16 Andy Piper <andy@xemacs.org> + + * redisplay-output.c (redisplay_output_subwindow): clip subwindows + that don't completely fit on-screen rather than just unmapping + them. + + * glyphs.h: change signature of map_subwindow. + + * glyphs.c (map_subwindow): add display_glyph_area to the + signature. make sure the mapped area saved in the subwindow_cachel + reflects this. + (Fforce_subwindow_map): make a no-op. I don't think this does + anything useful. + + * glyphs-x.h (struct x_subwindow_data): save the Display rather + than the Screen. Add a clipwindow and clipwidget handle. + (IMAGE_INSTANCE_X_CLIPWINDOW): new accessor. + (IMAGE_INSTANCE_X_CLIPWIDGET): ditto. + (XIMAGE_INSTANCE_X_CLIPWIDGET): ditto. + (XIMAGE_INSTANCE_X_CLIPWINDOW): ditto. + + * glyphs-x.c (x_finalize_image_instance): destroy the clipwidget + as well as the widget itself. + (x_unmap_subwindow): unmap the clipwindow and clipwidget rather + than the widgets and subwindows themselves. move the widget inside + the clipwidget. + (x_subwindow_instantiate): hold onto the Display rather than the + Screen. allocate a clipwindow to put the subwindow inside. + (x_resize_subwindow): use saved Display directly. + (x_widget_instantiate): allocate a clipwidget of type EmacsManager + to put widgets inside. + + * glyphs-widget.c: remove group stuff. + + * glyphs-msw.h (struct mswindows_subwindow_data): new structure to + hold the clipwindow. + (IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW): new accessor. + (XIMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW): ditto. + + * glyphs-msw.c: remove group stuff. + (mswindows_finalize_image_instance): destroy clipwindow as well as + the widget itself. + (mswindows_unmap_subwindow): unmap the clipwindow rather than the + widget. + (mswindows_map_subwindow): ditto. move the widget within the + clipwindow. + (mswindows_subwindow_instantiate): allocate and initialize + mswindows_subwindow_data. allocate a clipwindow with the subwindow + as a child. + (mswindows_widget_instantiate): ditto. + (mswindows_control_wnd_proc): new function that allows us to + propagate events from the widget to the main windows control loop. + + * device-msw.c (mswindows_init_device): register new widget clip window + class. + + * console.h (struct console_methods): add display_glyph_area to + map_window. + + * console-msw.h: declare new window class and wnd proc for + widgets. + +1999-09-14 Martin Buchholz <martin@xemacs.org> + + * general.c: + * eldap.c: + Move symbols used only by eldap.c into eldap.c as statics. + +1999-09-09 Martin Buchholz <martin@xemacs.org> + + * window.c (syms_of_window): + * symbols.c (syms_of_symbols): + * redisplay.c (syms_of_redisplay): + * print.c (syms_of_print): + * lisp.h: + * intl.c (syms_of_intl): + * general.c (syms_of_general): + * frame.c (syms_of_frame): + * fileio.c (syms_of_fileio): + * file-coding.h: + * file-coding.c (syms_of_file_coding): + * extents.c (syms_of_extents): + * event-stream.c (syms_of_event_stream): + * event-stream.c (Fnext_event): + * device.c (syms_of_device): + * data.c (syms_of_data): + * casetab.c (syms_of_casetab): + * casetab.c (check_case_table): + * callint.c (syms_of_callint): + * buffer.c (syms_of_buffer): + Delete unused C symbols: + Qbuffer_file_name, Qbuffer_undo_list, Quser_variable_p, + Qcurrent_prefix_arg, Qtranslate_table, Qkeywordp, + Qnumber_or_marker_p, Qcons, Qkeyword, Qignore, Qdelete_device, + Qcommand_execute, Qglyph_invisible, + Qbuffer_file_coding_system, Qfile_name_handler_alist, + Qframe_x_p, Qframe_tty_p, Qblack, Qkeyboard, Qmenubar, Qpath, + Qvector, Qwhite, Qcase, Qdomain, Qalternate_debugging_output, + Qprint_escape_newlines, Qprint_readably, Qfloat_output_format, + Qwindow_scroll_functions, Qfboundp, Qscroll_up, Qscroll_down + + Rename symbols as required by the CHECK_RECORD macro: + - Qcase_table_p to Qcase_tablep + - Qcoding_system_p to Qcoding_systemp + + * debug.h: + * debug.c (syms_of_debug): + Make debug.c's internal Lisp_Objects static. + + * events.c (vars_of_events): + * events.c (syms_of_events): + Use regular old defsymbol instead of KEYSYM + staticpro(). + + * select-x.c (CHECK_CUTBUFFER): + Rewrite in accordance with coding standards. + + * keymap.c (syms_of_keymap): + Use SPC in the same way as RET, TAB, etc. + +1999-08-27 Jan Vroonhof <vroonhof@math.ethz.ch> + + * xemacs-20/src/menubar-x.c (make_dummy_xbutton_event): Don't add + offset twice if HAVE_WMCOMMAND is defined. + +1999-09-13 Mike McEwan <mike@lotusland.demon.co.uk> + + * redisplay-x.c (x_output_vertical_divider): make sure + shadow_thickness is positive. + +1999-09-10 Julian Back <jback@rudd.compulink.co.uk> + + * process-nt.c (nt_create_process): fixup to cope with + Vprocess_environment. + +1999-09-02 Andy Piper <andy@xemacs.org> + + * redisplay-output.c (redisplay_output_layout): call output + routines with clear_clip false. output layout borders with text + correctly. + + * redisplay-msw.c (mswindows_output_blank): call output routines + with clear_clip true. + (mswindows_output_string): ditto. + (mswindows_output_display_block): ditto. + + * redisplay-x.c (x_output_display_block): call output routines + with clear_clip true. + + * redisplay.h: fix output routines for clear_clip parameter. + + * redisplay-output.c (redisplay_output_layout): cope with glyphs + in the border. + + * glyphs-widget.c (layout_instantiate): deal with border glyphs. + (check_valid_glyph_or_instantiator): renamed from + check_valid_glyph_or_image. + (check_valid_border): allow glyphs or their instantiators. + (check_valid_glyph_or_instantiator_list): renamed from + check_valid_glyph_or_image_list, + (glyph_instantiator_to_glyph): new function. make sure a glyph is + a glyph and not an instantiator. + (substitute_keyword_value): new function. replace a keyword value + with a new one. + +1999-09-01 Andy Piper <andy@xemacs.org> + + * glyphs.c (string_set_property): new function to set the data of + a string. + (image_instantiator_format_create): use it. + +1999-09-07 Hrvoje Niksic <hniksic@srce.hr> + + * fns.c (Fmapc): Rename back to Fmapc_internal. + +1999-07-30 Gleb Arshinov <gleb@cs.stanford.edu> + + * ntheap.h: CONST (semantically constant) name field of file_data + struct + + * unexnt.c (open_output_file): match function definition with + function declaration + + * editfns.c: #include "sysfile.h" for getcwd() prototype + + * gif_io.c: #include "sysfile.h" for close() prototype + +1999-09-02 Martin Buchholz <martin@xemacs.org> + + * elhash.c: + * elhash.h: + Change the :type keyword to :weakness, for compatibility with the + GNU Emacs 20.5 hash table implementation. + Keep (but don't document) the :type keyword for compatibility. + Obsolete function hash-table-type + General cleanup. + Define function sxhash for compatibility with Common Lisp and GNU Emacs. + +1999-09-01 Martin Buchholz <martin@xemacs.org> + + * floatfns.c (arith_error): + * floatfns.c (range_error): + * floatfns.c (range_error2): + * floatfns.c (domain_error): + * floatfns.c (domain_error2): + * lrecord.h (LRECORDP): + * console-x.h (X_ERROR_OCCURRED): + * console-x.h (HANDLING_X_ERROR): + * chartab.c (CATEGORYP): + * buffer.h (XCHAR_OR_CHAR_INT): + Remove redundant and confusing parentheses. + + * redisplay-output.c (redisplay_clear_to_window_end): + Remove redundant initialization. + + * redisplay.h: + * redisplay-msw.c: + * redisplay-x.c: + Move declarations of bevel_modeline() into redisplay.h. + +1999-08-30 Olivier Galibert <galibert@pobox.com> + + * lisp.h: Add staticpro_nodump for undumped staticpro-ing. + * alloc.c: Add staticpro_nodump for undumped staticpro-ing. Add + alignment information for dumped data. Enhance + descriptions. Phase out Vterminal_* variables while + dumping. + * lrecord.h: Add chained descriptions and automagically-reset + lisp_objects to the description system. + + * console-stream.h: Declare the Vterminal_* variables. + + * buffer.c: Don't dump Vbuffer_alist, Vbuffer_defaults and + Vbuffer_local_symbols. + * console.c: Don't dump Vconsole_list, Vconsole_defaults and + Vconsole_local_symbols. + * eval.c: Don't dump Qunbound_suspended_errors_tag. + * lread.c: Don't dump Vread_buffer_stream. + * lstream.c: Don't dump Vlstream_free_list[]. + * search.c: Don't dump last_thing_searched. + * window.c: Don't dump minibuf_window and + Vwindow_configuration_free_list[]. + + * faces.c: Add face description. + * fns.c: Add bit_vector description. + * glyphs.c: Add image specifier description. + * objects.c: Add color, face and face boolean specifiers descriptions. + * opaque.c: Add opaque description. Don't dump Vopaque_ptr_free_list. + * rangetab.c: Add range table description. + * specifier.c: Add specifier and specifier methods description. + * specifier.h: Add specifier extra description support. + + * symbols.c: Fix symbol_value_buffer_local_description. + + * gdbinit (Lisp): Add opaque_ptr, remove opaque_list. + +1999-09-02 Hrvoje Niksic <hniksic@srce.hr> + + * extents.c (extent_remprop): Get extent's plist address + correctly. + +1999-08-31 Andy Piper <andy@xemacs.org> + + * xmu.h: define Xmu/Converters.h things. + +1999-08-31 Andy Piper <andy@xemacs.org> + + * opaque.c (equal_opaque_ptr): define. + (hash_opaque_ptr): define. + + * xmu.h: define Xmu/Misc.h things. + +1999-08-17 MORIOKA Tomohiko <tomo@etl.go.jp> + + * file-coding.c (determine_real_coding_system): Treat `coding:' + cookie. + +1999-08-16 MORIOKA Tomohiko <tomo@etl.go.jp> + + * file-coding.c (struct decoding_stream): New member `counter'. + (reset_decoding_stream): Initialize `counter'. + (decode_coding_ucs4): Use `counter'. + (decode_coding_utf8): Likewise. + +1999-08-31 Andy Piper <andy@xemacs.org> + + * redisplay-output.c (redisplay_normalize_glyph_area): make sure + the clip offset doesn't exceed the height we have available to + show. + + * window.h (struct window): add top_yoffset and left_xoffset for + pixel scrolling. + (WINDOW_TEXT_TOP_CLIP): new macro. + + * window.c (window_scroll): add behaviour for pixel-scrolling of + tall lines. + + * redisplay.h (struct display_line): add top_clip. + (DISPLAY_LINE_HEIGHT): adjust for top_clip. + (DISPLAY_LINE_YPOS): ditto. + + * redisplay.c (position_redisplay_data_type): add + start_col_xoffset to prepare for pixel-based h-scrolling. + (WINDOW_SCROLLED): new macro. + (next_tab_position): use it. + (add_glyph_rune): use new hscoll vars. + (create_text_block): ditto. + (generate_displayable_area): adjust off-by-one error. + (regenerate_window): take top_clip into account. + (regenerate_window_extents_only_changed): ditto. + (regenerate_window_incrementally): ditto. + + * redisplay-x.c (x_output_display_block): use DISPLAY_LINE_YPOS, + DISPLAY_LINE_HEIGHT and DISPLAY_LINE_YEND macros. + (x_output_string): ditto. + (x_output_blank): ditto. + (x_output_hline): ditto. + (x_output_eol_cursor): ditto. + + * redisplay-output.c (output_display_line): allow for + top_clip. use DISPLAY_LINE_YPOS, DISPLAY_LINE_HEIGHT and + DISPLAY_LINE_YEND macros. + (redisplay_output_layout): output strings in layouts correctly. + (redisplay_clear_clipped_region): allow for top_clip. + (redisplay_calculate_display_boxes): ditto. + + * redisplay-msw.c (mswindows_output_blank): use DISPLAY_LINE_YPOS, + DISPLAY_LINE_HEIGHT and DISPLAY_LINE_YEND macros. + (mswindows_output_cursor): ditto. + (mswindows_output_string): ditto. + (mswindows_redraw_exposed_window): ditto. + (mswindows_output_display_block): ditto. + + * gutter.c: new specifier type gutter-size. + (gutter_size_validate): validate gutter-size specifier. + (Fgutter_size_specifier_p): predicate for gutter-size. + (Fredisplay_gutter_area): allow the gutter area to be redisplayed + under user contol, like Fredisplay_echo_area. + (syms_of_gutter): add new functions. + (specifier_type_create_gutter): add new specifier. + (specifier_vars_of_gutter): change specifier types of *-height to + gutter-size. + + * glyphs.c (glyph_width): make work with image instances. + + * console.h (struct console_methods): change api of output_string. + + * glyphs-x.c (x_map_subwindow): move before mapping as reported by + Stephen J. Turnbull <turnbull@sk.tsukuba.ac.jp> + +1999-08-30 Andy Piper <andy@xemacs.org> + + * glyphs-x.c (x_finalize_image_instance): X_MASK -> PIXMAP_MASK + for assignment. + (init_image_instance_from_x_image): ditto. + (x_xpm_instantiate): ditto. + (x_colorize_image_instance): ditto. Reported by Richard Cognot + <cognot@ensg.u-nancy.fr> + +1999-08-29 Andy Piper <andy@xemacs.org> + + * glyphs-x.c (x_widget_instantiate): move font initialisation so + that it doesn't get saved in the user defined args. + (x_tab_control_instantiate): Set the fg color of the tab's + children. + (x_tab_control_set_property): ditto. + +1999-08-27 Damon Lipparelli <lipp@primus.com> + + * events.h (XTIMEOUT): must preface Lisp_Timeout with ``struct'' + (XSETTIMEOUT): fixup typo + +1999-08-11 Jan Vroonhof <vroonhof@math.ethz.ch> + + * syntax.c (scan_words): Unified Mule and Non-mule scanning. + Word boundary search looks back instead of forward so that it + doesn't peek over the limit. + +1999-08-20 Olivier Galibert <galibert@pobox.com> + + * config.h.in: Add PDUMP define. + * emacs.c (Fdump_emacs): Hackish, call pdump() if configured in. + + * lrecord.h: Enhance description system. + * alloc.c: Fix vector and string description. Add portable + dumper enumeration fonctions. + + * symbols.c: Fix symbols description. Add symbol_value_forward + description. + * eval.c: Add subr description. + * elhash.c (CLEAR_HENTRY): Clean value pointer too. Fix hash + table description. + (remhash_1): CLEAR_HENTRY evaluates the parameter two times now. + +1999-08-20 Olivier Galibert <galibert@pobox.com> + + * opaque.c: Kill opaque lists, make Lisp_Opaque_Ptr a lrecord of + its own. + * opaque.h: Ditto. + + * eval.c (eval_in_buffer_trapping_errors): + (run_hook_trapping_errors): + (safe_run_hook_trapping_errors): + (call0_trapping_errors): + (call1_trapping_errors): + (call2_trapping_errors): OPAQUEP -> OPAQUE_PTRP. make_opaque_ptr + now takes a non-const void *. + +1999-08-20 Olivier Galibert <galibert@pobox.com> + + * opaque.c: Remove make_opaque_long. + + * opaque.h: Remove everything opaque_long related. + + * eval.c (vars_of_eval): Make Qunbound_suspended_errors_tag an + opaque_ptr. + + * emacs.c (main_1): Remove make_opaque_long from comment. + +1999-08-20 Olivier Galibert <galibert@pobox.com> + + * event-stream.c (mark_timeout): + (print_timeout): + (event_stream_generate_wakeup): + (event_stream_resignal_wakeup): + (event_stream_disable_wakeup): + (event_stream_wakeup_pending_p): + (vars_of_event_stream): Lisp_Timeout is now a lrecord. + + * events.h (struct Lisp_Timeout): Added. + +1999-08-24 Andy Piper <andy@xemacs.org> + + * console-x.h: declare new pixmap signatures. + +1999-08-23 Andy Piper <andy@xemacs.org> + + * glyphs-x.c (x_update_subwindow): make sure the widget size is + maintained after an update. + + * event-Xt.c (emacs_Xt_handle_magic_event): use + find_matching_subwindow to check whether the exposure is totally + inside a subwindow, if it is then ignore it. + + * glyphs.c (find_matching_subwindow): new function. + + * toolbar-x.c (x_draw_blank_toolbar_button): use new + x_output_shadows signature. + (x_output_toolbar_button): use new x_output_x_pixmap signature. + + * redisplay.h (struct display_box): new structure. + (struct display_glyph_area): ditto. + declare new display_box functions. + + * redisplay-x.c (x_output_pixmap): update for new display + box stuff. + (x_bevel_area): update to allow multiple edge styles and border + segments. + (x_output_display_block): update for new display_box stuff and + signatures. + (x_clear_region): ditto. + (x_output_x_pixmap): ditto. adjust offsets rather than clip. + (console_type_create_redisplay_x): declare new console methods. + (x_output_vertical_divider): update for new bevel_area signature. + (x_output_shadows): update to allow selective drawing of edges. + + * redisplay-tty.c (tty_output_display_block): do nothing for + layouts. + + * redisplay-output.c (redisplay_output_subwindow): convert to use + display_box structure, this allows us to put subwindows anywhere + with any offset, useful for layout glyphs. + (redisplay_output_layout): new function. output a layout and its + sub-glyphs. + (redisplay_output_pixmap): new modular function combining generic + parts of the X and mswindows versions. convert to use display_box + structures. + (redisplay_clear_clipped_region): new function. clear the area a + glyph is going into. + (redisplay_normalize_glyph_area): new function. calculate the + bounds of a display_glyph_area given a display_box. + (redisplay_normalize_display_box): new function. shrink a + display_box to enclose a display_glyph_area. + (redisplay_display_boxes_in_window_p): check whether the input + display_box and display_glyph_area are actually in a window. + (redisplay_calculate_display_boxes): calculate display boxes based + on conventional display_line metrics. + (bevel_modeline): update for new bevel_area signature. + + * redisplay-msw.c (mswindows_output_blank): update for new + display_box stuff. + (mswindows_output_string): ditto. + (mswindows_output_dibitmap): ditto. + (mswindows_output_dibitmap_region): ditto. + (mswindows_output_pixmap): ditto. + (mswindows_bevel_area): update to allow multiple edge styles and + border segments. + (mswindows_output_display_block): update for new display_box stuff + and signatures. + (mswindows_clear_region): ditto. + (console_type_create_redisplay_mswindows): declare new console methods. + + * lisp.h (edge_style): new enum. + declare display_box and display_glyph_area. + + * gutter.c (output_gutter): update for new bevel_area signature. + + * glyphs.h (image_instance_type): add layout. + (IMAGE_LAYOUT_MASK): ditto. + (LAYOUT_IMAGE_INSTANCEP): new macro. + (CHECK_LAYOUT_IMAGE_INSTANCE): ditto. + (struct Lisp_Image_Instance): add offsets for layout and the + layout type itself. move mask here also. + (IMAGE_INSTANCE_LAYOUT_CHILDREN): new macro. + (IMAGE_INSTANCE_LAYOUT_BORDER): ditto. + (XIMAGE_INSTANCE_LAYOUT_CHILDREN): ditto. + (XIMAGE_INSTANCE_LAYOUT_BORDER): ditto. + + * glyphs.c (mark_image_instance): update for layouts. + (print_image_instance): ditto. + (image_instance_equal): ditto. + (image_instance_hash): ditto. + (allocate_image_instance): initialise offsets for layout. + (decode_image_instance_type): update for layouts. + (encode_image_instance_type): ditto. + (Fimage_instance_height): ditto. + (Fimage_instance_width): ditto. + (allocate_glyph): ditto. + (glyph_width): allow image instances as an argument. update for layouts. + (glyph_height_internal): ditto. + (syms_of_glyphs): add layout symbols. + + * glyphs-x.h (struct x_image_instance_data): remove mask entry. + (IMAGE_INSTANCE_X_MASK): update. + + * glyphs-x.c (x_label_instantiate): new function. instantiate a + label. + (image_instantiator_format_create_glyphs_x): initialise new layout + glyph type. + + * glyphs-widget.c: new layout type. + (check_valid_orientation): new keyword checker for layouts. + (check_valid_justification): ditto. + (check_valid_border): ditto. + (check_valid_glyph_or_image_list): ditto. + (layout_possible_dest_types): new function for layout glyph type. + (layout_normalize): ditto. + (layout_instantiate): ditto. + (syms_of_glyphs_widget): new keywords for layout. + (image_instantiator_format_create_glyphs_widget): initialise the + layout glyph type. + + * glyphs-msw.h (struct mswindows_image_instance_data): remove mask + argument. + (IMAGE_INSTANCE_MSWINDOWS_MASK): update. + + * glyphs-msw.c: declare layout format. + (image_instantiator_format_create_glyphs_mswindows): initialise it. + + * general.c: new symbols for layouts. + + * console.h (struct console_methods): new console methods for + outputting pixmaps and strings. + +1999-08-23 Didier Verna <verna@inf.enst.fr> + + * sound.c: revert the renaming of `bell_volume' to `Vbell_volume' + and `bell_inhibit_time' to `Vbell_inhibit_time'. + +1999-08-18 Andy Piper <andy@xemacs.org> + + * redisplay-output.c (redisplay_output_subwindow): disable + clipping attempt. + +1999-08-17 Andy Piper <andy@xemacs.org> + + * gutter.c (redraw_exposed_gutter): handle degenerate case of no + area to expose or no gutter to display. + +1999-08-16 Charles G Waldman <cgw@fnal.gov> + + * sound.c: rename `bell_volume' to `Vbell_volume' and + `bell_inhibit_time' to `Vbell_inhibit_time'. + +1999-08-13 Charles G Waldman <cgw@fnal.gov> + + * sound.c: (bell-inhibit-time): New variable. + (ding): Use it. + (sound-alist): Fix docstring. + +1999-08-17 Andy Piper <andy@xemacs.org> + + * gui-x.c (button_item_to_widget_value): xstrdup name so that + deleting it is ok. + +1999-08-16 Jeff Miller <jmiller@smart.net> + + * syntax.c (scan_words): make compile. + +1999-08-16 Andy Piper <andy@xemacs.org> + + * redisplay-output.c (redisplay_output_subwindow): try and be more + relaxed about clipping possibilities. + + * glyphs-x.c (x_tab_control_set_property): free_widget_value_tree + rather than just the widget_value. + (x_update_subwindow): ditto. + (x_widget_instantiate): ditto. + + * gutter.c (output_gutter): shrink current display lines if + required. + +1999-08-15 Andy Piper <andy@xemacs.org> + + * redisplay.h: declare free_display_lines. + + * redisplay.c (free_display_lines): make non-static. + + * gutter.c (free_frame_gutters): use free_display_lines instead of + Dynarr_free. + (calculate_gutter_size): ditto. + +1999-08-12 Jan Vroonhof <vroonhof@math.ethz.ch> + + * eval.c (run_hook_with_args_in_buffer): GCPRO globals. + +1999-08-14 Andy Piper <andy@xemacs.org> + + * glyphs.c (update_subwindow_cachel): make it less brittle. + +1999-08-04 Mike Woolley <mike@bulsara.com> + + * scrollbar-msw.c (mswindows_handle_mousewheel_event): Fixed + problem in wheelmouse code occurring when the horizontal scrollbar + is enabled but not visible. + +1999-08-08 Andy Piper <andyp@beasys.com> + + * toolbar-msw.c (mswindows_redraw_frame_toolbars): new function. + (console_type_create_toolbar_mswindows): use it. + + * glyphs.c (Fset_image_instance_property): fiddly reorganisation. + + * redisplay-output.c (redisplay_output_display_block): unmap + subwindows in the block area before outputting the block. + + * event-msw.c (mswindows_wnd_proc): check the update rect before + painting and disable expose registration while painting. + + * glyphs.c (register_ignored_expose): check + hold_ignored_expose_registration before registering expose events. + + * redisplay.c (redisplay_frame): reset the subwindow cache before + displaying the gutter. + + * glyphs-msw.c (mswindows_map_subwindow): move the window before + mapping. + + * gutter.c (update_frame_gutters): check for glyphs_changed as if + it is the subwindow cache will have been reset. + +1999-08-06 Andy Piper <andyp@beasys.com> + + * gui-x.c (button_item_to_widget_value): cope with strings. + + * glyphs.h: declare global widget functions. + (IIFORMAT_HAS_SHARED_DEVMETHOD): new macro. + + * glyphs-x.c (x_combo_box_instantiate): do generic initialization + here. remove dead code. + (image_instantiator_format_create_glyphs_x): enable combo boxes + for Motif 2.0. + + * glyphs-widget.c (widget_instantiate_1): make non-static. + (tree_view_instantiate): renamed from combo_box_instantiate. + (image_instantiator_format_create_glyphs_widget): use new/changed methods. + + * glyphs-msw.c (mswindows_combo_box_instantiate): do generic + initialization here. + + * lwlib-Xm.c (xm_update_combo_box): new function. + (xm_update_one_widget): call it. + (xm_update_one_value): deal with combo boxes as well as lists. + (xm_create_combo_box): create a drop-down combo box. + + * toolbar-msw.c (mswindows_output_toolbar): call + mswindows_move_toolbar. + +1999-08-05 Andy Piper <andyp@beasys.com> + + * window.c (Fcurrent_pixel_column): new function. use display + lines to calculate pixel position of point. + * window.c (syms_of_window): declare it. + +1999-08-05 Andy Piper <andy@xemacs.org> + + * glyphs.c (check_for_ignored_expose): ignore exposures wholly + contained in our ignore list. + + * buffer.c (Frecord_buffer): add call to record-buffer-hook. + (syms_of_buffer): declare record-buffer-hook. + + * s/mingw32.h: define mousewheel things. + +1999-08-04 Mike Woolley <mike@bulsara.com> + + * windowsnt.h (_WIN32_WINNT): enable for win95 + + * s/cygwin32.h: define mousewheel things. + + * scrollbar-msw.h: declare mousewheel handler. + + * scrollbar-msw.c (mswindows_handle_mousewheel_event): new function. + +1999-08-04 Andy Piper <andy@xemacs.org> + + * gui-x.c (gui_items_to_widget_values): remove unused variable. + (gui_items_to_widget_values_1): ditto. + + * gui-x.h: unconditionally define since it is used everywhere. + +1999-08-04 Andy Piper <andy@xemacs.org> + + * glyphs-x.c (x_finalize_image_instance): only free pixels if we + have that type of image. + +1999-07-30 Andy Piper <andy@xemacs.org> + + * redisplay-output.c (redisplay_unmap_subwindows): add comparison + subwindow to not unmap if required. + (redisplay_unmap_subwindows_maybe): comparison is Qnil. + (redisplay_unmap_subwindows_except_us): new function. + (redisplay_output_subwindow): use it to unmap windows in the area + we are displaying into. + + * glyphs.c (update_subwindow_cachel_data): always update as we + only ever get called when an update is required. + (update_subwindow_cachel): new function. sync a subwindow with its + cachel. + (Fresize_subwindow): use it. + (register_ignored_expose): make sure we set the tail correctly. + +1999-07-28 Andy Piper <andy@xemacs.org> + + * redisplay-output.c (redisplay_clear_bottom_of_window): remove + unneeded device. + + * gutter.c (redraw_exposed_gutter): unmap subwindows from the + whole gutter. + + * gui.h: declare parse_gui_item_tree_list and + parse_gui_item_tree_children. + + * gui.c (parse_gui_item_tree_item): new function for parsing item + lists into gui-item trees. + (parse_gui_item_tree_children): ditto. + (parse_gui_item_tree_list): ditto. + + * gui-x.h: declare gui_items_to_widget_values. + + * gui-x.c (gui_items_to_widget_values_1): new function for + recursively parsing gui-items into widget_values. + (gui_item_children_to_widget_values): ditto. + (gui_items_to_widget_values): ditto. + (sanity_check_lwlib): add widgets macrolets. + + * glyphs.h (IMAGE_INSTANCE_WIDGET_ITEMS): rename from *ITEM. + (XIMAGE_INSTANCE_WIDGET_ITEMS): ditto. + (IMAGE_INSTANCE_WIDGET_ITEM): rename from *SINGLE_ITEM. + (XIMAGE_INSTANCE_WIDGET_ITEM): ditto. + (struct expose_ignore): new structure for storing ignorable expose + events. + + * glyphs.c (valid_image_instantiator_format_p): fix so that using + a console-type as a locale works. + (mark_image_instance): ITEM->ITEMS. + (image_instance_equal): ditto. + (image_instance_hash): ditto. + (struct expose_ignore_blocktype): new blocktype. + (check_for_ignored_expose): new function. checks frame exposure + list for events to ignore. + (register_ignored_expose): new function. registers an expose event + as ignorable. + (unmap_subwindow): register the expose event as ignorable. + (vars_of_glyphs): initialise the exposure blocktype. + + * glyphs-x.c (x_finalize_image_instance): use lw_destroy_widget. + (x_update_subwindow): modify all widgets using widget_value tree + rather than just a single widget value. + (x_widget_instantiate): LWLIB_USES_MOTIF -> LWLIB_WIDGETS_MOTIF. + make sure widgets don't resize themselves. + (x_tab_control_instantiate): new function. use lwlib tab functions. + (x_tab_control_set_property): new function. + (image_instantiator_format_create_glyphs_x): add tab_control. + + * glyphs-widget.c (widget_text_to_pixel_conversion): calculate + slightly more sensibly. + (initialize_widget_image_instance): ITEM->ITEMS. + (widget_instantiate_1): parse gui items generically into the ITEMS + entry. + + * glyphs-msw.c (mswindows_update_subwindow): replace + SINGLE_ITEM->ITEM. + (mswindows_register_widget_instance): ditto. + (add_tree_item): modify to use new pre-initialised gui-item + structure. + (add_tab_item): ditto. + (mswindows_tab_control_instantiate): ditto. + (mswindows_tab_control_set_property): ditto. + (image_instantiator_format_create_glyphs_mswindows): predicate + existance of widgets on HAVE_WIDGETS. + + * frame.h (struct frame): add subwindow_exposures variables. + + * frame.c (allocate_frame_core): reset subwindow_exposures links. + + * event-msw.c (mswindows_wnd_proc): check for ignored + expose events before redrawing. + + * event-Xt.c (emacs_Xt_handle_magic_event): check for ignored + expose events before redrawing. + +1999-07-30 SL Baur <steve@xemacs.org> + + * scrollbar-x.c: should include EmacsFrame.h. + From Jeff Miller <jmiller@smart.net> + +1999-07-30 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.19 is released + +1999-07-27 Jeff Miller <jmiller@smart.net> + + * add a "#ifdef HAVE_MENUBARS" wrapper to gui.c around + menubar_show_keybindings. + +1999-07-23 SL Baur <steve@miho> + + * mule-charset.c (syms_of_mule_charset): Delete duplicated + definition of Qccl_program. + + * mule-ccl.h: Make a global declaration of it here. + +1999-07-20 Bob Weiner <weiner@beopen.com> + + * s/sco7.h: Added from rr@sco.com. + +1999-06-25 MORIOKA Tomohiko <tomo@etl.go.jp> + + * mule-ccl.c (ccl_driver): Fix `CCL_WriteMultibyteChar2'. + +1999-06-24 MORIOKA Tomohiko <tomo@etl.go.jp> + + * file-coding.c (mule_decode): Setup `str->ccl.last_block'. + (mule_encode): Likewise. + + * mule-ccl.c (Qccl_program): New variable. + (CCL_SUSPEND): New macro. + (CCL_INVALID_CMD): New macro. + (CCL_READ_CHAR): Don't regard as invalid command while processing + the last block even if input is empty; use + `CCL_STAT_SUSPEND_BY_SRC' instead of `CCL_STAT_SUSPEND'. + (vars_of_mule_ccl): Setup `Qccl_program' and `Qccl_program_idx'. + + * mule-ccl.h (CCL_STAT_SUCCESS): Moved from mule-ccl.c. + (CCL_STAT_SUSPEND_BY_SRC): Imported from Emacs 20.3.10. + (CCL_STAT_SUSPEND_BY_DST): Likewise. + (CCL_STAT_INVALID_CMD): Moved from mule-ccl.c; change value from 2. + (CCL_STAT_QUIT): Moved from mule-ccl.c; change value from 3. + +1999-05-04 Ken'ichi Handa <handa@gnu.org> + + * mule-ccl.h (struct ccl_program): New member stack_idx. + + * mule-ccl.c (ccl_prog_stack_struct): Declare it as static. + (ccl_driver): Setup stack_idx and ccl_prog correctly. Update them + before returing. + (setup_ccl_program): Initialize ccl->stack_idx to 0. + +1998-10-12 Kenichi Handa <handa@etl.go.jp> + + * mule-ccl.c (CCL_DECODE_SJIS, CCL_ENCODE_SJIS): Swap the + definitions. + +1998-08-18 Kenichi Handa <handa@etl.go.jp> + + * mule-ccl.c (CCL_READ_CHAR): If eof is encounterd while + processing the last block, don't just finish but processes eol + block of the current CCL program. + (ccl_driver): Add a new jump label ccl_repeat for the above + change. + +1998-04-15 Kenichi Handa <handa@etl.go.jp> + + * mule-ccl.c: Typo in comments fixed. + (Qccl_program_idx): New variables. + (CCL_ReadMultibyteChar2): Macro name changed from + CCL_ReadMultibyteCharacter. + (CCL_WriteMultibyteChar2): Macro name changed from + CCL_WriteMultibyteChar2. + (ccl_driver): Adjusted for the above changes. + (resolve_symbol_ccl_program): New function. + (Fccl_execute): The arg CCL-PROGRAM can be a symbol of CCL + program. If CCL-PRGRAM is a vector, convert symbols in it to ID + numbers by resolve_symbol_ccl_program. + (Fccl_execute_on_string): Likewise. + (Fregister_ccl_program): If the arg CCL-PRGRAM is a vector, + convert symbols in it to ID numbers by resolve_symbol_ccl_program. + +1998-01-21 Kenichi Handa <handa@etl.go.jp> + + * mule-ccl.h: (struct ccl_program): New member private_state. + + * mule-ccl.c + (CCL_Call): Fix the comment. + (CCL_ReadMultibyteCharacter, CCL_WriteMultibyteCharacter): New + macros for CCL Commands. + (EXCMD): New macro. + (ccl_driver): New case label `CCL_Extension'. + (setup_ccl_program): Initialize the member `private_state' of CCL. + +1999-07-08 Katsumi Yamaoka <yamaoka@jpl.org> + + * keymap.c (copy_keymap_internal): Inherit the default binding. + +1999-07-14 Kazuyuki IENAGA <kazz@imasy.or.jp> + + * event-Xt.c (handle_focus_event_1): Re-enable Motif/XIM to get + focus the event (XIM_focus_event). + (emacs_Xt_handle_magic_event): No side effect on Motif/XIM because + XIM_SetGeometry does nothing in input_method_motif.c, but re-unify + the interface for future use (XIM_SetGeometry). + * redisplay-x.c (x_output_string): Re-enable Motif/XIM to set spot + location (XIM_SetSpotLocation). + (x_output_eol_cursor): Ditto. + +1999-07-17 Gunnar Evermann <ge204@eng.cam.ac.uk> + + * gdbinit (pobj): change lrecord_foo to &lrecord_foo to match + Olivier's change to lrecord.h of 1999-04-22 + +1999-07-20 Robert Pluim <rpluim@bigfoot.com> + + * gutter.c (redraw_exposed_gutter): Change type of pos from + enum toolbar_pos -> enum gutter_pos, since former is only defined + if toolbar support is. + +1999-07-19 Andy Piper <andy@xemacs.org> + + * glyphs-x.c (x_resize_subwindow): cope with widgets as well as + subwindows. + + * gutter.c (gutter_validate): new function for the gutter specifier. + (specifier_type_create_gutter): declare specifier validator. + + * buffer.h (INC_CHARBYTIND): add for no error checking version. + +1999-07-18 Andy Piper <andy@xemacs.org> + + * redisplay.c (add_emchar_rune): use XSTRING_DATA not string_data. + + * glyphs-msw.c (console_type_create_glyphs_mswindows): add + resize_subwindow. + (mswindows_resize_subwindow): new function. + + * gutter.c (redraw_exposed_gutter): only reset the + current_display_lines if non-zero. + (Fgutter_pixel_height): new function. + (Fgutter_pixel_width): new function. + + * event-msw.c (mswindows_wnd_proc): set the mask of the parameter + we want to retrive from the tab control. + +1999-07-17 Andy Piper <andy@xemacs.org> + + * window.c (change_window_height): mark gutters changed when we're + done. + + * gutter.c (specifier_vars_of_gutter): make defaults more + sensible. + + * gutter.h (WINDOW_REAL_GUTTER_BORDER_WIDTH): adjust to be 0 for 0 + height gutter. + (DEFAULT_GUTTER_WIDTH): change. + (DEFAULT_GUTTER_BORDER_WIDTH): change. + +1999-07-18 Andy Piper <andy@xemacs.org> + + * redisplay.c (add_emchar_rune): use XSTRING_DATA not string_data. + +1999-07-16 Andy Piper <andy@xemacs.org> + + * frame.c (Fmake_frame): call init_frame_gutters(). + + * redisplay.c (add_emchar_rune): use string functions if we are + working with a string. + (position_redisplay_data_type): add string element. + +1999-07-15 Andy Piper <andy@xemacs.org> + + * winslots.h: add real_gutter_size slots to hold the actual gutter + size. This is important for autodetected sizes. + + * gutter.c (calculate_gutter_size): calculate size for gutters + that have 'autodetect size. + + * redisplay-msw.c (mswindows_output_vertical_divider): adjust + extent of divider for gutters. + + * redisplay-x.c (x_output_vertical_divider): adjust extent of + divider for gutters. + + * scrollbar.c (update_scrollbar_instance): adjust scrollbar + position to take into account the gutters. + + * redisplay.c (generate_modeline): adjust modeline position to + take into account the gutters. + +1999-07-14 Andy Piper <andy@xemacs.org> + + * gutter.c (frame_topmost_window): new function. + (frame_bottommost_window): ditto. + (frame_leftmost_window): ditto. + (frame_rightmost_window): ditto. + +1999-07-13 Andy Piper <andy@xemacs.org> + + * redisplay.c (calculate_display_line_boundaries): use text + boundaries so that gutters get handled properly. + +1999-07-12 Andy Piper <andy@xemacs.org> + + * glyphs-x.c (x_widget_instantiate): set the font Motif-style if + we're using Motif. + + * redisplay-output.c (redisplay_clear_to_window_end): generalised + from redisplay-x.c + + * redisplay-x.c (redisplay_clear_to_window_end): moved to + redisplay.c + + * redisplay-msw.c (redisplay_clear_to_window_end): deleted. + + * gutter.c: new file - implements gutters. All new functions are + semantically equivalent to the toolbar functions. + (gutter_was_visible): new function. + (get_gutter_coords): ditto. + (output_gutter): ditto. + (clear_gutter): ditto. + (update_frame_gutters): ditto. + (redraw_exposed_gutter): ditto. + (redraw_exposed_gutters): ditto. + (free_frame_gutters): ditto. + (init_frame_gutters): ditto. + (decode_gutter_position): ditto. + (Fset_default_gutter_position): ditto. + (Fset_default_gutter_position): ditto. + (Fdefault_gutter_position): ditto. + (gutter_after_change): ditto. + (Fgutter_specifier_p): ditto. + (recompute_overlaying_specifier): ditto. + (gutter_specs_changed): ditto. + (default_gutter_specs_changed): ditto. + (gutter_geometry_changed_in_window): ditto. + (default_gutter_size_changed_in_window): ditto. + (default_gutter_border_width_changed_in_window): ditto. + (default_gutter_visible_p_changed_in_window): ditto. + (syms_of_gutter): ditto. + (vars_of_gutter): ditto. + (specifier_type_create_gutter): ditto. + (specifier_vars_of_gutter): ditto. + + * gutter.h: new file. Contains gutter constants and sizing macros + similar to those for the toolbar. + + * winslots.h: add gutter variables. + + * window.h: declare window_is_* functions. + + * window.c (window_is_lowest): make non-static. + (window_is_highest): ditto. + (window_top_toolbar_height): deleted. + (window_bottom_toolbar_height): deleted. + (window_left_toolbar_width): deleted. + (window_right_toolbar_width): deleted. + (window_top_gutter_height): add gutter sizing. + (window_bottom_gutter_height): ditto. + (window_left_gutter_width): ditto. + (window_right_gutter_width): ditto. + + * symsinit.h: declarations for gutters vars etc. + + * search.c (bi_find_next_emchar_in_string): new function. + + * scrollbar.c (update_scrollbar_instance): remove reference to + window_bottom_toolbar_height which did nothing. + + * redisplay.h (struct display_line): add face indices for + overriding defaults in output_display_line. + Add gutter_changed flags and declarations. + + * redisplay.c (create_string_text_block): new function, similar to + create_text_block but for strings. Display tables etc are used + from the currently selected window. + (generate_string_display_line): ditto. Similar to + generate_display_line. + (generate_displayable_area): generate display lines for a given + area on a frame. Input is the string, with associated extents, to + display. + (redisplay_frame): add gutter_changed check. + (redisplay_device): ditto. + (redisplay_without_hooks): ditto. + + * redisplay-x.c (bevel_modeline): moved to redisplay.c. + (x_redraw_exposed_area): redraw exposed gutters. + (x_bevel_area): new redisplay device method. + (x_type_create_redisplay_mswindows): add bevel_area device method. + (x_output_display_block): fiddly Martin-style cleanup. + (x_output_vertical_divider): use bevel_area. + + * redisplay-output.c (output_display_line): check display_lines + for face information before using defaults. + (bevel_modeline): new function, calls bevel_area with appropriate + values. + + * redisplay-msw.c (bevel_modeline): moved to redisplay.c. + (mswindows_redraw_exposed_area): redraw exposed gutters. + (mswindows_bevel_area): new redisplay device method. + (console_type_create_redisplay_mswindows): add bevel_area device + method. + + * indent.c (string_column_at_point): add column_at_point but for + strings. + + * glyphs-x.c (image_instantiator_format_create_glyphs_x): only + instantiate widgets that we have a toolkit for. + + * general.c: add Qgutter. + + * frame.h (struct frame): add display lines for gutters and + visibility flags. + + * frame.c (set_frame_selected_window): mark gutters changed. + + * emacs.c (main_1): add gutter initialisation. + + * device.h (struct device): add gutter_changed flag and macros to + manipulate it. + + * console.h (struct console_methods): new bevel area redisplay + method. + + * buffer.h (REAL_INC_CHARBYTIND): new macro for strings as + REAL_INC_BYTIND is for buffers. + (INC_CHARPTR): ditto. + + * Makefile.in.in (objs): add gutter.o + +1999-07-13 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.18 is released + +1999-07-08 SL Baur <steve@mule.m17n.org> + + * event-Xt.c (handle_focus_event_1): Guard FRAME_X_XIC with + XIM_XLIB. + (emacs_Xt_handle_magic_event): Ditto. + * redisplay-x.c (x_output_string): Ditto. + (x_output_eol_cursor): Ditto. + +1999-06-30 Kazuyuki IENAGA <kazz@imasy.or.jp> + + * event-Xt.c, input-method-xlib.c, redisplay-x.c: Avoid the + problem that when XIM is destroyed or missed with some reason, + xemacs will die. Now xim=xlib waits the XIM will be ready and + endures the case of XIM end up. + +1999-07-03 Gunnar Evermann <ge204@eng.cam.ac.uk> + + * tooltalk.c (init_tooltalk): save signal actions for SIGQUIT, + SIGINT and SIGCHLD before calling tt_open and restore the + afterwards. This fixes e.g. the zombie subprocesses on Solaris + +1999-07-06 SL Baur <steve@xemacs.org> + + * s/linux.h: gcc-2.8 changes for powerpc + From Justin Vallon <vallon@mindspring.com> + +1999-07-05 Didier Verna <verna@inf.enst.fr> + + * indent.c: new symbol Qcoerce. + (Fmove_to_column): use it + doc string update. + +1999-07-04 Andy Piper <andy@xemacs.org> + + * console.c: undo earlier Fprovide changes. + * fns.c: ditto. + * console.h: ditto. + + * console-tty.c (image_instantiator_format_create_glyphs_tty): new + function. validate appropriate image formats for tty. + + * glyphs.h (INITIALIZE_IMAGE_INSTANTIATOR_FORMAT_NO_SYM): + initialize consoles parameter. + (struct image_instantiator_methods): add consoles parameter. + (IIFORMAT_VALID_CONSOLE): new function. validate the format on the + console. + (INITIALIZE_DEVICE_IIFORMAT): validate the format on the given + console. + + * glyphs-msw.c: declare instantiators for later use. + (image_instantiator_format_create_glyphs_mswindows): validate xpm + and friends on the mswindows console. + * glyphs-x.c: ditto. + + * glyphs.c (valid_image_instantiator_format_p): disallow glyphs + that have not been registered on the supplied device. + (Fvalid_image_instantiator_format_p): add locale argument. + (instantiate_image_instantiator): valid image instantiator on the + device. + + * symsinit.h: add image_instantiator_format_create_glyphs_tty() + declaration. + + * emacs.c (main_1): add call to + image_instantiator_format_create_glyphs_tty(). + +1999-06-29 Olivier Galibert <galibert@pobox.com> + + * lisp.h: Add #include <stddef.h>. + + * sysdep.c: Remove #include <stddef.h>. + * symbols.c: Remove #include <stddef.h>. + * sheap.c: Remove #include <stddef.h>. + * opaque.c: Remove #include <stddef.h>. + * nt.c: Remove #include <stddef.h>. + * mule-charset.c: Remove #include <stddef.h>. + * marker.c: Remove #include <stddef.h>. + * file-coding.c: Remove #include <stddef.h>. + * extents.c: Remove #include <stddef.h>. + * elhash.c: Remove #include <stddef.h>. + * data.c: Remove #include <stddef.h>. + * chartab.c: Remove #include <stddef.h>. + * bytecode.c: Remove #include <stddef.h>. + * alloc.c: Remove #include <stddef.h>. Fix vector description + +1999-06-30 SL Baur <steve@miho.m17n.org> + + * editfns.c: Document "%s" format spec. + Suggested by Bob Weiner <weiner@altrasoft.com> + +1999-06-29 Andy Piper <andy@xemacs.org> + + * event-msw.c: fix definition booboo. + +1999-06-28 Andy Piper <andy@xemacs.org> + + * glyphs-x.c: change tree -> tree-view, progress -> + progress_gauge, edit -> edit-field, tab -> tab-control, combo -> + combo-box. + (complex_vars_of_glyphs_x): provide-on-console the implemented + widget types. + + * glyphs-msw.c: ditto. + (complex_vars_of_glyphs_mswindows): ditto. + + * lisp.h: add Fprovide_on_console. + + * fns.c (Ffeaturep): add extra optional console argument. + (Fprovide_on_console): like Fprovide but provides only on the + specified console-type. + (Frequire): check console-features as well as global features. + + * console.c (Fconsole_features): new function. return features for + this console. + (syms_of_console): add Fconsole_features. + + * console.h (CONMETH_FEATURES): new function for accessing features. + (CONSOLE_FEATURES): ditto. + (struct console_methods): add features slot. + (INITIALIZE_CONSOLE_TYPE): initialize features slot. + +1999-06-28 Andy Piper <andy@xemacs.org> + + * event-Xt.c (handle_focus_event_1): conditionally compile for + X11R5. + + * s/cygwin32.h: fix me website address. + + * event-msw.c: add NMHDR for pre b20 cygwin builds. + + * gui-x.c (button_item_to_widget_value): only add callback if it + is non-nil. + + * glyphs-x.c: add progress, edit and combo instantiators. + (x_widget_set_property): new function. uses lwlib to set widget + values. + (x_widget_property): new function. uses lwlib to get widget + values. + (x_button_instantiate): support images in buttons. + (x_button_property): new function. use lwlib to get the selected + state. + (x_progress_instantiate): new function for instantiating progress + gauges. + (x_progress_set_property): new function. sets the progress gauge + position. + (x_edit_instantiate): new function. for instantiating edit fields. + (x_combo_instantiate): new function. for instantiating combo + boxes. + (image_instantiator_format_create_glyphs_x): add new device ii + formats. + + * glyphs-msw.c (mswindows_tab_instantiate): remove redundant var. + + * console.h (CONSOLE_FEATURES): new features accesor. + + * conslots.h (MARKED_SLOT): add features entry. + +1999-06-25 Andy Piper <andy@xemacs.org> + + * menubar-x.c (menu_item_descriptor_to_widget_value_1): use new + gui functions. + + * menubar-msw.c: move MAX_MENUITEM_LENGTH to gui.h + + * gui.h (struct Lisp_Gui_Item): add accelerator. + + * gui.c (gui_item_add_keyval_pair): deal with accelerators. + (gui_item_init): ditto. + (gui_add_item_keywords_to_plist): ditto. + (mark_gui_item): ditto. + (gui_item_hash): ditto. + (gui_item_accelerator): new function. + (gui_name_accelerator): new function stolen from gui-x.c + + * gui-x.c (popup_selection_callback): always define. mark + subwindows changed after calling a callback. + (menu_name_to_accelerator): deleted. + (button_item_to_widget_value): forward gui_item things to gui_item + functions. + + * glyphs-x.h (struct x_subwindow_data): add data for widgets. add + appropriate accesors. + + * glyphs-x.c: declare new glyph formats. + (x_finalize_image_instance): unmanage and destroy widgets if they + exist. + (x_unmap_subwindow): handle widgets specially. + (x_map_subwindow): ditto. offset display of widgets by offset of + text widget within container. + (x_update_subwindow): new function. call lw_modify_all_widgets + when we are a widget. + (x_widget_instantiate): new function for generically creating + widgets-glyphs. toolkit specifics forwarded to lwlib. + (x_button_instantiate): new function for instantiating + widgets-glyph buttons. + (console_type_create_glyphs_x): register update_subwindow. + (image_instantiator_format_create_glyphs_x): register widget and + button types. + + * event-msw.c (mswindows_wnd_proc): remove redundant variable. + + * event-Xt.c (x_event_to_emacs_event): call handle_focus_event_1 + when we get a button press in case we do not have the focus. + (handle_focus_event_1): set the keyboard focus to the text widget + if we do not have it. + + * dialog-x.c (dbox_descriptor_to_widget_value): use new gui_item + functions. + +1999-06-24 SL Baur <steve@miho.m17n.org> + + * syntax.c (scan_words): Restore non-Mule code. + (word_constituent_p): Restore. + +1999-06-23 Olivier Galibert <galibert@pobox.com> + + * config.h.in: Add missing #undef *_USER_DEFINED. + +1999-06-23 SL Baur <steve@miho.m17n.org> + + * lisp.h (set_bit_vector_bit): Force promotion to unsigned long + int (fixes a 64-bit problem). + + * chartab.c (word_boundary_p): Use EQ not == for lisp_object + comparison. + +1999-03-23 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de> + + * paths.h.in (PATH_DOC): Made doc-directory configurable. + +1999-06-22 Olivier Galibert <galibert@pobox.com> + + * lrecord.h: Added basic external description system. + + * symbols.c: Added symbol, symbol-value-buffer-local, + symbol-value-lisp-magic and symbol-value-varalias description. + * mule-charset.c: Added charset description. + * marker.c: Added marker description. + * keymap.c: Added keymap description. + * glyphs.c: Added glyph description. + * floatfns.c: Added float description. + * file-coding.c: Added coding-system description. + * extents.c: Added extent description. + * elhash.c: Added hash-table description. + * data.c: Added weak-list desciption. + * chartab.c: Added char-table-entry and char-table description. + * bytecode.c: Added compiled-function description. + * alloc.c: Added cons, vector and string description. + +1999-06-22 Olivier Galibert <galibert@pobox.com> + + * lrecord.h (struct lrecord_header): Reduced size to 4 bytes. + Updated everything to the removal of the "flags" substructure. + + * lisp.h (subr_lheader_initializer): Updated. + * symeval.h (symbol_value_forward_lheader_initializer): Updated. + +1999-06-20 MORIOKA Tomohiko <tomo@etl.go.jp> + + * syntax.c (word_constituent_p): Deleted. + (scan_words): Use `WORD_BOUNDARY_P'. + + * chartab.c (Vword_combining_categories): New variable. + (Vword_separating_categories): Likewise. + (CATEGORYP): New macro. + (CATEGORY_SET): Likewise. + (CATEGORY_MEMBER): Likewise. + (word_boundary_p): New function. + (complex_vars_of_chartab): Set up new variable + `word-combining-categories' and `word-separating-categories'. + +1999-06-18 Olivier Galibert <galibert@pobox.com> + + * lrecord.h: Added description as a placehold in the lrecord + implementation structures. Added the parameter to all constructor + defines. + + * alloc.c: Added placeholders. + * buffer.c: Ditto. + * bytecode.c: Ditto. + * chartab.c: Ditto. + * console.c: Ditto. + * data.c: Ditto. + * database.c: Ditto. + * device.c: Ditto. + * eldap.c: Ditto. + * elhash.c: Ditto. + * eval.c: Ditto. + * event-stream.c: Ditto. + * events.c: Ditto. + * extents.c: Ditto. + * faces.c: Ditto. + * file-coding.c: Ditto. + * floatfns.c: Ditto. + * fns.c: Ditto. + * frame.c: Ditto. + * glyphs.c: Ditto. + * gui-x.c: Ditto. + * keymap.c: Ditto. + * lstream.c: Ditto. + * marker.c: Ditto. + * mule-charset.c: Ditto. + * objects.c: Ditto. + * opaque.c: Ditto. + * process.c: Ditto. + * rangetab.c: Ditto. + * specifier.c: Ditto. + * symbols.c: Ditto. + * toolbar.c: Ditto. + * tooltalk.c: Ditto. + * window.c: Ditto. + +1999-06-22 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.17 is released + +1999-06-13 Oscar Figueiredo <oscar@xemacs.org> + + * config.h.in (HAVE_LDAP_SET_OPTION): New define + (HAVE_LDAP_GET_LDERRNO): Ditto + (HAVE_LDAP_RESULT2ERROR): Ditto + (HAVE_LDAP_PARSE_RESULT): Ditto + (HAVE_UMICH_LDAP): Removed + (HAVE_NS_LDAP): Removed + + * eldap.h (struct Lisp_LDAP): Removed the `livep' member as + suggested by Olivier Galibert + (CHECK_LIVE_LDAP): Test on `ld' instead of `livep' + + * eldap.c: Take the removal of `livep' into account in all the + necessary functions + (signal_ldap_error): Take two additional parameters + Added new finer compilation conditions in order to use + ldap_parse_result or ldap_result2error if available + (Fldap_open): Conform to this new API + (Fldap_search_internal): Ditto + +1999-06-17 SL Baur <steve@miho.m17n.org> + + * data.c (struct int_or_double): Should use EMACS_INT not int. + +1999-06-16 Norbert Koch <n.koch@eai-delta.de> + + * redisplay-msw.c: Run 'ccl_driver' with 'CCL_MODE_ENCODING' as in + redisplay-x.c + +1999-06-12 MORIOKA Tomohiko <tomo@etl.go.jp> + + * redisplay-x.c (separate_textual_runs): Run `ccl_driver' with + `CCL_MODE_ENCODING'. + + * file-coding.c (mule_decode): Run `ccl_driver' with + `CCL_MODE_DECODING'. + (mule_encode): Run `ccl_driver' with `CCL_MODE_ENCODING'. + + * mule-ccl.c (CCL_WRITE_CHAR): Refer `conversion_mode'. + (ccl_driver): Add new argument `conversion_mode'. + (Fccl_execute): Run `ccl_driver' with `CCL_MODE_ENCODING'. + (Fccl_execute_on_string): Likewise [perhaps it is better to add + new optional argument]. + + * mule-ccl.h (CCL_MODE_ENCODING): New macro. + (CCL_MODE_DECODING): New macro. + (ccl_driver): Add new argument `conversion_mode'. + +1999-06-15 SL Baur <steve@miho.m17n.org> + + * mule-charset.c (Fsplit_char): New subr. + (Fchar_octet): delete. + (syms_of_mule_charset): DEFSUBR it. + +1999-06-13 Andy Piper <andy@xemacs.org> + + * menubar.h: update declarations involving gui_items. + + * lisp.h: declare Lisp_Gui_Item. + + * glyphs.h (struct Lisp_Image_Instance): update type of gui_item. + + * glyphs.c (mark_image_instance): modify for new lisp-based gui_items. + (print_image_instance): ditto. + (image_instance_equal): ditto. + (image_instance_hash): ditto. + + * event-msw.c (mswindows_need_event): assert badly_p status. + (mswindows_wnd_proc): modify WM_NOTIFY handling to cope with + callbacks in tree-view and tab-control widgets. + (emacs_mswindows_next_event): modify use of + mswindows_dequeue_dispatch_event. + + * dialog-msw.c (mswindows_popup_dialog_box): modify for new + lisp-based gui_items. + + * glyphs-msw.c (mswindows_update_subwindow): update use of + gui_items. + (mswindows_register_gui_item): new function. + (mswindows_register_gui_item): fix to use lisp gui_items. + (mswindows_widget_instantiate): ditto. + (mswindows_button_instantiate): ditto. + (add_tree_item): new function to recursively add tree view + elements. + (add_tree_item_list): ditto. + (mswindows_tree_instantiate): new function. instantiate tree view + controls. + (add_tab_item): new function to add tabs to a tab control. + (mswindows_tab_instantiate): new function. instantiate tab + controls. + (image_instantiator_format_create_glyphs_mswindows): add tree view + and tab controls. + (vars_of_glyphs_mswindows): ditto. + + * glyphs-widget.c (check_valid_item_list_1): allow nested lists in + item lists. + (check_valid_item_list): ditto. + (initialize_widget_image_instance): fix to use new lisp gui_item. + (widget_instantiate_1): allow the setting of default textwidth in + characters. + (widget_instantiate): change to use new widget_instantiate_1 + signature. + (combo_instantiate): ditto. + (static_instantiate): ditto. + (tab_instantiate): new function for tab widgets. + (image_instantiator_format_create_glyphs_widget): add tab and tree + view widgets. + + * menubar-msw.c (displayable_menu_item): convert to use lisp + gui_items. + (populate_menu_add_item): ditto. + (populate_or_checksum_helper): ditto. + + * menubar.c (menu_parse_submenu_keywords): convert to use lisp + gui_items. + (Fmenu_find_real_submenu): ditto. + + * gui.h (struct Lisp_Gui_Item): make gui_item a lisp oebjct. + + * gui.c (gui_item_add_keyval_pair): gui_items are now lisp + objects, convert functions that use them accordingly. + (gui_item_init): ditto. + (gui_item_active_p): ditto. + (gui_item_selected_p): ditto. + (gui_item_included_p): ditto. + (gui_item_display_flush_left): ditto. + (gui_item_display_flush_right): ditto. + (mark_gui_item): ditto. + (allocate_gui_item): new function to create a gui_item. + (make_gui_item_from_keywords_internal): ditto. create and return a + gui_item as well as setting keywords. + (gui_parse_item_keywords): ditto. + (gui_parse_item_keywords_no_errors): ditto. + (gui_add_item_keywords_to_plist): new function, not yet used. + (gui_item_hash): new function. + (gui_item_id_hash): use gui_item_hash. + (gui_item_equal): new function. + (print_gui_item): new function. + +1999-06-11 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.16 is released + +1999-06-10 Andy Piper <andy@xemacs.org> + + * select-msw.c (mswindows_own_selection): only set the clipboard + if asked. + (mswindows_get_foreign_selection): only get the clipboard if + asked. + (mswindows_disown_selection): only disown the clipboard if asked. + +1999-06-03 MORIOKA Tomohiko <tomo@etl.go.jp> + + * file-coding.c (coding_system_from_mask): Use `raw-text' instead + of `no-conversion'. + (complex_vars_of_mule_coding): Use `raw-text' as the coding-system + of coding-category `no-conversion'. + +1999-06-03 MORIOKA Tomohiko <tomo@etl.go.jp> + + * file-coding.c (Qraw_text): New variable. + (syms_of_mule_coding): Add new symbol `raw-text'. + (complex_vars_of_mule_coding): Add new coding-system `raw-text'; + define coding-system `binary' independently; define coding-system + `no-conversion' as an alias for `raw-text'. + + * file-coding.h (Qraw_text): New variable. + +1999-06-08 SL Baur <steve@xemacs.org> + + * s/decosf4-0.h: Explicitly #undef SYSTEM_MALLOC. + +1999-06-06 Hrvoje Niksic <hniksic@srce.hr> + + * fns.c (MIME_LINE_LENGTH): Default to 72, as in mimencode and + base64.el. + (base64_decode_1): Signal errors instead of returning -1. + +1999-06-07 Hrvoje Niksic <hniksic@srce.hr> + + * mule-charset.c (Fmake_char): Update docstring. + +1999-06-07 Hrvoje Niksic <hniksic@srce.hr> + + * fns.c (Fstring_lessp): Actually increment the Bufbyte pointers. + +1999-06-05 Hrvoje Niksic <hniksic@srce.hr> + + * fns.c (base64_decode_1): Allow and ignore any non-base64 + characters in input. + +1999-05-27 Olivier Galibert <galibert@pobox.com> + + * emacs.c (Fdump_emacs): Add clear_message() lost with the removal + of report_pure_usage(). + +1999-06-04 Hrvoje Niksic <hniksic@srce.hr> + + * fns.c (Fstring_lessp): Remove O(n^2) under Mule. + +1999-06-04 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.15 is released + +1999-06-01 Hirokazu FUKUI <fukui@atesoft.advantest.co.jp> + + * frame.c (Fset_mouse_position): + (Fset_mouse_pixel_position): + * window.c (Fsplit_window): + (Fmove_to_window_line): + Fix crash when invoking functions with an already-deleted window + argument. + + * indent.c (vertical_motion_1): + (vmotion_pixels): + (Fvertical_motion_pixels): + * window.c (Fwindow_displayed_text_pixel_height): + Fix error message when invoking functions with an already-deleted + window argument. + +1999-06-01 Jan Vroonhof <vroonhof@math.ethz.ch> + + * sysdep.c (request_sigio_on_device): Guard against glibc + 2.1's stub streams implementation. + +1999-06-03 SL Baur <steve@xemacs.org> + + * config.h.in: + * emacs.c: Implement x.y.z version numbers + From Jan Vroonhof <vroonhof@math.ethz.ch> + +1999-05-20 MORIOKA Tomohiko <tomo@etl.go.jp> + + * mule-charset.c (complex_vars_of_mule_charset): Registry of + japanese-jisx0208-1978 should not match with "jisx0208.1983" nor + "jisc6226.1983". + +1999-06-03 SL Baur <steve@xemacs.org> + + * frame-x.c: + * device-x.c: rename session option to wmcommand. + From Oliver Graf <ograf@rhein-zeitung.de> + +1999-05-27 Hrvoje Niksic <hniksic@srce.hr> + + * fns.c (Fsubstring): Don't traverse the same region twice with + charcount_to_bytecount(). + +1999-06-03 SL Baur <steve@steve1.m17n.org> + + * m/alpha.h (SYSTEM_MALLOC): Fix indented preprocessor directive + garbage. + + * s/decosf4-0.h: Defining ORDINARY_LINK here is redundant (and it + doesn't really work as is implied by the commentary). + Don't define SYSTEM_MALLOC so the old GNU malloc can be used. + +1999-06-02 SL Baur <steve@steve1.m17n.org> + + * symsinit.h: Declare vars_of_ntproc. + * emacs.c (main_1): Call it. + + * ntproc.c (syms_of_ntproc): Move variable initializations from + here ... + (vars_of_ntproc): ... to here [new function]. + + * file-coding.c (syms_of_file_coding): Rename. + (vars_of_file_coding): Ditto. + (complex_vars_of_file_coding): Ditto. + + * symsinit.h: Rename *_mule_coding to *_file_coding. + + * emacs.c (main_1): Call them by the proper name. + + * device-msw.c (syms_of_device_mswindows): Move variable + initializations from here ... + (vars_of_device_mswindows): ... to here. + + * chartab.c (vars_of_chartab): New function. + + * symsinit.h: New function, vars_of_chartab. + + * emacs.c (main_1): Call it. + + * mule-canna.c (syms_of_mule_canna): Move CANNA initialization ... + (vars_of_mule_canna): ... to here. + + * mule-ccl.c (vars_of_mule_ccl): New function. Move variable + initializations out of syms_of_mule_ccl. + + * symsinit.h: Declare new function vars_of_mule_ccl. + + * emacs.c (main_1): Call it. + +1999-05-27 Hrvoje Niksic <hniksic@srce.hr> + + * fns.c (base64_decode_1): Ignore whitespace. + +1999-05-27 Hrvoje Niksic <hniksic@srce.hr> + + * mule-charset.c (Fmake_char): Strip the eighth bit off ARG1 and + ARG2. + +1999-05-21 Andy Piper <andy@xemacs.org> + + * xselect.c: deleted. + + * symsinit.h: declare select initialisation. + + * select.h: new file. declare commonly used select functions and + variables. + + * select.c: new file. generalised from xselect.c. + (clean_local_selection_data): moved from xselect.c. + (get_local_selection): ditto. device specific pieces called via a + devmeth. + (handle_selection_clear): ditto. + (Fown_selection_internal): renamed and generalised from + Fx_own_selection_internal. moved from xselect.c. + (Fdisown_selection_internal): ditto. + (Fselection_owner_p): ditto. + (Fselection_exists_p): ditto. + (Fget_selection_internal): ditto. + (syms_of_select): new function. QXXXX values moved from xselect.c + (vars_of_select): new function. selection_converter_alist, + lost_selection_hooks moved and renamed from xselect.c + + * select-x.c: renamed from xselect.c. + (x_own_selection): converted to device specific. non-X-specific + bits moved to select.c. + (x_get_foreign_selection): ditto. + (x_disown_selection): ditto. + (x_selection_exists_p): ditto. + (console_type_create_select_x): new function. + + * select-msw.c (mswindows_own_selection): new device method to set + the clipboard when we 'own' the selection. + (mswindows_get_foreign_selection): new device method to get the + clipboard. + (mswindows_disown_selection): new device method to delete the + selection when we 'disown' it. + (console_type_create_select_mswindows): new function. + + * emacs.c (main_1): add select to things to initialise. + + * console.h (struct console_methods): new console methods for + selection. + + * Makefile.in.in (x_objs): xselect.c renamed to select-x.c + +1999-05-20 Hrvoje Niksic <hniksic@srce.hr> + + * print.c (long_to_string): Install a faster version. + +1999-05-16 Andy Piper <andy@xemacs.org> + + * ntproc.c (syms_of_ntproc): default + win32-start-process-share-console to t. + +1999-05-14 Hrvoje Niksic <hniksic@srce.hr> + + * config.h.in: Do it here. + + * bytecode.c: Don't define ERROR_CHECK_TYPECHECK here. + +1999-05-14 Andy Piper <andy@xemacs.org> + + * toolbar-msw.c (mswindows_output_toolbar): hash on something + hashable. + +1999-05-14 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.14 is released + +1999-05-12 Andy Piper <andy@xemacs.org> + + * ntproc.c (sys_spawnve): kludge argv[0] in a MS compatible way. + +1999-05-11 Gunnar Evermann <ge204@eng.cam.ac.uk> + + * emacs.c (Frun_emacs_from_temacs): (re)alloc natgs+2 entries for + run_temacs_argv array -- fixes random memory corruption crash + +1999-05-12 Jan Vroonhof <vroonhof@math.ethz.ch> + + * window.c (Fcurrent_window_configuration): + Save minibuffer height; + + * window.c (set_window_configuration): use it. + +1999-05-10 Robert Pluim <rpluim@bigfoot.com> + + * lisp.h (NNUNGCPRO): fix typo in name of DEBUG_GCPRO version + +1999-04-21 Jan Vroonhof <vroonhof@math.ethz.ch> + + * redisplay.c (redisplay_window): Do not put data + in the line start cache if it is not guaranteed to be correct + +1999-04-02 Jan Vroonhof <vroonhof@math.ethz.ch> + + * window.c (struct window_config): Removed frame + size members. + (window_config_equal): No longer compare frame sizes. + (Fset_window_configuration): Resize old top window to fit in the + current frame directly, no longer use a fake frame resize. + (Fcurrent_window_configuration): No longer save frame size + +1999-05-11 Andy Piper <andy@xemacs.org> + + * ntproc.c (sys_spawnve): actually assign argv[0] instead of the + first character. + +1999-05-10 Hrvoje Niksic <hniksic@srce.hr> + + * sysdep.c (init_system_name): If gethostname gives a proper + domain name, don't look further for one. + +1999-05-09 Hrvoje Niksic <hniksic@srce.hr> + + * symbols.c (Fintern): Avoid frequent XSYMBOL (foo). + (Fintern_soft): Accept a symbol argument. + +1999-05-06 Hrvoje Niksic <hniksic@srce.hr> + + * symbols.c (Fintern): ...do it here. + + * lread.c (read_atom): Don't handle keywords here. + +1999-05-06 Hrvoje Niksic <hniksic@srce.hr> + + * symbols.c (reject_constant_symbols): Just use SYMBOL_IS_KEYWORD. + +1999-05-03 Olivier Galibert <galibert@pobox.com> + + * lisp.h (SYMBOL_IS_KEYWORD): A symbol can be a keyword only if it + is interned in the main obarray. + +1999-04-23 Gunnar Evermann <ge204@eng.cam.ac.uk> + + * menubar-x.c (pre_activate_callback): set accelerator field in + "No menu" entries to nil. Avoid crash in + command_builder_operate_menu_accelerator + +1999-05-03 Olivier Galibert <galibert@pobox.com> + + * symeval.h (symbol_value_forward_lheader_initializer): Ditto. + + * lisp.h (DEFUN): Fix lrecord header initialisation. + +1999-05-02 Andy Piper <andy@xemacs.org> + + * objects-msw.c (mswindows_font_instance_truename): add a ';'. + + * ntproc.c (sys_kill): cast using MS mandated defines. + +1999-04-29 Andy Piper <andy@xemacs.org> + + * m/intel386.h: remove redundant definitions. + + * s/mingw32.h: new header for mingw32. + + * unexnt.c: (open_input_file): function moved to nt.c. + (close_file_data): ditto. + (rva_to_section): function moved to ntproc. + + * symsinit.h: declare syms_of_ntproc(); + + * objects-msw.c (mswindows_font_instance_truename): new function. + + * ntproc.c: remove many warnings. + (_sys_read_ahead): moved from nt.c and made static. + (rva_to_section): moved from unexnt.c but not defined under + mingw32. + (win32_executable_type): implement what we can for mingw32 + headers. + (sys_spawnve): fix bad MULE/GCPRO bug in filename handling. + + * ntheap.h: remove declarations of functions that are now static. + + * ntheap.c: support static heap. + + * nt.h: conditionalise X_OK definition. + + * nt.c: eliminate many warnings and support mingw32. + (open_input_file): function moved from unexnt.c and made static + (close_file_data): ditto. + (_sys_read_ahead): moved to ntproc.c + + * emacs.c: make sure syms_of_ntptroc gets called under windows. + + * console-msw.h: support mingw32. + * getloadavg.c: ditto. + * ntplay.c: ditto. + * sysdep.c: ditto. + * sysdir.h: ditto. + * systime.h: ditto. + * systty.h: ditto. + + * config.h.in: dont turn on DEBUG_ENCAPSULATION by default because + some systems don't have all of the encapsulated system calls. + + * callproc.c: warning elimination. + * dired-msw.c: ditto. + * process-nt.c: ditto. + * realpath.c: ditto. + + * Makefile.in.in: tweak : and ; for building under mswindows. + +1999-04-26 Michael Harnois <mharnois@willinet.net> + + * eldap.c (allocate_ldap): Adapt to the new semantics of + alloc_lcrecord_type(). + +1999-03-16 MORIOKA Tomohiko <tomo@etl.go.jp> + + * file-coding.c (DECODE_HANDLE_END_OF_CONVERSION): fixed. + +1998-09-04 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * Delete mule-coding.c and mule-coding.h because they are not + used. + +1999-04-22 Gunnar Evermann <ge204@eng.cam.ac.uk> + + * objects.c (print_font_instance): Check for NILP(f->device), + i.e. Vthe_null_font_instance. + (font_instance_truename_internal): ditto. + (Ffont_instance_properties): ditto. + +1999-04-22 Olivier Galibert <galibert@pobox.com> + + * lrecord.h (DECLARE_LRECORD): lrecord_implementation isn't an + array anymore. + +1999-04-22 Hrvoje Niksic <hniksic@srce.hr> + + * Makefile.in.in (tests): Don't mention tests explicitly -- makes + it easier to add new ones. + +1999-04-22 Hrvoje Niksic <hniksic@srce.hr> + + * symbols.c (reject_constant_symbols): Ditto. + (init_symbols_once_early): Ditto. + + * print.c (print_symbol): Don't use ->obarray. + + * symbols.c (Funintern): Ditto. + + * alloc.c (Fmake_symbol): Don't set ->obarray. + + * lisp.h (struct Lisp_Symbol): Removed .obarray field. + + * symbols.c (init_symbols_once_early): Removed + Vpure_uninterned_symbol_table. + (Fintern): Don't store to ->obarray field. + +1999-04-22 Hrvoje Niksic <hniksic@srce.hr> + + * data.c (vars_of_data): Default debug_issue_ebola_notices to 0. + (eq_with_ebola_notice): Remove abracadabra support. + +1999-04-11 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> + + * eldap.c (Fldap_search_internal): Add a new parameter `withdn' to + retrieve the distinguished names of entries + +1999-03-08 Martin Buchholz <martin@xemacs.org> + + * lread.c (read_escape): Make hex escapes read only two hex digits. + +1999-04-05 Olivier Galibert <galibert@pobox.com> + + * Makefile.in.in: Remove puresize-adjust.h and recursive makes. + * make-src-depend: Remove puresize-adjust.h. + * src-headers: Remove puresize-adjust.h. + * config.h.in: Kill everything purespace/gung-ho related. + + * dbxrc: Make gung-ho mandatory. + * gdbinit: Ditto. + + * lrecord.h: Make gung-ho mandatory. Remove pure flag and add + c_readonly and lisp_readonly. Remove implementation arrays. + (C_READONLY_RECORD_HEADER_P): Added. + (LISP_READONLY_RECORD_HEADER_P): Added. + (SET_C_READONLY_RECORD_HEADER): Added. + (SET_LISP_READONLY_RECORD_HEADER): Added. + + * lisp.h: Kill everything purespace/non gung-ho related. + (CHECK_C_WRITEABLE): Added. + (CHECK_LISP_WRITEABLE): Added. + (C_READONLY): Added. + (LISP_READONLY): Added. + + * lisp-union.h: Make gung-ho mandatory. + * lisp-disunion.h: Ditto. + + * alloc.c: Kill everything purespace/non gung-ho related. Fix all + set_lheader_implementation calls. + (c_readonly): Added. + (lisp_readonly): Added. + (make_string_nocopy): Added. + (Fpurecopy): Changed to do nothing. Kept the old documentation + for reference purposes for the next patches. + (sweep_lcrecords_1): Don't free C readonly lcrecords. + (sweep_bit_vectors_1): Don't free C readonly bitvectors. + (SWEEP_FIXED_TYPE_BLOCK): Don't free C readonly lrecords. + + * fns.c: Make gung-ho mandatory. + (Fput): CHECK_IMPURE -> CHECK_LISP_WRITEABLE. + (Fremprop): Ditto. + (Ffillarray): Ditto. + + * data.c: Make gung-ho mandatory. + (pure_write_error): Removed. + (c_write_error): Added. + (lisp_write_error): Added. + (Fsetcar): CHECK_IMPURE -> CHECK_LISP_WRITEABLE. + (Fsetcdr): Ditto. + (Faset): Ditto. + + * symbols.c: Make gung-ho mandatory. make_pure_pname -> + make_string or make_string_nocopy. Fix various + alloc_lcrecord_type. + + * lread.c: Remove everything purespace related. + (Flocate_file_clear_hashing): purified -> c_readonly. + (locate_file): Ditto. + (read_atom): make_pure_pname -> make_string. + + * emacs.c (Frun_emacs_from_temacs): Remove purespace stats + reporting. + (Fdump_emacs): Ditto. + + * print.c (print_internal): Make gung-ho mandatory. + * ntheap.c (sbrk): Ditto. + * mem-limits.h (EXCEEDS_LISP_PTR): Ditto + * symeval.h (symbol_value_forward_lheader_initializer): Ditto. + + * sheap.c (more_static_core): Remove puresize-adjust.h from + message. + + * syntax.c (complex_vars_of_syntax): make_pure_string -> + make_string_nocopy. + * keymap.c (make_keymap): Fix alloc_lcrecord_type. + (vars_of_keymap): make_pure_string -> make_string_nocopy. + * events.c (deinitialize_event): Fix set_lheader_implementation. + (zero_event): Ditto. + * specifier.c (make_specifier_internal): Fix alloc_lcrecord. + * menubar-x.c (set_frame_menubar): Fix alloc_lcrecord_type. + * mule-charset.c (make_charset): Ditto. + * console.c (allocate_console): Ditto. + (complex_vars_of_console): Ditto. + * file-coding.c (allocate_coding_system): Ditto. + * device.c (allocate_device): Ditto + * gui-x.c (gcpro_popup_callbacks): Ditto. + * extents.c (allocate_extent_auxiliary): Ditto. + (allocate_extent_info): Ditto. + (copy_extent): Ditto. + * glyphs.c (allocate_image_instance): Ditto. + (allocate_glyph): Ditto. + * frame.c (allocate_frame_core): Ditto. + * database.c (allocate_database): Ditto. + * tooltalk.c (make_tooltalk_message): Ditto. + (make_tooltalk_pattern): Ditto. + * rangetab.c (Fmake_range_table): Ditto. + (Fcopy_range_table): Ditto. + * process.c (make_process_internal): Ditto. + * chartab.c (Fmake_char_table): Ditto. + (make_char_table_entry): Ditto. + (copy_char_table_entry): Ditto. + (Fcopy_char_table): Ditto. + * elhash.c (make_general_lisp_hash_table): Ditto. + (Fcopy_hash_table): Ditto. + * buffer.c (allocate_buffer): Ditto. + (complex_vars_of_buffer): Ditto. + * event-stream.c (allocate_command_builder): Ditto. + * objects.c (Fmake_color_instance): Ditto. + (Fmake_font_instance): Ditto. + (vars_of_objects): Ditto. + * toolbar.c (update_toolbar_button): Ditto. + * window.c (allocate_window): Ditto. + (make_dummy_parent): Ditto. + (Fcurrent_window_configuration): Fix alloc_lcrecord. + (vars_of_window): Fix make_lcrecord_list. + * faces.c (allocate_face): Fix alloc_lcrecord_type. pure_list -> + Flist. + * lstream.c (Lstream_new): Fix make_lcrecord_list. + * opaque.c (make_opaque): Fix alloc_lrecord. + (make_opaque_list): Fix alloc_lrecord_type. + +1999-04-19 Hrvoje Niksic <hniksic@srce.hr> + + * process.c (Fstart_process_internal): Ditto. + + * ntproc.c (sys_spawnve): Use Vlisp_EXEC_SUFFIXES when calling + locate_file(). + + * glyphs-x.c (x_locate_pixmap_file): Ditto. + + * glyphs-msw.c (mswindows_locate_pixmap_file): Fix call to + locate_file(). + + * emodules.c (vars_of_module): New variable Vmodule_extensions. + (emodules_load): Use it when calling locate_file(). + + * emacs.c (main_1): Use Vlisp_EXEC_SUFFIXES when calling + locate_file(). + + * callproc.c: Vlisp_EXEC_SUFFIXES: New variable. + (vars_of_callproc): Initialize it. + (Fcall_process_internal): Use it when calling locate_file(). + + * alloc.c (disksave_object_finalization): Use + Flocate_file_clear_hashing(). + + * lread.c (Flocate_file_clear_hashing): Clear all hasing when + given `t' as argument. + +1999-04-18 Hrvoje Niksic <hniksic@srce.hr> + + * lread.c (locate_file): Expand `pathel' when appropriate. + (Flocate_file_clear_hashing): Expand path elements. + (Flocate_file_clear_hashing): Use Vlocate_file_hash_table. + + * dired.c (make_directory_hash_table): Create the hash-table only + if the directory open is successful. + + * lread.c (decode_mode_1): New function. + (decode_mode): Ditto. + (Flocate_file): Use them. + (Flocate_file): Expand FILENAME. + (locate_file_map_suffixes): New function. + (locate_file_in_directory_mapper): New function. + (locate_file_in_directory): Use locate_file_in_directory_mapper() + and locate_file_map_suffixes(). + (locate_file_construct_suffixed_files): Use + locate_file_map_suffixes(). + (locate_file_without_hash): Don't GCPRO path. + (Flocate_file_clear_hashing): Use EXTERNAL_LIST_LOOP. + (syms_of_lread): Remove Qlocate_file_hash_table. + (locate_file_find_directory_hash_table): Use + Vlocate_file_hash_table. + (locate_file_refresh_hashing): Ditto. + + * lread.c: Renamed read_objects to Vread_objects. + +1999-04-16 Olivier Galibert <galibert@pobox.com> + + * mule-charset.c: Generally resync with fsf 20.3 charset + interface. + (make_charset): Add long and short name. Use id instead of + leading byte. + (Fmake_charset): Ditto. + (Fmake_reverse_direction_charset): Ditto. + (Fcharset_property): Ditto. + (Fcharset_short_name): Added. + (Fcharset_long_name): Added. + (Fcharset_description): Renamed from charset-doc-string. + (syms_of_mule_charset): Synced symbols. + (complex_vars_of_mule_charset): Synced charsets. + + * mule-charset.h: Removed leading byte (uses id instead), added + short and long name. + +1999-04-15 Hrvoje Niksic <hniksic@srce.hr> + + * file-coding.c (Fdefine_coding_system_alias): New function. + +1999-04-08 Olivier Galibert <galibert@pobox.com> + + * mule-charset.c (complex_vars_of_mule_charset): Allow all iso8859 + and -ascii fonts for displaying ascii instead of iso8859-1 only. + +1998-12-14 Hrvoje Niksic <hniksic@srce.hr> + + * extents.c (set_extent_glyph_1): Make sure that the glyph we + attach to the extent is valid. + +1998-12-12 Hrvoje Niksic <hniksic@srce.hr> + + * dired.c (user_name_completion): Mule-ize. + (user_name_completion): Use xmalloc/xrealloc/xfree. + (user_name_completion): Use DO_REALLOC. + (user_name_completion): Cut down the number of static variables; + use a structure. + (user_name_completion): Username completion is always + case-sensitive. + +1998-12-06 Hrvoje Niksic <hniksic@srce.hr> + + * fns.c (base64_decode_1): Remove COUNTER. + (base64_decode_1): Accept CRLF in addition to CR. + (base64_decode_1): Disallow a stray character after final EOF; the + check was probably a remnant of buggy recode code. + +1998-12-05 Hrvoje Niksic <hniksic@srce.hr> + + * fns.c (init_provide_once): Provide `base64'. + +1998-12-04 Hrvoje Niksic <hniksic@srce.hr> + + * fns.c (XMALLOC_UNBIND): Include SPECCOUNT argument, for clarity. + (Fbase64_encode_region): If buffer is read-only, bail out early. + (Fbase64_decode_region): Ditto. + (Fbase64_encode_region): Initialize SPECCOUNT to pacify the + compiler. + (Fbase64_encode_string): Ditto. + (Fbase64_decode_region): Ditto. + (Fbase64_decode_string): Ditto. + +1998-11-25 Hrvoje Niksic <hniksic@srce.hr> + + * dired.c (Fdirectory_files): Remove redundant code. + +1999-03-05 Philip Aston <philipa@parallax.co.uk> + + * frame-msw.c Make raise-frame restore minimised windows. + +1999-03-05 Philip Aston <philipa@parallax.co.uk> + + * device-msw.c: Fix DEFVAR format - Death to phantom quote, and + add magic newline. + +1999-03-05 Philip Aston <philipa@parallax.co.uk> + + * toolbar-msw.c Consider captions when deciding whether to rebuild + toolbar. This fixes the initial toolbar display for those of us + who don't like captions. These patches applied by Andy Piper. + +1999-03-12 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.13 is released + +1999-03-12 SL Baur <steve@xemacs.org> + + * file-coding.c: Guard ucs table initialization with ifdef MULE. + +1999-03-10 Stephen J. Turnbull <turnbull@sk.tsukuba.ac.jp> + + * file-coding.c: docstring and comment improvements. + (decode_ucs4) flag possible data loss with comment. + +1999-03-10 Martin Buchholz <martin@xemacs.org> + + * file-coding.c (Fset_ucs_char): add CHECK_INT, CHECK_CHAR + (ucs_to_char): + (Fucs_char): + (Fset_char_ucs): + (decode_coding_ucs4): + (encode_coding_ucs4): + (detect_coding_utf8): + (decode_coding_utf8): + (encode_utf8): + (encode_coding_utf8): + Add CHECK_* macros where needed to avoid crashes. + #ifdef out all composite character support using + #ifdef ENABLE_COMPOSITE_CHARS + Use normal XEmacs coding standards. + Fix docstrings. + Remove CODING_STREAM_COMPOSE, CODING_STREAM_DECOMPOSE. + +1998-09-08 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * file-coding.c (make-coding-system): Add description about + `ucs-4' and `utf-8'. + (detection_state): Modify to implement ucs-4 and utf-8. + (detect_coding_type): Likewise. + (detect_coding_ucs4): New implementation. + (detect_coding_utf8): New implementation. + (encode_utf8): fixed. + (syms_of_mule_coding): Rename `ucs4' and `utf8' to `ucs-4' and + `utf-8'. + +1998-09-08 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * file-coding.c (mule_char_to_ucs4): Encode 94x94 chars in ISO + 2022 registry to private area. + +1998-09-07 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * file-coding.c (encode_utf8): New function. + (encode_coding_utf8): New implementation. + +1998-09-07 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * file-coding.c (ucs_to_mule_table): New variable; abolish + `Vucs_to_mule_table' + (mule_to_ucs_table): renamed from `Vmule_to_ucs_table'. + (set-ucs-char): New function. + (ucs_to_char): New function. + (ucs-char): New function. + (set-char-ucs): New function. + (char-ucs): New function. + (decode_ucs4): Use `ucs_to_char'. + (complex_vars_of_mule_coding): Abolish `ucs-to-mule-table' and + `mule-to-ucs-table'. + +1998-09-06 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * chartab.h: EXFUN `Fget_char_table'. + + * file-coding.c (encode_ucs4): New function. + (encode_coding_ucs4): Use `encode_ucs4'. + +1998-09-06 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * file-coding.c (decode_coding_ucs4): New implementation. + +1998-09-06 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * file-coding.c (decode_coding_ucs4): fixed. + + * file-coding.c (Vmule_to_ucs_table): New variable. + (mule_char_to_ucs4): New function. + (encode_coding_ucs4): New implementation. + (complex_vars_of_mule_coding): Define variable + `mule-to-ucs-table'. + +1998-09-06 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * file-coding.c (decode_coding_utf8): New implementation. + +1998-09-06 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * file-coding.c (decode_coding_utf8): fixed. + +1998-09-06 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * file-coding.c (Vucs_to_mule_table): New variable. + (decode_ucs4): Refer `Vucs_to_mule_table'. + (complex_vars_of_mule_coding): Define variable + `ucs-to-mule-table'. + +1998-09-04 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * file-coding.c (detect_coding_ucs4): New function (not + implemented yet). + (decode_coding_ucs4): New function. + (encode_coding_ucs4): New function (not implemented yet). + (detect_coding_utf8): New function (not implemented yet). + (decode_coding_utf8): New function. + (encode_coding_utf8): New function (not implemented yet). + (make-coding-system): New type `ucs4' and `utf8'. + (coding-system-type): Likewise. + (detection_state): Add `ucs4' and `utf8'. + (detect_coding_type): Likewise. + (mule_decode): Use `decode_coding_ucs4' and `decode_coding_utf8'. + (mule_encode): Use `encode_coding_ucs4' and `encode_coding_utf8'. + (decode_ucs4): New function (very incomplete). + (syms_of_mule_coding): Add `ucs4' and `utf8'. + + * file-coding.h: Add definitions for UCS-4 and UTF-8. + +1999-03-08 Martin Buchholz <martin@xemacs.org> + + * mule-charset.c: + (non_ascii_valid_char_p): + (lookup_composite_char): + (composite_char_string): + (make-composite-char): + (composite-char-string): + (syms_of_mule_charset): + (complex_vars_of_mule_charset): + * mule-charset.h (LEADING_BYTE_COMPOSITE): + (CHAR_LEADING_BYTE): + (MAKE_CHAR): + * file-coding.h (CODING_STATE_COMPOSITE): + (CODING_STATE_ISO2022_LOCK): + (iso_esc_flag): + (LEADING_BYTE_COMPOSITE): + * file-coding.c (struct iso2022_decoder): + (decoding_closer): + (reset_iso2022): + (parse_iso2022_esc): + (encode_coding_iso2022): + #ifdef out all composite character support using + #ifdef ENABLE_COMPOSITE_CHARS + + * alloc.c: Define lrecord_coding_system only if ! FILE_CODING + +1999-03-04 Takeshi YAMADA <yamada@cslab.kecl.ntt.co.jp> + + * fns.c (Fbase64_encode_string): Calculate `allength' in the same + way of `Fbase64_encode_region'. + +1999-02-18 Katsumi Yamaoka <yamaoka@jpl.org> + + * fns.c (base64_encode_1): Don't add a newline at the tail. + +1999-03-08 Andy Piper <andy@xemacs.org> + + * menubar-msw.c (displayable_menu_item): correct off-by-one & + handling. + +1999-03-07 Martin Buchholz <martin@xemacs.org> + + * console-stream.h (struct stream_console): + * event-unixoid.c (event_stream_unixoid_select_console): + (event_stream_unixoid_unselect_console): + * print.c (Fexternal_debugging_output): + * sysdep.c (reset_one_device): + * console-stream.c (stream_init_console): + (stream_delete_console): + (allocate_stream_console_struct): move into stream_init_console. + (free_stream_console_struct): move into stream_delete_console. + Use `fd' only for file descriptors. + Therefore, rename members of struct stream_console. + + * systime.h: Unix98 says sys/time.h should define select(), but + some systems define that in unistd.h. So include that file always. + + * glyphs.h (MAYBE_IIFORMAT_METH): Don't use leading `_'. Avoid + multiple evaluation of first arg. Do proper do {} while (0) wrapping. + (HAS_IIFORMAT_METH_P): Prevent macro from being used in + non-boolean context + (MAYBE_IIFORMAT_DEVMETH): Use standard internal macro naming convention. + + * EmacsShell.c: + * balloon_help.c: + Add #include <stdio.h>. + Some versions of assert.h use printf() without #include'ing stdio.h + + * free-hook.c (blocktype): Add gcpro5_type to blocktype. + (log_gcpro): Remove unused variable FRAME. + (show_gcprohist): Ansify. + Comment the #endif's + + * frame-x.c (x_delete_frame): Don't use FRAME_X_SHELL_WIDGET(f) + after it's just been XtDestroy'ed! + +1999-02-18 Martin Buchholz <martin@xemacs.org> + + * opaque.c (print_opaque): + (sizeof_opaque): + (equal_opaque): + (hash_opaque): + Egcs 1.1.1 seems to have a bug where + INTP (p->size_or_chain) + will crash XEmacs. Fix by introducing intermediate variable. + + * sound.c (Fdevice_sound_enabled_p): Fix compiler warning. + + * dired.c (Fdirectory_files): + (Ffile_name_completion): + (Ffile_name_all_completions): + (file_name_completion): + - Use `directory' instead of `dirname' to sync with FSF Emacs and + avoid compiler warnings. + - Fix up docstrings so that C variables match documentation. + +1999-03-05 Martin Buchholz <martin@xemacs.org> + + * alloc.c: (garbage_collect_1): Reorg code to make scope of local + variables as small as possible to help out the compiler and the maintainer. + + * alloc.c: (disksave_object_finalization): + Set all the *-load-path variables to + nil, not just load-path itself. This gets the locate-file hash + tables garbage collected BEFORE dump, and has the side effect of + preventing crashes on OSF4.0+egcs. + + * alloc.c: + * gdbinit: + * dbxrc: + - Clean up gdb/dbx debugging support. + - Storing an EMACS_INT in an enum is not 64-bit clean! + - So change the enum to a set of separate variables. + - Add test cases to help debug the debugging support! + - Add `lisp-shadows' and `run-temacs' targets for dbx. + - Both dbx and gdb have been tested now. + +1999-03-05 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.12 is released + +1999-02-16 Kazuyuki IENAGA <ienaga@jsys.co.jp> + + * device-x.c: Support to find best visual without flashing. + +1999-03-02 Paul Keusemann <pkeusem@visi.com> + + * database.c (berkdb_map): Add flags argument to cursor call (must + be 0 according to docs) required for Berkeley DB 2.6.4 and later. + +1999-03-03 Martin Buchholz <martin@xemacs.org> + + * hash.c: + * hash.h: + General cleanup. Get free-hook.c working again. + Remove unused functions: + make_strings_hash_table, copy_hash, expand_hash_table. + + * malloc.c: + * mem-limits.h: + Always use new ANSI-style function prototypes. + + * unexalpha.c (unexec): Never use implicit int. + + * sgiplay.c (close_sound_file): + (play_sound_file): + (restore_audio_port): + (play_sound_data): + (audio_initialize): + (play_internal): + (drain_audio_port): + (write_mulaw_8_chunk): + (write_linear_chunk): + (write_linear_32_chunk): + (initialize_audio_port): + (open_audio_port): + (set_channels): + (set_output_format): + (adjust_audio_volume): + (get_current_volumes): + (parse_snd_header): + Always use new ANSI-style function prototypes. + Use unistd.h for missing prototypes. + + * unexelfsgi.c (round_up): + (find_section): + (unexec): Always use new ANSI-style function prototypes + + * elhash.c (struct Lisp_Hash_Table): rename golden to golden_ratio + + * console.h (struct console_methods): Always use full ANSI prototypes + + * emacs.c (__sti__iflPNGFile_c___): Always use full ANSI prototypes + +1999-03-02 Andy Piper <andy@xemacs.org> + + * event-stream.c (init_event_stream): make sure native mswindows + gets an appropriate event loop. + +1999-02-22 Andy Piper <andy@xemacs.org> + + * frame-msw.c (mswindows_make_frame_visible): use SW_SHOW rather + than SW_SHOWNORMAL to prevent resizing of maximised frames. + (mswindows_raise_frame): remove comment. + +1999-03-01 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.11 is released + +1999-02-25 SL Baur <steve@xemacs.org> + + * mule-charset.c (Qleading_byte): New variable to implement + charset-leading-byte function. + (Fcharset_property): Use it. + (syms_of_mule_charset): Initialize it. + From Kazuyuki IENAGA <ienaga@jsys.co.jp> + +1999-02-17 Kazuo Oishi <oishi@ae.agr.yamaguchi-u.ac.jp> + + * glyphs-x.c (cononvert_EImage_to_XImage): correct + bytes per pixel counting. + +1999-02-15 Andy Piper <andy@xemacs.org> + + * s/cygwin32.h (BROKEN_SIGIO): don't define this as it causes + major lockups. + +1999-02-16 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * fns.c (Fbase64_encode_string): New optional argument + `NO_LINE_BREAK'. + +1999-02-16 Martin Buchholz <martin@xemacs.org> + + * gdbinit: Fix up commands to run temacs. Add lisp-shadows command. + * alloc.c (xcalloc): undef xcalloc, just like xmalloc + +1999-02-10 Martin Buchholz <martin@xemacs.org> + + * s/bsdos4.h: New file. Port to BSDI BSD/OS 4.0. + * xintrinsic.h: Redo CONST support for X11 R4 compatibility. + +1999-02-05 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.10 is released + +1999-02-02 Gleb Arshinov <gleb@cs.stanford.edu> + + * process-nt.c (nt_send_process): + Fix for process-send-region/process-send-string breaking when size + of the input > 128 chars: change maximum chunk size for process + stream from 512 to 128, thus guaranteeing that ntpipe_shove_writer + succeeds. + +1999-02-02 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.9 is released + +1999-01-30 Martin Buchholz <martin@xemacs.org> + + * bytecode.c (funcall_compiled_function): Call + UNBIND_TO_GCPRO instead of UNBIND_TO_GCPRO_VARIABLES_ONLY. + + * backtrace.h (UNBIND_TO_GCPRO_VARIABLES_ONLY): + #ifdef 0 out unused macro. + +1999-01-27 Martin Buchholz <martin@xemacs.org> + + * gui.c (gui_parse_item_keywords_internal): Make static. + +1999-01-21 Andy Piper <andy@xemacs.org> + + * glyphs-msw.c: add xface support. + (mswindows_xface_instantiate): new function copied from glyphs-x.c + (image_instantiator_format_create_glyphs_mswindows): do device + specific initialisation for xfaces. + (xbm_create_bitmap_from_data): line data must be padded to a word + boundary. + + * glyphs-x.c (xface_validate): moved to glyphs.c + (xface_normalize): ditto. + (xface_possible_dest_types): ditto. + (image_instantiator_format_create_glyphs_x): do device specific + initialisation for xfaces. + + * glyphs.h: declare xface symbol. + + * glyphs.c: move generic xface support here. + (xface_validate): moved from glyphs-x.c + (xface_normalize): ditto. + (xface_possible_dest_types): ditto. + (image_instantiator_format_create): xface declarations moved from + glyphs-x.c. + +1999-01-14 Adrian Aichner <adrian@xemacs.org> + + * event-stream.c (vars_of_event_stream): Fixing documentation. + +1999-01-17 Gunnar Evermann <ge204@eng.cam.ac.uk> + + * glyphs-eimage.c (gif_instantiate): Correct handling of + interlaced gifs to avoid writing past the end of the eimage + buffer. + +1999-01-13 Hrvoje Niksic <hniksic@srce.hr> + + * search.c (Freplace_match): Handle single backslash at end of + NEWTEXT correctly. + +1999-01-12 William M. Perry <wmperry@aventail.com> + + * eldap.c (Fldap_open): slow down interrupts around ldap_open to + avoid connection errors. + +1999-01-12 Andy Piper <andy@xemacs.org> + + * redisplay-output.c (redisplay_update_line): backout change that + shouldn't have gone ine. + +1999-01-09 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> + + * eldap.c (vars_of_ldap): Do no provide `ldap' here since it may + collide with ldap.el + +1999-01-11 Andy Piper <andy@xemacs.org> + + * redisplay.h (DISPLAY_LINE_HEIGHT): new macro. + (DISPLAY_LINE_YPOS): new macro. + + * redisplay-msw.c (mswindows_output_string): use it. + (mswindows_output_pixmap): ditto. + (mswindows_output_display_block): ditto. + + * redisplay-output.c (redisplay_output_display_block): new + function. just call the devmeth, maybe insert some generic code + here later. + (compare_display_blocks): use it. + (output_display_line): ditto. + (redisplay_unmap_subwindows_maybe): new function. potentially + unmap subwindows in the given area. + + * glyphs.c (reset_subwindow_cachels): unmap subwindows that we are + resetting. + +1999-01-10 J. Kean Johnston <jkj@sco.com> + + * Makefile.in.in: Set value of moduledir + - Changed DUMPENV to include $(MODULEPATH) + - Added install rule to install header files for use by ellcc. + + * config.h.in: Added INHIBIT_SITE_MODULES + - Added HAVE__DLERROR + - Added HAVE_DLFCN_H + - Added DLSYM_NEEDS_UNDERSCORE + + * dll.c: Removed. + + * emodules.c: New file containing dynamic loading code. + + * emodules.h: New file. + + * emacs.c: Added variables Vmodule_directory, + Vsite_module_directory, Vconfigure_module_directory and + Vconfigure_site_module_directory. + - (main_1): Added new variable inhibit_site_modules and command + line options `-no-site-modules' and `--no-site-modules'. + - (main_1): Call syms_of_module() instead of syms_of_dll(). + - (main_1): Call vars_of_module(). + - (vars_of_emacs): Introduce inhibit-site-modules, + module-directory, configure-module-directory, + site-module-directory, and configure-site-module-directory to the + Lisp reader. + + * lisp.h: Declare load_module and list_modules, as well as + Vmodule_directory, Vsite_module_directory, + Vconfigure_module_directory and Vconfigure_site_module_directory. + + * paths.h.in: Added PATH_MODULESEARCH and PATH_SITE_MODULES. + - Added correct support for site-lisp directory. + + * symbols.c (defsubr): Modified to allow modules to add new subrs + after dump time. + - (defsubr_macro): Same. + - (defvar_magick): Only use purespace when not initialized, so + that loaded modules can still add symbols. + + * symsinit.h: Add definitions for syms_of_module(), + vars_of_module(). Removed syms_of_dll(). + + * sysdll.c: Include dlfcn.h if HAVE_DLFCN_H is defined. + - (dll_variable): Take DLSYM_NEEDS_UNDERSCORE into account. + - (dll_error): use _dlerror() if HAVE__DLERROR is defined. + + * s/sco5-shr.h (C_SWITCH_SYSTEM): Correct for modern gcc and + explicitly pass -belf for native cc. + + * s/sco5.h (LIB_GCC): Use -print-libgcc-file-name instead of + hard-coding the library name. + +1999-01-01 <martin@xemacs.org> + + * device-x.c (Fx_set_font_path): + Add proper cast to permit compilation under C++. + + * buffer.c (directory_is_current_directory): + Add proper casts to permit compilation under C++. + +1998-12-30 Damon Lipparelli <lipp@primus.com> + + * event-msw.c (mswindows_wnd_proc): + Fixed failure when building with MSVC 5. + +1998-12-29 Martin Buchholz <martin@xemacs.org> + + * file-coding.c (decode_coding_iso2022): + - Prevent crash when decoding ISO7/Lock detected files + - the usual martin fiddling + +1998-12-29 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * event-msw.c: + glyphs-msw.c: + Fixed failures when building with MSVC. + * unexnt.c (dump_bss_and_heap): + Removed compiler warning by removing bss_data variable. + +1998-12-18 Jim Radford <radford@robby.caltech.edu> + + * device-x.c (Fx_set_font_path, Fx_get_font_path): New functions + so that packages that distribute their own fonts can access them. + +1998-12-28 Andy Piper <andy@xemacs.org> + + * glyphs-msw.c (mswindows_button_instantiate): cope with buttons + that have an image provided. + + * glyphs.h: add Q_image decl. + + * glyphs-widget.c new functionality allowing images in + widgets. + (check_valid_glyph_or_image): new function to validate + glyphs passed in through :image. + (widget_normalize): new function. convert :image parameters into + real glyphs if not already so. + (widget_instantiate_1): mess with size parameters to be similar to + :image if provided. + (syms_of_glyphs_widget): new keyword :image. + (image_instantiator_format_create_glyphs_widget): normalize + buttons and allow :image. + +1998-12-27 Andy Piper <andy@xemacs.org> + + * frame-msw.c (mswindows_init_frame_1): warning elimination. + + * glyphs-widget.c (check_valid_anything): no-op function. + (check_valid_callback): check callbacks in gui_items. + (check_valid_symbol): as it sounds. + (check_valid_string_or_vector): ditto. + (widget_validate): modified for descriptors that are vectors or + sequences of keyword/val pairs. + (widget_instantiate_1): ditto. + (image_instantiator_format_create_glyphs_widget): allow gui_item + keywords in the instantiator. + + * gui.c (gui_parse_item_keywords_internal): renamed from + gui_parse_item_keywords but taking error behaviour. + (gui_parse_item_keywords): use it. + (gui_parse_item_keywords_no_errors): ditto. + (gui_item_add_keyval_pair): add Error_behavior flag and only + signal invalid keywords if required. + + * gui.h: new gui signatures. + + * menubar.c (menu_parse_submenu_keywords): use new + gui_item_add_keyval_pair signature. + + * s/cygwin32.h: modify PTY_ITERATION to eliminate warnings. + +1998-12-28 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.8 is released. + +1998-12-28 Martin Buchholz <martin@xemacs.org> + + * editfns.c (get_home_directory): + (user-home-directory): Simplify. + + + * callproc.c (child_setup): + - Environment variables were being passed to inferior processes + using internal encoding. + - Convert to external encoding. + - Rename local var `tem' to better name `tail'. + - Use Flength instead of `manual' calculation. + + * buffer.c (kill-buffer): + (record-buffer): + (set-buffer-major-mode): + (current-buffer): + - Fix up parameter names to correspond to docstrings. + - Don't use `bufname' when a buffer will do as well. + - Remove one unneeded GCPRO. + + * buffer.h (initial_directory): + * buffer.c (init_initial_directory): + - use correct conversions between internal and external format. + (directory_is_current_directory): new function + (init_buffer): convert initial_directory to internal format. + - solve crashes when current working directory is non-ASCII. + + * alloc.c (xmalloc): + (xcalloc): + (xrealloc): + - remove stupid casts, since XEmacs requires an ANSI C system. + (lrecord_type_index): replace abort() with more readable assert(). + + (reset_lcrecord_stats): remove. + (sweep_lcrecords_1): + - replace call to reset_lcrecord_stats() with call to xzero(). + +1998-12-27 Martin Buchholz <martin@xemacs.org> + + * process-unix.c (unix_create_process): + - Fix crash invoking program with non-ASCII name. + Try invoking xemacs with SHELL=/bin/sh, then M-x shell. + - Remove unused variable `env'. + - Rename `temp' to better name `save_errno'. + - Reorganize code for clarity. But still too chicken to nuke the + BSD 4.2 support. + +1998-12-24 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.7 is released. + +1998-12-23 Martin Buchholz <martin@xemacs.org> + + * glyphs.c (decode_device_ii_format): + - Fix indentation. + - Use GET_C_STRING_FILENAME_DATA_ALLOCA with char *, not Extbyte *. + + * glyphs-x.c (x_subwindow_instantiate): + - A image instance mask was being assigned to a image instance type! + - X_SUBWINDOW_INSTANCE_DATA (ii) is not an lvalue in C++. + + * glyphs-msw.c (mswindows_initialize_dibitmap_image_instance): + Fix indentation. + * glyphs-x.h: Make indentation consistent. + + * emacs.c (Fdump_emacs): Remove Steve Martin merge artifacts. + + * glyphs-widget.c (check_valid_glyph): Warning suppression. + - Make it static + - #ifdef it out, since it's not actually used yet (FIX THIS!) + + * glyphs-widget.c: + * glyphs.h: + Move declarations of decode_device_ii_format and + decode_image_instantiator_format into glyphs.h where they belong. + +1998-12-22 Martin Buchholz <martin@xemacs.org> + + * frame-x.c (x_delete_frame): Revert part of my changes at the + suggestion of Gunnar Evermann - unfortunately no one really + understands this code. + + * callproc.c (init_callproc): code cleanup. + + * free-hook.c (malloc): + (check_malloc): + (__free_hook): + (__malloc_hook): + (__realloc_hook): + (block_input_malloc): + (block_input_realloc): + * device-x.c (x_delete_device): + * emacs.c (voodoo_free_hook): + * events.c (print_event): + (CHECK_EVENT_TYPE): + (CHECK_EVENT_TYPE2): + (CHECK_EVENT_TYPE3): + Use proper prototypes. + Make C_E_T macros a little faster. + Pedantic fiddly little changes. You really don't care. + +1998-12-22 Andy Piper <andy@xemacs.org> + + * redisplay-output.c (redisplay_clear_region): make sure that + fg/bg colors get set even when we are in the border area. + +1998-12-13 Martin Buchholz <martin@xemacs.org> + + * console-msw.c: Function definitions follow coding standards + - This prevents e.g. find-tag on Lisp_Event finding DEVENT + +1998-12-11 Martin Buchholz <martin@xemacs.org> + + * events.h (struct timeout_data): + * event-tty.c (tty_timeout_to_emacs_event): + * event-msw.c (mswindows_wm_timer_callback): + * event-Xt.c (Xt_timeout_to_emacs_event): + * event-msw.c (mswindows_cancel_dispatch_event): + Make sure Lisp_Objects inside events are initialized to Qnil, not + Qnull_pointer, which is now illegal. + +1998-12-10 Martin Buchholz <martin@xemacs.org> + + * lisp.h: Fix up prototypes to match alloc.c + +1998-12-08 Martin Buchholz <martin@xemacs.org> + + * windowsnt.h: Remove `support' for using index and rindex + + * filelock.c (current_lock_owner): + - Change uses of index -> strchr, rindex -> strrchr + +1998-12-07 Martin Buchholz <martin@xemacs.org> + + * sysdep.c (set_descriptor_non_blocking): + Since O_NONBLOCK is now always #defined, make use of fcntl + conditional on F_SETFL being defined. + + * console-msw.c (DHEADgER): + (DOPAQUE_DATA): + (DEVENT): + (DCONS): + (DCONSCDR): + (DSTRING): + (DVECTOR): + (DSYMBOL): + (DSYMNAME): + - max_align_t should not be visible to the user of the + XOPAQUE_DATA macro. + - use Bufbyte instead of char + - parens around (FOOP (obj)) are always redundant. + If they were necessary, we should fix the macro instead. + - Always use string_data(foo) instead of foo->data. + + +1998-12-06 Martin Buchholz <martin@xemacs.org> + + * frame-msw.c (mswindows_init_frame_1): + - use make_lisp_hash_table, not Fmake_hash_table + - include elhash.h + + * lisp.h: + * alloc.c (make_vector): remove travesty + (Fmake_vector): + (make_pure_vector): + (pure_cons): + (make_bit_vector_internal): + (make_bit_vector): + (make_bit_vector_from_byte_vector): + (Fmake_bit_vector): + - make vector_equal a little faster. + - Don't use variable name `new'. + - Use size_t instead of EMACS_INT. + - usual Martin-style pointless bit-twiddling. + + * fns.c (mapcar1): + (Fmapconcat): + (Fmapcar): + (Fmapvector): + Make mapcar faster. In particular, make + (mapc #'identity long-string) + MUCH faster under Mule. + * tests/automated/lisp-tests.el: Test 'em! + + * bytecode.c (Ffetch_bytecode): Fix crash when loading lazy-loaded + bytecode. + +1998-12-01 Martin Buchholz <martin@xemacs.org> + + * menubar-x.c (menu_item_descriptor_to_widget_value_1): Always use + Qnil, not NULL, to initialize `null' Lisp_Objects. + +1998-11-29 Hrvoje Niksic <hniksic@srce.hr> + + * specifier.c (display_table_validate): Update. + + * redisplay.c (create_text_block): Use them. + + * glyphs.c (display_table_entry): New function. + (get_display_tables): Ditto. + +1998-12-15 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> + + * eldap.c (toplevel): Mention that eldap.c compiles with + OpenLDAP libs + (Fldap_open): Use `GET_C_STRING_OS_DATA_ALLOCA' + (Fldap_search_internal): Ditto + +1998-12-11 Martin Buchholz <martin@xemacs.org> + + * event-msw.c (mswindows_cancel_dispatch_event): + Gratuitous code prettification + + +1998-12-07 Hrvoje Niksic <hniksic@srce.hr> + + * fns.c (Fnconc): Fix use of wrong_type_argument(). + + * floatfns.c (Ffloat): Fix docstring. + (Ffloat): Fix use of wrong_type_argument(). + (Fabs): Ditto. + (extract_float): Ditto. + (Fceiling): Ditto. + (Fround): Ditto. + (Ftruncate): Ditto. + +1998-12-06 Martin Buchholz <martin@xemacs.org> + + * frame-msw.c (mswindows_init_frame_1): + - use make_lisp_hash_table, not Fmake_hash_table + - include elhash.h + + * lisp.h: + * alloc.c (make_vector): remove travesty + (Fmake_vector): + (make_pure_vector): + (pure_cons): + (make_bit_vector_internal): + (make_bit_vector): + (make_bit_vector_from_byte_vector): + (Fmake_bit_vector): + - make vector_equal a little faster. + - Don't use variable name `new'. + - Use size_t instead of EMACS_INT. + - usual Martin-style pointless bit-twiddling. + + * fns.c (mapcar1): + (Fmapconcat): + (Fmapcar): + (Fmapvector): + Make mapcar faster. In particular, make + (mapc #'identity long-string) + MUCH faster under Mule. + * tests/automated/lisp-tests.el: Test 'em! + + * bytecode.c (Ffetch_bytecode): Fix crash when loading lazy-loaded + bytecode. + +1998-12-02 Didier Verna <verna@inf.enst.fr> + + * menubar-x.c (menu_item_descriptor_to_widget_value_1): set the + accelerator field to nil for labels. + +1998-12-16 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * menubar-msw.c (displayable_menu_item): + Escape occurrences of '&' and support occurrences of the + '%_' accelerator indicator in menus. + +1998-11-26 Didier Verna <verna@inf.enst.fr> + + * dired.c (Fdirectory_files): use make_string instead of + make_ext_string on the filename. The conversion external->internal + format is already done in sys_readdir. + +1998-12-15 Gunnar Evermann <ge204@eng.cam.ac.uk> + + * glyphs.c (normalize_image_instantiator): GCPRO instantiator + +1998-12-16 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * event-msw.c + (Belatedly) added Kirill to list of file's authors. + emacs_mswindows_quit_p: Don't process WM_PAINT messages in + quit checking. WM_PAINT messages cause redisplay, but + windows' states are not necessarily stable when this function + gets called. + +1998-12-17 Andy Piper <andy@xemacs.org> + + * strftime.c (zone_name): CONSTify. + +1998-12-15 Andy Piper <andy@xemacs.org> + + * glyphs-msw.c (mswindows_combo_instantiate): ditto. + (mswindows_widget_property): return Qunbound when no property available. + (mswindows_button_property): ditto. + (mswindows_combo_property): ditto. + (mswindows_widget_set_property): ditto. + + * glyphs-widget.c (check_valid_item_list): use properties. + + * glyphs.h (struct Lisp_Image_Instance): we have properties now. + + * glyphs.c (Fset_image_instance_property): allow setting of arbitrary properties. + (Fimage_instance_property): ditto. + * glyphs-widget.c (widget_property): ditto. + (widget_set_property): ditto. + + * frame-msw.c (mswindows_set_frame_pointer): SetCursor() as well + as setting the class cursor so that GC actually changes the + cursor. + + * config.h: don't undef MAIL_USE_POP. + +1998-12-13 Andy Piper <andy@xemacs.org> + + * glyphs-msw.c + (image_instantiator_format_create_glyphs_mswindows): line -> + label. + (mswindows_label_instantiate): ditto. Play with window flags. + (image_instantiator_format_create_glyphs_mswindows): ditto. + (vars_of_glyphs_mswindows): provide Qlabel as we support it now. + + * glyphs-widget.c (widget_instantiate_1): re-jig autosizing to + cope with lines and labels. + (static_instantiate): use widget_instantiate_1. + line -> label. + (image_instantiator_format_create_glyphs_widget): ditto. + +1998-12-10 Andy Piper <andy@xemacs.org> + + * Makefile.in.in (objs): add gui.o + +1998-12-10 Andy Piper <andy@xemacs.org> + + * gui.c: adjust defines of HAVE_POPUPS so that we can build with + no window system. + +1998-12-09 Andy Piper <andy@xemacs.org> + + * glyphs.c (finalize_image_instance): mark glyphs changed when an + image instance is removed so that the subwindow cache gets reset + and thus destroyed images get GC'd. + +1998-12-08 Andy Piper <andy@xemacs.org> + + * gui-msw.c (mswindows_handle_gui_wm_command): call + MARK_SUBWINDOWS_CHANGED. + + * glyphs-msw.c (mswindows_finalize_image_instance): make sure + subwindows really get deleted. + + * redisplay.c: new variable subwindows_changed[_set]. + (redisplay_window): use it. + (redisplay_frame): ditto. + (redisplay_device): ditto. + (redisplay_without_hooks): ditto. + + * device.h (MARK_DEVICE_SUBWINDOWS_CHANGED): new macro for + subwindows redisplay as per glyphs equivalent. + * redisplay.h: ditto. + (MARK_SUBWINDOWS_CHANGED): ditto. + (RESET_CHANGED_SET_FLAGS): ditto. + * frame.h (MARK_FRAME_SUBWINDOWS_CHANGED): ditto. + +1998-12-07 Andy Piper <andy@xemacs.org> + + * frame.c (Fmake_frame): reset subwindow cachels on non-stream + frames. + + * redisplay.c (redisplay_frame): invalidate subwindow cachels. + + * event-msw.c (mswindows_wnd_proc): catch the various WM_CTLCOLOR* + messages and paint widget glyphs as appropriate with their face fg + & bg. + +1998-12-06 Andy Piper <andy@xemacs.org> + + * glyphs-msw.c (vars_of_glyphs_mswindows): provide widget types + here rather than in glyphs-widget - do this because we only want + to provide what is really available. + + * glyphs.c (Fimage_instance_property): new function to get the + properties of image instances. wires through to console specific + methods and then to widget specific methods. + (Fset_image_instance_property): ditto but for setting widget properties. + (check_valid_face): make extern so that it can be used elsewhere. + + * glyphs-widget.c (widget_property): new function. gets the + properties of widgets in general and wires the function through to + widget specific ones. + (widget_set_property): ditto but for setting widget properties. + + * glyphs-msw.c (mswindows_combo_instantiate): Add functionality to + add items to the list. Play with window styles a bit to get the + desired effect. + (mswindows_widget_property): break out specific widget properties. + (mswindows_button_property): new function. gets the checked state + of a button. + (mswindows_combo_property): new function. gets the current + selection in the combo box. + (mswindows_widget_set_property): new function. sets specific + properties of specific widgets. + + * glyphs-widget.c (check_valid_item_list): new function. check + that items for a combo-box are just a list of strings. + (combo_validate): new function. check there is an item list. + (widget_instantiate_1): new function. renamed from + widget_instantiate so that we can do slightly different things for + other widgets. + (widget_instantiate): call widget_instantiate_1. + (combo_instantiate): new function to instantiate combo boxes, + defaults height to the pixel height of the number of items in the + box. + (syms_of_glyphs_widget): move widget keywords here. + (image_instantiator_format_create_glyphs_widget): use new combo + functions. + +1998-12-04 Andy Piper <andy@xemacs.org> + + * event-msw.c (mswindows_wnd_proc): mule-ize. + + * glyphs.c (pixmap_to_lisp_data): mule-ize. + + * glyphs-msw.c (extract_xpm_color_names): mule-ize. + (resource_name_to_resource): ditto. + (mswindows_resource_instantiate): ditto. + (mswindows_widget_instantiate): ditto. + (mswindows_widget_set_property): ditto. + + * redisplay-output.c (redisplay_output_subwindow): don't show + subwindows if they are obscured at the edge of the frame, emacs + gets into some sort of redisplay loop otherwise. + + * gui.h: prototype gui_item_selected_p. + + * gui.c (gui_item_selected_p): new function to determine the + selected state of a gui_item. + + * frame.h (struct frame): add subwindows_changed flag. + + * redisplay.c (redisplay_frame): call update_frame_subwindows (). + + * glyphs.c (update_subwindow): new function to update a + subwindow's state. + (update_frame_subwindows): new function to update all the + subwindows on a frame. + + * console.h (struct console_methods): add update_subwindow. + + * glyphs-msw.c (mswindows_widget_property): return selected state + for selected property. + (mswindows_update_subwindow): new function. updates widget glyphs + in redisplay as per menubars or toolbars e.g. selected state. + (console_type_create_glyphs_mswindows): add update_subwindow. + +1998-12-03 Andy Piper <andy@xemacs.org> + + * console-tty.c (syms_of_console_tty): MULE -> FILE_CODING since + tty coding system things are such. + + * glyphs-widget.c (widget_face_font_info): new function for + pulling out height and width metrics for a widget's face. + (widget_text_to_pixel_conversion): calculate pixel sizes of text + for widgets. + + * event-msw.c (mswindows_drain_windows_queue): translate messages + that are destined for subwindows. This makes edit fields interact + with the keyboard correctly. + nuke warnings by #ifndef'ing out stuff not required by msg select(). + + * glyphs.h (INITIALIZE_IMAGE_INSTANTIATOR_FORMAT_NO_SYM): new + macro defining the iiforma without the symbol required by widget. + (INITIALIZE_IMAGE_INSTANTIATOR_FORMAT): use it. + + * general.c (syms_of_general): add Qwidget, Qselected. + + * faces.c (complex_vars_of_faces): add widget face inheriting from + gui-element face. + +1998-11-09 Andy Piper <andy@xemacs.org> + + * window.h (struct window): add a cache of subwindows on a + per-window basis. + + * window.c (mark_window): mark the subwindow_instance_cache. + (allocate_window): initialise the subwindow instance_cache. + + * toolbar-x.c (x_output_toolbar): call redisplay_clear_region + instead of the devmeth. + (x_clear_toolbar): ditto. + + * redisplay-x.c (x_output_display_block): call + redisplay_output_subwindow for subwindows and widgets. + + * redisplay-tty.c (tty_output_display_block): add IMAGE_WIDGET to + types to do nothing for. + + * lisp.h: declare new widget/subwindow symbols. + + * glyphs.c (image_instantiate): cache subwindows on a per-window + basis. + (subwindow_possible_dest_types): new function for subwindow dest + types. + (subwindow_instantiate): generic instantiation of a + subwindow. specialised by device multi-methods. + (Fsubwindowp): moved from glyphs-x.c. adapted for glyph-based + subwindows. + (Fimage_instance_subwindow_id): ditto. + (Fresize_subwindow): ditto. + (Fforce_subwindow_map): ditto. + + * glyphs-x.c (x_print_image_instance): remove subwindow + stuff. Handled genrically in glyphs.c. + (x_image_instance_equal): ditto. + (x_image_instance_hash): ditto. + (x_finalize_image_instance): delete subwindows when required. + (mark_subwindow) (print_subwindow) (finalize_subwindow) + (subwindow_hash) (Fmake_subwindow): deleted because of new, + glyph-based, subwindow implementation. + (Fsubwindow_height) (Fsubwindow_width) (Fsubwindow_xid): aliased + in glyphs.el + (Fsubwindowp) (Fresize_subwindow) (Fforce_subwindow_map): moved to + glyphs.c. + (x_unmap_subwindow): new function to unmap X subwindows. + (x_map_subwindow): new function to map X subwindows. + (x_subwindow_instantiate): new function to instantiate X + subwindows. + (x_resize_subwindow): new function to resize X subwindows. + (console_type_create_glyphs_x): add subwindow functions. + (image_instantiator_format_create_glyphs_x): add device + multi-methods for xpm, xbm and subwindow. + + * glyphs.el (subwindow-xid): old alias for new subwindow functions. + (subwindow-width): ditto. + (subwindow-height): ditto. + + * glyphs-msw.c (mswindows_widget_instantiate): new function for + generally instantiating ms subwindows. Used by + mswindows_*_instantiate. + (mswindows_edit_instantiate): instantiate an edit field on a + mswindows frame. + +1998-11-04 Andy Piper <andy@xemacs.org> + + * symsinit.h: declare new functions. + + * redisplay.h: declare new functions. + + * redisplay-x.c (x_output_display_block): call + redisplay_clear_region rather than x_clear_region. + (x_output_string): ditto. + (x_output_pixmap): ditto. + (x_clear_to_window_end): ditto. + (x_output_eol_cursor): ditto. + (x_clear_region): only do X specific things. other duties handled + in redisplay_clear_region. + + * redisplay-tty.c (tty_clear_region): do tty specific things - some + duties moved to redisplay_clear_region. + + * redisplay-output.c (clear_left_border): use + redisplay_clear_region instead of device method. + (clear_right_border): ditto. + (output_display_line): ditto. + (redisplay_output_subwindow): ditto. + (redisplay_clear_top_of_window): ditto. + (redisplay_clear_region): perform duties previously handled by + device methods. call the appropriate device method at the + end. unmap subwindows if necessary. + + * redisplay-msw.c (mswindows_output_string): use + redisplay_clear_region instead of mswindows_clear_region. + (mswindows_clear_to_window_end): ditto. + (mswindows_output_display_block): output subwindows when required. + (mswindows_clear_region): only do mswindows specific things, + everything else is now handled in redisplay_clear_region. + + * gui.h: add item id hash defines and declare function prototypes. + + * gui.c (mark_gui_item): new function for marking gui_items. + (gui_item_hash): generic hash function for generating command ids + for gui_items. + + * gui-msw.c: new file. + (mswindows_handle_gui_wm_command): new function to handle widget + callbacks. + + * glyphs.h (MAYBE_IIFORMAT_DEVMETH): new function for device + multi-methods. + (IIFORMAT_HAS_SHARED_METHOD): ditto. + (DEFINE_DEVICE_IIFORMAT): ditto. + (INITIALIZE_DEVICE_IIFORMAT): ditto. + (struct Lisp_Image_Instance): add widget and subwindow data plus + appropriate access functions. + + * glyphs.c (decode_device_ii_format): new function for decoding + image instantiator functions based on a device type as well as an + image format. + (decode_image_instantiator_format): just call + decode_device_ii_format with nil device. + (add_entry_to_device_ii_format_list): new function for per device + method instances. + (add_entry_to_image_instantiator_format_list): just call + add_entry_to_device_ii_format_list with nil device. + (check_valid_vector): new function. + (instantiate_image_instantiator): instantiate using per-format + method and then per-format-per-device method (device + multi-methods). signal an error if neither is possible. + (mark_image_instance): cope with subwindows and widgets. + (print_image_instance): ditto. + (image_instance_equal): ditto. + (image_instance_hash): ditto. + (allocate_glyph): ditto. + (glyph_width): ditto. + (glyph_height_internal): ditto. + (xpm_instantiate): removed because of device multi-methods. + (mark_subwindow_cachels): new cachel functions for caching + instantiated subwindows on a per-frame basis. mostly copied from + glyph cachel functions. + (update_subwindow_cachel_data): ditto. + (add_subwindow_cachel): ditto. + (get_subwindow_cachel_index): ditto. + (reset_subwindow_cachels): ditto. + (mark_subwindow_cachels_as_not_updated): ditto. + (unmap_subwindow): generic unmapping of subwindows based on cachel + data. + (map_subwindow): ditto. + (initialize_subwindow_image_instance): generic initialisation of + subwindow data. + (syms_of_glyphs): add widget keywords. + + * glyphs-x.h (struct x_subwindow_data): convert Lisp_Subwindow to + x_subwindow_data. + +1998-11-04 Andy Piper <andy@xemacs.org> + + * glyphs-widget.c: new file for instantiating widget type glyphs. + (widget_possible_dest_types): new general dest type function for + widgets. + (widget_validate): ditto. + (initialize_widget_image_instance): ditto + (widget_instantiate): ditto. Sets up fg/bg, gui_item parsing + before handing on control to device multi-methods. + (syms_of_glyphs_widget): new function. + (image_instantiator_format_create_glyphs_widget): new function, + added placeholders for button, edit, combo, scrollbar + (vars_of_glyphs_widget): new function. + + * glyphs-msw.h (WIDGET_INSTANCE_MSWINDOWS_HANDLE): new define for + storing window ids of widgets. + + * glyphs-msw.c (mswindows_finalize_image_instance): cope with + deletion of widget and subwindow glyphs. + (mswindows_unmap_subwindow): new device function for unmapping + subwindows on a msw frame. + (mswindows_map_subwindow): ditto. + (mswindows_register_image_instance): register instantiated widgets + with the widget hastable. + (mswindows_button_instantiate): instantiate a button type widget + on an msw frame. + (mswindows_subwindow_instantiate): instanttiate a subwindow on a + mswindows frame. + (image_instantiator_format_create_glyphs_mswindows): add device + multi-methods for xbm, xpm, subwindow, edit and button. + + * frame.h (struct frame): add subwindow_cachels dynarr for caching + information about subwindows visible on the current frame. used by + redisplay_clear_region to unmap subwindows as required. + + * frame.c (mark_frame): mark subwindow_cachels. + (allocate_frame_core): instantiate subwindow_cachels. + + * frame-msw.c (mswindows_init_frame_1): instntiate and mark the + widget hashtable. + + * event-msw.c (mswindows_wnd_proc): add call to + mswindows_handle_gui_wm_command to handle widget callbacks. + + * emacs.c (main_1): add calls to glyphs-widget initialisation + routines. + + * console.h (struct console_methods): add + unmap/map_subwindow_method for use be redisplay_clear_region to + map and unmap subwindows. Remove xpm and xbm stuff - now dealt + with by image instantiator multi-methods. Add + resize_subwindow_method. + + * console-stream.c (stream_clear_region): change signature to + match new generic clear region function. + + * Makefile.in.in: add glyphs-widget.o to list of objects. + + * console-msw.h (struct mswindows_frame): add widget hashtable for + wiring command ids to callbacks. + +1998-12-16 Andy Piper <andy@xemacs.org> + + * XEmacs 21.2.6 is released + +1998-12-08 Hrvoje Niksic <hniksic@srce.hr> + + * md5.c (Fmd5): Correctly initiate string input stream. + + * Makefile.in.in (tests): Add md5-tests.el. + +1998-12-06 Martin Buchholz <martin@xemacs.org> + + * lisp.h: + * alloc.c (make_vector): remove travesty + (Fmake_vector): + (make_pure_vector): + (pure_cons): + (make_bit_vector_internal): + (make_bit_vector): + (make_bit_vector_from_byte_vector): + (Fmake_bit_vector): + - make vector_equal a little faster. + - Don't use variable name `new'. + - Use size_t instead of EMACS_INT. + - usual Martin-style pointless bit-twiddling. + + * fns.c (mapcar1): + (Fmapconcat): + (Fmapcar): + (Fmapvector): + Make mapcar faster. In particular, make + (mapc #'identity long-string) + MUCH faster under Mule. + * tests/automated/lisp-tests.el: Test 'em! + +1998-12-06 Martin Buchholz <martin@xemacs.org> + + * bytecode.c (Ffetch_bytecode): Fix crash when loading lazy-loaded + bytecode. + +1998-12-13 Martin Buchholz <martin@xemacs.org> + + * console-msw.c: Function definitions follow coding standards + - This prevents e.g. find-tag on Lisp_Event finding DEVENT + +1998-12-11 Martin Buchholz <martin@xemacs.org> + + * events.h (struct timeout_data): + * event-tty.c (tty_timeout_to_emacs_event): + * event-msw.c (mswindows_wm_timer_callback): + * event-Xt.c (Xt_timeout_to_emacs_event): + * event-msw.c (mswindows_cancel_dispatch_event): + Make sure Lisp_Objects inside events are initialized to Qnil, not + Qnull_pointer, which is now illegal. + +1998-12-10 Martin Buchholz <martin@xemacs.org> + + * lisp.h: Fix up prototypes to match alloc.c + +1998-12-09 Andy Piper <andy@xemacs.org> + + * glyphs-msw.c (init_image_instance_from_xbm_inline): don't use + XSETINT for assigning lisp objects. + +1998-12-07 Martin Buchholz <martin@xemacs.org> + + * opaque.h: + * console-msw.c (DHEADER): + (DOPAQUE_DATA): + (DEVENT): + (DCONS): + (DCONSCDR): + (DSTRING): + (DVECTOR): + (DSYMBOL): + (DSYMNAME): + - max_align_t should not be visible to the user of the + XOPAQUE_DATA macro. + - use Bufbyte instead of char + - parens around (FOOP (obj)) are always redundant. + If they were necessary, we should fix the macro instead. + - Always use string_data(foo) instead of foo->data. + +1998-12-07 Martin Buchholz <martin@xemacs.org> + + * sysdep.c (set_descriptor_non_blocking): + Since O_NONBLOCK is now always #defined, make use of fcntl + conditional on F_SETFL being defined. + +1998-12-09 Andy Piper <andy@xemacs.org> + + * menubar-msw.c (mswindows_handle_wm_command): add back in checks + that got removed in the merge + +1998-11-30 Greg Klanderman <greg@alphatech.com> + + * dired.c (vars_of_dired): bugfix for previous conditionalization + of user-name-completion on non- Windows NT. + +1998-12-08 Martin Buchholz <martin@xemacs.org> + + * windowsnt.h: Remove `support' for using index and rindex + + * filelock.c (current_lock_owner): + - Change uses of index -> strchr, rindex -> strrchr + +1998-12-06 Martin Buchholz <martin@xemacs.org> + + * frame-msw.c (mswindows_init_frame_1): + - use make_lisp_hash_table, not Fmake_hash_table + - include elhash.h + +1998-12-05 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.5 is released + +1998-11-30 Martin Buchholz <martin@xemacs.org> + + * xselect.c (receive_incremental_selection): + * xselect.c (x_get_window_property): + * xmu.c (XmuReadBitmapDataFromFile): + * xmu.c (XmuCursorNameToIndex): + * xgccache.c (describe_gc_cache): + * xgccache.c (gc_cache_lookup): + * xgccache.c (free_gc_cache): + * xgccache.c (make_gc_cache): + * window.h: + * window.c (map_windows_1): + * window.c (Fother_window_for_scrolling): + * window.c (window_scroll): + * window.c (change_window_height): + * window.c (Fsplit_window): + * window.c (window_left_gutter_width): + * window.c (window_modeline_height): + * window.c (invalidate_vertical_divider_cache_in_window): + * window.c (window_needs_vertical_divider_1): + * window.c (update_mirror_internal): + * window.c (SET_LAST_FACECHANGE): + * widget.c (Fwidget_plist_member): + * unexec.c (copy_text_and_data): + * unexcw.c (copy_executable_and_dump_data_section): + * tooltalk.doc: + * tooltalk.c (struct Lisp_Tooltalk_Pattern): + * tooltalk.c (struct Lisp_Tooltalk_Message): + * toolbar.h (struct toolbar_button): + * toolbar.c (default_toolbar_visible_p_changed_in_window): + * toolbar.c (recompute_overlaying_specifier): + * toolbar.c (toolbar_validate): + * toolbar.c (toolbar_button_at_pixpos): + * toolbar.c (get_toolbar_coords): + * toolbar.c (update_frame_toolbars): + * toolbar-x.c: + * toolbar-msw.c (mswindows_handle_toolbar_wm_command): + * toolbar-msw.c (mswindows_find_toolbar_pos): + * toolbar-msw.c (mswindows_output_toolbar): + * toolbar-msw.c (mswindows_clear_toolbar): + * toolbar-msw.c: + * systty.h: + * syssignal.h: + * sysproc.h: + * sysfile.h: + * sysdll.c: + * sysdep.h: + * sysdep.c (rmdir): + * sysdep.c (sys_fopen): + * sysdep.c (sys_open): + * sysdep.c (tty_init_sys_modes_on_device): + * sysdep.c (get_eof_char): + * sysdep.c (child_setup_tty): + * sysdep.c (set_descriptor_non_blocking): + * syntax.h: + * syntax.c (scan_words): + * syntax.c: + * symsinit.h: + * symeval.h (struct symbol_value_varalias): + * symeval.h (struct symbol_value_forward): + * symbols.c (syms_of_symbols): + * symbols.c (init_symbols_once_early): + * symbols.c (Fbuilt_in_variable_type): + * symbols.c (Fsymbol_value_in_buffer): + * symbols.c (default_value): + * symbols.c (Fset): + * symbols.c (find_symbol_value_quickly): + * symbols.c (store_symval_forwarding): + * symbols.c (set_default_console_slot_variable): + * symbols.c (set_default_buffer_slot_variable): + * symbols.c (verify_ok_for_buffer_local): + * symbols.c (symbol_is_constant): + * symbols.c (oblookup): + * symbols.c (Funintern): + * symbols.c (Fintern): + * symbols.c (check_obarray): + * sunplay.c: + * specifier.h (struct specifier_methods): + * specifier.h: + * specifier.c (specifier_instance): + * specifier.c (specifier_instance_from_inst_list): + * specifier.c (decode_locale_type): + * specifier.c (specifier_equal): + * specifier.c (finalize_specifier): + * specifier.c (prune_specifiers): + * specifier.c (kill_specifier_buffer_locals): + * sound.c (init_native_sound): + * sound.c: + * signal.c (alarm): + * search.c (Fmatch_data): + * search.c (match_limit): + * search.c (Freplace_match): + * search.c (skip_chars): + * search.c (scan_buffer): + * search.c: + * scrollbar.c (specifier_vars_of_scrollbar): + * scrollbar.c (Fscrollbar_set_hscroll): + * scrollbar.c (vertical_scrollbar_changed_in_window): + * scrollbar.c (release_window_mirror_scrollbars): + * scrollbar.c (free_scrollbar_instance): + * scrollbar-x.c: + * scrollbar-msw.c: + * s/msdos.h (O_BINARY): + * s/linux.h: + * s/freebsd.h (LIBS_TERMCAP): + * regex.c (re_match_2_internal): + * regex.c (compile_extended_range): + * regex.c (POP_FAILURE_POINT): + * regex.c (PUSH_FAILURE_POINT): + * redisplay.h (RESET_CHANGED_SET_FLAGS): + * redisplay.h: + * redisplay.h (struct display_line): + * redisplay.h (struct rune): + * redisplay.c (vars_of_redisplay): + * redisplay.c (redisplay_variable_changed): + * redisplay.c (UPDATE_CACHE_RETURN): + * redisplay.c (validate_line_start_cache): + * redisplay.c (mark_redisplay_structs): + * redisplay.c (mark_glyph_block_dynarr): + * redisplay.c (window_line_number): + * redisplay.c (redisplay_frame): + * redisplay.c (redisplay_window): + * redisplay.c (generate_modeline): + * redisplay.c (create_right_glyph_block): + * redisplay.c (create_left_glyph_block): + * redisplay.c (create_text_block): + * redisplay.c: + * redisplay-x.c (x_output_hline): + * redisplay-x.c (x_output_vertical_divider): + * redisplay-tty.c (tty_output_display_block): + * redisplay-output.c (output_display_line): + * redisplay-output.c: + * redisplay-msw.c (mswindows_output_vertical_divider): + * redisplay-msw.c (mswindows_ring_bell): + * redisplay-msw.c (mswindows_output_cursor): + * redisplay-msw.c: + * rangetab.c: + * ralloc.c: + * puresize.h (RAW_PURESIZE): + * profile.c (syms_of_profile): + * profile.c (Fstart_profiling): + * profile.c (sigprof_handler): + * profile.c: + * procimpl.h: + * process.c (vars_of_process): + * process.c (read_process_output): + * process.c (get_process): + * process.c: + * process-unix.c (unix_open_multicast_group): + * process-unix.c (unix_get_tty_name): + * process-unix.c (unix_send_process): + * process-unix.c (unix_reap_exited_processes): + * process-unix.c (unix_create_process): + * process-unix.c (unix_init_process_io_handles): + * process-unix.c (allocate_pty): + * process-unix.c: + * process-nt.c (nt_open_network_stream): + * process-nt.c (nt_update_status_if_terminated): + * process-nt.c (nt_finalize_process_data): + * process-nt.c: + * print.c (debug_short_backtrace): + * print.c (debug_backtrace): + * print.c (print_symbol): + * print.c (print_internal): + * print.c (print_cons): + * print.c (Fwrite_char): + * print.c (print_prepare): + * print.c (canonicalize_printcharfun): + * print.c (output_string): + * print.c: + * opaque.h: + * opaque.c (allocate_managed_opaque): + * opaque.c: + * offix.c (DndSetData): + * objects.c (face_boolean_create): + * objects.c (font_instantiate): + * objects.c (font_create): + * objects.c (color_create): + * objects.c (finalize_font_instance): + * objects.c (finalize_color_instance): + * objects.c: + * objects-x.c (x_font_instance_truename): + * objects-x.c: + * objects-x.c (x_initialize_font_instance): + * objects-x.c (allocate_nearest_color): + * objects-tty.c (tty_initialize_font_instance): + * objects-tty.c (tty_initialize_color_instance): + * objects-msw.c (mswindows_initialize_color_instance): + * ntproc.c (syms_of_ntproc): + * ntproc.c (Fwin32_set_process_priority): + * ntproc.c (sys_spawnve): + * ntproc.c: + * ntheap.c (get_data_end): + * nt.c (period): + * nt.c: + * nt.c (stat): + * nt.c (generate_inode_val): + * nt.c (sys_rename): + * nas.c: + * mule-wnnfns.c (Fwnn_hinsi_number): + * mule-wnnfns.c (Fwnn_yuragi): + * mule-wnnfns.c (Fwnn_common_learn): + * mule-wnnfns.c (Fwnn_suffix_learn): + * mule-wnnfns.c (Fwnn_prefix_learn): + * mule-wnnfns.c (Fwnn_okuri_learn): + * mule-wnnfns.c (Fwnn_complex_conv): + * mule-wnnfns.c (Fwnn_last_is_first): + * mule-wnnfns.c (Fwnn_bmodify_dict_add): + * mule-wnnfns.c (Fwnn_notrans_dict_add): + * mule-wnnfns.c (Fwnn_fiusr_dict_add): + * mule-wnnfns.c (Fwnn_fisys_dict_add): + * mule-wnnfns.c (Fwnn_hinsi_list): + * mule-wnnfns.c (Fwnn_fuzokugo_set): + * mule-wnnfns.c (Fwnn_dict_search): + * mule-wnnfns.c (Fwnn_word_toroku): + * mule-wnnfns.c (Fwnn_hindo_update): + * mule-wnnfns.c (Fwnn_bunsetu_henkou): + * mule-wnnfns.c (Fwnn_kakutei): + * mule-wnnfns.c (Fwnn_begin_henkan): + * mule-wnnfns.c (Fwnn_dict_comment): + * mule-wnnfns.c (Fwnn_dict_add): + * mule-wnnfns.c (Fwnn_open): + * mule-mcpath.c (mc_getcwd): + * mule-coding.c (vars_of_mule_coding): + * mule-coding.c (convert_to_external_format): + * mule-coding.c (encoding_marker): + * mule-coding.c (decoding_marker): + * mule-coding.c (Fcopy_coding_system): + * mule-coding.c (Fmake_coding_system): + * mule-coding.c (Fcoding_system_list): + * mule-coding.c (Ffind_coding_system): + * mule-coding.c (symbol_to_eol_type): + * mule-coding.c: + * mule-charset.c (complex_vars_of_mule_charset): + * mule-charset.c (vars_of_mule_charset): + * mule-charset.c (Fset_charset_ccl_program): + * mule-charset.c (struct charset_list_closure): + * mule-charset.c (Ffind_charset): + * mule-charset.c (make_charset): + * mule-charset.c (non_ascii_valid_char_p): + * mule-charset.c: + * mule-ccl.c (ccl_driver): + * mule-canna.c (c2mu): + * mule-canna.c (Fcanna_henkan_begin): + * mule-canna.c (Fcanna_parse): + * mule-canna.c (Fcanna_store_yomi): + * mule-canna.c (Fcanna_touroku_string): + * mule-canna.c (Fcanna_initialize): + * minibuf.c: + * menubar.c (menu_parse_submenu_keywords): + * menubar-x.c (make_dummy_xbutton_event): + * menubar-x.c (set_frame_menubar): + * menubar-x.c (menu_item_descriptor_to_widget_value_1): + * menubar-x.c: + * menubar-msw.h: + * menubar-msw.c (mswindows_popup_menu): + * menubar-msw.c (mswindows_update_frame_menubars): + * menubar-msw.c (mswindows_handle_wm_command): + * menubar-msw.c (unsafe_handle_wm_initmenu_1): + * menubar-msw.c (unsafe_handle_wm_initmenupopup_1): + * menubar-msw.c (update_frame_menubar_maybe): + * menubar-msw.c (populate_or_checksum_helper): + * menubar-msw.c (empty_menu): + * menubar-msw.c: + * md5.c: + * marker.c (set_marker_internal): + * marker.c (print_marker): + * malloc.c: + * make-src-depend: + * lstream.c (lisp_buffer_rewinder): + * lstream.c (mark_lstream): + * lrecord.h: + * lrecord.h (struct lrecord_header): + * lread.c (readevalloop): + * lread.c (locate_file): + * lread.c (locate_file_in_directory): + * lread.c (Flocate_file): + * lread.c (load_force_doc_string_unwind): + * lread.c (ebolify_bytecode_constants): + * lread.c: + * lisp.h: + * lisp-union.h: + * lisp-disunion.h: + * linuxplay.c (linux_play_data_or_file): + * linuxplay.c (audio_init): + * line-number.c: + * keymap.h: + * keymap.c (describe_map): + * keymap.c (describe_map_mapper): + * keymap.c (Fdescribe_bindings_internal): + * keymap.c (Fsingle_key_description): + * keymap.c (map_keymap_sorted): + * keymap.c (get_relevant_keymaps): + * keymap.c (Flookup_key): + * keymap.c (raw_lookup_key_mapper): + * keymap.c (Fdefine_key): + * keymap.c (Fevent_matches_key_specifier_p): + * keymap.c (key_desc_list_to_event): + * keymap.c (define_key_parser): + * keymap.c (define_key_check_and_coerce_keysym): + * keymap.c (keymap_submaps): + * keymap.c (keymap_store_internal): + * keymap.c (keymap_delete_inverse_internal): + * keymap.c (keymap_store_inverse_internal): + * keymap.c (print_keymap): + * keymap.c (Lisp_Keymap): + * keymap.c: + * intl.c: + * insdel.c (convert_bufbyte_string_into_emchar_dynarr): + * insdel.c (make_gap): + * input-method-xlib.c (get_XIM_input): + * input-method-xlib.c (XIM_init_frame): + * imgproc.c: + * hash.h: + * hash.c: + * gui.c: + * gui-x.c (button_item_to_widget_value): + * gui-x.c (popup_selection_callback): + * glyphs.h (struct image_instantiator_methods): + * glyphs.c (mark_glyph_cachels): + * glyphs.c (Fglyph_type): + * glyphs.c (image_instantiate): + * glyphs.c (image_create): + * glyphs.c (make_image_instance_1): + * glyphs.c (finalize_image_instance): + * glyphs.c: + * glyphs-x.c (finalize_subwindow): + * glyphs-x.c (xface_validate): + * glyphs-x.c (x_locate_pixmap_file): + * glyphs-x.c (convert_EImage_to_XImage): + * glyphs-msw.c: + * glyphs-msw.c (mswindows_resource_instantiate): + * glyphs-msw.c (xpm_to_eimage): + * glyphs-msw.c (convert_EImage_to_DIBitmap): + * glyphs-eimage.c (tiff_instantiate): + * glyphs-eimage.c (png_instantiate): + * glyphs-eimage.c (struct png_error_struct): + * glyphs-eimage.c (gif_memory_storage): + * glyphs-eimage.c: + * gifrlib.h: + * getloadavg.c (getloadavg): + * getloadavg.c: + * gdbinit: + * free-hook.c (log_gcpro): + * free-hook.c (check_malloc): + * free-hook.c (check_free): + * free-hook.c (ROUND_UP_TO_PAGE): + * free-hook.c: + * frame.h (struct frame): + * frame.h: + * frame.c (change_frame_size_1): + * frame.c (allocate_frame_core): + * frame.c: + * frame-x.c (x_focus_on_frame): + * frame-x.c (x_init_frame_2): + * frame-x.c (x_popup_frame): + * frame-x.c (xemacs_XtPopup): + * frame-x.c: + * frame-x.c (Foffix_start_drag_internal): + * frame-x.c (x_cde_destroy_callback): + * frame-x.c (x_wm_hack_wm_protocols): + * frame-tty.c (tty_frame_visible_p): + * frame-msw.c (mswindows_make_frame_invisible): + * frame-msw.c (mswindows_after_init_frame): + * frame-msw.c (mswindows_init_frame_1): + * fns.c (syms_of_fns): + * fns.c (Fbase64_decode_string): + * fns.c (Fnconc): + * fns.c (Ffillarray): + * fns.c (Fobject_plist): + * fns.c (Fget): + * fns.c (Fcanonicalize_lax_plist): + * fns.c (Fcanonicalize_plist): + * fns.c (Fplist_remprop): + * fns.c (Fplist_get): + * fns.c (advance_plist_pointers): + * fns.c (internal_plist_put): + * fns.c (Fnreverse): + * fns.c (Fremassq): + * fns.c (Felt): + * fns.c (Fsubstring): + * fns.c (Fbvconcat): + * fns.c (Flength): + * fns.c (length_with_bytecode_hack): + * fns.c (print_bit_vector): + * fns.c: + * floatfns.c (Ffloor): + * floatfns.c: + * floatfns.c (in_float_error): + * fileio.c (Ffile_modes): + * fileio.c (Fexpand_file_name): + * fileio.c (Fmake_temp_name): + * fileio.c (Ffile_name_nondirectory): + * fileio.c (Ffile_name_directory): + * file-coding.h: + * file-coding.c (vars_of_mule_coding): + * file-coding.c (convert_to_external_format): + * file-coding.c (encoding_marker): + * file-coding.c (decoding_marker): + * file-coding.c (Fcopy_coding_system): + * file-coding.c (Fmake_coding_system): + * file-coding.c (struct coding_system_list_closure): + * file-coding.c (Ffind_coding_system): + * file-coding.c (symbol_to_eol_type): + * file-coding.c: + * faces.h (struct face_cachel): + * faces.c (vars_of_faces): + * faces.c (face_property_was_changed): + * faces.c (mark_face_cachels): + * faces.c (temporary_faces_list): + * faces.c (struct face_list_closure): + * faces.c: + * extents.h (struct extent): + * extents.c (vars_of_extents): + * extents.c (struct copy_string_extents_1_arg): + * extents.c (add_string_extents_mapper): + * extents.c (Fextent_property): + * extents.c (Fset_extent_property): + * extents.c (symbol_to_glyph_layout): + * extents.c (properties_equal): + * extents.c (print_extent): + * extents.c (print_extent_1): + * extents.c (extent_in_region_p): + * extents.c (gap_array_make_gap): + * extents.c: + * events.h (struct Lisp_Event): + * events.h: + * events.c (Fevent_properties): + * events.c (format_event_object): + * events.c (Fmake_event): + * events.c (event_equal): + * events.c (print_event): + * events.c (mark_event): + * event-stream.c ((read-char) + * event-stream.c (vars_of_event_stream): + * event-stream.c (syms_of_event_stream): + * event-stream.c (Fset_recent_keys_ring_size): + * event-stream.c (Fsit_for): + * event-stream.c (Fnext_event): + * event-stream.c (execute_help_form): + * event-stream.c (maybe_kbd_translate): + * event-stream.c: + * event-msw.c (vars_of_event_mswindows): + * event-msw.c (mswindows_wnd_proc): + * event-msw.c (mswindows_need_event): + * event-msw.c (mswindows_drain_windows_queue): + * event-msw.c (mswindows_pump_outstanding_events): + * event-msw.c: + * event-msw.c (slurp_thread): + * event-msw.c (struct ntpipe_slurp_stream): + * event-msw.c (HANDLE_TO_USID): + * event-Xt.c (emacs_Xt_handle_magic_event): + * event-Xt.c (x_event_to_emacs_event): + * event-Xt.c (x_reset_modifier_mapping): + * event-Xt.c (x_reset_key_mapping): + * event-Xt.c: + * eval.c (syms_of_eval): + * eval.c (warn_when_safe): + * eval.c (warn_when_safe_lispobj): + * eval.c (Fbacktrace_frame): + * eval.c (Fbacktrace): + * eval.c (top_level_set): + * eval.c (unbind_to_hairy): + * eval.c (specbind_magic): + * eval.c (specbind_unwind_wasnt_local): + * eval.c (call2_trapping_errors): + * eval.c (call1_trapping_errors): + * eval.c (catch_them_squirmers_call2): + * eval.c (call0_trapping_errors): + * eval.c (run_hook_trapping_errors): + * eval.c (catch_them_squirmers_eval_in_buffer): + * eval.c (call4_in_buffer): + * eval.c (call3_in_buffer): + * eval.c (call2_in_buffer): + * eval.c (call1_in_buffer): + * eval.c (call0_in_buffer): + * eval.c (run_hook): + * eval.c (run_hook_with_args_in_buffer): + * eval.c (Fapply): + * eval.c (Feval): + * eval.c (do_autoload): + * eval.c (un_autoload): + * eval.c (Fautoload): + * eval.c (Finteractive_p): + * eval.c (Fcommand_execute): + * eval.c (signal_quit): + * eval.c (call_with_suspended_errors): + * eval.c (signal_error): + * eval.c (return_from_signal): + * eval.c (Fcall_with_condition_handler): + * eval.c (run_condition_case_handlers): + * eval.c (condition_case_1): + * eval.c (Funwind_protect): + * eval.c (unwind_to_catch): + * eval.c (internal_catch): + * eval.c (Fmacroexpand_internal): + * eval.c (Fuser_variable_p): + * eval.c (Fdefconst): + * eval.c (Fdefvar): + * eval.c (Ffunction): + * eval.c (signal_call_debugger): + * eval.c (call_debugger): + * eval.c: + * emacs.c (main): + * emacs.c (sort_args): + * emacs.c (main_1): + * elhash.h: + * elhash.c: + * editfns.c (Fencode_time): + * editfns.c (Fdecode_time): + * editfns.c (Fuser_full_name): + * editfns.c: + * editfns.c (save_excursion_restore): + * ecrt0.c: + * dynarr.c: + * doprnt.c (emacs_doprnt_1): + * doc.c (verify_doc_mapper): + * doc.c (Fsnarf_documentation): + * doc.c (Fdocumentation): + * dll.c: + * dired.c (user_name_completion): + * dired.c (Fdirectory_files): + * dialog-x.c: + * dialog-msw.c: + * dgif_lib.c (FreeSavedImages): + * dgif_lib.c (DGifGetImageDesc): + * device.h: + * device.h (struct device): + * device.c (Fselect_device): + * device.c (allocate_device): + * device.c: + * device-x.c (Fx_keysym_on_keyboard_p): + * device-x.c (Fx_valid_keysym_name_p): + * device-x.c (x_IO_error_handler): + * device-x.c (x_delete_device): + * device-x.c (x_finish_init_device): + * device-x.c (x_init_device): + * device-x.c: + * device-msw.c (mswindows_init_device): + * dbxrc: + * database.c (vars_of_database): + * database.c (Fput_database): + * database.c (Fopen_database): + * database.c (berkdb_remove): + * database.c (berkdb_put): + * database.c (Fdatabasep): + * database.c (print_database): + * database.c: + * data.c (vars_of_data): + * data.c (syms_of_data): + * data.c (init_errors_once_early): + * data.c (prune_weak_lists): + * data.c (finish_marking_weak_lists): + * data.c (print_weak_list): + * data.c (Fmod): + * data.c (Fstring_to_number): + * data.c (Fnumber_to_string): + * data.c (Findirect_function): + * data.c (Fsetcdr): + * data.c (Ffloatp): + * data.c (Fsubr_interactive): + * data.c (Farrayp): + * data.c (Fkeywordp): + * data.c (Fnull): + * data.c: + * console.h (CONSOLE_NAME): + * console.h: + * console.c (vars_of_console): + * console.c (Fselect_console): + * console.c: + * console-x.h (DEVICE_X_COLORMAP): + * console-x.h (struct x_device): + * console-x.c (x_device_to_console_connection): + * console-tty.h (CONSOLE_TTY_FINAL_CURSOR_Y): + * console-tty.c (tty_init_console): + * console-tty.c: + * console-msw.h (struct mswindows_frame): + * conslots.h: + * config.h.in: + * cmds.c (internal_self_insert): + * cmds.c (Fforward_line): + * cmds.c (Fforward_char): + * cmds.c: + * cmdloop.c: + * chartab.c (mark_char_table_entry): + * chartab.c: + * casefiddle.c (casify_word): + * callproc.c (child_setup): + * callproc.c (Fcall_process_internal): + * callproc.c: + * callint.c (Fcall_interactively): + * bytecode.h: + * bytecode.c (execute_rare_opcode): + * bytecode.c (execute_optimized_program): + * bytecode.c: + * bufslots.h: + * buffer.h (BUFFER_REALLOC): + * buffer.h (GET_CHARPTR_INT_DATA_ALLOCA): + * buffer.h (GET_CHARPTR_EXT_DATA_ALLOCA): + * buffer.h: + * buffer.h (MAP_INDIRECT_BUFFERS): + * buffer.h (CHECK_LIVE_BUFFER): + * buffer.c (init_initial_directory): + * buffer.c (complex_vars_of_buffer): + * buffer.c (vars_of_buffer): + * buffer.c (finish_init_buffer): + * buffer.c (Fget_file_buffer): + * buffer.c (Fbuffer_list): + * buffer.c (mark_buffer): + * balloon_help.c (balloon_help_move_to_pointer): + * balloon_help.c (show_help): + * balloon_help.c: + * backtrace.h: + * alloc.c (garbage_collect_1): + * alloc.c (sweep_strings): + * alloc.c (sweep_compiled_functions): + * alloc.c (sweep_bit_vectors_1): + * alloc.c (sweep_vectors_1): + * alloc.c (sweep_lcrecords_1): + * alloc.c (tick_lcrecord_stats): + * alloc.c (pure_string_sizeof): + * alloc.c (mark_conses_in_list): + * alloc.c (mark_object): + * alloc.c (report_pure_usage): + * alloc.c (make_pure_float): + * alloc.c (make_pure_string): + * alloc.c (free_managed_lcrecord): + * alloc.c (mark_string): + * alloc.c (noseeum_make_marker): + * alloc.c (allocate_event): + * alloc.c (Fbit_vector): + * alloc.c (Fvector): + * alloc.c (make_float): + * alloc.c (Fmake_list): + * alloc.c (Flist): + * alloc.c (FREE_FIXED_TYPE_WHEN_NOT_IN_GC): + * alloc.c (PUT_FIXED_TYPE_ON_FREE_LIST): + * alloc.c (DECLARE_FIXED_TYPE_ALLOC): + * alloc.c (dbg_constants): + * alloc.c (gc_record_type_p): + * alloc.c (free_lcrecord): + * alloc.c (xmalloc): + * alloc.c (NOSEEUM_INCREMENT_CONS_COUNTER): + * abbrev.c: + * Makefile.in.in (mostlyclean): + * Makefile.in.in (external_client_xlib_objs_nonshared): + * Makefile.in.in (temacs_link_args): + * Makefile.in.in (release): + * Makefile.in.in (dnd_objs): + * Makefile.in.in (objs): + * Makefile.in.in (PROGNAME): + * EmacsShell.c: cast strings to (XtPointer) + * EmacsFrame.c: cast strings to (XtPointer) + - mega patch + - rewrite basic lisp functions for speed + - rewrite bytecode interpreter for speed + - rewrite list looping constructs for speed and safety using + tortoise/hare. + - use size_t where appropriate. + - new hashtable implementation + - cleanup implementation of opaques + - opaques can now be purecopy'ed + - move some cl functionality into C for speed. + - remove last remaining VMS support + - spelling fixes + - improve gdb/dbx debugger support + - move pure.c back into alloc.c for performance + - enable report_pure_usage() if --memory-usage-stats + - remove remnants of Energize support (EMACS_BTL, cadillac...) + - don't use symbols with leading `_' or embedded `__' + - globally cleanup duplicated semicolons `;;' + - I give in on %p vs %lx - we use printf("%lx",(long) p) + globally. + - globally replace O_NDELAY with O_NONBLOCK. + - globally replace CDISABLE with _POSIX_VDISABLE. + - use O_RDONLY and O_RDWR instead of magic `0' and `2'. + - define (and maybe use!) STDERR_FILENO and friends. + - add support for macros defined in C + - `when', `unless', `not' and `defalias' now defined in C, + so that they are universally available. + - rename defvar_mumble to defvar_magic + - rename RETURN__ to RETURN_SANS_WARNINGS + - use consistent style of initial caps in error messages + - implement last, butlast, nbutlast, copy-list in C. + - provide typedefs for all struct Lisp_foo types + - Lisp_Objects must be initialized to Qnil rather than 0. + - make sure XEmacs runs (slowly) with always_gc == 1; + - fast and safe LOOP_* macros + - change calls to XSETOBJ to XSETFOO + - replace calls to XSETINT by make_int() + - plug up memory leaks + - use style markobj (foo), not silly ((markobj) (foo)) + - use XFLOAT_DATA (obj) instead of float_data (XFLOAT (obj)) + +1998-12-02 P. E. Jareth Hein <jareth@camelot.co.jp> + + * unexec.c: Changed a #ifndef statement to fix XEmacs on BSDI 3.0 + +1998-11-28 SL Baur <steve@altair.xemacs.org> + + * XEmacs 21.2-beta4 is released. + +1998-11-27 SL Baur <steve@altair.xemacs.org> + + * mule-charset.c (complex_vars_of_mule_charset): Fix graphic + property in control-1 charset. + From Julian Bradfield <jcb@daimi.au.dk> + +1998-11-26 Jan Vroonhof <vroonhof@math.ethz.ch> + + * gui-x.c (button_item_to_widget_value): Ignore :key-sequence + keyword. + Add stub for :label. + + * gui.c (gui_item_add_keyval_pair): ditto. + + * menubar-x.c (menu_item_descriptor_to_widget_value_1): Ignore + :key-sequence keyword. + Add stub for:label. + Support :active for submenus like the Windows code and FSF Emacs. + +1998-11-27 Hrvoje Niksic <hniksic@srce.hr> + + * dired.c (make_directory_hash_table): make_string() is OK because + readdir() Mule-encapsulates. + +1998-11-26 Hrvoje Niksic <hniksic@srce.hr> + + * fns.c (Fbase64_encode_string): Fix docstring. + (Fbase64_decode_string): Ditto. + +1998-11-26 Hrvoje Niksic <hniksic@srce.hr> + + * editfns.c (Ftranslate_region): Use + convert_bufbyte_string_into_emchar_string(). + +1998-11-25 Hrvoje Niksic <hniksic@srce.hr> + + * editfns.c (Ftranslate_region): Accept vectors and char-tables as + well as strings. + (Ftranslate_region): Turn table into an array of Emchars for + larger regions. + +1998-11-25 Hrvoje Niksic <hniksic@srce.hr> + + * chartab.c (Freset_char_table): Fix wrong placement of #endif. + +1998-11-24 Hrvoje Niksic <hniksic@srce.hr> + + * chartab.c (Freset_char_table): Don't blindly fill chartables of + type `char' with nils. + + * chartab.c (canonicalize_char_table_value): Coerce ints to chars + for tables of type `char'. + +1998-11-26 Didier Verna <verna@inf.enst.fr> + + * input-method-xlib.c (Initialize_Locale): don't call + XtSetLanguageProc. We've done the whole work here. + * input-method-xfs.c (Initialize_Locale): ditto. + * input-method-motif.c (Initialize_Locale): ditto. + +1998-11-26 Didier Verna <verna@inf.enst.fr> + + * process-unix.c (unix_create_process): handle properly + Vfile_name_coding_system for converting the program and directory + names. + +1998-11-27 SL Baur <steve@altair.xemacs.org> + + * m/arm.h: New file. + From James LewisMoss <dres@ioa.com> + +1998-11-27 Takeshi Hagiwara <hagiwara@ie.niigata-u.ac.jp> + + * m/mips-nec.h: + Fix the realpath() problem of UnixWare2.1.3. + Patches for NEC's sysv4.2 machine. + +1998-11-25 Hrvoje Niksic <hniksic@srce.hr> + + * dired.c (Fdirectory_files): Remove redundant code. + +1998-11-25 Hrvoje Niksic <hniksic@srce.hr> + + * fns.c (free_malloced_ptr): New function. + (XMALLOC_OR_ALLOCA): New macro. + (XMALLOC_UNBIND): Ditto. + (Fbase64_encode_region): Use malloc() for large blocks; arrange it + to be freed in case of non-local exit. + (Fbase64_encode_string): Ditto. + (Fbase64_decode_region): Ditto. + (Fbase64_decode_string): Ditto. + (STORE_BYTE): New macro. + (base64_decode_1): Use it. + +1998-11-25 Hrvoje Niksic <hniksic@srce.hr> + + * fns.c (base64_value_to_char): Base64 stuff. + +1998-11-24 Hrvoje Niksic <hniksic@srce.hr> + + * editfns.c (Fbuffer_substring): New function. + + * lisp.h: Declare make_string_from_buffer_no_extents(). + + * insdel.c (make_string_from_buffer_1): New function. + (make_string_from_buffer_no_extents): Ditto. + +1998-11-15 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de> + + * linuxplay.c: Including <fcntl.h> instead of <sys/fcntl.h> makes + sound work on AIX with OSS installed. Linux should still work. + +1998-11-03 Andy Piper <andyp@parallax.co.uk> + + * config.h.in: name change for cygwin/version.h + + * configure.in: check for cygwin/version.h now. + + * cygwin32.h: track CYGWIN_DLL_VERSION_MAJOR -> + CYGWIN_VERSION_DLL_MAJOR name change in cygwin b20. + move cygwin32/version.h to cygwin/version.h + +1998-11-03 Olivier Galibert <galibert@pobox.com> + + * lisp.h (struct Lisp_Bit_Vector): Fix declaration of bits from + int to long. + +1998-10-22 Andy Piper <andyp@parallax.co.uk> + + * cygwin32.h: track CYGWIN_DLL_VERSION_MAJOR -> + CYGWIN_VERSION_DLL_MAJOR name change in cygwin b20. + enable BROKEN_SIGIO under b20 to make QUIT work. + +1998-10-22 Andy Piper <andyp@parallax.co.uk> + + * frame-msw.c (mswindows_size_frame_internal): force frame sizing + to fit within the constraints of the screen size. I.e. make the + frame small enough to fit and move it if some of it will be + off-screen. + +1998-10-19 Greg Klanderman <greg@alphatech.com> + + * dired.c: conditionalize inclusion of user-name-completion + primitives on non-Windows NT. The needed functions don't exist on NT. + +1998-11-24 SL Baur <steve@altair.xemacs.org> + + * gifrlib.h: Clean up types for 64 bit compile. + * dgif_lib.c (DGifInitRead): Ditto. + (MakeSavedImage): Ditto. + * emacs.c (decode_path): Ditto. + From Steve Carney <carney@pa.dec.com> + +1998-10-16 William M. Perry <wmperry@aventail.com> + + * glyphs-msw.c (bitmap_table): Fixed typo in builtin bitmaps + (cehckboxes instead of checkboxes). + +1998-10-15 SL Baur <steve@altair.xemacs.org> + + * XEmacs 21.2-beta3 is released. + +1998-10-13 Raymond Toy <toy@rtp.ericsson.se> + + * runemacs.c (WinMain): If the basename is "rungnuclient.exe", run + gnuclient. Otherwise, we run xemacs as we always did. This gets + rid of the annoying DOS window when running gnuclient. + +1998-10-13 Andy Piper <andyp@parallax.co.uk> + + * dragdrop.c (vars_of_dragdrop): rename HAVE_MSWINDOWS -> + HAVE_MS_WINDOWS typo. + +1998-10-13 SL Baur <steve@altair.xemacs.org> + + * process-unix.c (unix_send_process): Set closed flag on writable + pipe after SIGPIPE is received and before we call deactivate_process. + +1998-10-03 Gunnar Evermann <ge204@eng.cam.ac.uk> + + * window.c (Fset_window_start): respect narrowing when + checking wheter start is at the beginning of a line. + (Fset_window_buffer): Ditto + Fixes repeatable crash in VM. + +1998-10-09 SL Baur <steve@altair.xemacs.org> + + * window.c (specifier_vars_of_window): Set default vertical + divider width to 1 on ttys. + +1998-10-08 Martin Buchholz <martin@xemacs.org> + + * alloc.c: + * unexec.c: + * malloc.c: + Add <stddef.h> to get ptrdiff_t declaration + +1998-10-07 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * scrollbar-msw.c: Use the same vertical scrollbar drag hack as + is used for Motif or Lucid scrollbars under X. + +1998-10-08 Pierre Wendling <pw@ebc.vbe.dec.com> + + * m/alpha.h (UNEXEC): quoted to avoid bad expansion when running + `configure' + +1998-10-06 Takeshi Hagiwara <hagiwara@ie.niigata-u.ac.jp> + + * frame-x.c (x_delete_frame): Fix an argument of XtDestroyWidget. + +1998-10-05 Andy Piper <andyp@parallax.co.uk> + + * s/cygwin32.h: more cygwin b20 reorganisation. + +1998-10-01 Raymond Toy <toy@rtp.ericsson.se> + + * nas.c: Added necessary support functions to be able to handle + WAVE files in memory, just like the support for SND files in + memory. + +1998-09-30 SL Baur <steve@altair.xemacs.org> + + * callproc.c (child_setup): Fix spelling typo. + +1998-09-29 SL Baur <steve@altair.xemacs.org> + + * XEmacs 21.2-beta2 is released. + +1998-09-27 P. E. Jareth Hein <jareth@camelot.co.jp> + + * regex.c (re_match_2_internal): Add in code to reset lowest_active_reg + to prevent memory corruption in the case of jumping out of a series of + nested match patterns. This is a rather brute force approach, though. + +1998-09-02 Andy Piper <andyp@parallax.co.uk> + + * config.h.in: ditto. + + * s/cygwin32.h: rearrange declarations to cope with cygwin + b20. Include cygwin32/version.h if it exists. + +1998-09-20 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * device-msw.c (mswindows_init_device): Call new + mswindows_enumerate_fonts() function in objects-msw.c instead + of font_enum_callback_1() to enumerate fonts. + + font_enum_callback_1() and _2() moved to objects-msw.c. + + * faces.c (complex_vars_of_faces): Make the mswindows default + face font fully specified and provide some fallbacks. + + * objects-msw.c: font_enum_callback_1() and _2() moved here + from objects-msw.c. Obtain the enumerated font's character + sets by table lookup instead of using the locale-specific + string provided by Windows. + + New public non-method mswindows_enumerate_fonts() that fills + in the supplied mswindows device's font list. + + mswindows_initialize_font_instance: Use the supplied name + variable instead of f->name when signalling errors. Match font + weights and character sets using lookup tables which handle + spaces instead of by frobbing. + +1998-09-20 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * process-nt.c: Define an arbitrary limit, FRAGMENT_CODE_SIZE, + on the size of code fragments passed to run_in_other_process. + + run_in_other_process(): Use FRAGMENT_CODE_SIZE to determine + the amount of memory to allocate in the other process. + + Removed sigkill_code_end(), sigint_code_end() and + sig_enable_code_end() since they are now redundant. + + send_signal() and enable_child_signals(): Don't try to work + out the end of the code fragments passed to + run_in_other_process() + +1998-09-10 Kazuyuki IENAGA <ienaga@jsys.co.jp> + + * src/s/freebsd.h: Added __ELF__ and compiler/liker flags for + FreeBSD-current. + + * src/unexelf.c: Partially synched with FSF's 20.3. + +1998-09-10 Hrvoje Niksic <hniksic@srce.hr> + + * insdel.c (signal_after_change): Map across indirect buffers + here, and not in the upper-level functions. + (signal_first_change): Don't check for Armageddon. + (signal_before_change): Map across indirect buffers here. + (prepare_to_modify_buffer): ...and here. + +1998-09-09 Hrvoje Niksic <hniksic@srce.hr> + + * insdel.c (signal_after_change): Add return value. + (buffer_insert_string_1): Use it. + (buffer_delete_range): Ditto. + (buffer_replace_char): Ditto. + (cancel_multiple_change): Map the indirect buffers. + +1998-09-06 Hrvoje Niksic <hniksic@srce.hr> + + * insdel.c (init_buffer_text): Remove INDIRECT_P parameter. + (uninit_buffer_text): Ditto. + + * buffer.c (Fmake_indirect_buffer): Implement stricter + error-checking. + +1998-09-04 Hrvoje Niksic <hniksic@srce.hr> + + * insdel.c (change_function_restore): Reverse order of + function-call and assignment. + (first_change_hook_restore): Ditto. + + * extents.c (mark_extent_auxiliary): Mark them. + (Fset_extent_property): Set them. + (Fextent_property): Get them. + (Fextent_properties): Ditto. + (vars_of_extents): Set their default. + + * extents.h (struct extent_auxiliary): Add before_change_functions + and after_change_functions. + + * insdel.c (signal_before_change): Use it. + (signal_after_change): Ditto. + + * extents.c (report_extent_modification): New function. + + * insdel.c (signal_before_change): Don't check for Armageddon. + (signal_after_change): Ditto. + +1998-09-11 Gunnar Evermann <Gunnar.Evermann@nats.informatik.uni-hamburg.de> + + * redisplay.c (redisplay_window): make sure a new starting point + is chosen if it somehow got moved from the beginning of the line + -- this can happen because Fwiden was called recently. + + * window.c (Fset_window_start): set start_at_line_beg correctly + (Fset_window_buffer): Ditto + +1998-09-06 Hrvoje Niksic <hniksic@srce.hr> + + * insdel.c (init_buffer_text): Remove INDIRECT_P parameter. + (uninit_buffer_text): Ditto. + + * buffer.c (Fmake_indirect_buffer): Implement stricter + error-checking. + +1998-05-14 Jan Vroonhof <vroonhof@math.ethz.ch> + + * emacs.c (main_1): Removed references to *vars_of_filelock. + + * lisp.h: Added Fsystem_name. + + * filelock.c: Replaced by version from FSF 20.2. Now implements + locking by using symlinks which is NFS safe. However keep the + GCPRO's in lock_file and the calls to callx_in_buffer like our old + version (and of course use ansi C, acessor macros, etc). + +1998-09-06 Jan Vroonhof <vroonhof@math.ethz.ch> + + * process-unix.c (unix_create_process): Reset SIGHUP handler to + SIG_DFL. We now try to conserve any inherted SIG_IGN settings + in init_signals_very_early. However these should not be passed + on to children attached to the new pty. + +1998-08-28 Andy Piper <andyp@parallax.co.uk> + + * glyphs-eimage.c (png_instantiate_unwind): clean up eimage after use. + +1998-09-07 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * fileio.c (file-name-directory, file_name_as_directory): + Don't call CORRECT_DIR_SEPS, even when #defined WINDOWSNT. + +1998-09-02 Andy Piper <andyp@parallax.co.uk> + + * emacs.c (main_1): init_ralloc() if initialised and we have REL_ALLOC + + * ralloc.c: uncomment __morecore. + +1998-09-92 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * event-msw.c(winsock_writer): Supply a dummy 4th argument to + WriteFile() to fix a winsock 1.x bug on Win95. + +1998-08-28 Hrvoje Niksic <hniksic@srce.hr> + + * event-Xt.c (emacs_Xt_mapping_action): Check for device being + deleted. + (x_event_to_emacs_event): Ditto. + (emacs_Xt_handle_focus_event): Ditto. + (emacs_Xt_handle_magic_event): Ditto. + + * console-x.h (struct x_device): New flag being_deleted. + (DEVICE_X_BEING_DELETED): New macro. + + * device-x.c (x_IO_error_handler): Throw to top-level instead of + returning. Before doing that, set the being_deleted flag on the + device. + +1998-08-27 Hrvoje Niksic <hniksic@srce.hr> + + * device-x.c (x-seppuku-on-epipe): Removed. + +1998-08-26 Gunnar Evermann <Gunnar.Evermann@nats.informatik.uni-hamburg.de> + + * frame-x.c (x_delete_frame): Flush the X output buffer after + calling XtDestroyWidget to ensure that the windows are really + killed right now. + +1998-08-26 Hrvoje Niksic <hniksic@srce.hr> + + * menubar-x.c (my_run_hook): New unused function. + (pre_activate_callback): Use run_hook for Qactivate_menubar_hook, + since we ignore the results of the contained functions anyway. + +1998-08-26 P. E. Jareth Hein <jareth@camelot.co.jp> + + * glyphs-eimage.c (gif_instantiate): Fix a crash in handling + interlaced GIF files that are smaller than 4 lines high... + +1998-08-31 Hrvoje Niksic <hniksic@srce.hr> + + * buffer.c (map_over_sharing_buffers): Deleted. + + * insdel.c (MAP_INDIRECT_BUFFERS): Move to buffer.h. + + * buffer.c (Fkill_buffer): Keep indirect_children updated while + killing them. + +1998-08-31 Hrvoje Niksic <hniksic@srce.hr> + + * insdel.c (buffer_insert_string_1): Advance the point bytind in + all the buffers. + (buffer_delete_range): Ditto. + + * marker.c (init_buffer_markers): Set point-marker to the value of + point in an indirect buffer. + +1998-08-30 Hrvoje Niksic <hniksic@srce.hr> + + * undo.c (undo_prelude): Test last-undo-buffer against base + buffer. + + * insdel.c (MAP_INDIRECT_BUFFERS): Use it. + + * buffer.h (BUFFER_BASE_BUFFER): New macro. + +1998-08-30 Hrvoje Niksic <hniksic@srce.hr> + + * insdel.c (init_buffer_text): Initialize it here. + + * line-number.c: Address line_number_cache through buffer->text. + + * buffer.c (mark_buffer): Mark line number cache. + + * bufslots.h (line_number_cache): Move to struct buffer_text. + + * insdel.c (buffer_insert_string_1): Propagate signals and changes + across the children buffers. + (buffer_delete_range): Ditto. + (buffer_replace_char): Ditto. + (gap_left): Ditto. + (gap_right): Ditto. + + * insdel.c (MAP_INDIRECT_BUFFERS): New macro. + + * buffer.c (Fmake_indirect_buffer): Uncomment. + +1998-08-31 Hrvoje Niksic <hniksic@srce.hr> + + * macros.c (Fend_kbd_macro): Remove trailing period from error + message. + (Fexecute_kbd_macro): Ditto. + +1998-08-21 Greg Klanderman <greg@alphatech.com> + + * dired.c (Fuser_name_completion): remove optional 2nd argument. + (Fuser_name_completion_1): new function to return uniqueness + indication in addition to the user name completion. + (user_name_completion): change type of `uniq' argument. + +1998-08-19 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de> + + * lread.c (vars_of_lread): Removed `source-directory' variable. + +1998-08-22 Hrvoje Niksic <hniksic@srce.hr> + + * fileio.c (Ffile_readable_p): Apply the DOS/Windows logic to + Cygwin. + +1998-08-19 SL Baur <steve@altair.xemacs.org> + + * dired.c (vars_of_dired): Fix misapplied patch. + +1998-08-16 Martin Buchholz <martin@xemacs.org> + + * fns.c (Fremrassq, remrassq_no_quit): + A XCAR that should have been an XCDR turned Fremrassq into Fremassq + +1998-07-17 Didier Verna <verna@inf.enst.fr> + + * redisplay-x.c (x_get_gc): returns a GC with a FillStipple fill + style as foreground GC for faces that have the `dim' property. + (x_output_string): when the `dim' face property is set, + ensure the gray pixmap has been created, and get a proper + foreground GC to draw the text. + +1998-08-09 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * event-msw.c (mswindows_wnd_proc): Workaround for a Win95 bug: + Manually track the state of the left and right Ctrl and Alt + modifiers. + +1998-08-07 Matt Stupple <matts@tibco.com> + + * ntproc.c: don't wait on char_consumed at thread entry. + Additionally, to get the 'process' marked as finished, ensure + that the CHILD_ACTIVE macro returns false, so before exiting + close char_avail and set it to NULL, and close other handles + to reduce handle leak problems. + +1998-08-09 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * menubar-msw.c (displayable_menu_item): take account of menu + depth when deciding whether to try to display accelerators. + +1998-08-04 Andy Piper <andyp@parallax.co.uk> + + * event-msw.c: use MsgWaitForMultipleObjects if there are no + subprocesses. + + * glyphs-msw.c: fix a couple of potential handle leaks. + +1998-08-04 P. E. Jareth Hein <jareth@camelot.co.jp> + + * dgif_lib.c gif_io.c gifrlib.h: New files to put GIF + *decoding ONLY* back into the core. + * glyphs-eimage.c: Change referenced header file for GIF + reading to point to the incore version. + +1998-07-20 Martin Buchholz <martin@xemacs.org> + + * casefiddle.c (casify_object): + Change algorithm from O(N**2) to O(N). + Code cleanup. + Doc string cleanup. + +1998-07-22 Greg Klanderman <greg@alphatech.com> + + * dired.c (file_name_completion_unwind): don't leak the cons. + +1998-07-20 Greg Klanderman <greg@alphatech.com> + + * dired.c (Fuser_name_completion): new function. + (Fuser_name_all_completions): new function. + (user_name_completion): new function. + (syms_of_dired): 2 new DEFSUBRs. + (vars_of_dired): initialize user name cache vars. + +1998-07-29 P. E. Jareth Hein <jareth@camelot.co.jp> + + * glyphs-eimage.c (png_instantiate): Add proper handling for background + colors taken from the default face. Also correct a thinko in + transparency (not alpha) handling. + +1998-07-23 Martin Buchholz <martin@xemacs.org> + + * s/decosf4-0.h: Use a perfectly ordinary link. Nuke BSD crap. + * unexalpha.c: ANSI C-ize. Clean compiler warnings. + * lread.c (Fload_internal): Be very careful with printfs of + size_t's + * gui-x.c (menu_name_to_accelerator): tolower wants an `int' + argument. + +1998-07-27 Gunnar Evermann <Gunnar.Evermann@nats.informatik.uni-hamburg.de> + + * callint.c (Fcall_interactively): GCPRO prompt string before + passing it to Fread_key_sequence + +1998-07-27 SL Baur <steve@altair.xemacs.org> + + * keymap.c (vars_of_keymap): Initialize Vkey_translation_map and + Vvertical_divider_map. + + * mule-canna.c (vars_of_mule_canna): Initialize every symbol to + Qnil or 0, none were initialized prior to this change. + + Rename misnamed `V' prefixed integer variables: + Vcanna_empty_info, Vcanna_through_info, Vcanna_underline, + Vcanna_inhibit_hankakukana, Vcanna_henkan_length, Vcanna_henkan_revPos, + Vcanna_henkan_revLen, Vcanna_ichiran_length, Vcanna_ichiran_revPos, + Vcanna_ichiran_revLen. + + Rename misnamed `V' prefixed integer variables and initialize + properly in the vars_of routine. + Vcanna_mode_AlphaMode, Vcanna_mode_EmptyMode, Vcanna_mode_KigoMode, + Vcanna_mode_YomiMode, Vcanna_mode_JishuMode, Vcanna_mode_TankouhoMode, + Vcanna_mode_IchiranMode, Vcanna_mode_YesNoMode, Vcanna_mode_OnOffMode, + Vcanna_mode_AdjustBunsetsuMode, Vcanna_mode_ChikujiYomiMode, + Vcanna_mode_ChikujiTanMode, Vcanna_mode_HenkanMode, + Vcanna_mode_HenkanNyuryokuMode, Vcanna_mode_ZenHiraHenkanMode, + Vcanna_mode_HanHiraHenkanMode, Vcanna_mode_ZenKataHenkanMode, + Vcanna_mode_HanKataHenkanMode, Vcanna_mode_HanKataHenkanMode, + Vcanna_mode_ZenAlphaHenkanMode, Vcanna_mode_HanAlphaHenkanMode, + Vcanna_mode_ZenHiraKakuteiMode, Vcanna_mode_HanHiraKakuteiMode, + Vcanna_mode_ZenKataKakuteiMode, Vcanna_mode_HanKataKakuteiMode, + Vcanna_mode_ZenAlphaKakuteiMode, Vcanna_mode_HanAlphaKakuteiMode, + Vcanna_mode_HexMode, Vcanna_mode_BushuMode, Vcanna_mode_ExtendMode, + Vcanna_mode_RussianMode, Vcanna_mode_GreekMode, Vcanna_mode_LineMode, + Vcanna_mode_ChangingServerMode, Vcanna_mode_HenkanMethodMode, + Vcanna_mode_DeleteDicMode, Vcanna_mode_TourokuMode, + Vcanna_mode_TourokuEmptyMode, Vcanna_mode_TourokuHinshiMode, + Vcanna_mode_TourokuDicMode, Vcanna_mode_QuotedInsertMode, + Vcanna_mode_BubunMuhenkanMode, Vcanna_mode_MountDicMode, + Vcanna_fn_SelfInsert, Vcanna_fn_FunctionalInsert, + Vcanna_fn_QuotedInsert, Vcanna_fn_JapaneseMode, Vcanna_fn_AlphaMode, + Vcanna_fn_HenkanNyuryokuMode, Vcanna_fn_Forward, Vcanna_fn_Backward, + Vcanna_fn_Next, Vcanna_fn_Prev, Vcanna_fn_BeginningOfLine, + Vcanna_fn_EndOfLine, Vcanna_fn_DeleteNext, Vcanna_fn_DeletePrevious, + Vcanna_fn_KillToEndOfLine, Vcanna_fn_Henkan, Vcanna_fn_Kakutei, + Vcanna_fn_Extend, Vcanna_fn_Shrink, Vcanna_fn_AdjustBunsetsu, + Vcanna_fn_Quit, Vcanna_fn_ConvertAsHex, Vcanna_fn_ConvertAsBushu, + Vcanna_fn_KouhoIchiran, Vcanna_fn_BubunMuhenkan, Vcanna_fn_Zenkaku, + Vcanna_fn_Hankaku, Vcanna_fn_ExtendMode, Vcanna_fn_ToUpper, + Vcanna_fn_Capitalize, Vcanna_fn_ToLower, Vcanna_fn_Hiragana, + Vcanna_fn_Katakana, Vcanna_fn_Romaji, Vcanna_fn_BaseHiragana, + Vcanna_fn_BaseKatakana, Vcanna_fn_BaseEisu, Vcanna_fn_BaseZenkaku, + Vcanna_fn_BaseHankaku, Vcanna_fn_BaseKana, Vcanna_fn_BaseKakutei, + Vcanna_fn_BaseHenkan, Vcanna_fn_BaseHiraKataToggle, + Vcanna_fn_BaseZenHanToggle, Vcanna_fn_BaseKanaEisuToggle, + Vcanna_fn_BaseKakuteiHenkanToggle, Vcanna_fn_BaseRotateForward, + Vcanna_fn_BaseRotateBackward, Vcanna_fn_Touroku, Vcanna_fn_HexMode, + Vcanna_fn_BushuMode, Vcanna_fn_KigouMode, Vcanna_fn_Mark, + Vcanna_fn_TemporalMode, Vcanna_key_Nfer, Vcanna_key_Xfer, + Vcanna_key_Up, Vcanna_key_Left, Vcanna_key_Right, Vcanna_key_Down, + Vcanna_key_Insert, Vcanna_key_Rollup, Vcanna_key_Rolldown, + Vcanna_key_Home, Vcanna_key_Help, Vcanna_key_KP_Key, + Vcanna_key_Shift_Nfer, Vcanna_key_Shift_Xfer, Vcanna_key_Shift_Up, + Vcanna_key_Shift_Left, Vcanna_key_Shift_Right, Vcanna_key_Shift_Down, + Vcanna_key_Cntrl_Nfer, Vcanna_key_Cntrl_Xfer, Vcanna_key_Cntrl_Up, + Vcanna_key_Cntrl_Left, Vcanna_key_Cntrl_Right, Vcanna_key_Cntrl_Down + +1998-07-16 Jan Vroonhof <vroonhof@math.ethz.ch> + + * event-Xt.c (x_to_emacs_keysym): Return nil for modifier keysyms. + (x_event_to_emacs_event): Let x_to_emacs_keysym check for modifier + keys thus no longer considering all keysyms on a key. + +1998-07-19 SL Baur <steve@altair.xemacs.org> + + * XEmacs 21.2-beta1 is released. + +1998-07-12 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> + + * eldap.c (Fldap_search_internal): When converting the list of + attributes to search Copy the final 0 from Lisp strings to C + strings. + Check base, not Vldap_default_base as a a string + +1998-07-13 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * nt.c: Remove Vstdio_str; already defined in console-stream.c. + + * unexnt.c: Unconditionally define bss_start and bss_size, and + ensure that they don't go in the .bss section. + +1998-07-17 Olivier Galibert <galibert@pobox.com> + + * glyphs-x.c (convert_EImage_to_XImage): Fix previous patch (conv + byte order is dependant of the local byte order). + From Takeshi Hagiwara <hagiwara@ie.niigata-u.ac.jp> + +1998-07-18 SL Baur <steve@altair.xemacs.org> + + * glyphs-msw.c (mswindows_resource_normalize): Qresource -> + Qmswindows_resource. + From Jonathan Harris <jhar@tardis.ed.ac.uk> + +1998-07-12 SL Baur <steve@altair.xemacs.org> + + * general.c (syms_of_general): Add defsymbol for Qresource. + + * glyphs-msw.c (vars_of_glyphs_mswindows): Rename Qresource to + Qmswindows_resource. + (TopLevel): Rename 'resource image format to 'mswindows_resource. + (mswindows_resource_validate): Rename. + (mswindows_resource_normalize): Rename. + (mswindows_resource_possible_dest_types): Rename. + (mswindows_resource_instantiate): Rename. + (image_instantiator_format_create_glyphs_mswindows): Replace + `resource' with `mswindows.resource'. + + * XEmacs 21.0-pre5 is released. + +1998-07-10 SL Baur <steve@altair.xemacs.org> + + * mule-wnnfns.c (Fwnn_open): Correctly trap on misdefined Wnn + server type in environment. + Use alloca-ed strings instead of tiny fixed size ones. + +1998-07-09 SL Baur <steve@altair.xemacs.org> + + * XEmacs 21.0-pre4 is released. + +1998-07-01 James N. Potts <jnpotts@plutonium.net> + + * fileio.c: (expand_file_name): under win32: Don't treat names + as UNC names if a drive letter has been specified. If a drive + has been specified, strip out extra directory-seperators that + reportedly cause problems under Win95. + +1998-07-09 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * windowsnt.h: Define DUMP_SEPARATE_SECTION when building with + MSVC >= 5.0. Put emacs init and zero-init data in a special + section of the executable when this is defined. + + * unexnt.c, ntheap.h: + Removed unused find_section() and get_section_size(). + + * unexnt.c: + Fix up the executable's checksum after dumping otherwise the + profiler complains. + When DUMP_SEPARATE_SECTION is defined, don't need to dump + zero-init data separately from init data. Dump emacs data + into a special section of the executable. + When DUMP_SEPARATE_SECTION not defined, dump .bss up to + my_ebss instead of up to the end of bss. + +1998-07-09 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * filelock.c: Removed Vconfigure_lock_directory - already + defined in emacs.c. + + * frame-msw.c: Removed Qinitially_unmapped and Qpopup - already + defined in frame.c and general.c respectively. + + * glyphs-msw.c: Removed Qresource - already defined in + general.c. + +1998-07-05 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> + + * eldap.c (Fldap_search_internal): Docstring fixes + +1998-07-04 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * nt.c (init_environment): Removed unused PRELOAD_WINSOCK, + EMACSDOC and TERM variables. Added EMACSDEBUGPATHS, + EMACSPACKAGEPATH and INFOPATH variables. + Removed unused get_emacs_configuration function. + + * s/windowsnt.h: Don't define EMACS_CONFIGURATION here because + it is now defined at build-time by the makefile. + +1998-07-01 James N. Potts <jnpotts@plutonium.net> + + * fileio.c: (expand_file_name): under win32: Don't treat names as + UNC names if a drive letter has been specified. If a drive has + been specified, strip out extra directory-seperators that + reportedly cause problems under Win95. + +1998-07-05 Andy Piper <andyp@parallax.co.uk> + + * faces.c (complex_vars_of_faces): for the gui-element face don't + fallback to the default face, instead provide reasonable default + fallbacks that were previously hardcoded elsewhere. + +1998-07-06 Olivier Galibert <galibert@pobox.com> + + * glyphs-x.c (convert_EImage_to_XImage): Fix pixel writing problem + when the X server endianness is different than the client's one. + +1998-06-29 Kyle Jones <kyle_jones@wonderworks.com> + + * eval.c (run_hook_with_args_in_buffer): Check + default (non-buffer-local) value of hook for + nil before treating it as a function. Don't initialize + the `globals' variable twice. + +1998-06-24 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * fileio.c: Don't do directory seperator canonicalisation in + substitute-in-file-name because we don't know that the + filename refers to a local file. + +1998-06-24 Adrian Aichner <adrian@xemacs.org> + + * process-nt.c (nt_create_process): Try appending the standard + executable file extensions to the filename if none supplied. + +1998-06-29 SL Baur <steve@altair.xemacs.org> + + * fileio.c (Fsubstitute_in_file_name): Enable double slash notation + for cygwin32. + From Keisuke Mori <ksk@ntts.com> + +1998-06-24 Andy Piper <andyp@parallax.co.uk> + + * toolbar-msw.c (mswindows_output_toolbar): only enable masked + images if we have masks. This handles the xbm case (have masks) + and avoids overuse of resources in the xpm case (generally no masks). + Don't output small toolbars. + +1998-06-29 Kyle Jones <kyle_jones@wonderworks.com> + + * eval.c (run_hook_with_args_in_buffer): Don't treat + the default value of a buffer local hook as a list of + hooks unless it is both a cons and the car of that cons + is not Qlambda. + +1998-06-29 SL Baur <steve@altair.xemacs.org> + + * extents.c: Email address for Ben Wing is ben@xemacs.org. + * process-unix.c: Ditto. + * mule-coding.h: Ditto. + * mule-coding.c: Ditto. + * mule-charset.c: Ditto. + * mule-charset.h: Ditto. + * file-coding.c: Ditto. + * file-coding.h: Ditto. + +1998-06-22 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * event-msw.c: Guard against recursion when freeing + FRAME_MSWINDOWS_TARGET_RECT struture in WM_SIZE processing. + + * frame-msw.c: Don't set WS_VISIBLE attribute on first frame. + Call ShowWindow twice in init_frame_3 to get round runemacs + weirdness. + +1998-06-27 Hrvoje Niksic <hniksic@srce.hr> + + * scrollbar.c (vertical_scrollbar_changed_in_window): Ditto. + + * winslots.h: Rename. + + * window.c (specifier_vars_of_window): Renamed + vertical-divider-draggable-p to vertical-divider-always-visible-p, + as suggested by Ben Wing. + (specifier_vars_of_window): Fix docstrings. + +1998-06-22 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de> + + * unexaix.c: Line number information works correctly again. + +1998-06-22 Olivier Galibert <galibert@pobox.com> + + * emacs.c (__sti__iflPNGFile_c___): Added. See comment. Cry. + +1998-06-21 Martin Buchholz <martin@xemacs.org> + + * editfns.c (get_home_directory): ANSIfy. + XEmacs is compilable under C *and* C++. + It's XEmacs, not Xemacs! + +1998-06-19 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * console-msw.h: added a list of fonts to device data. + + * device-msw.c: enumerate list of available fonts in + mswindows_init_device. Free list in mswindows_delete_device. + + * objects-msw.c: Added helper function match_font used by + mswindows_initialize_font_instance and mswindows_list_fonts. + Allow a charset to be specified in a font string, even if + previous fields havn't been specified. + +1998-06-23 Greg Klanderman <greg@alphatech.com> + + * indent.c (column_at_point): column cache bugfix. + Set last_known_column_point to the buffer position for + which the column was requested, not buffer's point. + + * redisplay.c (decode_mode_spec): for current-column, show + window's point's column, not buffer's point's column. + +1998-06-23 Andy Piper <andyp@parallax.co.uk> + + * menubar-msw.c (mswindows_handle_wm_command): use + enqueue_misc_user event rather than + mswindows_enqueue_msic_user_event to fix customize problems. Add some + checks that X does. + + * console-msw.h: declare mswindows_enqueue_magic_event. + + * event-msw.c (mswindows_enqueue_magic_event): make global. + +1998-06-24 Hrvoje Niksic <hniksic@srce.hr> + + * line-number.c (LINE_NUMBER_FAR): Reverted to 16384. + (buffer_line_number): Use EMACS_INT_MAX instead of random LOTS. + (add_position_to_cache): Use EMACS_INT instead of int. + +1998-06-21 Olivier Galibert <galibert@pobox.com> + + * lisp-disunion.h (XMARKBIT): Have XMARKBIT return something + suitable for an int used as a boolean (btw, C sucks.). + +1998-06-18 Andy Piper <andyp@parallax.co.uk> + + * object-msw.c: remove warnings. + + * device-msw.c: #define wrongly named cygwin structure elements. + + * s/cygwin32.h: define DEMI_BOLD + +1998-06-19 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * redisplay-msw.c: new function mswindows_apply_face_effects. + This is called by output_string and output_cursor to display + underline and strikeout on faces. + +1998-06-19 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * console-msw.h: added a list of fonts to device data. + + * device-msw.c: enumerate list of available fonts in + mswindows_init_device. Free list in mswindows_delete_device. + + * objects-msw.c: Added helper function match_font used by + mswindows_initialize_font_instance and mswindows_list_fonts. + Allow a charset to be specified in a font string, even if + previous fields havn't been specified. + +1998-06-15 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * objects-msw.c: + Removed compilation warnings from mswindows_string_to_color. + mswindows_list_fonts returns a more general bogus font. + New lisp-visible function mswindows-color-list. + +1998-06-19 David Bush <david.bush@adn.alcatel.com> + + * editfns.c (Fuser_login_name): Modify to user new function + user_login_name. + (user_login_name): C only function to avoid Lisp object overhead + Returns "unknown" instead of nil in Cygwin environment + + * fileio.c (Fexpand_file_name): Treat "~" and "~user" as + equivalent for current user in Cygwin environment. Use new + function user_login_name to get username. + + * lisp.h: Declare user_login_name + +1998-06-18 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de> + + * unexaix.c (make_hdr): Fixed bias computations so debugging info + works again. + Some other insignificant nitpicks. + +1998-06-18 Andy Piper <andyp@parallax.co.uk> + + * toolbar-msw.c (mswindows_output_toolbar): specify ILC_MASK when + creating the image list and make sure he bk color is transparent. + +1998-06-18 Jan Vroonhof <vroonhof@math.ethz.ch> + + * event-Xt.c (emacs_Xt_remove_timeout): Also remove timeout from + completed_timeouts. The timer could have expired. + +1998-06-17 Andy Piper <andyp@parallax.co.uk> + + * console-msw.h: move XEMACS_RECT_WH inside frame + parameters. define macors to access it. + + * frame-msw.c (mswindows_init_frame_1): use new target_rect + parameter to intialise desired sizing. (mswindows_init_frame_2): + enable and size the frame to something sensible when we get + here. (mswindows_set_frame_properites): use new + mswindows_size_frame_internal function and size frame if frame + parameters not just if init is finished - WM_SIZE happens too + early for some specs. (mswindows_size_frame_internal): new + function abstracted from mswindows_set_frame_properties. + (Vmswindows_use_system_frame_size_defaults): + new variable controls whether to allow the system to pick frame + size defaults, defaults to nil. + + * event-msw.c: in WM_SIZE use mswindows_size_frame_internal rather + than duplicated code. + +1998-06-15 Colin Rafferty <colin@xemacs.org> + + * Makefile.in.in: Made EXTW_LINK expand properly. + +1998-06-12 Martin Buchholz <martin@xemacs.org> + + * redisplay.c (vars_of_redisplay): default value of + column-number-start-at-one should be NIL! + +1998-06-11 Martin Buchholz <martin@xemacs.org> + + * casefiddle.c: + (upcase-initials "fooBar") ==> "FooBar" instead of "Foobar" + +1998-06-05 Hrvoje Niksic <hniksic@srce.hr> + + * eldap.c (Fldap_search_internal): Use build_ext_string instead of + build_string to avoid crashes under Mule. + +1998-06-13 Andy Piper <andyp@parallax.co.uk> + + * ntplay.c (play_sound_data_1): don't delete the sound data until + the next sound is played and the previous one finished. + +1998-06-10 Samuel Mikes <smikes@alumni.hmc.edu> + + * fileio.c (directory-sep-char): Escape backslashes. + +1998-06-10 Hrvoje Niksic <hniksic@srce.hr> + + * event-stream.c: Fix docstring reference. + +1998-06-12 Hrvoje Niksic <hniksic@srce.hr> + + * alloc.c (make_float): Remove useless initialization of `next' + field. + (make_pure_float): Ditto. + + * lisp.h (struct Lisp_Float): Rename `next' to `__unused__next'. + +1998-06-08 Kirill M. Katsnelson <kkm@kis.ru> + + * fileio.c (Fmake_directory_internal): Remove conditionals + on WINDOWSNT when calling mkdir. + + * ntproc.c: Deleted the following unused functions: + register_child, reap_subprocess, sys_wait. + + * nt.c (sys_rename): Ifzeroed this implementation. + Deleted the following unused functions: + sys_access, sys_chdir, sys_chmod, sys_creat, sys_link, sys_mkdir, + sys_mktemp, sys_rmdir, sys_unlink, sys_close, sys_dup, sys_dup2, + sys_read, sys_write. + Merger sys_fopen and sys_open with sysdep.c implementation. + + * sysdep.c: Removed MS-DOS code. + (sys_rename): Deal with Microsoft rename weirdness. + (sys_open): Implemented for Windows. + (sys_fopen): Ditto. + (sys_mkdir): Ditto. + +1998-06-08 Kirill M. Katsnelson <kkm@kis.ru> + + * buffer.c (complex_vars_of_buffer): Removed %t description from + the docstring. + +1998-06-04 Rick Rankin <Rick_Rankin-P15254@email.mot.com> + + * scrollbar-msw.c: initialize the cbSize element of the + SCROLLINFO struct before calling SetScrollInfo. WinNT seems + to ignore the value of cbSize, but Win95 (and I presume Win98) + appear to want it set to sizeof(SCROLLINFO). + +1998-06-04 Kirill M. Katsnelson <kkm@kis.ru> + + * event-stream.c: Defined Qcancel_mode_internal. + (syms_of_event_stream): defsymbol'ed it. + + * events.h: Externed it. + + * event-msw.c (mswindows_wnd_proc, WM_CANCELMODE): Added this handler. + +1998-06-04 Oliver Graf <ograf@fga.de> + + * frame-x.c (x_cde_destroy_callback): free the data + (cde-start-drag-internal) corrected root position, 21.1 needs this + hardcoded in Button events + (offix-start-drag-internal) corrected root position + +1998-06-03 Kirill M. Katsnelson <kkm@kis.ru> + + * process-nt.c (signal_cannot_launch): Use signal_simple_error() + instead of error(). + +1998-06-03 Kirill M. Katsnelson <kkm@kis.ru> + + * dialog-msw.c (button_width): Removed `inline' from the function + declaration. + +1998-06-03 Rick Rankin <Rick_Rankin-P15254@email.mot.com> + + * frame-msw.c: add WS_VISIBLE flag to the first frame created. + Note that adding this flag to subsequent frames causes problems. + +1998-06-03 Gunnar Evermann <Gunnar.Evermann@nats.informatik.uni-hamburg.de> + + * glyphs-eimage.c (png_instantiate) move 'struct + png_memory_storage tbr' out of nested block to avoid dangling + reference + +1998-06-02 Andy Piper <andyp@parallax.co.uk> + + * faces.h: + * faces.c: rename 3d-object -> gui-element. add toolbar face which + inherits from gui-element. + + * glyphs-msw.c: use DIBitmaps for xbm bitmaps to be consistent + with existing code, generate masks correctly. + +1998-06-03 P. E. Jareth Hein <jareth@camelot-soft.com> + + * glyphs-eimage.c: Changed included header for gifs to use + Gifreader instead of giflib. + + * glyphs-x.c: removed the image-related functions that were + moved into glyphs-eimage. + +1998-06-02 David Bush <david.bush@adnb.alcatel.com> + + * glyphs.c (bitmap_to_lisp_data) Define XFree to be free + if built without X Windows support. + +1998-06-02 Hrvoje Niksic <hniksic@srce.hr> + + * fns.c (Fconcat): Synch docstring with new reality. + +1998-06-03 SL Baur <steve@altair.xemacs.org> + + * frame.c: Remove reference to msdos.h (which is going away). + Suggested by Hrvoje Niksic and Kirill Katsnelson. + +1998-06-02 P. E. Jareth Hein <jareth@camelot-soft.com> + + * glyphs-eimage.c (jpeg_instantiate): Fix handling of + grayscale images/ + + +1998-05-30 Kirill M. Katsnelson <kkm@kis.ru> + + * events.h: Fixed commentary about misc-user scrollbar events. + + * scrollbar-x.c (x_update_vertical_scrollbar_callback): Use frame + object as an event channel, instead of window object. + (x_update_horizontal_scrollbar_callback): Ditto. + +1998-05-29 Andy Piper <andyp@parallax.co.uk> + + * ntplay.c (play_sound_data_1) new function. convert alloca data + to malloc if necessary. + (play_sound_file): if the file is not in our path then convert to + data and play. + +1998-06-01 SL Baur <steve@altair.xemacs.org> + + * mule-mcpath.c (mc_chdir): Reverse parameters in call to memcpy. + * msdos.c (Frecent_doskeys): Ditto. + + * unexalpha.c (unexec): Reverse parameters in call to memcpy. + Suggested by Reggie Perry <perry@zso.dec.com> + + * buffer.h: Eliminate size in declaration. + +1998-06-01 Olivier Galibert <galibert@pobox.com> + + * unexelfsgi.c (unexec): Cleanup n/nn and remove useless kludge. + +1998-06-01 Kirill M. Katsnelson <kkm@kis.ru> + + * gui.c (gui_item_init): Changed the default value for config member + from Qunbound to Qnil. + +1998-06-01 Greg Klanderman <greg@alphatech.com> + + * indent.c (vmotion_pixels): Don't #define abs(). + +1998-05-30 Kirill M. Katsnelson <kkm@kis.ru> + + * s/windowsnt.h: Defined popen and pclose to be _popen and _pclose + respectively. + +1998-05-30 Andy Piper <andyp@parallax.co.uk> + + * glyphs.h: add xbm declarations. + + * console.h: add xbm_instantiate_method device method. + + * glyphs.c (check_valid_xbm_inline) (xbm_validate) + (bitmap_to_lisp_data) (xbm_mask_file_munging) (xbm_normalize) + (xbm_possible_dest_types): moved here from glyphs-x.c. use + locate_pixmap_file device method and read_bitmap_data_from_file + instead of XmuReadBitmapDataFromFile. + (xbm_instatntiate): make a device method. + + * glyphs-x.c: see glyphs.c changes. (read_bitmap_data_from_file) + new function that just calls XmuReadBitmapDataFromFile. + (x_xbm_instatntiate): device method from xbm_instantiate. + + * glyphs-msw.c (read_bitmap_data) (NextInt) + (read_bitmap_data_from_file): new functions copied from Xmu + sources. + (xbm_create_bitmap_from_data) from Ben <ben@666.com> convert + inline data to an mswindows bitmap. + (init_image_instance_from_xbm_inline) (xbm_instantiate_1) + (mswindows_xbm_instantiate): mswindows-ized versions of the X + functions. + +1998-05-30 Kirill M. Katsnelson <kkm@kis.ru> + + * window.c (specifier_vars_of_window): Renamed `has_modeline-p' to + `modeline-visible-p'. + Declared specifier lisp variables at the beginning oh the file + as static. + + * procimpl.h (struct process_methods): Changed semantics of + create_process method so it accepts lisp strings instead of + char pointers. + + * process.c (Fstart_process_internal): Moved building of + unix style argv from here to process-unix.c, ... + + * process-unix.c (unix_create_process): ... right here. + + * process-nt.c (nt_create_process): Changed this function to + support new semantics, so avoided a GC problem. + + * events.c (Fmake_event): Document misc-user events properties. + (Fmake_event): Do not allow arbitrary objects for channel property + of misc-user events. + (Fmake_event): Change misc-user event validation: it is function + which is required, not button. + + * event-msw.c (mswindows_user_event_p): Recognize misc user events as + user events. + (mswindows_enqueue_misc_user_event): Added function. + (mswindows_bump_queue): Removed function. + (mswindows_enqueue_magic_event): Support NULL HWND parameter. + (mswindows_wnd_proc, WM_CLOSE): Use mswindows_enqueue_misc_user_event(). + (mswindows_wnd_proc, WM_EXITSIZEMOVE): Ditto. + (emacs_mswindows_handle_magic_event): Handle XM_BUMPQUEUE, by doing + really nothing, which is my personal favorite thing. + + * console-msw.h: Removed prototype for mswindows_bump_queue(). + Added prototype for mswindows_enqueue_misc_user_event(). + + * menubar-msw.c (mswindows_handle_wm_command): Use + mswindows_enqueue_misc_user_event(). + + * toolbar-msw.c (mswindows_handle_toolbar_wm_command): Ditto. + + * dialog-msw.c (dialog_proc): Ditto. + + * scrollbar-msw.c (mswindows_handle_scrollbar_event): Ditto. + (mswindows_handle_scrollbar_event): Use frame, not window, for misc + user events channel. + +1998-05-29 Greg Klanderman <greg@alphatech.com> + + * window.c (Fwindow_displayed_text_pixel_height): was relying on + incorrect semantics of vmotion_pixels which has been fixed. don't + use it anymore as it can't easily be used. + + * indent.c (vmotion_pixels): fix off by one bug moving up. also + the motion was reported incorrectly if you tried to go past end of + buffer. + +1998-05-30 Kirill M. Katsnelson <kkm@kis.ru> + + * toolbar.h: Removed misleading commentary, as Martin suggested. + +1998-05-30 Kirill M. Katsnelson <kkm@kis.ru> + + * lisp.h: Extern Qactivate_menubar_hook. + + * menubar-msw.c (unsafe_handle_wm_initmenu_1): Pass correct value to + run_hook (). + +1998-05-29 Andy Piper <andyp@parallax.co.uk> + + * glyphs-msw.c: use BPLINE macro. + + * select-msw.c (mswindows-selection-exists-p) + (mswindows-delete-selection): doc string fixes. + + * toolbar-msw.c (mswindows_output_toolbar): make disabled buttons + unpressable. warning elimination. + +1998-05-28 Martin Buchholz <martin@xemacs.org> + + * alloc.c (dbg_constants): + * dbxrc: + * gdbinit: + Remove toolbar_data debugging code, since that lrecord has + also been removed. + +Wed May 27, 1998 Darryl Okahata <darrylo@sr.hp.com> + + * alloc.c: zap cached value of (user-home-directory), so that + it's not undumped. + + * buffer.c: From init_buffer(), separated out code that + determined the initial directory for the *scratch* buffer, and + put them into a function called "init_initial_directory()". + The initial directory is now available as a global "char *" + called initial_directory. + + * buffer.h: Added extern entries for initial_directory[] and + init_initial_directory(). + + * editfns.c: added new elisp function "user-home-directory", + which basically returns getenv("HOME"), but attempts to use + other values if $HOME isn't set.This may have to be tweaked in + the future as, under Unix, "/" is used if $HOME isn't set (this + probably should be set to the current directory). To support + this, a new C function, "get_home_directory()", now exists, + which returns the "home directory", as a "char *" string. + + * emacs.c: Rearrange NT initialization order so that + environment/registry variables will be properly entered into + Vprocess_environment. + + * fileio.c: replaced egetenv("HOME") with calls to the new + get_home_directory(). + + * lisp.h: Added function prototypes for uncache_home_directory() + and get_home_directory(), along with lisp prototypes for + Fuser_home_directory() and friends. + + * nt.c: replaced getenv("HOME") with calls to the new + get_home_directory(). + + * sysfile.h: for WINDOWSNT, #include <direct.h>, to suppress + warnings about getcwd(), etc. not having prototypes. + +1998-05-28 Kirill M. Katsnelson <kkm@kis.ru> + + * process-nt.c (send_signal): Emulate SIGHUP. + (validate_signal_number): Ditto. + + * event-msw.c (mswindows_wnd_proc, WM_KEYDOWN): Unconditionally + remove MOD_SHIFT from ASCII characters. + (mswindows_wnd_proc, WM_KEYDOWN): Do not activate the menubar when + F10 is pressed. + +1998-05-24 Oliver Graf <ograf@fga.de> + + * frame-x.c (cde-start-drag-internal): added filename and multi- + data transfers + (x_cde_convert_callback) dito + +1998-05-26 Oliver Graf <ograf@fga.de> + + * frame-x.c: include event-mod.h also with CDE + (x_cde_convert_callback) made the thing working + (cde-start-drag-internal) also debugging + +1998-05-25 Hans Guenter Weigand <hgweigand@wiesbaden.netsurf.de> + + * m/sparc.h: + * getloadavg.c: + * malloc.c: + * unexec.c: + * mem-limits.h: + - add __OpenBSD__ where __NetBSD__ was found. + - TODO: replace platform-specific conditional compilation by + feature tests in configure.in. + +1998-05-15 Greg Klanderman <greg@alphatech.com> + + * window.c (Fwindow_displayed_text_pixel_height): New function. + (syms_of_window): DEFSUBR it. + + * indent.c (Fvertical_motion_pixels): New function - request + movement in pixels. + (vmotion_pixels): helper. + (syms_of_indent): DEFSUBR. + * lisp.h: declaration for vmotion_pixels(). + + * indent.c (Fvertical_motion): Add optional third argument PIXELS, + to request returning motion in pixels. + (Fvertical_motion_pixels): Remove, functionality merged into + Fvertical_motion. + * window.c (window_scroll): call Fvertical_motion with 3 arguments. + (Fmove_to_window_line): ditto. + * lisp.h: Change declaration for Fvertical_motion. + + * window.c: rename window-text-pixel-{height,width,edges} to + window-text-area-pixel-*. + +1998-05-26 Gunnar Evermann <Gunnar.Evermann@nats.informatik.uni-hamburg.de> + + * tooltalk.c (vars_of_tooltalk) added staticpro for + Tooltalk_Message_plist_str and Tooltalk_Pattern_plist_str + +1998-05-27 Andy Piper <andyp@parallax.co.uk> + + * faces.c: create a new 3d_object_face, make modeline and + vertical_divider faces fallback to this rather than the default. + +1998-05-21 Andy Piper <andyp@parallax.co.uk> + + * s/cygwin32.h: define charsets for cygwin. + +1998-05-25 Andy Piper <andyp@parallax.co.uk> + + * toolbar-msw.c (mswindows_output_toolbar): fix up button sizes + and coordinates. resize bitmaps if we have already settled on a + different size. + + * glyphs-msw.c (xpm_to_eimage): add ';' for mswindows compiler. + +1998-05-25 Hrvoje Niksic <hniksic@srce.hr> + + * toolbar-msw.c (mswindows_handle_toolbar_wm_command): Ditto. + + * menubar-msw.c (mswindows_handle_wm_command): Ditto. + + * gui.h: Ditto. + + * gui-x.c (popup_selection_callback): Ditto. + + * dialog-msw.c (dialog_proc): get_callback -> get_gui_callback. + + * gui.c (get_callback): Renamed to get_gui_callback. + +1998-05-17 Martin Buchholz <martin@xemacs.org> + + * glyphs.h: order rearrangement. + + * device-tty.c (tty_asynch_device_change): Warning suppression. + * device-x.c (x_device_system_metrics): Warning suppression. + Make Doc strings consistent with coding standards. + +1998-05-24 Martin Buchholz <martin@xemacs.org> + + * general.c: multiple definition of `Qicon'. general.c seems + like a good home for Qicon. + +1998-05-20 Kirill M. Katsnelson <kkm@kis.ru> + + * This patch is to fix compilation warnings under Windows. + + * s/windowsnt.h: Encapsulate getpid with sys_getpid. + Added prototypes for FSF inherited functions, with which XEmacs is + sprinkled thoroughly. + Removed some #if 0 code. Bracketed some more definitions, probably + related to Visual C versions prior to 4 (we do not support them). + + * sysfloat.h (logb): Finally, get logb() prototyped. + + * sysfile.h: Added Windows specific includes. + Removed old Windows specific code bracketed with #if 0. + + * sysdep.h: Added prototype for xrealpath(). + + * sysdep.c (sys_getpid): Added function, to support '95 negative pids. + + * symsinit.h: Added prototypes for syms_of_dired_mswindows, + vars_of_dired_mswindows and init_ntproc (Grrr). + + * realpath.c: Added Windows specific include files. + (xrealpath): Conditionalized declaration of some auto variables on + S_IFLNK, to avoid warnings. + + * ntproc.c: Disabled some compiler warnings. This file is going to + die, so I have not cleaned it up much. + (set_process_dir): Const parameter. + (Fwin32_short_file_name): Down CHECK_* macros to one argument. + (Fwin32_long_file_name): Ditto. + (Fwin32_set_process_priority): Ditto. Why didn't I remove these + three functions? + + * nt.h: Added prototypes for set_process_dir and convert_time. + + * nt.c: More include files. + (getpwnam): Consted char* argument. + (get_emacs_configuration): Const return value. + (opendir): Const argument. + (stat): Casted converstion long->short. + (stat): Removed ad hoc and questionable support for non-MSC compile. + (sys_pipe): Removed unused auto variable. + (_sys_read_ahead): Removed calls to DebPrint. + (sys_read): Ditto, in 2 places. + (term_ntproc): Added unused int parameter to signal handler, to + avoid a warning when compiling a call to signal(). + (msw_sigset): Properly return old signandler or NULL instead of void. + + * floatfns.c (Flogb): Casted arguments to unary minus to signed. + + * gmalloc.c (morecore): Ditto. + (_free_internal): Ditto. + + * lread.c (parse_integer): Ditto. + + * dired-msw.c: Added several include files. + + * cmdloop.c (Fcommand_loop_1): Added Microsoft C to the Big List + of Compilers to Shut Up. + + * callproc.c: Added #includes to suppress warnings under Windows. + (init_callproc): Removed #if0'ed code and unused variables. + +1998-05-25 Andy Piper <andyp@parallax.co.uk> + + * device-msw.c (mswindows_device_system_metrics): do planes in a + way consistent with X. + + * glyphs-msw.c (mswindows_initialize_image_instance_mask): don't + use SetPixel, use DIBits functions. + (xpm_to_eimage): frob colors more closely like xpm deos. + + * toolbar-msw.c: only resize bitmaps when shrinking. Adjust look + to be closer to X version. + + * event-msw.c: use tooltip string directly. + + * redisplay-msw.c: reinstate Kirill's bg pixmap change. + + * objects-msw.c: frob rgb colors that only Kyle uses. + + * dialog-msw.c (button_width): INLINE -> inline. + +1998-05-23 SL Baur <steve@altair.xemacs.org> + + * getloadavg.c (getloadavg): Fix typo. + +1998-05-23 Kirill M. Katsnelson <kkm@kis.ru> + + * objects-msw.c (mswindows_initialize_font_instance): Added support + for font character sets. + Replaced 'XXX' with '####' in comments throughout the file. + +1998-05-23 Kirill M. Katsnelson <kkm@kis.ru> + + * emacs.c (main_1): Added calls to vars_of_dialog_mswindows() and + console_type_create_dialog_mswindows(), to initialize Windows dialog + support. + + * symsinit.h: Prototyped the above functions. + + * dialog-x.c (x_popup_dialog_box): Moved dialog descriptor consistency + checks to dialog.c... + + * dialog.c (Fpopup_dialog_box): ...right here. Added more checks: a + device must support dialog boxes, and the descriptor must supply at + least one button. + + * dialog-msw.c: New file, dialogs for Windows. + +1998-05-21 Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> + + * eldap.c (ldap_search_unwind): Return Qnil instead of nothing + (Fldap_search_internal): Removed unused variable `err' + + * eldap.h: Moved Lisp_LDAP declaration here instead of using a + forward declaration + +1998-05-17 Martin Buchholz <martin@xemacs.org> + + * eldap.h: eldap.[ch] should never be used unless HAVE_LDAP is + defined. Therefore there is no need to handle the case when + HAVE_LDAP is undefined. Similarily, there is no reason to have + any code wrapped within `#ifdef emacs', since this code is only + useful within an emacs. This simplifies the code significantly. + + * inline.c: Include eldap.h only if HAVE_LDAP. + * inline.c: Don't bother including TT_C_H_PATH, since tooltalk.h + already does that. + +1998-05-21 Kirill M. Katsnelson <kkm@kis.ru> + + * unexnt.c (copy_executable_and_dump_data_section): Suppress + printing dump stats when building without DEBUG_XEMACS. + (dump_bss_and_heap): Ditto. + +1998-05-21 Andy Piper <andyp@parallax.co.uk> + + * gnuclient.c: don't suppress window system if there is no display + and we are running under mswindows. send 'mswindows device type if + we are in this situation. + +1998-05-20 Andy Piper <andyp@parallax.co.uk> + + * general.c: + * lisp.h: Qbitmap, Qcursor, Qicon moved here from glyphs-msw.c. + + * glyphs-msw.c: change cursor imgae type name to resource. Fix + some nits. + +1998-05-20 Kirill M. Katsnelson <kkm@kis.ru> + + * EmacsFrame.c (Xt_StringToScrollBarPlacement): Added support for + {top,bottom}-{left,right} values in addition to + {top,bottom}_{left,right}. + +1998-05-18 Hrvoje Niksic <hniksic@srce.hr> + + * fileio.c (Fmake_temp_name): Remove unreached code. + + * process-nt.c (validate_signal_number): Use + signal_simple_error(). + +1998-05-19 Martin Buchholz <martin@xemacs.org> + + * unexhp9k800.c: + * sound.c (vars_of_sound): + * sysdep.c (reset_sigio_on_device): + * window.c (window_bottom_gutter_height): + unexhp9k800.c:258: warning: implicit declaration of function + `calculate_checksum' + sound.c:604: warning: implicit declaration of function `vars_of_hpplay' + sysdep.c:1012: warning: unused variable `owner' + window.c:993: warning: `window_right_toolbar_width' defined but not used + +1998-05-19 Andy Piper <andyp@parallax.co.uk> + + * glyphs-msw.c (mswindows_create_resized_mask) + (mswindows_create_resized_bitmap): new funnctions split out from + mswindows_resize_dibitmap_instance. + + * glyphs-msw.h: declare new resize functions. + + * toolbar-msw.c (mswindows_output_toolbar): use new bitmap resize + functions so that the original bitmaps are preserved. + + * sheap.c: fixup static heap exhausted error to avoid FAQs. + + * redisplay-msw.c (mswindows_output_blank): fixup brush from bg + color if we are trying to output 0 depth bg pixmap. + + * scrollbar-msw.c: warning elimination. + +1998-05-18 Martin Buchholz <martin@xemacs.org> + + * frame-x.c (x_update_frame_external_traits): Start preprocessor + directives in column 1. + + * search.c (skip_chars): Avoid using xzero with arrays, since some + compilers get confused by the construct &array. + +1998-05-18 Kirill M. Katsnelson <kkm@kis.ru> + + * objects-msw.h: + * objects-msw.c: Changed the charset value for a new font from + "don't care" to "ansi". + + * glyphs-msw.c (convert_EImage_to_DIBitmap): Warnings fix. + +1998-05-18 Kirill M. Katsnelson <kkm@kis.ru> + + * event-msw.c (mswindows_wnd_proc, WM_KEYDOWN): Do not clear shift + modifier on control chars. + Use IsCharAlpha() instead of isaplha(). + +1998-05-19 Kazuyuki IENAGA <ienaga@jsys.co.jp> + + * s/freebsd.h: FreeBSD 2.2.6 now supports setlocale(LC_ALL, ""). + +1998-05-18 Kirill M. Katsnelson <kkm@kis.ru> + + * objects-msw.c (mswindows_initialize_font_instance): Use ANSI + charset when creating font. + (mswindows_initialize_color_instance): Do not create brush along + with a color. + (mswindows_finalize_color_instance): Do not delete it then. + + * objects-msw.h (struct mswindows_color_instance_data): Removed + brush slot, and corresponding accessor macro. + +1998-05-18 Kirill M. Katsnelson <kkm@kis.ru> + + * toolbar.c: Removed toolbar_data lrecord implementation. + (mark_frame_toolbar_buttons_dirty): Replase usage of toolbar_data + with toolbar_buttons (via FRAME_TOOLBAR_BUTTONS). + (compute_frame_toolbar_buttons): Ditto. + (CHECK_TOOLBAR): Ditto. + (set_frame_toolbar): Removed allocation of toolbar_data lrecord. + (update_frame_toolbars): Do not check for changed buffer + here. Toolbar information is provided by cached specs in + windows. The check for buffer is eliminated becuase toolbars are + marked changed in set_frame_selected_window() in frame.c + Added check for changed toolbars geometry. + (compute_frame_toolbars_data): Removed unused second parameter; + Adjusted callers of this static function throughout the file. + (init_frame_toolbars): Initialize current_toolbar_size. + (update_frame_toolbars): Use DEVICE_SUPPORTS_TOOLBARS_P instead of + what is its current expansion, for clarity. + (init_frame_toolbars): Ditto. + (init_device_toolbars): Ditto. + (init_global_toolbars): Ditto. + + * toolbar.h: Removed definition of toolbar_data lrecord. + Added accessor macros FRAME_TOOLBAR_BUTTONS and + FRAME_CURRENT_TOOLBAR_SIZE. + Added macro DEVICE_SUPPORTS_TOOLBARS_P. + + * toolbar-x.c (x_output_toolbar): The same change as in + toolbar-msw.c + (x_output_toolbar): Ditto. + (x_redraw_exposed_toolbar): Ditto. + + * toolbar-msw.c (mswindows_output_toolbar): Retrieve current + buttons from toolbar_buttons using FRAME_TOOLBAR_BUTTONS macro. + (mswindows_output_toolbar): Ditto. + (mswindows_output_toolbar): Ditto. + + * frame.c (mark_frame): Removed marking of arrays, according to + frameslots.h change. + (nuke_all_frame_slots): Ditto. + (set_frame_selected_window): Mark toolbars changed when + last_nonminibuf_window changes. + + * frame.h (struct frame): Moved some slots to frameslots.h. + Added current_toolbar_size array. + Changed references from toolbar_data to toolbar_buttons in macros + FRAME_RAW_THEORETICAL_TOOLBAR_VISIBLE, + FRAME_RAW_THEORETICAL_TOOLBAR_SIZE and + FRAME_RAW_THEORETICAL_TOOLBAR_BORDER_WIDTH. + + * frameslots.h: Added macro MARKED_SLOT_ARRAY a la winslots.h + Moved arrays of lisp objects here from frame.h: toolbar_size, + toolbar_visible_p, toolbar_border_width. + Removed toolbar_data slot and added toolbar_buttons. + +1998-05-17 Kirill M. Katsnelson <kkm@kis.ru> + + * symsinit.h: Externed syms_of_process_nt() + + * emacs.c (main_1): Call syms_of_process_nt() + + * process-nt.c: Quote process arguments by a call to Lisp function + `nt-quote-process-args'. + (syms_of_process_nt): New function. + (nt_send_process): Flush data stream after each write, to avoid + leaving buffered data. + (nt_send_process): When blocked on process output, wait for + process to slurp more for progressively increasing time intervals. + +1998-05-17 Martin Buchholz <martin@xemacs.org> + + * window.c (have_undivided_common_edge): Make file-local function + static. + (map_windows): Return 0 if all map functions successful. + Fix typos. + + * winslots.h: Use unlikely names for local variables in macros to + avoid shadowing warnings. + +1998-05-17 Andy Piper <andyp@parallax.co.uk> + + * toolbar-msw.c (mswindows_output_toolbar): hash on toolbar width + so that we re-output if the toolbar size has changed. + +1998-05-17 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de> + + * s/aix4-2.h (ALIGN_DATA_RELOC): Undefined to support new unexaix.c. + + * s/aix3-1.h (ALIGN_DATA_RELOC): Defined to support new unexaix.c. + + * unexaix.c: Massive cleanup and support of AIX 4.2 (and hopefully + greater). + +1998-05-16 Kirill M. Katsnelson <kkm@kis.ru> + + * glyphs-msw.c: Defined OEMRESOURCE before including windows.h to + get bitmap manifest constants defined. + + * console-msw.h: Include system files in angle brackets, not in + quotes. + + * window.c (specifier_vars_of_window): Fixed a typo in + `vertical-divider-line-width' docstirng. + +1998-05-16 Olivier Galibert <galibert@pobox.com> + + * line-number.c (delete_invalidate_line_number_cache): Use an + EMACS_INT. + (buffer_line_number): Remove dangerous, plain wrong when using + 64bits emacs ints, cast. + + * insdel.c (buffer_delete_range): Use an EMACS_INT. + + * cmds.c (Fforward_line): Use EMACS_INTs. + + * search.c (bi_scan_buffer): Change to use EMACS_INTs. + (scan_buffer): Ditto. + (bi_find_next_newline_no_quit): Remove useless cast. + (find_next_newline_no_quit): Ditto. + (find_next_newline): Ditto. + (find_before_next_newline): Use an EMACS_INT. + + * lisp.h: Change scan_buffer to pass EMACS_INTs. + +1998-05-16 Hrvoje Niksic <hniksic@srce.hr> + + * menubar-msw.c (mswindows_handle_wm_command): Ditto. + + * toolbar-msw.c (mswindows_handle_toolbar_wm_command): Ditto. + + * gui-x.c (popup_selection_callback): Use it. + + * gui.h (get_callback): Declare it. + + * gui.c (get_callback): New function. + +1998-05-15 SL Baur <steve@altair.xemacs.org> + + * window.c (have_undivided_common_edge): Guard scrollbar specific + stuff. + (window_needs_vertical_divider_1): Ditto. + +1998-05-16 Hrvoje Niksic <hniksic@srce.hr> + + * emacs.c (decode_path): Eliminate compiler warning. + (Fdecode_path): Renamed to Fsplit_path. + (Fsplit_string_by_char): New function. + +1998-05-14 Damon Lipparelli <lipp@primus.com> + + * winslots.h: close comment + +1998-05-16 Kirill M. Katsnelson <kkm@kis.ru> + + * callproc.c: Removed declared and unused variable Qbuffer_file_type. + + * bufslots.h: Removed buffer_file_type slot. + + * buffer.c (complex_vars_of_buffer): Removed buffer_file_type from + buffer local flags. + (complex_vars_of_buffer): Removed buffer-file-type variable and + its default reference. + +1998-05-15 Kirill M. Katsnelson <kkm@kis.ru> + + * faces.c (complex_vars_of_faces): Defined + Vvertical_divider_face. + (vars_of_faces): Staticpro it. + + * faces.h: Externed Vvertical_divider_face. + + * redisplay-x.c (x_output_vertical_divider): Use + Vvertical_divider_face to draw the divider instead of modeline + face. + + * redisplay-msw.c (mswindows_output_vertical_divider): Draw + divider face using Vvertical_divider_face background. + Fix drawing spacing gaps around the divider. + +1998-05-14 Didier Verna <verna@inf.enst.fr> + + * redisplay-x.c (x_output_vertical_divider): removed hard-wired + values for the vertical divider line width and spacing. Use the + cached values from the window structure instead. + (x_divider_width): ditto. + + * window.c (specifier_vars_of_window): new specifiers: + vertical-divier -line-width and -spacing. + (vertical_divider_global_width_changed): formerly known as + vertical_divider_shadow_thickness_changed. + + * winslots.h: new slots: vertical_specifier _line_width and + _spacing. Plus corrected a comment typo. + +1998-05-15 Kirill M. Katsnelson <kkm@kis.ru> + + * window.h: Declared window_divider_width(). + + * console-stream.c (stream_divider_width): Removed method. + (console_type_create_stream): And declaration for it. + + * redisplay.c (pixel_to_glyph_translation): Use + window_divider_width() instead of divider_width redisplay method. + (pixel_to_glyph_translation): Fix top divider edge calculation + when scrollbar is on top. + + * window.c (window_divider_width): New function, an outphaser for + divider_width redisplay method. + (window_right_gutter_width): Use it. + (specifier_vars_of_window): For vertical-divider-{spacing,line-width} + specifiers, set fallback values differently on TTYs, and document + the behavior of these on TTYs in the docstrings. + + * scrollbar.c (update_scrollbar_instance): Use + window_divider_width() instead of divider_width redisplay method. + + * console.h (struct console_methods): Removed divider_width_method. + + * redisplay-tty.c (tty_divider_width): Removed device method. + (console_type_create_redisplay_tty): Removed definition for it. + (tty_output_vertical_divider): Respect the value returned by + window_divider_width thus divider line width specification. + + * redisplay-msw.c (mswindows_divider_width): Removed device method. + (console_type_create_redisplay_mswindows): Removed definition for it. + (mswinodws_output_vertical_divider): Respect the value returned by + window_divider_width thus divider line width specification. + +1998-05-15 Andy Piper <andyp@parallax.co.uk> + + * toolbar-msw.c: guess toolbar frame size a bit more accurately. + +1998-05-15 Andy Piper <andyp@parallax.co.uk> + + * glyphs-msw.c: resource loading implementation. + (cursor_normalize): new function. + (cursor_validate): ditto. + (cursor_instantiate): ditto. + (cursor_name_to_resource): ditto. + (cursor_possible_dest_types): ditto. + (check_valid_symbol): ditto. + (check_valid_string_or_int): ditto. + +1998-05-14 Martin Buchholz <martin@xemacs.org> + + * sysdep.c (tty_init_sys_modes_on_device): Treat VSUSP just like + VINTR and VQUIT. + + * process-unix.c (process_signal_char): Use VSUSP instead of + non-standard VSWTCH. Always prefer VSUSP to VSWTCH. + +1998-05-14 Kirill M. Katsnelson <kkm@kis.ru> + + * specifier.c (specifier_instance): Change locale precedence of + instantiation so window locale has higher priority than buffer + locale. + (Fspecifier_instance): Reflect this in docstring. + (Fadd_spec_list_to_specifier): Ditto. + (Fadd_spec_to_specifier): Ditto. + (Fremove_specifier): Ditto. + +1998-05-15 Kirill M. Katsnelson <kkm@kis.ru> + + ** Dialog separation into a device method from Andy Piper + + * emacs.c (main_1): Call console_type_create_dialog_x(). + + * dialog-x.c (x_popup_dialog_box): Old Fpopup_dialog_box converted + into this device method. + (console_type_create_dialog_x): New function. + + * dialog.c (Fpopup_dialog_box): New function. + (syms_of_dialog): Defsubr it. + + * console.h (struct console_methods): Declared + popup_dialog_box_method(). + + * symsinit.h: Defined console_type_create_dialog_{x,mswindows} + +1998-05-14 Oliver Graf <ograf@fga.de> + + * dragdrop.c (vars_of_dragdrop): dragdrop-protocols created + * frame-x.c (x_cde_transfer_callback): checked for merge errors + +1998-05-13 Oliver Graf <ograf@fga.de> + + * dragdrop.c (vars_of_dragdrop): provide dragdrop-api + +1998-05-15 Kirill M. Katsnelson <kkm@kis.ru> + + * console.h (device_metrics): Removed dbcs, input-method-editor + and right-to-left metrics. + + * device.c (Fdevice_system_metric): Ditto. + (Fdevice_system_metrics): Ditto. + (syms_of_device): Ditto. + (Fdevice_system_metric): Swapped DEVICE and METRIC parameters back + again. + +1998-05-14 Hrvoje Niksic <hniksic@srce.hr> + + * line-number.h (mark_line_number_cache): Remove unused + declaration. + + * line-number.c (LINE_NUMBER_FAR): Increase to 32768. + (get_nearest_line_number): Simplify. + (add_position_to_cache): Make the old marker point nowhere. + +1998-05-14 Kirill M. Katsnelson <kkm@kis.ru> + + ** Renamed window-divider-map => vertical-divider-map + and event-over-divider-p => event-over-vertical-divider-p, + in the following files/functions: + * events.h: + * events.c (Fevent_over_divider_p): + * keymap.c (get_relevant_keymaps): + (vars_of_keymap): + + * redisplay.h (OVER_V_DIVIDER): Renamed so from OVER_DIVIDER. + + * redisplay.c (pixel_to_glyph_translation): Use OVER_V_DIVIDER. + +1998-05-14 Kirill M. Katsnelson <kkm@kis.ru> + + * window.c (vertical_divider_changed_in_window): Renamed so. + (specifier_vars_of_window): Defined Vvertical_divider_draggable_p. + (window_needs_vertical_divider_1): Decide whether we need it based + on the value of the above specifier. If separators are unwanted, + put them only if there's no scrollbar between this window and its + right neighbor. + (have_undivided_common_edge): New function, helper for the above. + (window_needs_vertical_divider): Return either a cached value, + or clauclate and cache one. + (invalidate_vertical_divider_cache_in_window): Implemented. + (map_windows): Changed return type to int, return the value from + MAPFUN. + + * window.h: Prototype invalidate_vertical_divider_cache_in_window. + (struct window): Added need_vertical_divider_p and + need_vertical_divider_valid_p. + + * winslots.h: Added vertical_divider_draggable_p slot. + + * scrollbar.c (vertical_scrollbar_changed_in_window): Implemented. + (specifier_vars_of_scrollbar): Used it in all vertical specifiers. + + * frame.c (invalidate_vertical_divider_cache_in_frame): New function. + + * frame.h (MARK_FRAME_WINDOWS_STRUCTURE_CHANGED): Call + invalidate_vertical_divider_cache_in_frame(). + Prototype it. + +1998-05-14 Andy Piper <andyp@parallax.co.uk> + + * toolbar-msw.c: provide correct parameters to TB_SETROWS. + + * glyphs-msw.c (mswindows_initialize_image_instance_mask): size + masks correctly and don't select 0. + +1998-05-14 Kirill M. Katsnelson <kkm@kis.ru> + + * winslots.h: New file, declaration of some struct window and + struct saved_window members. + + * window.h (struct window): Include it, with required preprocessor + magic. + + * window.c (mark_window): Ditto. + (allocate_window): Ditto. + (struct saved_window): Ditto. + (mark_window_config): Ditto. + (saved_window_equal): Ditto. + (Fset_window_configuration): Ditto. + +1998-05-14 Kirill M. Katsnelson <kkm@kis.ru> + + * redisplay-msw.c (mswindows_output_vertical_divider): Syntax fix. + +1998-05-12 Didier Verna <verna@inf.enst.fr> + + * redisplay-x.c (x_output_vertical_divider): draw shadows around + the divider line. The shadow thickness is currently + hard-wired. This will probably be turned into a specifier soon. + +1998-05-12 Didier Verna <verna@inf.enst.fr> + + * console.h (struct console_methods): the divider_width console + method now requires a struct window * argument. + + * redisplay-x.c (x_divider_width): ditto. Plus remove + X_DIVIDER_WIDTH, X_DIVIDER_SHADOW_THICKNESS. + (x_output_vertical_divider): give a depressed look when the shadow + thickness is negative. + + * console-stream.c (stream_divider_width): pass a struct window * + argument. + + * redisplay-tty.c (tty_divider_width): ditto. + + * window.c (window_right_gutter_width): totdi. + + * redisplay.c (generate_modeline): ittod. + + * scrollbar.c (update_scrollbar_instance): ttido. + + * redisplay-msw.c (mswindows_divider_width): ottid. + WARNING: this enables to compile, but the feature is not functional. + + * window.h (struct window): new field + vertical_divider_shadow_thickness. + + * window.c (specifier_vars_of_window): new specifier + vertical-divider-shadow-thickness. + (vertical_divider_shadow_thickness_changed): new function to + inform redisplay that the window has changed. + (mark_window): handle new field vertical_divider_shadow_thickness + from struct window. + (allocate_window): ditto. + (saved_window_equal): toddi. + (Fset_window_configuration): totid. + (save_window_save): ttdio. + (struct saved_window): new field vertical_divider_shadow_thickness. + +1998-05-14 Kirill M. Katsnelson <kkm@kis.ru> + + * device-msw.c (mswindows_device_system_metrics): Support a deluge + of metrics. + +1998-05-12 Oliver Graf <ograf@fga.de> + + * frame-x.c (x_cde_transfer_callback): fixed for the new protocol + * event-Xt.c (x_event_to_emacs_event): C++ compability + +1998-05-14 Hrvoje Niksic <hniksic@srce.hr> + + * emacs.c (Fdecode_path): Default SEPCHAR to value of + path-separator. + +1998-05-14 Hrvoje Niksic <hniksic@srce.hr> + + * emacs.c (vars_of_emacs): Do it here; change the meaning of + Vpath_separator. + + * fileio.c (vars_of_fileio): Don't define Vpath_separator here. + +1998-05-14 Hrvoje Niksic <hniksic@srce.hr> + + * emacs.c (decode_path_1): New function. + (decode_path): Use it. + (Fdecode_path): Renamed from Fdecode_path_internal; use + decode_path_1. + +1998-05-12 Hrvoje Niksic <hniksic@srce.hr> + + * macros.c (Fzap_last_kbd_macro_event): New function. + (Fend_kbd_macro): Remove REMOVE_LAST kludge. + +1998-05-10 Andy Piper <andyp@parallax.co.uk> + + * redisplay-msw.c (mswindows_output_dibitmap_region): make sure + multiple bitmaps are output vertically as well as horizontally. + * (mswindows_output_dibitmap): don't cope with bitmap boundaries + crossing lines this is handled by + mswindows_output_dibitmap_region. + +1998-05-12 Martin Buchholz <martin@xemacs.org> + + * inline.c: Include eldap.h + + * menubar-x.c (x_update_frame_menubar_internal): + Remove: unused variable `container' + +1998-05-11 Martin Buchholz <martin@xemacs.org> + + * s/aix4.h: Allow AIX 4.3 XEmacs to compile cleanly. + Unfortunately, the resulting temacs still cannot dump. + + * symbols.c (symbol_is_constant): + (verify_ok_for_buffer_local): + -Wswitch Warning suppression - add default case to switches. + + * redisplay.c (decode_mode_spec): Remove unused variables, + Replace Fcoding_system_property (codesys, Qmnemonic) with + XCODING_SYSTEM_MNEMONIC (codesys); + Fcoding_system_property is for users. + + * buffer.c: + * fileio.c: + * lread.c: + * xselect.c: + Change empty docstrings into no doc strings at all. + Fix bogus FSF-format docstrings. + + * extents.c: + Standardize docstrings. + + * floatfns.c: + Explain problems with matherr. + + * glyphs.c: make DEFUNs etags-readable, i.e. single-line + + * syssignal.h: + if BROKEN_SIGIO, then SIGIO wants to be undefined. + if SIGIO and not SIGPOLL, SIGPOLL wants to be SIGIO.\ + Fix the weird resultant interaction (causes windows problems) + + * gdbinit: + * dbxrc: + Take new EMACSBOOTSTRAPLOADPATH into account. + Update documentation strings + + * Makefile.in.in: + - Adjust for luser's CDPATH being set to something weird. + - Take into account bash 2.02's tendency to print the cwd when + using CDPATH. Always use `cd ./foo' instead of `cd foo'. + - fix the run-temacs target to use $(DUMPENV) + - fix the run-puremacs target to use $(DUMPENV) + - fix the `depend' target to properly $(RM) the right files + - Generate a better TAGS file for XEmacs' lisp code using + hand-crafted regexps. + - Use standard coding conventions for modules/Makefile.in + +1998-05-12 Didier Verna <verna@inf.enst.fr> + + * redisplay.c: removed the scrolling modeline code that didn't + make it for 21.0. To be continued ... + +1998-05-13 Michael Sperber [Mr. Preprocessor] <sperber@informatik.uni-tuebingen.de> + + * emacs.c (Fdecode_path_internal): Removed bogus handling of nil + and empty string inputs. + +1998-05-12 Hrvoje Niksic <hniksic@srce.hr> + + * redisplay-x.c (x_output_vertical_divider): Fixed typo. + +1998-05-10 Oliver Graf <ograf@fga.de> + + * event-stream.c (enqueue_misc_user_event_pos): created + * lisp.h (enqueue_misc_user_event_pos): prototype added + * frame-x.c (x_cde_transfer_callback): debug code plus API changes + * emacs.c: call vars_of_dragdrop + * dragdrop.c (vars_of_dragdrop): provide dragdrop + +1998-05-11 Oliver Graf <ograf@fga.de> + + * frame-x.c (x_cde_transfer_callback): return at correct pos + * event-Xt.c (x_event_to_emacs_event): changed format of drop + object for MIME (see comment in dragdrop.c) + * dragdrop.c: API change documented in comment + removed provide of dragdrop [is provided by dragdrop.el] + +1998-05-12 Kirill M. Katsnelson <kkm@kis.ru> + + * window.c (window_needs_vertical_divider): Enable vertical + dividers for every non-rightmost window. + (window_left_gutter_width): Left gutter consists of mythical + toolbar and a virtual scrollbar. + (window_right_gutter_width): The right one may have a divider + also. + + * scrollbar.c (update_scrollbar_instance): Position vertical + scrollbar left to divider if the latter present. + + * redisplay.h: Declared OVER_DIVIER constant. + + * redisplay.c (pixel_to_glyph_translation): Handle OVER_DIVIDER + case. + + * redisplay-x.c (x_output_vertical_divider): Output divider along + the right side of the window, down to window bottom. Swapped + foreground and background colors so it is visible by default. + + * redisplay-tty.c (tty_output_vertical_divider): Uncondiionally + stick the divider to the right window side. + + * redisplay-msw.c (mswindows_redisplay_deadbox_maybe): Fixed + deadbox painting. + (mswindows_divider_width): Ask system for user preferred value. + (mswindows_output_vertical_divider): Always output the divider on + the right side of a window, down to bottom. + + * keymap.c (get_relevant_keymaps): Route mouse button events which + happened over a window divider through window-divider-map. + (Fkey_binding): Documented that in the docstring. + Defined the variable Vwindow_divider_map. + + * events.c (Fevent_over_divider_p): Added this function. + + * events.h: EXFUNed it. + +1998-05-12 Kirill M. Katsnelson <kkm@kis.ru> + + * toolbar.c (update_frame_toolbars): Re-layout frame windows if + toolbar geometry is suspected to change. + +1998-05-11 Jonathan Harris <jhar@tardis.ed.ac.uk> + + * src/device-msw.c + * src/event-msw.c + Condition dnd and dde code on HAVE_DRAGNDROP. + +1998-05-11 Hrvoje Niksic <hniksic@srce.hr> + + * events.c (format_event_object): Print space as SPC etc. + +1998-05-11 Hrvoje Niksic <hniksic@srce.hr> + + * print.c (print_internal): In the default case, abort() if + ERROR_CHECK_TYPECHECK. + + * fileio.c (Fmake_temp_name): Doc fix. + +1998-05-10 Hrvoje Niksic <hniksic@srce.hr> + + * xgccache.c (describe_gc_cache): Define only if DEBUG_XEMACS. + + * undo.c (Fprimitive_undo): Fixed typo. + +1998-05-11 Hrvoje Niksic <hniksic@srce.hr> + + * fns.c (concat): Signal error on integer argument. + +1998-05-10 Kirill M. Katsnelson <kkm@kis.ru> + + * console.h (device_metrics): Prefixed each constatnt with DM_ + + * device.c: (Fdevice_system_metric): Renamed so from plural form + (metrics); Changed parameters order and added DEFAULT parameter; + Unabbreviated some metric constants; Fixed and untabified doc string. + (Fdevice_system_metrics): Added. Returns a plist of all provided + metrics. + + * device-msw.c (mswindows_device_system_metrics): Renamed + device_metrics enum constants. + Return Qunbound instead of Qnil. + + * device-tty.c (tty_device_system_metrics): Ditto. + + * device-x.c (x_device_system_metrics): Ditto. + +1998-05-10 Andy Piper <andyp@parallax.co.uk> + + * redisplay-msw.c: implement background pixmaps (really!). Make + sure bg color is transparent if we have bg pmaps. + * (mswindows_output_string) (mswindows_clear_region): output bg + pmap if required. + * (mswindows_output_dibitmap_region): new function. + * (mswindows_output_dibitmap): output offset pixmaps, blt masks in + the bg color rather than transparently. + + * toolbar-msw.c: use masks if they exist. + + * glyphs-msw.c: set up masks correctly. + + * event-msw.c: typedef SOCKET if cygwin and not msg select(). + +1998-05-10 Hrvoje Niksic <hniksic@srce.hr> + + * regex.c (re_match_2_internal): Check for quit. + +1998-05-10 Hrvoje Niksic <hniksic@srce.hr> + + * frame.c (Ffocus_frame): New function. diff -r f4aeb21a5bad -r 74fd4e045ea6 src/EmacsFrame.c --- a/src/EmacsFrame.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/EmacsFrame.c Mon Aug 13 11:13:30 2007 +0200 @@ -57,110 +57,141 @@ #undef XtOffset #define XtOffset(p_type,field) \ ((Cardinal) (((char *) (&(((p_type)0)->field))) - ((char *)0))) -#define offset(field) XtOffset(EmacsFrame, emacs_frame.field) +#define offset(field) XtOffset (EmacsFrame, emacs_frame.field) static XtResource resources[] = { - {XtNgeometry, XtCGeometry, XtRString, sizeof(String), - offset (geometry), XtRString, (XtPointer) 0}, - {XtNiconic, XtCIconic, XtRBoolean, sizeof(Boolean), - offset (iconic), XtRImmediate, (XtPointer) False}, + { XtNgeometry, XtCGeometry, + XtRString, sizeof (String), + offset (geometry), XtRString, (XtPointer) 0 }, + { XtNiconic, XtCIconic, + XtRBoolean, sizeof (Boolean), + offset (iconic), XtRImmediate, (XtPointer) False }, - {XtNemacsFrame, XtCEmacsFrame, XtRPointer, sizeof (XtPointer), - offset (frame), XtRImmediate, 0}, - {XtNmenubar, XtCMenubar, XtRBoolean, sizeof (Boolean), - offset (menubar_p), XtRImmediate, (XtPointer) True}, - {XtNinitiallyUnmapped, XtCInitiallyUnmapped, XtRBoolean, sizeof (Boolean), - offset (initially_unmapped), XtRImmediate, (XtPointer) False}, - {XtNminibuffer, XtCMinibuffer, XtRBoolean, sizeof (Boolean), - offset (minibuffer), XtRImmediate, (XtPointer) True}, - {XtNunsplittable, XtCUnsplittable, XtRBoolean, sizeof (Boolean), - offset (unsplittable), XtRImmediate, (XtPointer) False}, - {XtNinternalBorderWidth, XtCInternalBorderWidth, XtRInt, sizeof (int), - offset (internal_border_width), XtRImmediate, (XtPointer)4}, + { XtNemacsFrame, XtCEmacsFrame, + XtRPointer, sizeof (XtPointer), + offset (frame), XtRImmediate, 0 }, + { XtNmenubar, XtCMenubar, + XtRBoolean, sizeof (Boolean), + offset (menubar_p), XtRImmediate, (XtPointer) True }, + { XtNinitiallyUnmapped, XtCInitiallyUnmapped, + XtRBoolean, sizeof (Boolean), + offset (initially_unmapped), XtRImmediate, (XtPointer) False }, + { XtNminibuffer, XtCMinibuffer, + XtRBoolean, sizeof (Boolean), + offset (minibuffer), XtRImmediate, (XtPointer) True }, + { XtNunsplittable, XtCUnsplittable, + XtRBoolean, sizeof (Boolean), + offset (unsplittable), XtRImmediate, (XtPointer) False }, + { XtNinternalBorderWidth, XtCInternalBorderWidth, + XtRInt, sizeof (int), + offset (internal_border_width), XtRImmediate, (XtPointer)4 }, #ifdef HAVE_SCROLLBARS - {XtNscrollBarWidth, XtCScrollBarWidth, XtRInt, sizeof (int), - offset (scrollbar_width), XtRImmediate, (XtPointer)-1}, - {XtNscrollBarHeight, XtCScrollBarHeight, XtRInt, sizeof (int), - offset (scrollbar_height), XtRImmediate, (XtPointer)-1}, - {XtNscrollBarPlacement, XtCScrollBarPlacement, XtRScrollBarPlacement, - sizeof(unsigned char), offset(scrollbar_placement), XtRImmediate, + { XtNscrollBarWidth, XtCScrollBarWidth, + XtRInt, sizeof (int), + offset (scrollbar_width), XtRImmediate, (XtPointer)-1 }, + { XtNscrollBarHeight, XtCScrollBarHeight, + XtRInt, sizeof (int), + offset (scrollbar_height), XtRImmediate, (XtPointer)-1 }, + { XtNscrollBarPlacement, XtCScrollBarPlacement, + XtRScrollBarPlacement, sizeof (unsigned char), + offset (scrollbar_placement), XtRImmediate, #if defined (LWLIB_SCROLLBARS_MOTIF) || defined (LWLIB_SCROLLBARS_LUCID) || \ defined (LWLIB_SCROLLBARS_ATHENA3D) - (XtPointer) XtBOTTOM_RIGHT + (XtPointer) XtBOTTOM_RIGHT #else - (XtPointer) XtBOTTOM_LEFT + (XtPointer) XtBOTTOM_LEFT #endif }, #endif /* HAVE_SCROLLBARS */ + #ifdef HAVE_TOOLBARS - {XtNtopToolBarHeight, XtCTopToolBarHeight, XtRInt, sizeof (int), - offset (top_toolbar_height), XtRImmediate, (XtPointer)-1}, - {XtNbottomToolBarHeight, XtCBottomToolBarHeight, XtRInt, sizeof (int), - offset (bottom_toolbar_height), XtRImmediate, (XtPointer)-1}, - {XtNleftToolBarWidth, XtCLeftToolBarWidth, XtRInt, sizeof (int), - offset (left_toolbar_width), XtRImmediate, (XtPointer)-1}, - {XtNrightToolBarWidth, XtCRightToolBarWidth, XtRInt, sizeof (int), - offset (right_toolbar_width), XtRImmediate, (XtPointer)-1}, - {XtNtopToolBarBorderWidth, XtCTopToolBarBorderWidth, XtRInt, - sizeof (int), - offset (top_toolbar_border_width), XtRImmediate, (XtPointer)-1}, - {XtNbottomToolBarBorderWidth, XtCBottomToolBarBorderWidth, XtRInt, - sizeof (int), - offset (bottom_toolbar_border_width), XtRImmediate, (XtPointer)-1}, - {XtNleftToolBarBorderWidth, XtCLeftToolBarBorderWidth, XtRInt, - sizeof (int), - offset (left_toolbar_border_width), XtRImmediate, (XtPointer)-1}, - {XtNrightToolBarBorderWidth, XtCRightToolBarBorderWidth, XtRInt, - sizeof (int), - offset (right_toolbar_border_width), XtRImmediate, (XtPointer)-1}, - {XtNtopToolBarShadowColor, XtCTopToolBarShadowColor, XtRPixel, sizeof(Pixel), - offset(top_toolbar_shadow_pixel), XtRString, (XtPointer) "#000000"}, - {XtNbottomToolBarShadowColor, XtCBottomToolBarShadowColor, XtRPixel, - sizeof(Pixel), offset(bottom_toolbar_shadow_pixel), XtRString, (XtPointer) "#000000"}, - {XtNbackgroundToolBarColor, XtCBackgroundToolBarColor, XtRPixel, - sizeof(Pixel), offset(background_toolbar_pixel), XtRImmediate, - (XtPointer)-1}, - {XtNforegroundToolBarColor, XtCForegroundToolBarColor, XtRPixel, - sizeof(Pixel), offset(foreground_toolbar_pixel), XtRImmediate, - (XtPointer)-1}, - {XtNtopToolBarShadowPixmap, XtCTopToolBarShadowPixmap, XtRPixmap, - sizeof (Pixmap), offset(top_toolbar_shadow_pixmap), XtRImmediate, - (XtPointer)None}, - {XtNbottomToolBarShadowPixmap, XtCBottomToolBarShadowPixmap, XtRPixmap, - sizeof (Pixmap), offset(bottom_toolbar_shadow_pixmap), XtRImmediate, - (XtPointer)None}, - {XtNtoolBarShadowThickness, XtCToolBarShadowThickness, XtRDimension, - sizeof (Dimension), offset (toolbar_shadow_thickness), XtRImmediate, - (XtPointer)2}, + { XtNtopToolBarHeight, XtCTopToolBarHeight, + XtRInt, sizeof (int), + offset (top_toolbar_height), XtRImmediate, (XtPointer)-1 }, + { XtNbottomToolBarHeight, XtCBottomToolBarHeight, + XtRInt, sizeof (int), + offset (bottom_toolbar_height), XtRImmediate, (XtPointer)-1 }, + { XtNleftToolBarWidth, XtCLeftToolBarWidth, + XtRInt, sizeof (int), + offset (left_toolbar_width), XtRImmediate, (XtPointer)-1 }, + { XtNrightToolBarWidth, XtCRightToolBarWidth, + XtRInt, sizeof (int), + offset (right_toolbar_width), XtRImmediate, (XtPointer)-1 }, + { XtNtopToolBarBorderWidth, XtCTopToolBarBorderWidth, + XtRInt, sizeof (int), + offset (top_toolbar_border_width), XtRImmediate, (XtPointer)-1 }, + { XtNbottomToolBarBorderWidth, XtCBottomToolBarBorderWidth, + XtRInt, sizeof (int), + offset (bottom_toolbar_border_width), XtRImmediate, (XtPointer)-1 }, + { XtNleftToolBarBorderWidth, XtCLeftToolBarBorderWidth, + XtRInt, sizeof (int), + offset (left_toolbar_border_width), XtRImmediate, (XtPointer)-1 }, + { XtNrightToolBarBorderWidth, XtCRightToolBarBorderWidth, + XtRInt, sizeof (int), + offset (right_toolbar_border_width), XtRImmediate, (XtPointer)-1 }, + { XtNtopToolBarShadowColor, XtCTopToolBarShadowColor, + XtRPixel, sizeof (Pixel), + offset(top_toolbar_shadow_pixel), XtRString, (XtPointer) "#000000" }, + { XtNbottomToolBarShadowColor, XtCBottomToolBarShadowColor, + XtRPixel, sizeof (Pixel), + offset (bottom_toolbar_shadow_pixel), XtRString, (XtPointer) "#000000" }, + { XtNbackgroundToolBarColor, XtCBackgroundToolBarColor, + XtRPixel, sizeof (Pixel), + offset (background_toolbar_pixel), XtRImmediate, (XtPointer)-1 }, + { XtNforegroundToolBarColor, XtCForegroundToolBarColor, + XtRPixel, sizeof (Pixel), + offset (foreground_toolbar_pixel), XtRImmediate, (XtPointer)-1 }, + { XtNtopToolBarShadowPixmap, XtCTopToolBarShadowPixmap, + XtRPixmap, sizeof (Pixmap), + offset (top_toolbar_shadow_pixmap), XtRImmediate, (XtPointer)None }, + { XtNbottomToolBarShadowPixmap, XtCBottomToolBarShadowPixmap, + XtRPixmap, sizeof (Pixmap), + offset (bottom_toolbar_shadow_pixmap), XtRImmediate, (XtPointer)None }, + { XtNtoolBarShadowThickness, XtCToolBarShadowThickness, + XtRDimension, sizeof (Dimension), + offset (toolbar_shadow_thickness), XtRImmediate, (XtPointer)2 }, #endif /* HAVE_TOOLBARS */ - {XtNinterline, XtCInterline, XtRInt, sizeof (int), - offset (interline), XtRImmediate, (XtPointer)0}, + + { XtNinterline, XtCInterline, + XtRInt, sizeof (int), + offset (interline), XtRImmediate, (XtPointer)0 }, { #ifdef I18N4 - XtNfontSet, XtCFontSet, XtRFontSet, sizeof(XFontSet), + XtNfontSet, XtCFontSet, + XtRFontSet, sizeof (XFontSet), #else - XtNfont, XtCFont, XtRFontStruct, sizeof(XFontStruct *), + XtNfont, XtCFont, + XtRFontStruct, sizeof (XFontStruct *), #endif offset(font), XtRImmediate, (XtPointer)0 }, - {XtNforeground, XtCForeground, XtRPixel, sizeof(Pixel), - offset(foreground_pixel), XtRString, (XtPointer) "Black"}, - {XtNbackground, XtCBackground, XtRPixel, sizeof(Pixel), - offset(background_pixel), XtRString, (XtPointer) "Gray80"}, - {XtNcursorColor, XtCForeground, XtRPixel, sizeof(Pixel), - offset(cursor_color), XtRString, (XtPointer) "XtDefaultForeground"}, - {XtNbarCursor, XtCBarCursor, XtRBoolean, sizeof (Boolean), - offset (bar_cursor), XtRImmediate, (XtPointer)0}, - {XtNvisualBell, XtCVisualBell, XtRBoolean, sizeof (Boolean), - offset (visual_bell), XtRImmediate, (XtPointer)0}, - {XtNbellVolume, XtCBellVolume, XtRInt, sizeof (int), - offset (bell_volume), XtRImmediate, (XtPointer)0}, - {XtNuseBackingStore, XtCUseBackingStore, XtRBoolean, sizeof (Boolean), - offset (use_backing_store), XtRImmediate, (XtPointer)0}, - {XtNpreferredWidth, XtCPreferredWidth, XtRDimension, sizeof (Dimension), - offset (preferred_width), XtRImmediate, (XtPointer)0}, - {XtNpreferredHeight, XtCPreferredHeight, XtRDimension, sizeof (Dimension), - offset (preferred_height), XtRImmediate, (XtPointer)0}, + { XtNforeground, XtCForeground, + XtRPixel, sizeof (Pixel), + offset(foreground_pixel), XtRString, (XtPointer) "Black" }, + { XtNbackground, XtCBackground, + XtRPixel, sizeof (Pixel), + offset(background_pixel), XtRString, (XtPointer) "Gray80" }, + { XtNcursorColor, XtCForeground, + XtRPixel, sizeof (Pixel), + offset(cursor_color), XtRString, (XtPointer) "XtDefaultForeground" }, + { XtNbarCursor, XtCBarCursor, + XtRBoolean, sizeof (Boolean), + offset (bar_cursor), XtRImmediate, (XtPointer)0 }, + { XtNvisualBell, XtCVisualBell, + XtRBoolean, sizeof (Boolean), + offset (visual_bell), XtRImmediate, (XtPointer)0 }, + { XtNbellVolume, XtCBellVolume, + XtRInt, sizeof (int), + offset (bell_volume), XtRImmediate, (XtPointer)0 }, + { XtNuseBackingStore, XtCUseBackingStore, + XtRBoolean, sizeof (Boolean), + offset (use_backing_store), XtRImmediate, (XtPointer)0 }, + { XtNpreferredWidth, XtCPreferredWidth, + XtRDimension, sizeof (Dimension), + offset (preferred_width), XtRImmediate, (XtPointer)0 }, + { XtNpreferredHeight, XtCPreferredHeight, + XtRDimension, sizeof (Dimension), + offset (preferred_height), XtRImmediate, (XtPointer)0 }, }; #undef offset @@ -191,7 +222,7 @@ /* superclass */ &widgetClassRec, #endif /* class_name */ "EmacsFrame", - /* widget_size */ sizeof(EmacsFrameRec), + /* widget_size */ sizeof (EmacsFrameRec), /* class_initialize */ EmacsFrameClassInitialize, /* class_part_initialize */ 0, /* class_inited */ FALSE, @@ -201,7 +232,7 @@ /* actions */ emacsFrameActionsTable, /* num_actions */ XtNumber (emacsFrameActionsTable), /* resources */ resources, - /* resource_count */ XtNumber(resources), + /* resource_count */ XtNumber (resources), /* xrm_class */ NULLQUARK, /* compress_motion */ TRUE, /* compress_exposure */ TRUE, @@ -549,7 +580,7 @@ } /* Xt string-to-scrollbar-placement converter */ -/* ### Convert this to a `new-style' converter (See XtAddTypeConverter) */ +/* #### Convert this to a `new-style' converter (See XtAddTypeConverter) */ /* This variable cannot be a stack variable. */ static unsigned char cvt_string_scrollbar_placement; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/EmacsFrame.h --- a/src/EmacsFrame.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/EmacsFrame.h Mon Aug 13 11:13:30 2007 +0200 @@ -21,8 +21,8 @@ /* Synched up with: Not in FSF. */ -#ifndef _EmacsFrame_h -#define _EmacsFrame_h +#ifndef INCLUDED_EmacsFrame_h_ +#define INCLUDED_EmacsFrame_h_ #ifndef XtNminibuffer #define XtNminibuffer "minibuffer" @@ -347,4 +347,4 @@ void EmacsFrameRecomputeCellSize (Widget widget); void EmacsFrameSetCharSize (Widget widget, int rows, int cols); -#endif /* _EmacsFrame_h */ +#endif /* INCLUDED_EmacsFrame_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/EmacsFrameP.h --- a/src/EmacsFrameP.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/EmacsFrameP.h Mon Aug 13 11:13:30 2007 +0200 @@ -21,8 +21,8 @@ /* Synched up with: Not in FSF. */ -#ifndef _EmacsFrameP_h -#define _EmacsFrameP_h +#ifndef INCLUDED_EmacsFrameP_h_ +#define INCLUDED_EmacsFrameP_h_ #include "xintrinsicp.h" #include <X11/CoreP.h> @@ -109,6 +109,4 @@ extern EmacsFrameClassRec emacsFrameClassRec; /* class pointer */ - - -#endif /* _EmacsFrameP_h */ +#endif /* INCLUDED_EmacsFrameP_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/EmacsManager.c --- a/src/EmacsManager.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/EmacsManager.c Mon Aug 13 11:13:30 2007 +0200 @@ -37,12 +37,15 @@ static XtResource resources[] = { #define offset(field) XtOffset(EmacsManagerWidget, emacs_manager.field) - { XtNresizeCallback, XtCCallback, XtRCallback, sizeof(XtCallbackList), - offset(resize_callback), XtRImmediate, (XtPointer) 0 }, - { XtNqueryGeometryCallback, XtCCallback, XtRCallback, sizeof(XtCallbackList), - offset(query_geometry_callback), XtRImmediate, (XtPointer) 0 }, - { XtNuserData, XtCUserData, XtRPointer, sizeof(XtPointer), - offset(user_data), XtRImmediate, (XtPointer) 0 }, + { XtNresizeCallback, XtCCallback, + XtRCallback, sizeof (XtCallbackList), + offset(resize_callback), XtRImmediate, (XtPointer) 0 }, + { XtNqueryGeometryCallback, XtCCallback, + XtRCallback, sizeof (XtCallbackList), + offset(query_geometry_callback), XtRImmediate, (XtPointer) 0 }, + { XtNuserData, XtCUserData, + XtRPointer, sizeof (XtPointer), + offset(user_data), XtRImmediate, (XtPointer) 0 }, }; /**************************************************************** @@ -71,7 +74,7 @@ /* superclass */ (WidgetClass) &compositeClassRec, #endif /* class_name */ "EmacsManager", - /* widget_size */ sizeof(EmacsManagerRec), + /* widget_size */ sizeof (EmacsManagerRec), /* class_initialize */ ClassInitialize, /* class_part_init */ NULL, /* class_inited */ FALSE, @@ -147,17 +150,17 @@ { EmacsManagerWidget emw = (EmacsManagerWidget) w; EmacsManagerQueryGeometryStruct struc; - int mask = request->request_mode & (CWWidth | CWHeight); + int request_mode = request->request_mode; - struc.request_mode = mask; - if (mask & CWWidth) struc.proposed_width = request->width; - if (mask & CWHeight) struc.proposed_height = request->height; + struc.request_mode = request_mode; + struc.proposed_width = (request_mode & CWWidth) ? request->width : 0; + struc.proposed_height = (request_mode & CWHeight) ? request->height : 0; XtCallCallbackList (w, emw->emacs_manager.query_geometry_callback, &struc); reply->request_mode = CWWidth | CWHeight; reply->width = struc.proposed_width; reply->height = struc.proposed_height; - if (((mask & CWWidth) && (request->width != reply->width)) || - ((mask & CWHeight) && (request->height != reply->height))) + if (((request_mode & CWWidth) && (request->width != reply->width)) || + ((request_mode & CWHeight) && (request->height != reply->height))) return XtGeometryAlmost; return XtGeometryYes; } @@ -177,23 +180,21 @@ GeometryManager (Widget w, XtWidgetGeometry *request, XtWidgetGeometry *reply) { /* Sure, any changes are fine. */ -#define COPY(field, mask) \ - if (request->request_mode & mask) w->core.field = request->field +#ifdef LWLIB_MENUBARS_MOTIF /* The Motif menubar will merrily request a new size every time a child is added or deleted. Blow it off because it doesn't know what it's talking about. */ -#ifdef LWLIB_MENUBARS_MOTIF - if (!(XtClass (w) == xmRowColumnWidgetClass)) + if (XtClass (w) != xmRowColumnWidgetClass) #endif /* LWLIB_MENUBARS_MOTIF */ { - COPY (width, CWWidth); - COPY (height, CWHeight); + if (request->request_mode & CWWidth) w->core.width = request->width; + if (request->request_mode & CWHeight) w->core.height = request->height; } - COPY (border_width, CWBorderWidth); - COPY (x, CWX); - COPY (y, CWY); -#undef COPY + if (request->request_mode & CWBorderWidth) + w->core.border_width = request->border_width; + if (request->request_mode & CWX) w->core.x = request->x; + if (request->request_mode & CWY) w->core.y = request->y; return XtGeometryYes; } @@ -203,13 +204,13 @@ { if (!XtIsRealized (w)) { - XtWidgetGeometry req, repl; + XtWidgetGeometry request, reply; /* find out how big we'd like to be ... */ - req.request_mode = 0; - XtQueryGeometry (w, &req, &repl); - EmacsManagerChangeSize (w, repl.width, repl.height); + request.request_mode = 0; + XtQueryGeometry (w, &request, &reply); + EmacsManagerChangeSize (w, reply.width, reply.height); } } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/EmacsManager.h --- a/src/EmacsManager.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/EmacsManager.h Mon Aug 13 11:13:30 2007 +0200 @@ -23,8 +23,8 @@ /* Written by Ben Wing. */ -#ifndef _EmacsManager_h -#define _EmacsManager_h +#ifndef INCLUDED_EmacsManager_h_ +#define INCLUDED_EmacsManager_h_ #ifndef XtNresizeCallback #define XtNresizeCallback "resizeCallback" @@ -59,4 +59,4 @@ void EmacsManagerChangeSize (Widget w, Dimension width, Dimension height); -#endif /* _EmacsManager_h */ +#endif /* INCLUDED_EmacsManager_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/EmacsManagerP.h --- a/src/EmacsManagerP.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/EmacsManagerP.h Mon Aug 13 11:13:30 2007 +0200 @@ -23,8 +23,8 @@ /* Written by Ben Wing. */ -#ifndef _EmacsManagerP_h -#define _EmacsManagerP_h +#ifndef INCLUDED_EmacsManagerP_h_ +#define INCLUDED_EmacsManagerP_h_ #include "xintrinsicp.h" @@ -65,4 +65,4 @@ extern EmacsManagerClassRec emacsManagerClassRec; /* class pointer */ -#endif /* _EmacsManagerP_h */ +#endif /* INCLUDED_EmacsManagerP_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/EmacsShell-sub.c --- a/src/EmacsShell-sub.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/EmacsShell-sub.c Mon Aug 13 11:13:30 2007 +0200 @@ -137,26 +137,32 @@ the default values for X and Y, for no obvious reason. This causes Shell to indicate that the defaults of (0,0) were program-specified, instead of letting the WM do what it wants. */ - {XtNx, XtCPosition, XtRPosition, sizeof(Position), - coreoffset (x), XtRImmediate, (XtPointer)BIGSIZE}, - {XtNy, XtCPosition, XtRPosition, sizeof(Position), - coreoffset (y), XtRImmediate, (XtPointer)BIGSIZE}, + { XtNx, XtCPosition, + XtRPosition, sizeof (Position), + coreoffset (x), XtRImmediate, (XtPointer)BIGSIZE }, + { XtNy, XtCPosition, + XtRPosition, sizeof (Position), + coreoffset (y), XtRImmediate, (XtPointer)BIGSIZE }, #endif - { XtNwidthCells, XtCWidthCells, XtRInt, sizeof(int), - offset (width_cells), XtRImmediate, (XtPointer)0}, - { XtNheightCells, XtCHeightCells, XtRInt, sizeof(int), - offset (height_cells), XtRImmediate, (XtPointer)0}, - { XtNminWidthCells, XtCMinWidthCells, XtRInt, sizeof(int), - offset (min_width_cells), XtRImmediate, (XtPointer)0}, - { XtNminHeightCells, XtCMinHeightCells, XtRInt, sizeof(int), - offset (min_height_cells), XtRImmediate, (XtPointer)0}, + { XtNwidthCells, XtCWidthCells, + XtRInt, sizeof (int), + offset (width_cells), XtRImmediate, (XtPointer)0 }, + { XtNheightCells, XtCHeightCells, + XtRInt, sizeof (int), + offset (height_cells), XtRImmediate, (XtPointer)0 }, + { XtNminWidthCells, XtCMinWidthCells, + XtRInt, sizeof (int), + offset (min_width_cells), XtRImmediate, (XtPointer)0 }, + { XtNminHeightCells, XtCMinHeightCells, + XtRInt, sizeof (int), + offset (min_height_cells), XtRImmediate, (XtPointer)0 }, }; static CompositeClassExtensionRec compositeClassExtRec = { NULL, NULLQUARK, XtCompositeExtensionVersion, - sizeof(CompositeClassExtensionRec), + sizeof (CompositeClassExtensionRec), TRUE, }; @@ -164,7 +170,7 @@ NULL, NULLQUARK, XtShellExtensionVersion, - sizeof(ShellClassExtensionRec), + sizeof (ShellClassExtensionRec), RootGeometryManager }; @@ -174,7 +180,7 @@ */ /* superclass */ (WidgetClass) &SUPERCLASS_CLASS_REC, /* class_name */ (String) EMACS_SHELL_CLASS_NAME, - /* size */ sizeof(EMACS_SHELL_REC), + /* size */ sizeof (EMACS_SHELL_REC), /* Class Initializer */ NULL, /* class_part_initialize*/ NULL, /* XtInheritClassPartInitialize, */ /* Class init'ed ? */ FALSE, diff -r f4aeb21a5bad -r 74fd4e045ea6 src/EmacsShell.h --- a/src/EmacsShell.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/EmacsShell.h Mon Aug 13 11:13:30 2007 +0200 @@ -22,8 +22,8 @@ /* Written by Ben Wing, May, 1994. */ -#ifndef _EmacsShell_h -#define _EmacsShell_h +#ifndef INCLUDED_EmacsShell_h_ +#define INCLUDED_EmacsShell_h_ #ifndef XtNwidthCells #define XtNwidthCells "widthCells" @@ -68,4 +68,4 @@ void EmacsShellSetPositionUserSpecified (Widget gw); void EmacsShellSmashIconicHint (Widget shell, int iconic_p); -#endif /* _EmacsShell_h */ +#endif /* INCLUDED_EmacsShell_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/EmacsShellP.h --- a/src/EmacsShellP.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/EmacsShellP.h Mon Aug 13 11:13:30 2007 +0200 @@ -22,8 +22,8 @@ /* Written by Ben Wing, May, 1994. */ -#ifndef _EmacsShellP_h -#define _EmacsShellP_h +#ifndef INCLUDED_EmacsShellP_h_ +#define INCLUDED_EmacsShellP_h_ #include "xintrinsic.h" #include <X11/ShellP.h> @@ -99,4 +99,4 @@ /* class pointer */ extern TransientEmacsShellClassRec transientEmacsShellClassRec; -#endif /* _EmacsShellP_h */ +#endif /* INCLUDED_EmacsShellP_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/ExternalClient.c --- a/src/ExternalClient.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/ExternalClient.c Mon Aug 13 11:13:30 2007 +0200 @@ -77,24 +77,30 @@ static XtResource resources[] = { #define offset(field) XtOffset(ExternalClientWidget, externalClient.field) - { XtNshellTimeout, XtCShellTimeout, XtRInt, sizeof(int), - offset(shell_timeout), XtRImmediate,(XtPointer)DEFAULT_WM_TIMEOUT}, - { XtNdeadShell, XtCDeadShell, XtRBoolean, sizeof(Boolean), - offset(dead_shell), XtRImmediate, (XtPointer)False}, + { XtNshellTimeout, XtCShellTimeout, + XtRInt, sizeof (int), + offset(shell_timeout), XtRImmediate,(XtPointer)DEFAULT_WM_TIMEOUT }, + { XtNdeadShell, XtCDeadShell, + XtRBoolean, sizeof (Boolean), + offset(dead_shell), XtRImmediate, (XtPointer)False }, #ifdef EXTW_USES_MOTIF - { XmNnavigationType, XmCNavigationType, XmRNavigationType, - sizeof(XmNavigationType), XtOffset(ExternalClientWidget, - primitive.navigation_type), XtRImmediate, - (XtPointer)XmTAB_GROUP}, + { XmNnavigationType, XmCNavigationType, + XmRNavigationType, sizeof (XmNavigationType), + XtOffset (ExternalClientWidget, primitive.navigation_type), + XtRImmediate, (XtPointer)XmTAB_GROUP }, #endif - { XtNemacsProcID, XtCEmacsProcID, XtRString, sizeof(String), - offset(emacs_procid), XtRImmediate, (XtPointer)NULL}, - { XtNshellReadyCallback, XtCCallback, XtRCallback, sizeof(XtCallbackList), - offset(shell_ready_callback), XtRImmediate, (XtPointer)NULL}, - { XtNshellName, XtCShellName, XtRString, sizeof(String), - offset(shell_name), XtRImmediate, (XtPointer)NULL}, - { XtNuseToolTalk, XtCUseToolTalk, XtRBoolean, sizeof(Boolean), - offset(use_tooltalk), XtRImmediate, (XtPointer)False} + { XtNemacsProcID, XtCEmacsProcID, + XtRString, sizeof (String), + offset(emacs_procid), XtRImmediate, (XtPointer)NULL }, + { XtNshellReadyCallback, XtCCallback, + XtRCallback, sizeof (XtCallbackList), + offset(shell_ready_callback), XtRImmediate, (XtPointer)NULL }, + { XtNshellName, XtCShellName, + XtRString, sizeof (String), + offset(shell_name), XtRImmediate, (XtPointer)NULL }, + { XtNuseToolTalk, XtCUseToolTalk, + XtRBoolean, sizeof (Boolean), + offset(use_tooltalk), XtRImmediate, (XtPointer)False } }; static XtActionsRec actions[] = { @@ -114,13 +120,13 @@ /* superclass */ (WidgetClass) &coreClassRec, #endif /* class_name */ "ExternalClient", - /* size */ sizeof(ExternalClientRec), + /* size */ sizeof (ExternalClientRec), /* Class Initializer */ NULL, /* class_part_initialize*/ NULL, /* XtInheritClassPartInitialize, */ /* Class init'ed ? */ FALSE, /* initialize */ externalClientInitialize, /* initialize_notify */ NULL, - /* realize */ externalClientRealize, + /* realize */ externalClientRealize, /* actions */ actions, /* num_actions */ XtNumber (actions), /* resources */ resources, @@ -134,9 +140,9 @@ /* resize */ XtInheritResize, /* expose */ NULL, /* set_values */ NULL, /* XtInheritSetValues, */ - /* set_values_hook */ NULL, - /* set_values_almost */ XtInheritSetValuesAlmost, - /* get_values_hook */ NULL, + /* set_values_hook */ NULL, + /* set_values_almost */ XtInheritSetValuesAlmost, + /* get_values_hook */ NULL, /* accept_focus */ NULL, /* intrinsics version */ XtVersion, /* callback offsets */ NULL, @@ -186,7 +192,7 @@ -- BPW */ - + XtOverrideTranslations (new, XtParseTranslationTable ("None<Key>Tab:\n" "<FocusIn>:focusIn()\n" @@ -195,7 +201,7 @@ "<Leave>:leave()\n")); #endif - + XtAddEventHandler (new, 0, TRUE, EventHandler, (XtPointer) NULL); ecw->externalClient.shell_ready = False; @@ -214,7 +220,7 @@ tt_callback(Tt_message m, Tt_pattern p) { ExternalClientWidget ecw = (ExternalClientWidget)tt_message_user (m, 0); - + switch (tt_message_state(m)) { case TT_FAILED: @@ -226,7 +232,7 @@ ecw->externalClient.shell_ready_callback, NULL); break; } - + tt_message_destroy (m); return TT_CALLBACK_PROCESSED; } @@ -241,7 +247,7 @@ tt_message_class_set (m, TT_REQUEST); tt_message_arg_add (m, TT_IN, "string", name); tt_message_iarg_add (m, TT_IN, "int", win); - tt_message_arg_add (m, TT_OUT, "string", NULL); + tt_message_arg_add (m, TT_OUT, "string", NULL); tt_message_user_set (m, 0, (void *)ecw); tt_message_callback_add (m, tt_callback); if (ecw->externalClient.emacs_procid) @@ -261,8 +267,8 @@ externalClientRealize (Widget w, XtValueMask *vm, XSetWindowAttributes *attrs) { ExternalClientWidget ecw = (ExternalClientWidget)w; - -#ifdef EXTW_USES_MOTIF + +#ifdef EXTW_USES_MOTIF (*xmPrimitiveWidgetClass->core_class.realize) (w, vm, attrs); #else (*coreWidgetClass->core_class.realize) (w, vm, attrs); @@ -278,7 +284,7 @@ XSync (XtDisplay (w), False); send_tooltalk_handshake (ecw, XtWindow (w), XtName (w)); } -#endif +#endif } @@ -314,7 +320,7 @@ { struct ww_list *w1, *w2; Widget wid = 0; - + for (w1=ww_list, w2=w1->next; w2; w1=w2, w2=w2->next) if (w2->win == win) { @@ -366,7 +372,7 @@ XSetWindowAttributes xswa; XtValueMask mask; Widget wid = (Widget) w; - + w->externalClient.shell_ready = False; XtRemoveEventHandler (wid, w->externalClient.event_mask, FALSE, MaskableEventHandler, (XtPointer) NULL); @@ -379,7 +385,7 @@ my_error_handler (Display *display, XErrorEvent *xev) { Widget wid; - + if (xev->error_code != BadWindow) goto call_old; wid = remove_ww (xev->resourceid); @@ -388,7 +394,7 @@ end_connection ((ExternalClientWidget) wid); return 0; } - + call_old: return error_old_handler (display, xev); } @@ -399,7 +405,7 @@ /* closure and continue_to_dispatch unused */ { ExternalClientWidget w = (ExternalClientWidget) wid; - + if (w->externalClient.shell_ready) { if (event->type == KeyPress || event->type == KeyRelease || @@ -421,7 +427,7 @@ XSync (XtDisplay (wid), 0); /* make sure that any BadWindow errors (meaning the server died) get handled before XSendEvent is called again. */ - + } } @@ -431,7 +437,7 @@ /* closure and continue_to_dispatch unused */ { ExternalClientWidget w = (ExternalClientWidget) wid; - + if (w->core.window != event->xany.window) { XtAppErrorMsg (XtWidgetToApplicationContext (wid), @@ -440,41 +446,41 @@ (String *)NULL, (Cardinal *)NULL); return; } - + if (event->type == ClientMessage && event->xclient.message_type == a_EXTW_NOTIFY && event->xclient.data.l[0] == extw_shell_send) switch (event->xclient.data.l[1]) { - + case extw_notify_qg: /* shell is alive again. */ - + w->externalClient.dead_shell = False; break; - + case extw_notify_gm: { XtWidgetGeometry xwg, xwg_return; XtGeometryResult result; - + extw_get_geometry_value (XtDisplay (wid), XtWindow (wid), a_EXTW_GEOMETRY_MANAGER, &xwg); result = XtMakeGeometryRequest (wid, &xwg, &xwg_return); - + extw_send_geometry_value (XtDisplay (wid), XtWindow (wid), a_EXTW_GEOMETRY_MANAGER, extw_notify_gm, result == XtGeometryAlmost ? &xwg_return : NULL, result); break; } - + case extw_notify_init: w->externalClient.shell_ready = True; w->externalClient.event_window = event->xclient.data.l[2]; w->externalClient.event_mask = event->xclient.data.l[3]; add_ww (w->externalClient.event_window, (Widget) w); - + XtAddEventHandler (wid, w->externalClient.event_mask, FALSE, MaskableEventHandler, (XtPointer) NULL); #ifdef EXTW_USES_MOTIF @@ -487,12 +493,12 @@ 0, 0); #endif break; - + case extw_notify_end: end_connection (w); remove_ww (w->externalClient.event_window); break; - + case extw_notify_set_focus: #ifdef EXTW_USES_MOTIF XmProcessTraversal (wid, XmTRAVERSE_CURRENT); @@ -500,7 +506,7 @@ XtSetKeyboardFocus (wid, None); #endif break; - + } } @@ -508,7 +514,7 @@ Widget wid; { ExternalClientWidget w = (ExternalClientWidget)wid; - + NOTIFY(w, extw_notify_end, 0, 0, 0); } @@ -521,14 +527,14 @@ unsigned long request_num; Display *display = XtDisplay(gw); XtWidgetGeometry req = *request; /* don't modify caller's structure */ - + if (!XtIsRealized((Widget)w) || !w->externalClient.shell_ready) return XtGeometryYes; - + if (w->externalClient.dead_shell == TRUE) /* The shell is sick. */ return XtGeometryNo; - + req.sibling = None; req.request_mode &= ~CWSibling; request_num = NextRequest(display); @@ -554,7 +560,7 @@ Cardinal *num_params) { ExternalClientWidget ecw = (ExternalClientWidget) w; - + if (event->xfocus.send_event && !ecw->externalClient.has_focus) { ecw->externalClient.has_focus = True; NOTIFY(ecw, extw_notify_focus_in, 0, 0, 0); @@ -568,7 +574,7 @@ Cardinal *num_params) { ExternalClientWidget ecw = (ExternalClientWidget) w; - + if (event->xfocus.send_event && ecw->externalClient.has_focus) { ecw->externalClient.has_focus = False; NOTIFY(ecw, extw_notify_focus_out, 0, 0, 0); @@ -582,7 +588,7 @@ Cardinal *num_params) { ExternalClientWidget ecw = (ExternalClientWidget) w; - + if ( #ifdef EXTW_USES_MOTIF _XmGetFocusPolicy (w) != XmEXPLICIT && @@ -601,7 +607,7 @@ Cardinal *num_params) { ExternalClientWidget ecw = (ExternalClientWidget) w; - + if ( #ifdef EXTW_USES_MOTIF _XmGetFocusPolicy (w) != XmEXPLICIT && diff -r f4aeb21a5bad -r 74fd4e045ea6 src/ExternalClient.h --- a/src/ExternalClient.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/ExternalClient.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,8 +20,8 @@ /* Written by Ben Wing. */ -#ifndef _ExternalClient_h -#define _ExternalClient_h +#ifndef INCLUDED_ExternalClient_h_ +#define INCLUDED_ExternalClient_h_ #ifndef XtNshellTimeout #define XtNshellTimeout "shellTimeout" @@ -71,4 +71,4 @@ void ExternalClientInitialize (Display *display, Window win); void ExternalClientEventHandler (Display *display, Window win, XEvent *event); -#endif /* _ExternalClient_h */ +#endif /* INCLUDED_ExternalClient_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/ExternalClientP.h --- a/src/ExternalClientP.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/ExternalClientP.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,8 +20,8 @@ /* Written by Ben Wing. */ -#ifndef _ExternalClientP_h -#define _ExternalClientP_h +#ifndef INCLUDED_ExternalClientP_h_ +#define INCLUDED_ExternalClientP_h_ #include "ExternalClient.h" #ifdef EXTW_USES_MOTIF @@ -63,4 +63,4 @@ extern ExternalClientClassRec externalClientClassRec; /* class pointer */ -#endif /* _ExternalClientP_h */ +#endif /* INCLUDED_ExternalClientP_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/ExternalShell.c --- a/src/ExternalShell.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/ExternalShell.c Mon Aug 13 11:13:30 2007 +0200 @@ -171,19 +171,22 @@ static XtResource resources[] = { #define offset(field) XtOffset(ExternalShellWidget, externalShell.field) - { XtNwindow, XtCWindow, XtRWindow, sizeof (Window), - offset (external_window), XtRImmediate, (XtPointer)0}, - { XtNclientTimeout, XtCClientTimeout, XtRInt, sizeof(int), - offset(client_timeout), XtRImmediate,(XtPointer)DEFAULT_WM_TIMEOUT}, - { XtNdeadClient, XtCDeadClient, XtRBoolean, sizeof(Boolean), - offset(dead_client), XtRImmediate, (XtPointer)False}, + { XtNwindow, XtCWindow, + XtRWindow, sizeof (Window), + offset (external_window), XtRImmediate, (XtPointer)0 }, + { XtNclientTimeout, XtCClientTimeout, + XtRInt, sizeof (int), + offset(client_timeout), XtRImmediate,(XtPointer)DEFAULT_WM_TIMEOUT }, + { XtNdeadClient, XtCDeadClient, + XtRBoolean, sizeof (Boolean), + offset(dead_client), XtRImmediate, (XtPointer)False }, }; static CompositeClassExtensionRec compositeClassExtRec = { NULL, NULLQUARK, XtCompositeExtensionVersion, - sizeof(CompositeClassExtensionRec), + sizeof (CompositeClassExtensionRec), TRUE, }; @@ -191,7 +194,7 @@ NULL, NULLQUARK, XtShellExtensionVersion, - sizeof(ShellClassExtensionRec), + sizeof (ShellClassExtensionRec), ExternalShellRootGeometryManager }; @@ -201,7 +204,7 @@ */ /* superclass */ (WidgetClass) &shellClassRec, /* class_name */ "ExternalShell", - /* size */ sizeof(ExternalShellRec), + /* size */ sizeof (ExternalShellRec), /* Class Initializer */ NULL, /* class_part_initialize*/ NULL, /* XtInheritClassPartInitialize, */ /* Class init'ed ? */ FALSE, @@ -221,9 +224,9 @@ /* resize */ XtInheritResize, /* expose */ NULL, /* set_values */ NULL, /* XtInheritSetValues, */ - /* set_values_hook */ NULL, - /* set_values_almost */ XtInheritSetValuesAlmost, - /* get_values_hook */ NULL, + /* set_values_hook */ NULL, + /* set_values_almost */ XtInheritSetValuesAlmost, + /* get_values_hook */ NULL, /* accept_focus */ NULL, /* intrinsics version */ XtVersion, /* callback offsets */ NULL, @@ -319,7 +322,7 @@ case extw_notify_focus_in: { XFocusChangeEvent evnt; - + evnt.type = FocusIn; evnt.serial = LastKnownRequestProcessed (XtDisplay (wid)); evnt.send_event = True; @@ -334,10 +337,10 @@ #endif break; } - + case extw_notify_focus_out: { XFocusChangeEvent evnt; - + evnt.type = FocusOut; evnt.serial = LastKnownRequestProcessed (XtDisplay (wid)); evnt.send_event = True; @@ -368,11 +371,11 @@ int x, y, win_gravity = -1, flag; XSizeHints hints; Window win = w->externalShell.external_window; - + { Window dummy_root; unsigned int dummy_bd_width, dummy_depth, width, height; - + /* determine the existing size of the window. */ XGetGeometry(XtDisplay(W), win, &dummy_root, &x, &y, &width, &height, &dummy_bd_width, &dummy_depth); @@ -466,8 +469,8 @@ w->core.background_pixmap = (*childP)->core.background_pixmap; } else { - attr->background_pixel = - w->core.background_pixel = + attr->background_pixel = + w->core.background_pixel = (*childP)->core.background_pixel; } break; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/ExternalShell.h --- a/src/ExternalShell.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/ExternalShell.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,8 +20,8 @@ /* Written by Ben Wing, September 1993. */ -#ifndef _ExternalShell_h -#define _ExternalShell_h +#ifndef INCLUDED_ExternalShell_h_ +#define INCLUDED_ExternalShell_h_ #ifndef XtNwindow #define XtNwindow "window" @@ -54,4 +54,4 @@ #define is_external_shell(w) (XtClass (w) == externalShellWidgetClass) -#endif /* _ExternalShell_h */ +#endif /* INCLUDED_ExternalShell_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/ExternalShellP.h --- a/src/ExternalShellP.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/ExternalShellP.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,8 +20,8 @@ /* Written by Ben Wing, September 1993. */ -#ifndef _ExternalShellP_h -#define _ExternalShellP_h +#ifndef INCLUDED_ExternalShellP_h_ +#define INCLUDED_ExternalShellP_h_ #include "xintrinsic.h" #include <X11/ShellP.h> @@ -56,4 +56,4 @@ extern ExternalShellClassRec externalShellClassRec; /* class pointer */ -#endif /* _ExternalShellP_h */ +#endif /* INCLUDED_ExternalShellP_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/Makefile.in.in --- a/src/Makefile.in.in Mon Aug 13 11:12:06 2007 +0200 +++ b/src/Makefile.in.in Mon Aug 13 11:13:30 2007 +0200 @@ -97,7 +97,6 @@ vpath config.h vpath paths.h vpath Emacs.ad.h -vpath puresize-adjust.h vpath sheap-adjust.h #else VPATH=@srcdir@ @@ -118,7 +117,7 @@ cd ../lwlib && $(RECURSIVE_MAKE) x_objs=balloon_help.o balloon-x.o console-x.o device-x.o event-Xt.o frame-x.o\ - glyphs-x.o objects-x.o redisplay-x.o xgccache.o xselect.o + glyphs-x.o objects-x.o redisplay-x.o select-x.o xgccache.o #ifdef AIX4 LIBI18N = -li18n @@ -176,13 +175,13 @@ eval.o events.o $(extra_objs)\ event-stream.o extents.o faces.o\ fileio.o $(LOCK_OBJ) filemode.o floatfns.o fns.o font-lock.o\ - frame.o general.o getloadavg.o glyphs.o glyphs-eimage.o glyphs-widget.o\ - gui.o $(gui_objs) hash.o imgproc.o indent.o insdel.o intl.o\ + frame.o general.o glyphs.o glyphs-eimage.o glyphs-widget.o\ + gui.o gutter.o $(gui_objs) hash.o imgproc.o indent.o insdel.o intl.o\ keymap.o $(RTC_patch_objs) line-number.o lread.o lstream.o\ macros.o marker.o md5.o minibuf.o objects.o opaque.o\ print.o process.o profile.o\ rangetab.o redisplay.o redisplay-output.o regex.o\ - search.o $(sheap_obj) signal.o sound.o\ + search.o select.o $(sheap_obj) signal.o sound.o\ specifier.o strftime.o symbols.o syntax.o sysdep.o\ undo.o $(x_objs) widget.o window.o @@ -237,37 +236,37 @@ # define EXTW_LINK(objs, output) $(CC) -shared objs -Xlinker -z -Xlinker text -o output extw_link_beg = $(CC) -shared extw_link_mid = -Xlinker -z -Xlinker text -o -extw_link_end = +extw_link_end = ## I cannot figure out how to do shared a.out libraries, so just punt. # elif !defined (LINUX) || defined (__ELF__) # define EXTW_LINK(objs, output) $(CC) -shared objs -o output extw_link_beg = $(CC) -shared extw_link_mid = -o -extw_link_end = +extw_link_end = # endif # elif defined (USG5) # if defined (IRIX) # define EXTW_LINK(objs, output) $(LD) -shared -g -check_registry ${TOOLROOT}/usr/lib/so_locations objs -o output -extw_link_beg = $(LD) -shared -g -check_registry ${TOOLROOT}/usr/lib/so_locations -extw_link_mid = -o -extw_link_end = +extw_link_beg = $(LD) -shared -g -check_registry ${TOOLROOT}/usr/lib/so_locations +extw_link_mid = -o +extw_link_end = # else /* not IRIX */ # define EXTW_LINK(objs, output) $(CC) -G objs -z text -o output extw_link_beg = $(CC) -G extw_link_mid = -z text -o -extw_link_end = +extw_link_end = # endif /* not IRIX */ # else /* not USG5 */ # if defined (DEC_ALPHA) && defined (OSF1) # define EXTW_LINK(objs, output) $(LD) $(ldflags) $(ld_switch_shared) -d objs -o output $(LIBES) -extw_link_beg = $(LD) $(ldflags) $(ld_switch_shared) -d -extw_link_mid = -o +extw_link_beg = $(LD) $(ldflags) $(ld_switch_shared) -d +extw_link_mid = -o extw_link_end = $(LIBES) # else /* !(DEC_ALPHA && OSF1) */ # define EXTW_LINK(objs, output) $(LD) -dc objs -assert pure-text -o output extw_link_beg = $(LD) -dc extw_link_mid = -assert pure-text -o -extw_link_end = +extw_link_end = # endif /* !(DEC_ALPHA && OSF1) */ # endif /* not USG5 */ @@ -310,12 +309,18 @@ mo_file = ${mo_dir}emacs.mo #endif +#ifdef WINDOWSNT +LOADPATH = EMACSBOOTSTRAPLOADPATH="${lispdir};${blddir}" +MODULEPATH = EMACSBOOTSTRAPMODULEPATH="${moduledir};${blddir}" +#else LOADPATH = EMACSBOOTSTRAPLOADPATH="${lispdir}:${blddir}" MODULEPATH = EMACSBOOTSTRAPMODULEPATH="${moduledir}:${blddir}" +#endif DUMPENV = $(LOADPATH) $(MODULEPATH) temacs_loadup = $(DUMPENV) ./temacs -batch -l ${srcdir}/../lisp/loadup.el dump_temacs = ${temacs_loadup} dump run_temacs = ${temacs_loadup} run-temacs +debug_temacs = $(DUMPENV) gdb temacs release: temacs ${libsrc}DOC $(mo_file) ${other_files} #ifdef CANNOT_DUMP @@ -325,39 +330,40 @@ -if [ -w ${srcdir}/../lisp ]; then \ w=`pwd`; cd ${srcdir} && $${w}/temacs -nl -batch -l ${srcdir}/../lisp/inc-vers; \ else true; fi - @touch SATISFIED -$(DUMPENV) ./temacs -nl -batch -l ${srcdir}/../lisp/loadup.el dump - @if test ! -f SATISFIED; then $(RECURSIVE_MAKE) $@; fi - @$(RM) SATISFIED #else /* ! defined (HAVE_SHM) */ -if [ -w ${srcdir}/../lisp ]; then \ w=`pwd`; cd ${srcdir} && $${w}/temacs -batch -l ${srcdir}/../lisp/inc-vers; \ else true; fi - @touch SATISFIED -$(DUMPENV) ./temacs -batch -l ${srcdir}/../lisp/loadup.el dump - @if test ! -f SATISFIED; then $(RECURSIVE_MAKE) $@; fi - @$(RM) SATISFIED #endif /* ! defined (HAVE_SHM) */ touch release #endif /* ! defined (CANNOT_DUMP) */ ${PROGNAME}: temacs ${libsrc}DOC $(mo_file) ${other_files} update-elc.stamp - @$(RM) $@ && touch SATISFIED +#ifdef HEAP_IN_DATA + @$(RM) $@ $@.exe && touch SATISFIED -${dump_temacs} - @if test -f $@; then if test -f SATISFIED; then \ + @if test -f $@; then if test -f SATISFIED; then \ echo "Testing for Lisp shadows ..."; \ ./${PROGNAME} -batch -vanilla -f list-load-path-shadows; fi; \ $(RM) SATISFIED; exit 0; fi; \ if test -f SATISFIED; then $(RM) SATISFIED; exit 1; fi; \ $(RECURSIVE_MAKE) $@; +#else + @$(RM) $@ xemacs.dmp + ${dump_temacs} +#ifdef PDUMP + @mv temacs $@ +#endif + @echo "Testing for Lisp shadows ..." + @./${PROGNAME} -batch -vanilla -f list-load-path-shadows +#endif -fastdump: temacs +fastdump: temacs @$(RM) ${PROGNAME} && touch SATISFIED -${dump_temacs} - @if test -f ${PROGNAME}; then if test -f SATISFIED; then \ - ./${PROGNAME} -batch -vanilla -f list-load-path-shadows; fi; \ - $(RM) SATISFIED; exit 0; fi; \ - if test -f SATISFIED; then $(RM) SATISFIED; exit 1; fi; + @./${PROGNAME} -batch -vanilla -f list-load-path-shadows FRC.update-elc.stamp : @@ -448,6 +454,9 @@ temacs: $(temacs_deps) $(LD) $(temacs_link_args) +#ifdef PDUMP + @$(RM) xemacs.dmp +#endif .PHONY : run-temacs @@ -456,13 +465,7 @@ ## We have automated tests!! testdir = ${srcdir}/../tests/automated -tests = \ - ${testdir}/hash-table-tests.el \ - ${testdir}/lisp-tests.el \ - ${testdir}/database-tests.el \ - ${testdir}/byte-compiler-tests.el \ - ${testdir}/md5-tests.el -batch_test_emacs = -batch -l ${testdir}/test-harness.el -f batch-test-emacs ${tests} +batch_test_emacs = -batch -l ${testdir}/test-harness.el -f batch-test-emacs ${testdir} .PHONY: check check-temacs check: @@ -496,13 +499,21 @@ runargs -batch -l ${srcdir}/../lisp/loadup.el run-temacs -q; \ run' rtcmacs +debug-temacs: temacs + -${debug_temacs} + ## Purify, Quantify, PureCoverage are software quality products from ## Rational, formerly Pure Atria, formerly Pure Software. ## ## Purify PURIFY_PROG = purify -PURIFY_FLAGS = -chain-length=32 -ignore-signals=SIGPOLL -threads=yes \ - -cache-dir=./purecache -always-use-cache-dir=yes -pointer-mask=0x0fffffff +PURIFY_FLAGS =\ +#ifdef PDUMP + -search-mmaps=yes\ +#endif + -chain-length=32 -ignore-signals=SIGPOLL -threads=yes\ + -cache-dir=./purecache -always-use-cache-dir=yes + PURIFY_LIBS = -lpthread puremacs: $(temacs_deps) $(PURIFY_PROG) $(PURIFY_FLAGS) $(LD) $(temacs_link_args) $(PURIFY_LIBS) @@ -631,10 +642,9 @@ #endif /* EXTERNAL_WIDGET */ config.h: ${srcdir}/config.h.in -puresize-adjust.h: ${srcdir}/puresize.h Emacs.ad.h: ${srcdir}/${etcdir}Emacs.ad -config.h puresize-adjust.h sheap-adjust.h paths.h Emacs.ad.h : +config.h sheap-adjust.h paths.h Emacs.ad.h : @echo "The file $@ needs to be re-generated." @echo "Please run a make in the top level directory." @echo "Consult the file \`INSTALL' for instructions for building XEmacs." @@ -689,7 +699,7 @@ .PHONY: mostlyclean clean distclean realclean versionclean extraclean mostlyclean: $(RM) temacs puremacs quantmacs prefix-args *.o *.i \ - core temacs.exe puresize-adjust.h sheap-adjust.h + core temacs.exe sheap-adjust.h clean: mostlyclean versionclean $(RM) libextcli* update-elc.stamp ## This is used in making a distribution. @@ -744,5 +754,8 @@ FRC.depend: depend: FRC.depend cd ${srcdir} && $(RM) depend.tmp && \ - perl make-src-depend > depend.tmp && \ - $(RM) depend && mv depend.tmp depend + perl ./make-src-depend > depend.tmp && \ + if cmp -s depend depend.tmp; \ + then $(RM) depend.tmp; \ + else $(RM) depend && mv depend.tmp depend; \ + fi diff -r f4aeb21a5bad -r 74fd4e045ea6 src/README --- a/src/README Mon Aug 13 11:12:06 2007 +0200 +++ b/src/README Mon Aug 13 11:13:30 2007 +0200 @@ -44,9 +44,6 @@ 2. Storage classes: - -- All occurrences of `const' should get replaced by CONST. This - is to work around a header conflict with X11R4. - -- All occurrences of `register' should be replaced by `REGISTER'. It interferes with backtraces so we disable it if DEBUG_XEMACS is defined. diff -r f4aeb21a5bad -r 74fd4e045ea6 src/abbrev.c --- a/src/abbrev.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/abbrev.c Mon Aug 13 11:13:30 2007 +0200 @@ -77,9 +77,9 @@ struct abbrev_match_mapper_closure { struct buffer *buf; - struct Lisp_Char_Table *chartab; + Lisp_Char_Table *chartab; Charcount point, maxlen; - struct Lisp_Symbol *found; + Lisp_Symbol *found; }; /* For use by abbrev_match(): Match SYMBOL's name against buffer text @@ -91,8 +91,8 @@ struct abbrev_match_mapper_closure *closure = (struct abbrev_match_mapper_closure *)arg; Charcount abbrev_length; - struct Lisp_Symbol *sym = XSYMBOL (symbol); - struct Lisp_String *abbrev; + Lisp_Symbol *sym = XSYMBOL (symbol); + Lisp_String *abbrev; /* symbol_value should be OK here, because abbrevs are not expected to contain any SYMBOL_MAGIC stuff. */ @@ -147,7 +147,7 @@ /* Match the buffer text against names of symbols in obarray. Returns the matching symbol, or 0 if not found. */ -static struct Lisp_Symbol * +static Lisp_Symbol * abbrev_match (struct buffer *buf, Lisp_Object obarray) { struct abbrev_match_mapper_closure closure; @@ -175,7 +175,7 @@ This speed difference should be unnoticeable, though. I have tested the degenerated cases of thousands of abbrevs being defined, and abbrev_match() was still fast enough for normal operation. */ -static struct Lisp_Symbol * +static Lisp_Symbol * abbrev_oblookup (struct buffer *buf, Lisp_Object obarray) { Bufpos wordstart, wordend; @@ -222,10 +222,11 @@ because of consistency with abbrev_match. */ if (wordend < point) return 0; - if (wordend <= wordstart) - return 0; } + if (wordend <= wordstart) + return 0; + p = word = (Bufbyte *) alloca (MAX_EMCHAR_LEN * (wordend - wordstart)); for (idx = wordstart; idx < wordend; idx++) { @@ -281,10 +282,10 @@ Bufpos point; /* position of point */ Bufpos abbrev_start; /* position of abbreviation beginning */ - struct Lisp_Symbol *(*fun) (struct buffer *, Lisp_Object); + Lisp_Symbol *(*fun) (struct buffer *, Lisp_Object); - struct Lisp_Symbol *abbrev_symbol; - struct Lisp_String *abbrev_string; + Lisp_Symbol *abbrev_symbol; + Lisp_String *abbrev_string; Lisp_Object expansion, count, hook; Charcount abbrev_length; int lccount, uccount; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/alloc.c --- a/src/alloc.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/alloc.c Mon Aug 13 11:13:30 2007 +0200 @@ -36,6 +36,7 @@ Added lcrecord lists for 19.14. slb: Lots of work on the purification and dump time code. Synched Doug Lea malloc support from Emacs 20.2. + og: Killed the purespace. Portable dumper. */ #include <config.h> @@ -56,36 +57,35 @@ #include "specifier.h" #include "sysfile.h" #include "window.h" - -#include <stddef.h> +#include "console-stream.h" #ifdef DOUG_LEA_MALLOC #include <malloc.h> #endif +#ifdef HAVE_MMAP +#include <unistd.h> +#include <sys/mman.h> +#endif + +#ifdef PDUMP +typedef struct +{ + const struct lrecord_description *desc; + int count; +} pdump_reloc_table; + +static char *pdump_rt_list = 0; +#endif + EXFUN (Fgarbage_collect, 0); -/* Return the true size of a struct with a variable-length array field. */ -#define STRETCHY_STRUCT_SIZEOF(stretchy_struct_type, \ - stretchy_array_field, \ - stretchy_array_length) \ - (offsetof (stretchy_struct_type, stretchy_array_field) + \ - (offsetof (stretchy_struct_type, stretchy_array_field[1]) - \ - offsetof (stretchy_struct_type, stretchy_array_field[0])) * \ - (stretchy_array_length)) - #if 0 /* this is _way_ too slow to be part of the standard debug options */ #if defined(DEBUG_XEMACS) && defined(MULE) #define VERIFY_STRING_CHARS_INTEGRITY #endif #endif -/* Define this to see where all that space is going... */ -/* But the length of the printout is obnoxious, so limit it to testers */ -#ifdef MEMORY_USAGE_STATS -#define PURESTAT -#endif - /* Define this to use malloc/free with no freelist for all datatypes, the hope being that some debugging tools may help detect freed memory references */ @@ -94,8 +94,6 @@ #define ALLOC_NO_POOLS #endif -#include "puresize.h" - #ifdef DEBUG_XEMACS static int debug_allocation; static int debug_allocation_backtrace_length; @@ -167,7 +165,7 @@ /* "Garbage collecting" */ Lisp_Object Vgc_message; Lisp_Object Vgc_pointer_glyph; -static CONST char gc_default_message[] = "Garbage collecting"; +static const char gc_default_message[] = "Garbage collecting"; Lisp_Object Qgarbage_collecting; #ifndef VIRT_ADDR_VARIES @@ -180,38 +178,9 @@ #endif /* VIRT_ADDR_VARIES */ EMACS_INT malloc_sbrk_unused; -/* Non-zero means defun should do purecopy on the function definition */ +/* Non-zero means we're in the process of doing the dump */ int purify_flag; -#ifdef HEAP_IN_DATA -extern void sheap_adjust_h(); -#endif - -/* Force linker to put it into data space! */ -EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = { (EMACS_INT) 0}; - -#define PUREBEG ((char *) pure) - -#if 0 /* This is breathing_space in XEmacs */ -/* Points to memory space allocated as "spare", - to be freed if we run out of memory. */ -static char *spare_memory; - -/* Amount of spare memory to keep in reserve. */ -#define SPARE_MEMORY (1 << 14) -#endif - -/* Index in pure at which next pure object will be allocated. */ -static size_t pure_bytes_used; - -#define PURIFIED(ptr) \ -((char *) (ptr) >= PUREBEG && \ - (char *) (ptr) < PUREBEG + get_PURESIZE()) - -/* Non-zero if pure_bytes_used > get_PURESIZE(); - accounts for excess purespace needs. */ -static size_t pure_lossage; - #ifdef ERROR_CHECK_TYPECHECK Error_behavior ERROR_ME, ERROR_ME_NOT, ERROR_ME_WARN; @@ -219,93 +188,16 @@ #endif int -purified (Lisp_Object obj) -{ - return POINTER_TYPE_P (XGCTYPE (obj)) && PURIFIED (XPNTR (obj)); -} - -size_t -purespace_usage (void) -{ - return pure_bytes_used; -} - -static int -check_purespace (size_t size) +c_readonly (Lisp_Object obj) { - if (pure_lossage) - { - pure_lossage += size; - return 0; - } - else if (pure_bytes_used + size > get_PURESIZE()) - { - /* This can cause recursive bad behavior, we'll yell at the end */ - /* when we're done. */ - /* message ("\nERROR: Pure Lisp storage exhausted!\n"); */ - pure_lossage = size; - return 0; - } - else - return 1; + return POINTER_TYPE_P (XTYPE (obj)) && C_READONLY (obj); } - - -#ifndef PURESTAT - -#define bump_purestat(p,b) DO_NOTHING - -#else /* PURESTAT */ - -static int purecopying_function_constants; - -static size_t pure_sizeof (Lisp_Object); - -/* Keep statistics on how much of what is in purespace */ -static struct purestat +int +lisp_readonly (Lisp_Object obj) { - int nobjects; - int nbytes; - CONST char *name; + return POINTER_TYPE_P (XTYPE (obj)) && LISP_READONLY (obj); } - purestat_cons = {0, 0, "cons cells"}, - purestat_float = {0, 0, "float objects"}, - purestat_string_pname = {0, 0, "symbol-name strings"}, - purestat_function = {0, 0, "compiled-function objects"}, - purestat_opaque_instructions = {0, 0, "compiled-function instructions"}, - purestat_vector_constants = {0, 0, "compiled-function constants vectors"}, - purestat_string_interactive = {0, 0, "interactive strings"}, -#ifdef I18N3 - purestat_string_domain = {0, 0, "domain strings"}, -#endif - purestat_string_documentation = {0, 0, "documentation strings"}, - purestat_string_other_function = {0, 0, "other function strings"}, - purestat_vector_other = {0, 0, "other vectors"}, - purestat_string_other = {0, 0, "other strings"}, - purestat_string_all = {0, 0, "all strings"}, - purestat_vector_all = {0, 0, "all vectors"}; - -static void -bump_purestat (struct purestat *purestat, size_t nbytes) -{ - if (pure_lossage) return; - purestat->nobjects += 1; - purestat->nbytes += nbytes; -} - -static void -print_purestat (struct purestat *purestat) -{ - char buf [100]; - sprintf(buf, "%s:", purestat->name); - message (" %-36s %5d %7d %2d%%", - buf, - purestat->nobjects, - purestat->nbytes, - (int) (purestat->nbytes / (pure_bytes_used / 100.0) + 0.5)); -} -#endif /* PURESTAT */ /* Maximum amount of C stack to save when a GC happens. */ @@ -333,7 +225,7 @@ /* malloc calls this if it finds we are near exhausting storage */ void -malloc_warning (CONST char *str) +malloc_warning (const char *str) { if (ignore_malloc_warnings) return; @@ -369,10 +261,7 @@ /* like malloc and realloc but check for no memory left, and block input. */ -#ifdef xmalloc #undef xmalloc -#endif - void * xmalloc (size_t size) { @@ -382,10 +271,7 @@ return val; } -#ifdef xcalloc #undef xcalloc -#endif - static void * xcalloc (size_t nelem, size_t elsize) { @@ -401,10 +287,7 @@ return xcalloc (size, sizeof (char)); } -#ifdef xrealloc #undef xrealloc -#endif - void * xrealloc (void *block, size_t size) { @@ -463,24 +346,20 @@ #endif /* !ERROR_CHECK_GC */ -#ifdef xstrdup #undef xstrdup -#endif - char * -xstrdup (CONST char *str) +xstrdup (const char *str) { int len = strlen (str) + 1; /* for stupid terminating 0 */ void *val = xmalloc (len); if (val == 0) return 0; - memcpy (val, str, len); - return (char *) val; + return (char *) memcpy (val, str, len); } #ifdef NEED_STRDUP char * -strdup (CONST char *s) +strdup (const char *s) { return xstrdup (s); } @@ -490,38 +369,30 @@ static void * allocate_lisp_storage (size_t size) { - void *p = xmalloc (size); -#ifndef USE_MINIMAL_TAGBITS - char *lim = ((char *) p) + size; - Lisp_Object val; - - XSETOBJ (val, Lisp_Type_Record, lim); - if ((char *) XPNTR (val) != lim) - { - xfree (p); - memory_full (); - } -#endif /* ! USE_MINIMAL_TAGBITS */ - return p; + return xmalloc (size); } -/* lrecords are chained together through their "next.v" field. - * After doing the mark phase, the GC will walk this linked - * list and free any record which hasn't been marked. - */ +/* lcrecords are chained together through their "next" field. + After doing the mark phase, GC will walk this linked list + and free any lcrecord which hasn't been marked. */ static struct lcrecord_header *all_lcrecords; void * -alloc_lcrecord (size_t size, CONST struct lrecord_implementation *implementation) +alloc_lcrecord (size_t size, const struct lrecord_implementation *implementation) { struct lcrecord_header *lcheader; -#ifdef ERROR_CHECK_GC +#ifdef ERROR_CHECK_TYPECHECK if (implementation->static_size == 0) assert (implementation->size_in_bytes_method); else assert (implementation->static_size == size); + + assert (! implementation->basic_p); + + if (implementation->hash == NULL) + assert (implementation->equal == NULL); #endif lcheader = (struct lcrecord_header *) allocate_lisp_storage (size); @@ -591,65 +462,28 @@ } } - -/* This must not be called -- it just serves as for EQ test - * If lheader->implementation->finalizer is this_marks_a_marked_record, - * then lrecord has been marked by the GC sweeper - * header->implementation is put back to its correct value by - * sweep_records */ -void -this_marks_a_marked_record (void *dummy0, int dummy1) -{ - abort (); -} - /* Semi-kludge -- lrecord_symbol_value_forward objects get stuck - in CONST space and you get SEGV's if you attempt to mark them. + in const space and you get SEGV's if you attempt to mark them. This sits in lheader->implementation->marker. */ Lisp_Object -this_one_is_unmarkable (Lisp_Object obj, void (*markobj) (Lisp_Object)) +this_one_is_unmarkable (Lisp_Object obj) { abort (); return Qnil; } -/* XGCTYPE for records */ -int -gc_record_type_p (Lisp_Object frob, CONST struct lrecord_implementation *type) -{ - CONST struct lrecord_implementation *imp; - - if (XGCTYPE (frob) != Lisp_Type_Record) - return 0; - - imp = XRECORD_LHEADER_IMPLEMENTATION (frob); -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION - return imp == type; -#else - return imp == type || imp == type + 1; -#endif -} - /************************************************************************/ /* Debugger support */ /************************************************************************/ /* Give gdb/dbx enough information to decode Lisp Objects. We make sure certain symbols are always defined, so gdb doesn't complain - about expressions in src/gdbinit. See src/gdbinit or src/dbxrc to - see how this is used. */ - -#ifdef USE_MINIMAL_TAGBITS + about expressions in src/.gdbinit. See src/.gdbinit or src/.dbxrc + to see how this is used. */ + EMACS_UINT dbg_valmask = ((1UL << VALBITS) - 1) << GCBITS; EMACS_UINT dbg_typemask = (1UL << GCTYPEBITS) - 1; -unsigned char dbg_USE_MINIMAL_TAGBITS = 1; -unsigned char Lisp_Type_Int = 100; -#else -EMACS_UINT dbg_valmask = (1UL << VALBITS) - 1; -EMACS_UINT dbg_typemask = ((1UL << GCTYPEBITS) - 1) << (VALBITS + GCMARKBITS); -unsigned char dbg_USE_MINIMAL_TAGBITS = 0; -#endif #ifdef USE_UNION_TYPE unsigned char dbg_USE_UNION_TYPE = 1; @@ -657,35 +491,11 @@ unsigned char dbg_USE_UNION_TYPE = 0; #endif -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION -unsigned char dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 1; -#else -unsigned char dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 0; -#endif - -#ifdef LRECORD_CONS +unsigned char Lisp_Type_Int = 100; unsigned char Lisp_Type_Cons = 101; -#else -unsigned char lrecord_cons; -#endif - -#ifdef LRECORD_STRING unsigned char Lisp_Type_String = 102; -#else -unsigned char lrecord_string; -#endif - -#ifdef LRECORD_VECTOR unsigned char Lisp_Type_Vector = 103; -#else -unsigned char lrecord_vector; -#endif - -#ifdef LRECORD_SYMBOL unsigned char Lisp_Type_Symbol = 104; -#else -unsigned char lrecord_symbol; -#endif #ifndef MULE unsigned char lrecord_char_table_entry; @@ -695,6 +505,15 @@ #endif #endif +#if !((defined HAVE_X_WINDOWS) && \ + (defined (HAVE_MENUBARS) || \ + defined (HAVE_SCROLLBARS) || \ + defined (HAVE_DIALOGS) || \ + defined (HAVE_TOOLBARS) || \ + defined (HAVE_WIDGETS))) +unsigned char lrecord_popup_data; +#endif + #ifndef HAVE_TOOLBARS unsigned char lrecord_toolbar_button; #endif @@ -753,9 +572,9 @@ pointer to the actual string data, which is stored in structures of type struct string_chars_block. Each string_chars_block consists of a pointer to a struct Lisp_String, followed by the data for that - string, followed by another pointer to a struct Lisp_String, - followed by the data for that string, etc. At GC time, the data in - these blocks is compacted by searching sequentially through all the + string, followed by another pointer to a Lisp_String, followed by + the data for that string, etc. At GC time, the data in these + blocks is compacted by searching sequentially through all the blocks and compressing out any holes created by unmarked strings. Strings that are more than a certain size (bigger than the size of a string_chars_block, although something like half as big might @@ -869,8 +688,7 @@ varies depending on type) of them already on the list. This way, we ensure that an object that gets freed will remain free for the next 1000 (or whatever) times that - an object of that type is allocated. -*/ + an object of that type is allocated. */ #ifndef MALLOC_OVERHEAD #ifdef GNU_MALLOC @@ -1099,35 +917,41 @@ /* Cons allocation */ /************************************************************************/ -DECLARE_FIXED_TYPE_ALLOC (cons, struct Lisp_Cons); +DECLARE_FIXED_TYPE_ALLOC (cons, Lisp_Cons); /* conses are used and freed so often that we set this really high */ /* #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_cons 20000 */ #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_cons 2000 -#ifdef LRECORD_CONS static Lisp_Object -mark_cons (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_cons (Lisp_Object obj) { - if (GC_NILP (XCDR (obj))) + if (NILP (XCDR (obj))) return XCAR (obj); - markobj (XCAR (obj)); + mark_object (XCAR (obj)); return XCDR (obj); } static int cons_equal (Lisp_Object ob1, Lisp_Object ob2, int depth) { - while (internal_equal (XCAR (ob1), XCAR (ob2), depth + 1)) + depth++; + while (internal_equal (XCAR (ob1), XCAR (ob2), depth)) { ob1 = XCDR (ob1); ob2 = XCDR (ob2); if (! CONSP (ob1) || ! CONSP (ob2)) - return internal_equal (ob1, ob2, depth + 1); + return internal_equal (ob1, ob2, depth); } return 0; } +static const struct lrecord_description cons_description[] = { + { XD_LISP_OBJECT, offsetof (Lisp_Cons, car) }, + { XD_LISP_OBJECT, offsetof (Lisp_Cons, cdr) }, + { XD_END } +}; + DEFINE_BASIC_LRECORD_IMPLEMENTATION ("cons", cons, mark_cons, print_cons, 0, cons_equal, @@ -1137,8 +961,8 @@ * handle conses. */ 0, - struct Lisp_Cons); -#endif /* LRECORD_CONS */ + cons_description, + Lisp_Cons); DEFUN ("cons", Fcons, 2, 2, 0, /* Create a new cons, give it CAR and CDR as components, and return it. @@ -1147,12 +971,10 @@ { /* This cannot GC. */ Lisp_Object val; - struct Lisp_Cons *c; - - ALLOCATE_FIXED_TYPE (cons, struct Lisp_Cons, c); -#ifdef LRECORD_CONS - set_lheader_implementation (&(c->lheader), lrecord_cons); -#endif + Lisp_Cons *c; + + ALLOCATE_FIXED_TYPE (cons, Lisp_Cons, c); + set_lheader_implementation (&(c->lheader), &lrecord_cons); XSETCONS (val, c); c->car = car; c->cdr = cdr; @@ -1166,12 +988,10 @@ noseeum_cons (Lisp_Object car, Lisp_Object cdr) { Lisp_Object val; - struct Lisp_Cons *c; - - NOSEEUM_ALLOCATE_FIXED_TYPE (cons, struct Lisp_Cons, c); -#ifdef LRECORD_CONS - set_lheader_implementation (&(c->lheader), lrecord_cons); -#endif + Lisp_Cons *c; + + NOSEEUM_ALLOCATE_FIXED_TYPE (cons, Lisp_Cons, c); + set_lheader_implementation (&(c->lheader), &lrecord_cons); XSETCONS (val, c); XCAR (val) = car; XCDR (val) = cdr; @@ -1258,9 +1078,9 @@ { Lisp_Object val = Qnil; - int size = XINT (length); - - while (size-- > 0) + size_t size = XINT (length); + + while (size--) val = Fcons (init, val); return val; } @@ -1273,17 +1093,22 @@ #ifdef LISP_FLOAT_TYPE -DECLARE_FIXED_TYPE_ALLOC (float, struct Lisp_Float); +DECLARE_FIXED_TYPE_ALLOC (float, Lisp_Float); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_float 1000 Lisp_Object make_float (double float_value) { Lisp_Object val; - struct Lisp_Float *f; - - ALLOCATE_FIXED_TYPE (float, struct Lisp_Float, f); - set_lheader_implementation (&(f->lheader), lrecord_float); + Lisp_Float *f; + + ALLOCATE_FIXED_TYPE (float, Lisp_Float, f); + + /* Avoid dump-time `uninitialized memory read' purify warnings. */ + if (sizeof (struct lrecord_header) + sizeof (double) != sizeof (*f)) + xzero (*f); + + set_lheader_implementation (&(f->lheader), &lrecord_float); float_data (f) = float_value; XSETFLOAT (val, f); return val; @@ -1296,24 +1121,22 @@ /* Vector allocation */ /************************************************************************/ -#ifdef LRECORD_VECTOR static Lisp_Object -mark_vector (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_vector (Lisp_Object obj) { Lisp_Vector *ptr = XVECTOR (obj); int len = vector_length (ptr); int i; for (i = 0; i < len - 1; i++) - markobj (ptr->contents[i]); + mark_object (ptr->contents[i]); return (len > 0) ? ptr->contents[len - 1] : Qnil; } static size_t -size_vector (CONST void *lheader) +size_vector (const void *lheader) { - return STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, - ((Lisp_Vector *) lheader)->size); + return offsetof (Lisp_Vector, contents[((Lisp_Vector *) lheader)->size]); } static int @@ -1333,15 +1156,26 @@ return 1; } +static hashcode_t +vector_hash (Lisp_Object obj, int depth) +{ + return HASH2 (XVECTOR_LENGTH (obj), + internal_array_hash (XVECTOR_DATA (obj), + XVECTOR_LENGTH (obj), + depth + 1)); +} + +static const struct lrecord_description vector_description[] = { + { XD_LONG, offsetof (Lisp_Vector, size) }, + { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Vector, contents), XD_INDIRECT(0, 0) }, + { XD_END } +}; + DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION("vector", vector, mark_vector, print_vector, 0, vector_equal, - /* - * No `hash' method needed for - * vectors. internal_hash - * knows how to handle vectors. - */ - 0, + vector_hash, + vector_description, size_vector, Lisp_Vector); /* #### should allocate `small' vectors from a frob-block */ @@ -1349,35 +1183,13 @@ make_vector_internal (size_t sizei) { /* no vector_next */ - size_t sizem = STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, sizei); - Lisp_Vector *p = (Lisp_Vector *) alloc_lcrecord (sizem, lrecord_vector); + size_t sizem = offsetof (Lisp_Vector, contents[sizei]); + Lisp_Vector *p = (Lisp_Vector *) alloc_lcrecord (sizem, &lrecord_vector); p->size = sizei; return p; } -#else /* ! LRECORD_VECTOR */ - -static Lisp_Object all_vectors; - -/* #### should allocate `small' vectors from a frob-block */ -static Lisp_Vector * -make_vector_internal (size_t sizei) -{ - /* + 1 to account for vector_next */ - size_t sizem = STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, sizei+1); - Lisp_Vector *p = (Lisp_Vector *) allocate_lisp_storage (sizem); - - INCREMENT_CONS_COUNTER (sizem, "vector"); - - p->size = sizei; - vector_next (p) = all_vectors; - XSETVECTOR (all_vectors, p); - return p; -} - -#endif /* ! LRECORD_VECTOR */ - Lisp_Object make_vector (size_t length, Lisp_Object init) { @@ -1530,13 +1342,13 @@ static Lisp_Object all_bit_vectors; /* #### should allocate `small' bit vectors from a frob-block */ -static struct Lisp_Bit_Vector * +static Lisp_Bit_Vector * make_bit_vector_internal (size_t sizei) { size_t num_longs = BIT_VECTOR_LONG_STORAGE (sizei); - size_t sizem = STRETCHY_STRUCT_SIZEOF (Lisp_Bit_Vector, bits, num_longs); + size_t sizem = offsetof (Lisp_Bit_Vector, bits[num_longs]); Lisp_Bit_Vector *p = (Lisp_Bit_Vector *) allocate_lisp_storage (sizem); - set_lheader_implementation (&(p->lheader), lrecord_bit_vector); + set_lheader_implementation (&(p->lheader), &lrecord_bit_vector); INCREMENT_CONS_COUNTER (sizem, "bit-vector"); @@ -1552,7 +1364,7 @@ Lisp_Object make_bit_vector (size_t length, Lisp_Object init) { - struct Lisp_Bit_Vector *p = make_bit_vector_internal (length); + Lisp_Bit_Vector *p = make_bit_vector_internal (length); size_t num_longs = BIT_VECTOR_LONG_STORAGE (length); CHECK_BIT (init); @@ -1634,27 +1446,14 @@ #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_compiled_function 1000 static Lisp_Object -make_compiled_function (int make_pure) +make_compiled_function (void) { Lisp_Compiled_Function *f; Lisp_Object fun; - size_t size = sizeof (Lisp_Compiled_Function); - - if (make_pure && check_purespace (size)) - { - f = (Lisp_Compiled_Function *) (PUREBEG + pure_bytes_used); - set_lheader_implementation (&(f->lheader), lrecord_compiled_function); -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION - f->lheader.pure = 1; -#endif - pure_bytes_used += size; - bump_purestat (&purestat_function, size); - } - else - { - ALLOCATE_FIXED_TYPE (compiled_function, Lisp_Compiled_Function, f); - set_lheader_implementation (&(f->lheader), lrecord_compiled_function); - } + + ALLOCATE_FIXED_TYPE (compiled_function, Lisp_Compiled_Function, f); + set_lheader_implementation (&(f->lheader), &lrecord_compiled_function); + f->stack_depth = 0; f->specpdl_depth = 0; f->flags.documentationp = 0; @@ -1688,7 +1487,7 @@ /* In a non-insane world this function would have this arglist... (arglist instructions constants stack_depth &optional doc_string interactive) */ - Lisp_Object fun = make_compiled_function (purify_flag); + Lisp_Object fun = make_compiled_function (); Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); Lisp_Object arglist = args[0]; @@ -1698,22 +1497,6 @@ Lisp_Object doc_string = (nargs > 4) ? args[4] : Qnil; Lisp_Object interactive = (nargs > 5) ? args[5] : Qunbound; - /* Don't purecopy the doc references in instructions because it's - wasteful; they will get fixed up later. - - #### If something goes wrong and they don't get fixed up, - we're screwed, because pure stuff isn't marked and thus the - cons references won't be marked and will get reused. - - Note: there will be a window after the byte code is created and - before the doc references are fixed up in which there will be - impure objects inside a pure object, which apparently won't - get marked, leading to trouble. But during that entire window, - the objects are sitting on Vload_force_doc_string_list, which - is staticpro'd, so we're OK. */ - Lisp_Object (*cons) (Lisp_Object, Lisp_Object) - = purify_flag ? pure_cons : Fcons; - if (nargs < 4 || nargs > 6) return Fsignal (Qwrong_number_of_arguments, list2 (intern ("make-byte-code"), make_int (nargs))); @@ -1753,11 +1536,11 @@ f->constants = constants; CHECK_NATNUM (stack_depth); - f->stack_depth = XINT (stack_depth); + f->stack_depth = XINT (stack_depth); #ifdef COMPILED_FUNCTION_ANNOTATION_HACK if (!NILP (Vcurrent_compiled_function_annotation)) - f->annotated = Fpurecopy (Vcurrent_compiled_function_annotation); + f->annotated = Fcopy (Vcurrent_compiled_function_annotation); else if (!NILP (Vload_file_name_internal_the_purecopy)) f->annotated = Vload_file_name_internal_the_purecopy; else if (!NILP (Vload_file_name_internal)) @@ -1765,7 +1548,7 @@ struct gcpro gcpro1; GCPRO1 (fun); /* don't let fun get reaped */ Vload_file_name_internal_the_purecopy = - Fpurecopy (Ffile_name_nondirectory (Vload_file_name_internal)); + Ffile_name_nondirectory (Vload_file_name_internal); f->annotated = Vload_file_name_internal_the_purecopy; UNGCPRO; } @@ -1780,61 +1563,19 @@ #endif if ((f->flags.interactivep = !UNBOUNDP (interactive)) != 0) { - if (purify_flag) - { - interactive = Fpurecopy (interactive); - if (STRINGP (interactive)) - bump_purestat (&purestat_string_interactive, - pure_sizeof (interactive)); - } f->doc_and_interactive = (UNBOUNDP (f->doc_and_interactive) ? interactive : - cons (interactive, f->doc_and_interactive)); + Fcons (interactive, f->doc_and_interactive)); } if ((f->flags.documentationp = !NILP (doc_string)) != 0) { - if (purify_flag) - { - doc_string = Fpurecopy (doc_string); - if (STRINGP (doc_string)) - /* These should have been snagged by make-docfile... */ - bump_purestat (&purestat_string_documentation, - pure_sizeof (doc_string)); - } f->doc_and_interactive = (UNBOUNDP (f->doc_and_interactive) ? doc_string : - cons (doc_string, f->doc_and_interactive)); + Fcons (doc_string, f->doc_and_interactive)); } if (UNBOUNDP (f->doc_and_interactive)) f->doc_and_interactive = Qnil; - if (purify_flag) - { - - if (!purified (f->arglist)) - f->arglist = Fpurecopy (f->arglist); - - /* Statistics are kept differently for the constants */ - if (!purified (f->constants)) - { -#ifdef PURESTAT - int old = purecopying_function_constants; - purecopying_function_constants = 1; - f->constants = Fpurecopy (f->constants); - bump_purestat (&purestat_vector_constants, - pure_sizeof (f->constants)); - purecopying_function_constants = old; -#else - f->constants = Fpurecopy (f->constants); -#endif /* PURESTAT */ - } - - optimize_compiled_function (fun); - - bump_purestat (&purestat_opaque_instructions, - pure_sizeof (f->instructions)); - } - return fun; } @@ -1843,7 +1584,7 @@ /* Symbol allocation */ /************************************************************************/ -DECLARE_FIXED_TYPE_ALLOC (symbol, struct Lisp_Symbol); +DECLARE_FIXED_TYPE_ALLOC (symbol, Lisp_Symbol); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_symbol 1000 DEFUN ("make-symbol", Fmake_symbol, 1, 1, 0, /* @@ -1853,19 +1594,16 @@ (name)) { Lisp_Object val; - struct Lisp_Symbol *p; + Lisp_Symbol *p; CHECK_STRING (name); - ALLOCATE_FIXED_TYPE (symbol, struct Lisp_Symbol, p); -#ifdef LRECORD_SYMBOL - set_lheader_implementation (&(p->lheader), lrecord_symbol); -#endif + ALLOCATE_FIXED_TYPE (symbol, Lisp_Symbol, p); + set_lheader_implementation (&(p->lheader), &lrecord_symbol); p->name = XSTRING (name); p->plist = Qnil; p->value = Qunbound; p->function = Qunbound; - p->obarray = Qnil; symbol_next (p) = 0; XSETSYMBOL (val, p); return val; @@ -1885,7 +1623,7 @@ struct extent *e; ALLOCATE_FIXED_TYPE (extent, struct extent, e); - set_lheader_implementation (&(e->lheader), lrecord_extent); + set_lheader_implementation (&(e->lheader), &lrecord_extent); extent_object (e) = Qnil; set_extent_start (e, -1); set_extent_end (e, -1); @@ -1905,17 +1643,17 @@ /* Event allocation */ /************************************************************************/ -DECLARE_FIXED_TYPE_ALLOC (event, struct Lisp_Event); +DECLARE_FIXED_TYPE_ALLOC (event, Lisp_Event); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_event 1000 Lisp_Object allocate_event (void) { Lisp_Object val; - struct Lisp_Event *e; - - ALLOCATE_FIXED_TYPE (event, struct Lisp_Event, e); - set_lheader_implementation (&(e->lheader), lrecord_event); + Lisp_Event *e; + + ALLOCATE_FIXED_TYPE (event, Lisp_Event, e); + set_lheader_implementation (&(e->lheader), &lrecord_event); XSETEVENT (val, e); return val; @@ -1926,7 +1664,7 @@ /* Marker allocation */ /************************************************************************/ -DECLARE_FIXED_TYPE_ALLOC (marker, struct Lisp_Marker); +DECLARE_FIXED_TYPE_ALLOC (marker, Lisp_Marker); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_marker 1000 DEFUN ("make-marker", Fmake_marker, 0, 0, 0, /* @@ -1935,10 +1673,10 @@ ()) { Lisp_Object val; - struct Lisp_Marker *p; - - ALLOCATE_FIXED_TYPE (marker, struct Lisp_Marker, p); - set_lheader_implementation (&(p->lheader), lrecord_marker); + Lisp_Marker *p; + + ALLOCATE_FIXED_TYPE (marker, Lisp_Marker, p); + set_lheader_implementation (&(p->lheader), &lrecord_marker); p->buffer = 0; p->memind = 0; marker_next (p) = 0; @@ -1952,10 +1690,10 @@ noseeum_make_marker (void) { Lisp_Object val; - struct Lisp_Marker *p; - - NOSEEUM_ALLOCATE_FIXED_TYPE (marker, struct Lisp_Marker, p); - set_lheader_implementation (&(p->lheader), lrecord_marker); + Lisp_Marker *p; + + NOSEEUM_ALLOCATE_FIXED_TYPE (marker, Lisp_Marker, p); + set_lheader_implementation (&(p->lheader), &lrecord_marker); p->buffer = 0; p->memind = 0; marker_next (p) = 0; @@ -1983,18 +1721,17 @@ This new method makes things somewhat bigger, but it is MUCH safer. */ -DECLARE_FIXED_TYPE_ALLOC (string, struct Lisp_String); +DECLARE_FIXED_TYPE_ALLOC (string, Lisp_String); /* strings are used and freed quite often */ /* #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_string 10000 */ #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_string 1000 -#ifdef LRECORD_STRING static Lisp_Object -mark_string (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_string (Lisp_Object obj) { - struct Lisp_String *ptr = XSTRING (obj); - - if (GC_CONSP (ptr->plist) && GC_EXTENT_INFOP (XCAR (ptr->plist))) + Lisp_String *ptr = XSTRING (obj); + + if (CONSP (ptr->plist) && EXTENT_INFOP (XCAR (ptr->plist))) flush_cached_extent_info (XCAR (ptr->plist)); return ptr->plist; } @@ -2007,21 +1744,74 @@ !memcmp (XSTRING_DATA (obj1), XSTRING_DATA (obj2), len)); } -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("string", string, - mark_string, print_string, - /* - * No `finalize', or `hash' methods. - * internal_hash already knows how - * to hash strings and finalization - * is done with the - * ADDITIONAL_FREE_string macro, - * which is the standard way to do - * finalization when using - * SWEEP_FIXED_TYPE_BLOCK(). - */ - 0, string_equal, 0, - struct Lisp_String); -#endif /* LRECORD_STRING */ +static const struct lrecord_description string_description[] = { + { XD_BYTECOUNT, offsetof (Lisp_String, size) }, + { XD_OPAQUE_DATA_PTR, offsetof (Lisp_String, data), XD_INDIRECT(0, 1) }, + { XD_LISP_OBJECT, offsetof (Lisp_String, plist) }, + { XD_END } +}; + +/* We store the string's extent info as the first element of the string's + property list; and the string's MODIFF as the first or second element + of the string's property list (depending on whether the extent info + is present), but only if the string has been modified. This is ugly + but it reduces the memory allocated for the string in the vast + majority of cases, where the string is never modified and has no + extent info. + + #### This means you can't use an int as a key in a string's plist. */ + +static Lisp_Object * +string_plist_ptr (Lisp_Object string) +{ + Lisp_Object *ptr = &XSTRING (string)->plist; + + if (CONSP (*ptr) && EXTENT_INFOP (XCAR (*ptr))) + ptr = &XCDR (*ptr); + if (CONSP (*ptr) && INTP (XCAR (*ptr))) + ptr = &XCDR (*ptr); + return ptr; +} + +static Lisp_Object +string_getprop (Lisp_Object string, Lisp_Object property) +{ + return external_plist_get (string_plist_ptr (string), property, 0, ERROR_ME); +} + +static int +string_putprop (Lisp_Object string, Lisp_Object property, Lisp_Object value) +{ + external_plist_put (string_plist_ptr (string), property, value, 0, ERROR_ME); + return 1; +} + +static int +string_remprop (Lisp_Object string, Lisp_Object property) +{ + return external_remprop (string_plist_ptr (string), property, 0, ERROR_ME); +} + +static Lisp_Object +string_plist (Lisp_Object string) +{ + return *string_plist_ptr (string); +} + +/* No `finalize', or `hash' methods. + internal_hash() already knows how to hash strings and finalization + is done with the ADDITIONAL_FREE_string macro, which is the + standard way to do finalization when using + SWEEP_FIXED_TYPE_BLOCK(). */ +DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string, + mark_string, print_string, + 0, string_equal, 0, + string_description, + string_getprop, + string_putprop, + string_remprop, + string_plist, + Lisp_String); /* String blocks contain this many useful bytes. */ #define STRING_CHARS_BLOCK_SIZE \ @@ -2039,34 +1829,29 @@ unsigned char string_chars[STRING_CHARS_BLOCK_SIZE]; }; -struct string_chars_block *first_string_chars_block; -struct string_chars_block *current_string_chars_block; +static struct string_chars_block *first_string_chars_block; +static struct string_chars_block *current_string_chars_block; /* If SIZE is the length of a string, this returns how many bytes * the string occupies in string_chars_block->string_chars * (including alignment padding). */ -#define STRING_FULLSIZE(s) \ - ALIGN_SIZE (((s) + 1 + sizeof (struct Lisp_String *)),\ - ALIGNOF (struct Lisp_String *)) +#define STRING_FULLSIZE(size) \ + ALIGN_SIZE (((size) + 1 + sizeof (Lisp_String *)),\ + ALIGNOF (Lisp_String *)) #define BIG_STRING_FULLSIZE_P(fullsize) ((fullsize) >= STRING_CHARS_BLOCK_SIZE) #define BIG_STRING_SIZE_P(size) (BIG_STRING_FULLSIZE_P (STRING_FULLSIZE(size))) -#define CHARS_TO_STRING_CHAR(x) \ - ((struct string_chars *) \ - (((char *) (x)) - (slot_offset (struct string_chars, chars[0])))) - - struct string_chars { - struct Lisp_String *string; + Lisp_String *string; unsigned char chars[1]; }; struct unused_string_chars { - struct Lisp_String *string; + Lisp_String *string; EMACS_INT fullsize; }; @@ -2081,19 +1866,14 @@ } static struct string_chars * -allocate_string_chars_struct (struct Lisp_String *string_it_goes_with, +allocate_string_chars_struct (Lisp_String *string_it_goes_with, EMACS_INT fullsize) { struct string_chars *s_chars; - /* Allocate the string's actual data */ - if (BIG_STRING_FULLSIZE_P (fullsize)) - { - s_chars = (struct string_chars *) xmalloc (fullsize); - } - else if (fullsize <= - (countof (current_string_chars_block->string_chars) - - current_string_chars_block->pos)) + if (fullsize <= + (countof (current_string_chars_block->string_chars) + - current_string_chars_block->pos)) { /* This string can fit in the current string chars block */ s_chars = (struct string_chars *) @@ -2125,23 +1905,20 @@ Lisp_Object make_uninit_string (Bytecount length) { - struct Lisp_String *s; - struct string_chars *s_chars; + Lisp_String *s; EMACS_INT fullsize = STRING_FULLSIZE (length); Lisp_Object val; - if ((length < 0) || (fullsize <= 0)) - abort (); + assert (length >= 0 && fullsize > 0); /* Allocate the string header */ - ALLOCATE_FIXED_TYPE (string, struct Lisp_String, s); -#ifdef LRECORD_STRING - set_lheader_implementation (&(s->lheader), lrecord_string); -#endif - - s_chars = allocate_string_chars_struct (s, fullsize); - - set_string_data (s, &(s_chars->chars[0])); + ALLOCATE_FIXED_TYPE (string, Lisp_String, s); + set_lheader_implementation (&(s->lheader), &lrecord_string); + + set_string_data (s, BIG_STRING_FULLSIZE_P (fullsize) + ? xnew_array (Bufbyte, length + 1) + : allocate_string_chars_struct (s, fullsize)->chars); + set_string_length (s, length); s->plist = Qnil; @@ -2162,8 +1939,9 @@ */ void -resize_string (struct Lisp_String *s, Bytecount pos, Bytecount delta) +resize_string (Lisp_String *s, Bytecount pos, Bytecount delta) { + Bytecount oldfullsize, newfullsize; #ifdef VERIFY_STRING_CHARS_INTEGRITY verify_string_chars_integrity (); #endif @@ -2182,47 +1960,62 @@ } #endif /* ERROR_CHECK_BUFPOS */ - if (pos >= 0 && delta < 0) - /* If DELTA < 0, the functions below will delete the characters - before POS. We want to delete characters *after* POS, however, - so convert this to the appropriate form. */ - pos += -delta; - if (delta == 0) /* simplest case: no size change. */ return; - else + + if (pos >= 0 && delta < 0) + /* If DELTA < 0, the functions below will delete the characters + before POS. We want to delete characters *after* POS, however, + so convert this to the appropriate form. */ + pos += -delta; + + oldfullsize = STRING_FULLSIZE (string_length (s)); + newfullsize = STRING_FULLSIZE (string_length (s) + delta); + + if (BIG_STRING_FULLSIZE_P (oldfullsize)) { - Bytecount oldfullsize = STRING_FULLSIZE (string_length (s)); - Bytecount newfullsize = STRING_FULLSIZE (string_length (s) + delta); - - if (oldfullsize == newfullsize) + if (BIG_STRING_FULLSIZE_P (newfullsize)) { - /* next simplest case; size change but the necessary - allocation size won't change (up or down; code somewhere - depends on there not being any unused allocation space, - modulo any alignment constraints). */ + /* Both strings are big. We can just realloc(). + But careful! If the string is shrinking, we have to + memmove() _before_ realloc(), and if growing, we have to + memmove() _after_ realloc() - otherwise the access is + illegal, and we might crash. */ + Bytecount len = string_length (s) + 1 - pos; + + if (delta < 0 && pos >= 0) + memmove (string_data (s) + pos + delta, string_data (s) + pos, len); + set_string_data (s, (Bufbyte *) xrealloc (string_data (s), + string_length (s) + delta + 1)); + if (delta > 0 && pos >= 0) + memmove (string_data (s) + pos + delta, string_data (s) + pos, len); + } + else /* String has been demoted from BIG_STRING. */ + { + Bufbyte *new_data = + allocate_string_chars_struct (s, newfullsize)->chars; + Bufbyte *old_data = string_data (s); + if (pos >= 0) { - Bufbyte *addroff = pos + string_data (s); - - memmove (addroff + delta, addroff, - /* +1 due to zero-termination. */ - string_length (s) + 1 - pos); + memcpy (new_data, old_data, pos); + memcpy (new_data + pos + delta, old_data + pos, + string_length (s) + 1 - pos); } + set_string_data (s, new_data); + xfree (old_data); } - else if (BIG_STRING_FULLSIZE_P (oldfullsize) && - BIG_STRING_FULLSIZE_P (newfullsize)) + } + else /* old string is small */ + { + if (oldfullsize == newfullsize) { - /* next simplest case; the string is big enough to be malloc()ed - itself, so we just realloc. - - It's important not to let the string get below the threshold - for making big strings and still remain malloc()ed; if that - were the case, repeated calls to this function on the same - string could result in memory leakage. */ - set_string_data (s, (Bufbyte *) xrealloc (string_data (s), - newfullsize)); + /* special case; size change but the necessary + allocation size won't change (up or down; code + somewhere depends on there not being any unused + allocation space, modulo any alignment + constraints). */ if (pos >= 0) { Bufbyte *addroff = pos + string_data (s); @@ -2234,58 +2027,52 @@ } else { - /* worst case. We make a new string_chars struct and copy - the string's data into it, inserting/deleting the delta - in the process. The old string data will either get - freed by us (if it was malloc()ed) or will be reclaimed - in the normal course of garbage collection. */ - struct string_chars *s_chars = - allocate_string_chars_struct (s, newfullsize); - Bufbyte *new_addr = &(s_chars->chars[0]); - Bufbyte *old_addr = string_data (s); + Bufbyte *old_data = string_data (s); + Bufbyte *new_data = + BIG_STRING_FULLSIZE_P (newfullsize) + ? xnew_array (Bufbyte, string_length (s) + delta + 1) + : allocate_string_chars_struct (s, newfullsize)->chars; + if (pos >= 0) { - memcpy (new_addr, old_addr, pos); - memcpy (new_addr + pos + delta, old_addr + pos, + memcpy (new_data, old_data, pos); + memcpy (new_data + pos + delta, old_data + pos, string_length (s) + 1 - pos); } - set_string_data (s, new_addr); - if (BIG_STRING_FULLSIZE_P (oldfullsize)) - xfree (old_addr); - else - { - /* We need to mark this chunk of the string_chars_block - as unused so that compact_string_chars() doesn't - freak. */ - struct string_chars *old_s_chars = - (struct string_chars *) ((char *) old_addr - - sizeof (struct Lisp_String *)); - /* Sanity check to make sure we aren't hosed by strange - alignment/padding. */ - assert (old_s_chars->string == s); - MARK_STRUCT_AS_FREE (old_s_chars); - ((struct unused_string_chars *) old_s_chars)->fullsize = - oldfullsize; - } + set_string_data (s, new_data); + + { + /* We need to mark this chunk of the string_chars_block + as unused so that compact_string_chars() doesn't + freak. */ + struct string_chars *old_s_chars = (struct string_chars *) + ((char *) old_data - offsetof (struct string_chars, chars)); + /* Sanity check to make sure we aren't hosed by strange + alignment/padding. */ + assert (old_s_chars->string == s); + MARK_STRUCT_AS_FREE (old_s_chars); + ((struct unused_string_chars *) old_s_chars)->fullsize = + oldfullsize; + } } - - set_string_length (s, string_length (s) + delta); - /* If pos < 0, the string won't be zero-terminated. - Terminate now just to make sure. */ - string_data (s)[string_length (s)] = '\0'; - - if (pos >= 0) - { - Lisp_Object string; - - XSETSTRING (string, s); - /* We also have to adjust all of the extent indices after the - place we did the change. We say "pos - 1" because - adjust_extents() is exclusive of the starting position - passed to it. */ - adjust_extents (string, pos - 1, string_length (s), - delta); - } + } + + set_string_length (s, string_length (s) + delta); + /* If pos < 0, the string won't be zero-terminated. + Terminate now just to make sure. */ + string_data (s)[string_length (s)] = '\0'; + + if (pos >= 0) + { + Lisp_Object string; + + XSETSTRING (string, s); + /* We also have to adjust all of the extent indices after the + place we did the change. We say "pos - 1" because + adjust_extents() is exclusive of the starting position + passed to it. */ + adjust_extents (string, pos - 1, string_length (s), + delta); } #ifdef VERIFY_STRING_CHARS_INTEGRITY @@ -2296,7 +2083,7 @@ #ifdef MULE void -set_string_char (struct Lisp_String *s, Charcount i, Emchar c) +set_string_char (Lisp_String *s, Charcount i, Emchar c) { Bufbyte newstr[MAX_EMCHAR_LEN]; Bytecount bytoff = charcount_to_bytecount (string_data (s), i); @@ -2329,7 +2116,7 @@ memset (XSTRING_DATA (val), XCHAR (init), XSTRING_LENGTH (val)); else { - int i; + size_t i; Bufbyte *ptr = XSTRING_DATA (val); for (i = XINT (length); i; i--) @@ -2365,10 +2152,11 @@ return make_string (storage, p - storage); } + /* Take some raw memory, which MUST already be in internal format, and package it up into a Lisp string. */ Lisp_Object -make_string (CONST Bufbyte *contents, Bytecount length) +make_string (const Bufbyte *contents, Bytecount length) { Lisp_Object val; @@ -2385,34 +2173,58 @@ /* Take some raw memory, encoded in some external data format, and convert it into a Lisp string. */ Lisp_Object -make_ext_string (CONST Extbyte *contents, EMACS_INT length, - enum external_data_format fmt) +make_ext_string (const Extbyte *contents, EMACS_INT length, + Lisp_Object coding_system) { - Bufbyte *intstr; - Bytecount intlen; - - GET_CHARPTR_INT_DATA_ALLOCA (contents, length, fmt, intstr, intlen); - return make_string (intstr, intlen); + Lisp_Object string; + TO_INTERNAL_FORMAT (DATA, (contents, length), + LISP_STRING, string, + coding_system); + return string; +} + +Lisp_Object +build_string (const char *str) +{ + /* Some strlen's crash and burn if passed null. */ + return make_string ((const Bufbyte *) str, (str ? strlen(str) : 0)); +} + +Lisp_Object +build_ext_string (const char *str, Lisp_Object coding_system) +{ + /* Some strlen's crash and burn if passed null. */ + return make_ext_string ((const Extbyte *) str, (str ? strlen(str) : 0), + coding_system); } Lisp_Object -build_string (CONST char *str) +build_translated_string (const char *str) { - /* Some strlen's crash and burn if passed null. */ - return make_string ((CONST Bufbyte *) str, (str ? strlen(str) : 0)); + return build_string (GETTEXT (str)); } Lisp_Object -build_ext_string (CONST char *str, enum external_data_format fmt) +make_string_nocopy (const Bufbyte *contents, Bytecount length) { - /* Some strlen's crash and burn if passed null. */ - return make_ext_string ((CONST Extbyte *) str, (str ? strlen(str) : 0), fmt); -} - -Lisp_Object -build_translated_string (CONST char *str) -{ - return build_string (GETTEXT (str)); + Lisp_String *s; + Lisp_Object val; + + /* Make sure we find out about bad make_string_nocopy's when they happen */ +#if defined (ERROR_CHECK_BUFPOS) && defined (MULE) + bytecount_to_charcount (contents, length); /* Just for the assertions */ +#endif + + /* Allocate the string header */ + ALLOCATE_FIXED_TYPE (string, Lisp_String, s); + set_lheader_implementation (&(s->lheader), &lrecord_string); + SET_C_READONLY_RECORD_HEADER (&s->lheader); + s->plist = Qnil; + set_string_data (s, (Bufbyte *)contents); + set_string_length (s, length); + + XSETSTRING (val, s); + return val; } @@ -2428,7 +2240,7 @@ It works like this: 1) Create an lcrecord-list object using make_lcrecord_list(). - This is often done at initialization. Remember to staticpro + This is often done at initialization. Remember to staticpro_nodump this object! The arguments to make_lcrecord_list() are the same as would be passed to alloc_lcrecord(). 2) Instead of calling alloc_lcrecord(), call allocate_managed_lcrecord() @@ -2449,7 +2261,7 @@ */ static Lisp_Object -mark_lcrecord_list (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_lcrecord_list (Lisp_Object obj) { struct lcrecord_list *list = XLCRECORD_LIST (obj); Lisp_Object chain = list->free; @@ -2461,7 +2273,7 @@ (struct free_lcrecord_header *) lheader; #ifdef ERROR_CHECK_GC - CONST struct lrecord_implementation *implementation + const struct lrecord_implementation *implementation = LHEADER_IMPLEMENTATION(lheader); /* There should be no other pointers to the free list. */ @@ -2486,13 +2298,13 @@ DEFINE_LRECORD_IMPLEMENTATION ("lcrecord-list", lcrecord_list, mark_lcrecord_list, internal_object_printer, - 0, 0, 0, struct lcrecord_list); + 0, 0, 0, 0, struct lcrecord_list); Lisp_Object make_lcrecord_list (size_t size, - CONST struct lrecord_implementation *implementation) + const struct lrecord_implementation *implementation) { struct lcrecord_list *p = alloc_lcrecord_type (struct lcrecord_list, - lrecord_lcrecord_list); + &lrecord_lcrecord_list); Lisp_Object val; p->implementation = implementation; @@ -2515,7 +2327,7 @@ #ifdef ERROR_CHECK_GC struct lrecord_header *lheader = (struct lrecord_header *) free_header; - CONST struct lrecord_implementation *implementation + const struct lrecord_implementation *implementation = LHEADER_IMPLEMENTATION (lheader); /* There should be no other pointers to the free list. */ @@ -2552,7 +2364,7 @@ (struct free_lcrecord_header *) XPNTR (lcrecord); struct lrecord_header *lheader = (struct lrecord_header *) free_header; - CONST struct lrecord_implementation *implementation + const struct lrecord_implementation *implementation = LHEADER_IMPLEMENTATION (lheader); #ifdef ERROR_CHECK_GC @@ -2572,503 +2384,20 @@ } -/************************************************************************/ -/* Purity of essence, peace on earth */ -/************************************************************************/ - -static int symbols_initialized; - -Lisp_Object -make_pure_string (CONST Bufbyte *data, Bytecount length, - Lisp_Object plist, int no_need_to_copy_data) -{ - Lisp_String *s; - size_t size = sizeof (Lisp_String) + - (no_need_to_copy_data ? 0 : (length + 1)); /* + 1 for terminating 0 */ - size = ALIGN_SIZE (size, ALIGNOF (Lisp_Object)); - - if (symbols_initialized && !pure_lossage) - { - /* Try to share some names. Saves a few kbytes. */ - Lisp_Object tem = oblookup (Vobarray, data, length); - if (SYMBOLP (tem)) - { - s = XSYMBOL (tem)->name; - if (!PURIFIED (s)) abort (); - - { - Lisp_Object string; - XSETSTRING (string, s); - return string; - } - } - } - - if (!check_purespace (size)) - return make_string (data, length); - - s = (Lisp_String *) (PUREBEG + pure_bytes_used); -#ifdef LRECORD_STRING - set_lheader_implementation (&(s->lheader), lrecord_string); -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION - s->lheader.pure = 1; -#endif -#endif - set_string_length (s, length); - if (no_need_to_copy_data) - { - set_string_data (s, (Bufbyte *) data); - } - else - { - set_string_data (s, (Bufbyte *) s + sizeof (Lisp_String)); - memcpy (string_data (s), data, length); - set_string_byte (s, length, 0); - } - s->plist = Qnil; - pure_bytes_used += size; - -#ifdef PURESTAT - bump_purestat (&purestat_string_all, size); - if (purecopying_function_constants) - bump_purestat (&purestat_string_other_function, size); -#endif /* PURESTAT */ - - /* Do this after the official "completion" of the purecopying. */ - s->plist = Fpurecopy (plist); - - { - Lisp_Object string; - XSETSTRING (string, s); - return string; - } -} - - -Lisp_Object -make_pure_pname (CONST Bufbyte *data, Bytecount length, - int no_need_to_copy_data) -{ - Lisp_Object name = make_pure_string (data, length, Qnil, - no_need_to_copy_data); - bump_purestat (&purestat_string_pname, pure_sizeof (name)); - - /* We've made (at least) Qnil now, and Vobarray will soon be set up. */ - symbols_initialized = 1; - - return name; -} - - -Lisp_Object -pure_cons (Lisp_Object car, Lisp_Object cdr) -{ - Lisp_Cons *c; - - if (!check_purespace (sizeof (Lisp_Cons))) - return Fcons (Fpurecopy (car), Fpurecopy (cdr)); - - c = (Lisp_Cons *) (PUREBEG + pure_bytes_used); -#ifdef LRECORD_CONS - set_lheader_implementation (&(c->lheader), lrecord_cons); -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION - c->lheader.pure = 1; -#endif -#endif - pure_bytes_used += sizeof (Lisp_Cons); - bump_purestat (&purestat_cons, sizeof (Lisp_Cons)); - - c->car = Fpurecopy (car); - c->cdr = Fpurecopy (cdr); - - { - Lisp_Object cons; - XSETCONS (cons, c); - return cons; - } -} - -Lisp_Object -pure_list (int nargs, Lisp_Object *args) -{ - Lisp_Object val = Qnil; - - for (--nargs; nargs >= 0; nargs--) - val = pure_cons (args[nargs], val); - - return val; -} - -#ifdef LISP_FLOAT_TYPE - -static Lisp_Object -make_pure_float (double num) -{ - struct Lisp_Float *f; - Lisp_Object val; - - /* Make sure that PUREBEG + pure_bytes_used is aligned on at least a sizeof - (double) boundary. Some architectures (like the sparc) require - this, and I suspect that floats are rare enough that it's no - tragedy for those that don't. */ - { -#if defined (__GNUC__) && (__GNUC__ >= 2) - /* In gcc, we can directly ask what the alignment constraints of a - structure are, but in general, that's not possible... Arrgh!! - */ - int alignment = __alignof (struct Lisp_Float); -#else /* !GNUC */ - /* Best guess is to make the `double' slot be aligned to the size - of double (which is probably 8 bytes). This assumes that it's - ok to align the beginning of the structure to the same boundary - that the `double' slot in it is supposed to be aligned to; this - should be ok because presumably there is padding in the layout - of the struct to account for this. - */ - int alignment = sizeof (float_data (f)); -#endif /* !GNUC */ - char *p = ((char *) PUREBEG + pure_bytes_used); - - p = (char *) (((EMACS_UINT) p + alignment - 1) & - alignment); - pure_bytes_used = p - (char *) PUREBEG; - } - - if (!check_purespace (sizeof (struct Lisp_Float))) - return make_float (num); - - f = (struct Lisp_Float *) (PUREBEG + pure_bytes_used); - set_lheader_implementation (&(f->lheader), lrecord_float); -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION - f->lheader.pure = 1; -#endif - pure_bytes_used += sizeof (struct Lisp_Float); - bump_purestat (&purestat_float, sizeof (struct Lisp_Float)); - - float_data (f) = num; - XSETFLOAT (val, f); - return val; -} - -#endif /* LISP_FLOAT_TYPE */ - -Lisp_Object -make_pure_vector (size_t len, Lisp_Object init) -{ - Lisp_Vector *v; - size_t size = STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, len); - - init = Fpurecopy (init); - - if (!check_purespace (size)) - return make_vector (len, init); - - v = (Lisp_Vector *) (PUREBEG + pure_bytes_used); -#ifdef LRECORD_VECTOR - set_lheader_implementation (&(v->header.lheader), lrecord_vector); -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION - v->header.lheader.pure = 1; -#endif -#endif - pure_bytes_used += size; - bump_purestat (&purestat_vector_all, size); - - v->size = len; - - for (size = 0; size < len; size++) - v->contents[size] = init; - - { - Lisp_Object vector; - XSETVECTOR (vector, v); - return vector; - } -} - -#if 0 -/* Presently unused */ -void * -alloc_pure_lrecord (int size, struct lrecord_implementation *implementation) -{ - struct lrecord_header *header = (void *) (PUREBEG + pure_bytes_used); - - if (pure_bytes_used + size > get_PURESIZE()) - pure_storage_exhausted (); - - set_lheader_implementation (header, implementation); - header->next = 0; - return header; -} -#endif /* unused */ - DEFUN ("purecopy", Fpurecopy, 1, 1, 0, /* +Kept for compatibility, returns its argument. +Old: Make a copy of OBJECT in pure storage. Recursively copies contents of vectors and cons cells. Does not copy symbols. */ (obj)) { - if (!purify_flag) - { - return obj; - } - else if (!POINTER_TYPE_P (XTYPE (obj)) - || PURIFIED (XPNTR (obj)) - /* happens when bootstrapping Qnil */ - || EQ (obj, Qnull_pointer)) - { - return obj; - } - /* Order of subsequent tests determined via profiling. */ - else if (SYMBOLP (obj)) - { - /* Symbols can't be made pure (and thus read-only), because - assigning to their function, value or plist slots would - produced a SEGV in the dumped XEmacs. So we previously would - just return the symbol unchanged. - - But purified aggregate objects like lists and vectors can - contain uninterned symbols. If there are no other non-pure - references to the symbol, then the symbol is not protected - from garbage collection because the collector does not mark - the contents of purified objects. So to protect the symbols, - an impure reference has to be kept for each uninterned symbol - that is referenced by a pure object. All such symbols are - stored in the hash table pointed to by - Vpure_uninterned_symbol_table, which is itself - staticpro'd. */ - if (NILP (XSYMBOL (obj)->obarray)) - Fputhash (obj, Qnil, Vpure_uninterned_symbol_table); - return obj; - } - else if (CONSP (obj)) - { - return pure_cons (XCAR (obj), XCDR (obj)); - } - else if (STRINGP (obj)) - { - return make_pure_string (XSTRING_DATA (obj), - XSTRING_LENGTH (obj), - XSTRING (obj)->plist, - 0); - } - else if (VECTORP (obj)) - { - int i; - Lisp_Vector *o = XVECTOR (obj); - Lisp_Object pure_obj = make_pure_vector (vector_length (o), Qnil); - for (i = 0; i < vector_length (o); i++) - XVECTOR_DATA (pure_obj)[i] = Fpurecopy (o->contents[i]); - return pure_obj; - } -#ifdef LISP_FLOAT_TYPE - else if (FLOATP (obj)) - { - return make_pure_float (XFLOAT_DATA (obj)); - } -#endif - else if (COMPILED_FUNCTIONP (obj)) - { - Lisp_Object pure_obj = make_compiled_function (1); - Lisp_Compiled_Function *o = XCOMPILED_FUNCTION (obj); - Lisp_Compiled_Function *n = XCOMPILED_FUNCTION (pure_obj); - n->flags = o->flags; - n->instructions = o->instructions; - n->constants = Fpurecopy (o->constants); - n->arglist = Fpurecopy (o->arglist); - n->doc_and_interactive = Fpurecopy (o->doc_and_interactive); - n->stack_depth = o->stack_depth; - optimize_compiled_function (pure_obj); - return pure_obj; - } - else if (OPAQUEP (obj)) - { - Lisp_Object pure_obj; - Lisp_Opaque *old_opaque = XOPAQUE (obj); - Lisp_Opaque *new_opaque = (Lisp_Opaque *) (PUREBEG + pure_bytes_used); - struct lrecord_header *lheader = XRECORD_LHEADER (obj); - CONST struct lrecord_implementation *implementation - = LHEADER_IMPLEMENTATION (lheader); - size_t size = implementation->size_in_bytes_method (lheader); - size_t pure_size = ALIGN_SIZE (size, ALIGNOF (Lisp_Object)); - if (!check_purespace (pure_size)) - return obj; - pure_bytes_used += pure_size; - - memcpy (new_opaque, old_opaque, size); -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION - lheader->pure = 1; -#endif - new_opaque->header.next = 0; - - XSETOPAQUE (pure_obj, new_opaque); - return pure_obj; - } - else - { - signal_simple_error ("Can't purecopy %S", obj); - } - return obj; /* Unreached */ -} - - - -static void -puresize_adjust_h (size_t puresize) -{ - FILE *stream = fopen ("puresize-adjust.h", "w"); - - if (stream == NULL) - report_file_error ("Opening puresize adjustment file", - Fcons (build_string ("puresize-adjust.h"), Qnil)); - - fprintf (stream, - "/*\tDo not edit this file!\n" - "\tAutomatically generated by XEmacs */\n" - "# define PURESIZE_ADJUSTMENT (%ld)\n", - (long) (puresize - RAW_PURESIZE)); - fclose (stream); + return obj; } -void -report_pure_usage (int report_impurities, - int die_if_pure_storage_exceeded) -{ - int rc = 0; - - if (pure_lossage) - { - message ("\n****\tPure Lisp storage exhausted!\n" - "\tPurespace usage: %ld of %ld\n" - "****", - (long) get_PURESIZE() + pure_lossage, - (long) get_PURESIZE()); - if (die_if_pure_storage_exceeded) - { - puresize_adjust_h (get_PURESIZE() + pure_lossage); -#ifdef HEAP_IN_DATA - sheap_adjust_h(); -#endif - rc = -1; - } - } - else - { - size_t lost = (get_PURESIZE() - pure_bytes_used) / 1024; - char buf[200]; - /* extern Lisp_Object Vemacs_beta_version; */ - /* This used to be NILP(Vemacs_beta_version) ? 512 : 4; */ -#ifndef PURESIZE_SLOP -#define PURESIZE_SLOP 0 -#endif - size_t slop = PURESIZE_SLOP; - - sprintf (buf, "Purespace usage: %ld of %ld (%d%%", - (long) pure_bytes_used, - (long) get_PURESIZE(), - (int) (pure_bytes_used / (get_PURESIZE() / 100.0) + 0.5)); - if (lost > ((slop ? slop : 1) / 1024)) { - sprintf (buf + strlen (buf), " -- %ldk wasted", (long)lost); - if (die_if_pure_storage_exceeded) { - puresize_adjust_h (pure_bytes_used + slop); -#ifdef HEAP_IN_DATA - sheap_adjust_h(); -#endif - rc = -1; - } - } - - strcat (buf, ")."); - message ("%s", buf); - } - -#ifdef PURESTAT - - purestat_vector_other.nbytes = - purestat_vector_all.nbytes - - purestat_vector_constants.nbytes; - purestat_vector_other.nobjects = - purestat_vector_all.nobjects - - purestat_vector_constants.nobjects; - - purestat_string_other.nbytes = - purestat_string_all.nbytes - - (purestat_string_pname.nbytes + - purestat_string_interactive.nbytes + - purestat_string_documentation.nbytes + -#ifdef I18N3 - purestat_string_domain.nbytes + -#endif - purestat_string_other_function.nbytes); - - purestat_string_other.nobjects = - purestat_string_all.nobjects - - (purestat_string_pname.nobjects + - purestat_string_interactive.nobjects + - purestat_string_documentation.nobjects + -#ifdef I18N3 - purestat_string_domain.nobjects + -#endif - purestat_string_other_function.nobjects); - - message (" %-34s Objects Bytes", ""); - - print_purestat (&purestat_cons); - print_purestat (&purestat_float); - print_purestat (&purestat_string_pname); - print_purestat (&purestat_function); - print_purestat (&purestat_opaque_instructions); - print_purestat (&purestat_vector_constants); - print_purestat (&purestat_string_interactive); -#ifdef I18N3 - print_purestat (&purestat_string_domain); -#endif - print_purestat (&purestat_string_documentation); - print_purestat (&purestat_string_other_function); - print_purestat (&purestat_vector_other); - print_purestat (&purestat_string_other); - print_purestat (&purestat_string_all); - print_purestat (&purestat_vector_all); - -#endif /* PURESTAT */ - - - if (report_impurities) - { - Lisp_Object plist; - struct gcpro gcpro1; - plist = XCAR (XCDR (XCDR (XCDR (XCDR (XCDR (Fgarbage_collect())))))); - GCPRO1 (plist); - message ("\nImpurities:"); - for (; CONSP (plist); plist = XCDR (XCDR (plist))) - { - Lisp_Object symbol = XCAR (plist); - int size = XINT (XCAR (XCDR (plist))); - if (size > 0) - { - char buf [100]; - char *s = buf; - memcpy (buf, - string_data (XSYMBOL (symbol)->name), - string_length (XSYMBOL (symbol)->name) + 1); - while (*s++) if (*s == '-') *s = ' '; - *(s-1) = ':'; *s = 0; - message (" %-34s %6d", buf, size); - } - } - UNGCPRO; - garbage_collect_1 (); /* collect Fgarbage_collect()'s garbage */ - } - clear_message (); - - if (rc < 0) { - unlink("SATISFIED"); - fatal ("Pure size adjusted, Don't Panic! I will restart the `make'"); - } else if (pure_lossage && die_if_pure_storage_exceeded) { - fatal ("Pure storage exhausted"); - } -} /************************************************************************/ @@ -3078,13 +2407,14 @@ /* This will be used more extensively In The Future */ static int last_lrecord_type_index_assigned; -CONST struct lrecord_implementation *lrecord_implementations_table[128]; +const struct lrecord_implementation *lrecord_implementations_table[128]; #define max_lrecord_type (countof (lrecord_implementations_table) - 1) struct gcpro *gcprolist; /* 415 used Mly 29-Jun-93 */ /* 1327 used slb 28-Feb-98 */ +/* 1328 used og 03-Oct-99 (moving slowly, heh?) */ #ifdef HAVE_SHLIB #define NSTATICS 4000 #else @@ -3108,165 +2438,135 @@ staticvec[staticidx++] = varaddress; } +/* Not "static" because of linker lossage on some systems */ +Lisp_Object *staticvec_nodump[200] + /* Force it into data space! */ + = {0}; +static int staticidx_nodump; + +/* Put an entry in staticvec_nodump, pointing at the variable whose address is given + */ +void +staticpro_nodump (Lisp_Object *varaddress) +{ + if (staticidx_nodump >= countof (staticvec_nodump)) + /* #### This is now a dubious abort() since this routine may be called */ + /* by Lisp attempting to load a DLL. */ + abort (); + staticvec_nodump[staticidx_nodump++] = varaddress; +} + +/* Not "static" because of linker lossage on some systems */ +struct +{ + void *data; + const struct struct_description *desc; +} dumpstructvec[200]; + +static int dumpstructidx; + +/* Put an entry in dumpstructvec, pointing at the variable whose address is given + */ +void +dumpstruct (void *varaddress, const struct struct_description *desc) +{ + if (dumpstructidx >= countof (dumpstructvec)) + abort (); + dumpstructvec[dumpstructidx].data = varaddress; + dumpstructvec[dumpstructidx].desc = desc; + dumpstructidx++; +} + +/* Not "static" because of linker lossage on some systems */ +struct dumpopaque_info +{ + void *data; + size_t size; +} dumpopaquevec[200]; + +static int dumpopaqueidx; + +/* Put an entry in dumpopaquevec, pointing at the variable whose address is given + */ +void +dumpopaque (void *varaddress, size_t size) +{ + if (dumpopaqueidx >= countof (dumpopaquevec)) + abort (); + dumpopaquevec[dumpopaqueidx].data = varaddress; + dumpopaquevec[dumpopaqueidx].size = size; + dumpopaqueidx++; +} + +Lisp_Object *pdump_wirevec[50]; +static int pdump_wireidx; + +/* Put an entry in pdump_wirevec, pointing at the variable whose address is given + */ +void +pdump_wire (Lisp_Object *varaddress) +{ + if (pdump_wireidx >= countof (pdump_wirevec)) + abort (); + pdump_wirevec[pdump_wireidx++] = varaddress; +} + + +Lisp_Object *pdump_wirevec_list[50]; +static int pdump_wireidx_list; + +/* Put an entry in pdump_wirevec_list, pointing at the variable whose address is given + */ +void +pdump_wire_list (Lisp_Object *varaddress) +{ + if (pdump_wireidx_list >= countof (pdump_wirevec_list)) + abort (); + pdump_wirevec_list[pdump_wireidx_list++] = varaddress; +} + /* Mark reference to a Lisp_Object. If the object referred to has not been seen yet, recursively mark all the references contained in it. */ -static void +void mark_object (Lisp_Object obj) { tail_recurse: #ifdef ERROR_CHECK_GC - assert (! (GC_EQ (obj, Qnull_pointer))); + assert (! (EQ (obj, Qnull_pointer))); #endif /* Checks we used to perform */ /* if (EQ (obj, Qnull_pointer)) return; */ /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return; */ /* if (PURIFIED (XPNTR (obj))) return; */ - switch (XGCTYPE (obj)) + if (XTYPE (obj) == Lisp_Type_Record) { -#ifndef LRECORD_CONS - case Lisp_Type_Cons: - { - struct Lisp_Cons *ptr = XCONS (obj); - if (PURIFIED (ptr)) - break; - if (CONS_MARKED_P (ptr)) - break; - MARK_CONS (ptr); - /* If the cdr is nil, tail-recurse on the car. */ - if (GC_NILP (ptr->cdr)) - { - obj = ptr->car; - } - else - { - mark_object (ptr->car); - obj = ptr->cdr; - } - goto tail_recurse; - } -#endif - - case Lisp_Type_Record: - { - struct lrecord_header *lheader = XRECORD_LHEADER (obj); -#if defined (ERROR_CHECK_GC) && defined (USE_INDEXED_LRECORD_IMPLEMENTATION) - assert (lheader->type <= last_lrecord_type_index_assigned); -#endif - if (PURIFIED (lheader)) - return; - - if (! MARKED_RECORD_HEADER_P (lheader) && - ! UNMARKABLE_RECORD_HEADER_P (lheader)) - { - CONST struct lrecord_implementation *implementation = - LHEADER_IMPLEMENTATION (lheader); - MARK_RECORD_HEADER (lheader); -#ifdef ERROR_CHECK_GC - if (!implementation->basic_p) - assert (! ((struct lcrecord_header *) lheader)->free); + struct lrecord_header *lheader = XRECORD_LHEADER (obj); +#if defined (ERROR_CHECK_GC) + assert (lheader->type <= last_lrecord_type_index_assigned); #endif - if (implementation->marker) - { - obj = implementation->marker (obj, mark_object); - if (!GC_NILP (obj)) goto tail_recurse; - } - } - } - break; - -#ifndef LRECORD_STRING - case Lisp_Type_String: - { - struct Lisp_String *ptr = XSTRING (obj); - if (PURIFIED (ptr)) - return; - - if (!XMARKBIT (ptr->plist)) - { - if (CONSP (ptr->plist) && - EXTENT_INFOP (XCAR (ptr->plist))) - flush_cached_extent_info (XCAR (ptr->plist)); - XMARK (ptr->plist); - obj = ptr->plist; - goto tail_recurse; - } - } - break; -#endif /* ! LRECORD_STRING */ - -#ifndef LRECORD_VECTOR - case Lisp_Type_Vector: - { - struct Lisp_Vector *ptr = XVECTOR (obj); - int len, i; - - if (PURIFIED (ptr)) - return; - - len = vector_length (ptr); - - if (len < 0) - break; /* Already marked */ - ptr->size = -1 - len; /* Else mark it */ - for (i = 0; i < len - 1; i++) /* and then mark its elements */ - mark_object (ptr->contents[i]); - if (len > 0) - { - obj = ptr->contents[len - 1]; - goto tail_recurse; - } - } - break; -#endif /* !LRECORD_VECTOR */ - -#ifndef LRECORD_SYMBOL - case Lisp_Type_Symbol: - { - struct Lisp_Symbol *sym = XSYMBOL (obj); - - if (PURIFIED (sym)) - return; - - while (!XMARKBIT (sym->plist)) - { - XMARK (sym->plist); - mark_object (sym->value); - mark_object (sym->function); + if (C_READONLY_RECORD_HEADER_P (lheader)) + return; + + if (! MARKED_RECORD_HEADER_P (lheader) && + ! UNMARKABLE_RECORD_HEADER_P (lheader)) + { + const struct lrecord_implementation *implementation = + LHEADER_IMPLEMENTATION (lheader); + MARK_RECORD_HEADER (lheader); +#ifdef ERROR_CHECK_GC + if (!implementation->basic_p) + assert (! ((struct lcrecord_header *) lheader)->free); +#endif + if (implementation->marker) { - /* - * symbol->name is a struct Lisp_String *, not a - * Lisp_Object. Fix it up and pass to mark_object. - */ - Lisp_Object symname; - XSETSTRING (symname, sym->name); - mark_object (symname); + obj = implementation->marker (obj); + if (!NILP (obj)) goto tail_recurse; } - if (!symbol_next (sym)) - { - obj = sym->plist; - goto tail_recurse; - } - mark_object (sym->plist); - /* Mark the rest of the symbols in the hash-chain */ - sym = symbol_next (sym); - } - } - break; -#endif /* !LRECORD_SYMBOL */ - - /* Check for invalid Lisp_Object types */ -#if defined (ERROR_CHECK_GC) && ! defined (USE_MINIMAL_TAGBITS) - case Lisp_Type_Int: - case Lisp_Type_Char: - break; - default: - abort(); - break; -#endif /* ERROR_CHECK_GC && ! USE_MINIMAL_TAGBITS */ + } } } @@ -3292,75 +2592,8 @@ } -#ifdef PURESTAT -/* Simpler than mark-object, because pure structure can't - have any circularities */ - -static size_t -pure_string_sizeof (Lisp_Object obj) -{ - struct Lisp_String *ptr = XSTRING (obj); - - if (string_data (ptr) != (Bufbyte *) ptr + sizeof (*ptr)) - { - /* string-data not allocated contiguously. - Probably (better be!!) a pointer constant "C" data. */ - return sizeof (*ptr); - } - else - { - size_t size = sizeof (*ptr) + string_length (ptr) + 1; - size = ALIGN_SIZE (size, sizeof (Lisp_Object)); - return size; - } -} - -static size_t -pure_sizeof (Lisp_Object obj) -{ - if (!POINTER_TYPE_P (XTYPE (obj)) - || !PURIFIED (XPNTR (obj))) - return 0; - /* symbol sizes are accounted for separately */ - else if (SYMBOLP (obj)) - return 0; - else if (STRINGP (obj)) - return pure_string_sizeof (obj); - else if (LRECORDP (obj)) - { - struct lrecord_header *lheader = XRECORD_LHEADER (obj); - CONST struct lrecord_implementation *implementation - = LHEADER_IMPLEMENTATION (lheader); - - return implementation->size_in_bytes_method - ? implementation->size_in_bytes_method (lheader) - : implementation->static_size; - } -#ifndef LRECORD_VECTOR - else if (VECTORP (obj)) - return STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, XVECTOR_LENGTH (obj)); -#endif /* !LRECORD_VECTOR */ - -#ifndef LRECORD_CONS - else if (CONSP (obj)) - return sizeof (struct Lisp_Cons); -#endif /* !LRECORD_CONS */ - else - /* Others can't be purified */ - abort (); - return 0; /* unreached */ -} -#endif /* PURESTAT */ - - - - /* Find all structures not marked, and free them. */ -#ifndef LRECORD_VECTOR -static int gc_count_num_vector_used, gc_count_vector_total_size; -static int gc_count_vector_storage; -#endif static int gc_count_num_bit_vector_used, gc_count_bit_vector_total_size; static int gc_count_bit_vector_storage; static int gc_count_num_short_string_in_use; @@ -3371,7 +2604,7 @@ int -lrecord_type_index (CONST struct lrecord_implementation *implementation) +lrecord_type_index (const struct lrecord_implementation *implementation) { int type_index = *(implementation->lrecord_type_index); /* Have to do this circuitous validation test because of problems @@ -3400,9 +2633,9 @@ } lcrecord_stats [countof (lrecord_implementations_table)]; static void -tick_lcrecord_stats (CONST struct lrecord_header *h, int free_p) +tick_lcrecord_stats (const struct lrecord_header *h, int free_p) { - CONST struct lrecord_implementation *implementation = + const struct lrecord_implementation *implementation = LHEADER_IMPLEMENTATION (h); int type_index = lrecord_type_index (implementation); @@ -3454,7 +2687,9 @@ for (header = *prev; header; header = header->next) { struct lrecord_header *h = &(header->lheader); - if (!MARKED_RECORD_HEADER_P (h) && ! (header->free)) + if (!C_READONLY_RECORD_HEADER_P(h) + && !MARKED_RECORD_HEADER_P (h) + && ! (header->free)) { if (LHEADER_IMPLEMENTATION (h)->finalizer) LHEADER_IMPLEMENTATION (h)->finalizer (h, 0); @@ -3464,11 +2699,13 @@ for (header = *prev; header; ) { struct lrecord_header *h = &(header->lheader); - if (MARKED_RECORD_HEADER_P (h)) + if (C_READONLY_RECORD_HEADER_P(h) || MARKED_RECORD_HEADER_P (h)) { - UNMARK_RECORD_HEADER (h); + if (MARKED_RECORD_HEADER_P (h)) + UNMARK_RECORD_HEADER (h); num_used++; /* total_size += n->implementation->size_in_bytes (h);*/ + /* #### May modify header->next on a C_READONLY lcrecord */ prev = &(header->next); header = *prev; tick_lcrecord_stats (h, 0); @@ -3487,47 +2724,6 @@ /* *total = total_size; */ } -#ifndef LRECORD_VECTOR - -static void -sweep_vectors_1 (Lisp_Object *prev, - int *used, int *total, int *storage) -{ - Lisp_Object vector; - int num_used = 0; - int total_size = 0; - int total_storage = 0; - - for (vector = *prev; VECTORP (vector); ) - { - Lisp_Vector *v = XVECTOR (vector); - int len = v->size; - if (len < 0) /* marked */ - { - len = - (len + 1); - v->size = len; - total_size += len; - total_storage += - MALLOC_OVERHEAD + - STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, len + 1); - num_used++; - prev = &(vector_next (v)); - vector = *prev; - } - else - { - Lisp_Object next = vector_next (v); - *prev = next; - xfree (v); - vector = next; - } - } - *used = num_used; - *total = total_size; - *storage = total_storage; -} - -#endif /* ! LRECORD_VECTOR */ static void sweep_bit_vectors_1 (Lisp_Object *prev, @@ -3544,15 +2740,16 @@ { Lisp_Bit_Vector *v = XBIT_VECTOR (bit_vector); int len = v->size; - if (MARKED_RECORD_P (bit_vector)) + if (C_READONLY_RECORD_HEADER_P(&(v->lheader)) || MARKED_RECORD_P (bit_vector)) { - UNMARK_RECORD_HEADER (&(v->lheader)); + if (MARKED_RECORD_P (bit_vector)) + UNMARK_RECORD_HEADER (&(v->lheader)); total_size += len; total_storage += MALLOC_OVERHEAD + - STRETCHY_STRUCT_SIZEOF (Lisp_Bit_Vector, bits, - BIT_VECTOR_LONG_STORAGE (len)); + offsetof (Lisp_Bit_Vector, bits[BIT_VECTOR_LONG_STORAGE (len)]); num_used++; + /* #### May modify next on a C_READONLY bitvector */ prev = &(bit_vector_next (v)); bit_vector = *prev; } @@ -3597,7 +2794,11 @@ { \ num_free++; \ } \ - else if (!MARKED_##typename##_P (SFTB_victim)) \ + else if (C_READONLY_RECORD_HEADER_P (&SFTB_victim->lheader)) \ + { \ + num_used++; \ + } \ + else if (!MARKED_RECORD_HEADER_P (&SFTB_victim->lheader)) \ { \ num_free++; \ FREE_FIXED_TYPE (typename, obj_type, SFTB_victim); \ @@ -3647,7 +2848,12 @@ num_free++; \ PUT_FIXED_TYPE_ON_FREE_LIST (typename, obj_type, SFTB_victim); \ } \ - else if (!MARKED_##typename##_P (SFTB_victim)) \ + else if (C_READONLY_RECORD_HEADER_P (&SFTB_victim->lheader)) \ + { \ + SFTB_empty = 0; \ + num_used++; \ + } \ + else if (!MARKED_RECORD_HEADER_P (&SFTB_victim->lheader)) \ { \ num_free++; \ FREE_FIXED_TYPE (typename, obj_type, SFTB_victim); \ @@ -3700,21 +2906,15 @@ static void sweep_conses (void) { -#ifndef LRECORD_CONS -# define MARKED_cons_P(ptr) XMARKBIT ((ptr)->car) -# define UNMARK_cons(ptr) do { XUNMARK ((ptr)->car); } while (0) -#else /* LRECORD_CONS */ -# define MARKED_cons_P(ptr) MARKED_RECORD_HEADER_P (&((ptr)->lheader)) -# define UNMARK_cons(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) -#endif /* LRECORD_CONS */ +#define UNMARK_cons(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) #define ADDITIONAL_FREE_cons(ptr) - SWEEP_FIXED_TYPE_BLOCK (cons, struct Lisp_Cons); + SWEEP_FIXED_TYPE_BLOCK (cons, Lisp_Cons); } /* Explicitly free a cons cell. */ void -free_cons (struct Lisp_Cons *ptr) +free_cons (Lisp_Cons *ptr) { #ifdef ERROR_CHECK_GC /* If the CAR is not an int, then it will be a pointer, which will @@ -3728,7 +2928,7 @@ #endif /* ERROR_CHECK_GC */ #ifndef ALLOC_NO_POOLS - FREE_FIXED_TYPE_WHEN_NOT_IN_GC (cons, struct Lisp_Cons, ptr); + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (cons, Lisp_Cons, ptr); #endif /* ALLOC_NO_POOLS */ } @@ -3770,8 +2970,6 @@ static void sweep_compiled_functions (void) { -#define MARKED_compiled_function_P(ptr) \ - MARKED_RECORD_HEADER_P (&((ptr)->lheader)) #define UNMARK_compiled_function(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) #define ADDITIONAL_FREE_compiled_function(ptr) @@ -3783,33 +2981,25 @@ static void sweep_floats (void) { -#define MARKED_float_P(ptr) MARKED_RECORD_HEADER_P (&((ptr)->lheader)) #define UNMARK_float(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) #define ADDITIONAL_FREE_float(ptr) - SWEEP_FIXED_TYPE_BLOCK (float, struct Lisp_Float); + SWEEP_FIXED_TYPE_BLOCK (float, Lisp_Float); } #endif /* LISP_FLOAT_TYPE */ static void sweep_symbols (void) { -#ifndef LRECORD_SYMBOL -# define MARKED_symbol_P(ptr) XMARKBIT ((ptr)->plist) -# define UNMARK_symbol(ptr) do { XUNMARK ((ptr)->plist); } while (0) -#else -# define MARKED_symbol_P(ptr) MARKED_RECORD_HEADER_P (&((ptr)->lheader)) -# define UNMARK_symbol(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) -#endif /* !LRECORD_SYMBOL */ +#define UNMARK_symbol(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) #define ADDITIONAL_FREE_symbol(ptr) - SWEEP_FIXED_TYPE_BLOCK (symbol, struct Lisp_Symbol); + SWEEP_FIXED_TYPE_BLOCK (symbol, Lisp_Symbol); } static void sweep_extents (void) { -#define MARKED_extent_P(ptr) MARKED_RECORD_HEADER_P (&((ptr)->lheader)) #define UNMARK_extent(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) #define ADDITIONAL_FREE_extent(ptr) @@ -3819,17 +3009,15 @@ static void sweep_events (void) { -#define MARKED_event_P(ptr) MARKED_RECORD_HEADER_P (&((ptr)->lheader)) #define UNMARK_event(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) #define ADDITIONAL_FREE_event(ptr) - SWEEP_FIXED_TYPE_BLOCK (event, struct Lisp_Event); + SWEEP_FIXED_TYPE_BLOCK (event, Lisp_Event); } static void sweep_markers (void) { -#define MARKED_marker_P(ptr) MARKED_RECORD_HEADER_P (&((ptr)->lheader)) #define UNMARK_marker(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) #define ADDITIONAL_FREE_marker(ptr) \ do { Lisp_Object tem; \ @@ -3837,22 +3025,22 @@ unchain_marker (tem); \ } while (0) - SWEEP_FIXED_TYPE_BLOCK (marker, struct Lisp_Marker); + SWEEP_FIXED_TYPE_BLOCK (marker, Lisp_Marker); } /* Explicitly free a marker. */ void -free_marker (struct Lisp_Marker *ptr) +free_marker (Lisp_Marker *ptr) { #ifdef ERROR_CHECK_GC /* Perhaps this will catch freeing an already-freed marker. */ Lisp_Object temmy; XSETMARKER (temmy, ptr); - assert (GC_MARKERP (temmy)); + assert (MARKERP (temmy)); #endif /* ERROR_CHECK_GC */ #ifndef ALLOC_NO_POOLS - FREE_FIXED_TYPE_WHEN_NOT_IN_GC (marker, struct Lisp_Marker, ptr); + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (marker, Lisp_Marker, ptr); #endif /* ALLOC_NO_POOLS */ } @@ -3873,7 +3061,7 @@ { struct string_chars *s_chars = (struct string_chars *) &(sb->string_chars[pos]); - struct Lisp_String *string; + Lisp_String *string; int size; int fullsize; @@ -3924,7 +3112,7 @@ struct string_chars *from_s_chars = (struct string_chars *) &(from_sb->string_chars[from_pos]); struct string_chars *to_s_chars; - struct Lisp_String *string; + Lisp_String *string; int size; int fullsize; @@ -3954,11 +3142,7 @@ abort (); /* Just skip it if it isn't marked. */ -#ifdef LRECORD_STRING if (! MARKED_RECORD_HEADER_P (&(string->lheader))) -#else - if (!XMARKBIT (string->plist)) -#endif { from_pos += fullsize; continue; @@ -4013,7 +3197,7 @@ static int debug_string_purity; static void -debug_string_purity_print (struct Lisp_String *p) +debug_string_purity_print (Lisp_String *p) { Charcount i; Charcount s = string_char_length (p); @@ -4039,49 +3223,25 @@ int num_small_used = 0, num_small_bytes = 0, num_bytes = 0; int debug = debug_string_purity; -#ifdef LRECORD_STRING - -# define MARKED_string_P(ptr) MARKED_RECORD_HEADER_P (&((ptr)->lheader)) -# define UNMARK_string(ptr) \ - do { struct Lisp_String *p = (ptr); \ - int size = string_length (p); \ - UNMARK_RECORD_HEADER (&(p->lheader)); \ - num_bytes += size; \ - if (!BIG_STRING_SIZE_P (size)) \ - { num_small_bytes += size; \ - num_small_used++; \ - } \ - if (debug) debug_string_purity_print (p); \ - } while (0) -# define ADDITIONAL_FREE_string(p) \ - do { int size = string_length (p); \ - if (BIG_STRING_SIZE_P (size)) \ - xfree_1 (CHARS_TO_STRING_CHAR (string_data (p))); \ - } while (0) - -#else - -# define MARKED_string_P(ptr) XMARKBIT ((ptr)->plist) -# define UNMARK_string(ptr) \ - do { struct Lisp_String *p = (ptr); \ - int size = string_length (p); \ - XUNMARK (p->plist); \ - num_bytes += size; \ - if (!BIG_STRING_SIZE_P (size)) \ - { num_small_bytes += size; \ - num_small_used++; \ - } \ - if (debug) debug_string_purity_print (p); \ - } while (0) -# define ADDITIONAL_FREE_string(p) \ - do { int size = string_length (p); \ - if (BIG_STRING_SIZE_P (size)) \ - xfree_1 (CHARS_TO_STRING_CHAR (string_data (p))); \ - } while (0) - -#endif /* ! LRECORD_STRING */ - - SWEEP_FIXED_TYPE_BLOCK (string, struct Lisp_String); +#define UNMARK_string(ptr) do { \ + Lisp_String *p = (ptr); \ + size_t size = string_length (p); \ + UNMARK_RECORD_HEADER (&(p->lheader)); \ + num_bytes += size; \ + if (!BIG_STRING_SIZE_P (size)) \ + { num_small_bytes += size; \ + num_small_used++; \ + } \ + if (debug) \ + debug_string_purity_print (p); \ + } while (0) +#define ADDITIONAL_FREE_string(ptr) do { \ + size_t size = string_length (ptr); \ + if (BIG_STRING_SIZE_P (size)) \ + xfree (ptr->data); \ + } while (0) + + SWEEP_FIXED_TYPE_BLOCK (string, Lisp_String); gc_count_num_short_string_in_use = num_small_used; gc_count_string_total_size = num_bytes; @@ -4090,68 +3250,26 @@ /* I hate duplicating all this crap! */ -static int +int marked_p (Lisp_Object obj) { #ifdef ERROR_CHECK_GC - assert (! (GC_EQ (obj, Qnull_pointer))); + assert (! (EQ (obj, Qnull_pointer))); #endif /* Checks we used to perform. */ /* if (EQ (obj, Qnull_pointer)) return 1; */ /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return 1; */ /* if (PURIFIED (XPNTR (obj))) return 1; */ - switch (XGCTYPE (obj)) + if (XTYPE (obj) == Lisp_Type_Record) { -#ifndef LRECORD_CONS - case Lisp_Type_Cons: - { - struct Lisp_Cons *ptr = XCONS (obj); - return PURIFIED (ptr) || XMARKBIT (ptr->car); - } -#endif - case Lisp_Type_Record: - { - struct lrecord_header *lheader = XRECORD_LHEADER (obj); -#if defined (ERROR_CHECK_GC) && defined (USE_INDEXED_LRECORD_IMPLEMENTATION) - assert (lheader->type <= last_lrecord_type_index_assigned); + struct lrecord_header *lheader = XRECORD_LHEADER (obj); +#if defined (ERROR_CHECK_GC) + assert (lheader->type <= last_lrecord_type_index_assigned); #endif - return PURIFIED (lheader) || MARKED_RECORD_HEADER_P (lheader); - } -#ifndef LRECORD_STRING - case Lisp_Type_String: - { - struct Lisp_String *ptr = XSTRING (obj); - return PURIFIED (ptr) || XMARKBIT (ptr->plist); - } -#endif /* ! LRECORD_STRING */ -#ifndef LRECORD_VECTOR - case Lisp_Type_Vector: - { - struct Lisp_Vector *ptr = XVECTOR (obj); - return PURIFIED (ptr) || vector_length (ptr) < 0; - } -#endif /* !LRECORD_VECTOR */ -#ifndef LRECORD_SYMBOL - case Lisp_Type_Symbol: - { - struct Lisp_Symbol *ptr = XSYMBOL (obj); - return PURIFIED (ptr) || XMARKBIT (ptr->plist); - } -#endif - - /* Ints and Chars don't need GC */ -#if defined (USE_MINIMAL_TAGBITS) || ! defined (ERROR_CHECK_GC) - default: - return 1; -#else - default: - abort(); - case Lisp_Type_Int: - case Lisp_Type_Char: - return 1; -#endif + return C_READONLY_RECORD_HEADER_P (lheader) || MARKED_RECORD_HEADER_P (lheader); } + return 1; } static void @@ -4187,13 +3305,6 @@ /* Put all unmarked conses on free list */ sweep_conses (); -#ifndef LRECORD_VECTOR - /* Free all unmarked vectors */ - sweep_vectors_1 (&all_vectors, - &gc_count_num_vector_used, &gc_count_vector_total_size, - &gc_count_vector_storage); -#endif - /* Free all unmarked bit vectors */ sweep_bit_vectors_1 (&all_bit_vectors, &gc_count_num_bit_vector_used, @@ -4220,6 +3331,28 @@ sweep_events (); +#ifdef PDUMP + /* Unmark all dumped objects */ + { + int i; + char *p = pdump_rt_list; + if (p) + for (;;) + { + pdump_reloc_table *rt = (pdump_reloc_table *)p; + p += sizeof (pdump_reloc_table); + if (rt->desc) + { + for (i=0; i<rt->count; i++) + { + UNMARK_RECORD_HEADER ((struct lrecord_header *)(*(EMACS_INT *)p)); + p += sizeof (EMACS_INT); + } + } else + break; + } + } +#endif } /* Clearing for disksave. */ @@ -4234,7 +3367,7 @@ results of old evaluation don't look like potential problems. But first we set some notable variables to nil and do one more GC, to turn those strings into garbage. - */ + */ /* Yeah, this list is pretty ad-hoc... */ Vprocess_environment = Qnil; @@ -4247,9 +3380,7 @@ Vload_path = Qnil; /* Vdump_load_path = Qnil; */ /* Release hash tables for locate_file */ - Fset (intern ("early-package-load-path"), Qnil); - Fset (intern ("late-package-load-path"), Qnil); - Fset (intern ("last-package-load-path"), Qnil); + Flocate_file_clear_hashing (Qt); uncache_home_directory(); #if defined(LOADHIST) && !(defined(LOADHIST_DUMPED) || \ @@ -4263,14 +3394,6 @@ /* Run the disksave finalization methods of all live objects. */ disksave_object_finalization_1 (); -#if 0 /* I don't see any point in this. The purespace starts out all 0's */ - /* Zero out the unused portion of purespace */ - if (!pure_lossage) - memset ( (char *) (PUREBEG + pure_bytes_used), 0, - (((char *) (PUREBEG + get_PURESIZE())) - - ((char *) (PUREBEG + pure_bytes_used)))); -#endif - /* Zero out the uninitialized (really, unused) part of the containers for the live strings. */ { @@ -4280,10 +3403,11 @@ int count = sizeof (scb->string_chars) - scb->pos; assert (count >= 0 && count < STRING_CHARS_BLOCK_SIZE); - if (count != 0) { - /* from the block's fill ptr to the end */ - memset ((scb->string_chars + scb->pos), 0, count); - } + if (count != 0) + { + /* from the block's fill ptr to the end */ + memset ((scb->string_chars + scb->pos), 0, count); + } } } @@ -4380,7 +3504,7 @@ : 0); Lisp_Object args[2], whole_msg; args[0] = build_string (msg ? msg : - GETTEXT ((CONST char *) gc_default_message)); + GETTEXT ((const char *) gc_default_message)); args[1] = build_string ("..."); whole_msg = Fconcat (2, args); echo_area_message (f, (Bufbyte *) 0, whole_msg, 0, -1, @@ -4431,6 +3555,8 @@ int i; for (i = 0; i < staticidx; i++) mark_object (*(staticvec[i])); + for (i = 0; i < staticidx_nodump; i++) + mark_object (*(staticvec_nodump[i])); } { /* GCPRO() */ @@ -4475,8 +3601,8 @@ } } - mark_redisplay (mark_object); - mark_profiling_info (mark_object); + mark_redisplay (); + mark_profiling_info (); /* OK, now do the after-mark stuff. This is for things that are only marked when something else is marked (e.g. weak hash tables). @@ -4485,18 +3611,18 @@ weak hash table, the former one might get marked. So we have to iterate until nothing more gets marked. */ - while (finish_marking_weak_hash_tables (marked_p, mark_object) > 0 || - finish_marking_weak_lists (marked_p, mark_object) > 0) + while (finish_marking_weak_hash_tables () > 0 || + finish_marking_weak_lists () > 0) ; /* And prune (this needs to be called after everything else has been marked and before we do any sweeping). */ /* #### this is somewhat ad-hoc and should probably be an object method */ - prune_weak_hash_tables (marked_p); - prune_weak_lists (marked_p); - prune_specifiers (marked_p); - prune_syntax_tables (marked_p); + prune_weak_hash_tables (); + prune_weak_lists (); + prune_specifiers (); + prune_syntax_tables (); gc_sweep (); @@ -4530,7 +3656,7 @@ { Lisp_Object args[2], whole_msg; args[0] = build_string (msg ? msg : - GETTEXT ((CONST char *) + GETTEXT ((const char *) gc_default_message)); args[1] = build_string ("... done"); whole_msg = Fconcat (2, args); @@ -4556,7 +3682,7 @@ /* Debugging aids. */ static Lisp_Object -gc_plist_hack (CONST char *name, int value, Lisp_Object tail) +gc_plist_hack (const char *name, int value, Lisp_Object tail) { /* C doesn't have local functions (or closures, or GC, or readable syntax, or portable numeric datatypes, or bit-vectors, or characters, or @@ -4586,30 +3712,24 @@ { Lisp_Object pl = Qnil; int i; -#ifdef LRECORD_VECTOR int gc_count_vector_total_size = 0; -#endif - - if (purify_flag && pure_lossage) - return Qnil; garbage_collect_1 (); - for (i = 0; i < last_lrecord_type_index_assigned; i++) + for (i = 0; i <= last_lrecord_type_index_assigned; i++) { if (lcrecord_stats[i].bytes_in_use != 0 || lcrecord_stats[i].bytes_freed != 0 || lcrecord_stats[i].instances_on_free_list != 0) { char buf [255]; - CONST char *name = lrecord_implementations_table[i]->name; + const char *name = lrecord_implementations_table[i]->name; int len = strlen (name); -#ifdef LRECORD_VECTOR /* save this for the FSFmacs-compatible part of the summary */ - if (i == *lrecord_vector[0].lrecord_type_index) + if (i == *lrecord_vector.lrecord_type_index) gc_count_vector_total_size = lcrecord_stats[i].bytes_in_use + lcrecord_stats[i].bytes_freed; -#endif + sprintf (buf, "%s-storage", name); pl = gc_plist_hack (buf, lcrecord_stats[i].bytes_in_use, pl); /* Okay, simple pluralization check for `symbol-value-varalias' */ @@ -4668,13 +3788,6 @@ pl = gc_plist_hack ("compiled-functions-used", gc_count_num_compiled_function_in_use, pl); -#ifndef LRECORD_VECTOR - pl = gc_plist_hack ("vector-storage", gc_count_vector_storage, pl); - pl = gc_plist_hack ("vectors-total-length", - gc_count_vector_total_size, pl); - pl = gc_plist_hack ("vectors-used", gc_count_num_vector_used, pl); -#endif - pl = gc_plist_hack ("bit-vector-storage", gc_count_bit_vector_storage, pl); pl = gc_plist_hack ("bit-vectors-total-length", gc_count_bit_vector_total_size, pl); @@ -4714,6 +3827,7 @@ return make_int (consing_since_gc); } +#if 0 DEFUN ("memory-limit", Fmemory_limit, 0, 0, "", /* Return the address of the last byte Emacs has allocated, divided by 1024. This may be helpful in debugging Emacs's memory usage. @@ -4723,7 +3837,7 @@ { return make_int ((EMACS_INT) sbrk (0) / 1024); } - +#endif int @@ -4877,46 +3991,10 @@ /* Initialization */ void -init_alloc_once_early (void) +reinit_alloc_once_early (void) { - int iii; - - last_lrecord_type_index_assigned = -1; - for (iii = 0; iii < countof (lrecord_implementations_table); iii++) - { - lrecord_implementations_table[iii] = 0; - } - -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION - /* - * If USE_INDEXED_LRECORD_IMPLEMENTATION is defined, all the staticly - * defined subr lrecords were initialized with lheader->type == 0. - * See subr_lheader_initializer in lisp.h. Force type index 0 to be - * assigned to lrecord_subr so that those predefined indexes match - * reality. - */ - lrecord_type_index (lrecord_subr); - assert (*(lrecord_subr[0].lrecord_type_index) == 0); - /* - * The same is true for symbol_value_forward objects, except the - * type is 1. - */ - lrecord_type_index (lrecord_symbol_value_forward); - assert (*(lrecord_symbol_value_forward[0].lrecord_type_index) == 1); -#endif /* USE_INDEXED_LRECORD_IMPLEMENTATION */ - - symbols_initialized = 0; - gc_generation_number[0] = 0; - /* purify_flag 1 is correct even if CANNOT_DUMP. - * loadup.el will set to nil at end. */ - purify_flag = 1; - pure_bytes_used = 0; - pure_lossage = 0; breathing_space = 0; -#ifndef LRECORD_VECTOR - XSETINT (all_vectors, 0); /* Qzero may not be set yet. */ -#endif XSETINT (all_bit_vectors, 0); /* Qzero may not be set yet. */ XSETINT (Vgc_message, 0); all_lcrecords = 0; @@ -4941,7 +4019,11 @@ init_event_alloc (); ignore_malloc_warnings = 0; - staticidx = 0; + + staticidx_nodump = 0; + dumpstructidx = 0; + pdump_wireidx = 0; + consing_since_gc = 0; #if 1 gc_cons_threshold = 500000; /* XEmacs change */ @@ -4971,6 +4053,40 @@ } void +init_alloc_once_early (void) +{ + int iii; + + reinit_alloc_once_early (); + + last_lrecord_type_index_assigned = -1; + for (iii = 0; iii < countof (lrecord_implementations_table); iii++) + { + lrecord_implementations_table[iii] = 0; + } + + /* + * All the staticly + * defined subr lrecords were initialized with lheader->type == 0. + * See subr_lheader_initializer in lisp.h. Force type index 0 to be + * assigned to lrecord_subr so that those predefined indexes match + * reality. + */ + lrecord_type_index (&lrecord_subr); + assert (*(lrecord_subr.lrecord_type_index) == 0); + /* + * The same is true for symbol_value_forward objects, except the + * type is 1. + */ + lrecord_type_index (&lrecord_symbol_value_forward); + assert (*(lrecord_symbol_value_forward.lrecord_type_index) == 1); + + staticidx = 0; +} + +int pure_bytes_used = 0; + +void reinit_alloc (void) { gcprolist = 0; @@ -4997,7 +4113,9 @@ DEFSUBR (Fmake_marker); DEFSUBR (Fpurecopy); DEFSUBR (Fgarbage_collect); +#if 0 DEFSUBR (Fmemory_limit); +#endif DEFSUBR (Fconsing_since_gc); } @@ -5049,7 +4167,7 @@ DEFVAR_BOOL ("purify-flag", &purify_flag /* Non-nil means loading Lisp code in order to dump an executable. -This means that certain objects should be allocated in shared (pure) space. +This means that certain objects should be allocated in readonly space. */ ); DEFVAR_LISP ("pre-gc-hook", &Vpre_gc_hook /* @@ -5075,9 +4193,7 @@ image instance) in the domain of the selected frame, the mouse pointer will change instead of this message being printed. */ ); - Vgc_message = make_pure_string ((CONST Bufbyte *) gc_default_message, - countof (gc_default_message) - 1, - Qnil, 1); + Vgc_message = build_string (gc_default_message); DEFVAR_LISP ("gc-pointer-glyph", &Vgc_pointer_glyph /* Pointer glyph used to indicate that a garbage collection is in progress. @@ -5094,3 +4210,1049 @@ { Vgc_pointer_glyph = Fmake_glyph_internal (Qpointer); } + + +#ifdef PDUMP + +/* The structure of the file + * + * 0 - header + * 256 - dumped objects + * stab_offset - nb_staticpro*(Lisp_Object *) from staticvec + * - nb_staticpro*(relocated Lisp_Object) pointed to by staticpro + * - nb_structdmp*pair(void *, adr) for pointers to structures + * - lrecord_implementations_table[] + * - relocation table + * - wired variable address/value couples with the count preceding the list + */ +typedef struct +{ + char signature[8]; + EMACS_UINT stab_offset; + EMACS_UINT reloc_address; + int nb_staticpro; + int nb_structdmp; + int nb_opaquedmp; + int last_type; +} dump_header; + +char *pdump_start, *pdump_end; + +static const unsigned char align_table[256] = +{ + 8, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, + 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, + 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, + 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, + 6, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, + 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, + 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, + 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, + 7, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, + 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, + 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, + 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, + 6, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, + 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, + 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, + 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0 +}; + +typedef struct pdump_entry_list_elmt +{ + struct pdump_entry_list_elmt *next; + const void *obj; + size_t size; + int count; + int is_lrecord; + EMACS_INT save_offset; +} pdump_entry_list_elmt; + +typedef struct +{ + pdump_entry_list_elmt *first; + int align; + int count; +} pdump_entry_list; + +typedef struct pdump_struct_list_elmt +{ + pdump_entry_list list; + const struct struct_description *sdesc; +} pdump_struct_list_elmt; + +typedef struct +{ + pdump_struct_list_elmt *list; + int count; + int size; +} pdump_struct_list; + +static pdump_entry_list pdump_object_table[256]; +static pdump_entry_list pdump_opaque_data_list; +static pdump_struct_list pdump_struct_table; +static pdump_entry_list_elmt *pdump_qnil; + +static int pdump_alert_undump_object[256]; + +static unsigned long cur_offset; +static size_t max_size; +static int pdump_fd; +static void *pdump_buf; + +#define PDUMP_HASHSIZE 200001 + +static pdump_entry_list_elmt **pdump_hash; + +/* Since most pointers are eight bytes aligned, the >>3 allows for a better hash */ +static int +pdump_make_hash (const void *obj) +{ + return ((unsigned long)(obj)>>3) % PDUMP_HASHSIZE; +} + +static pdump_entry_list_elmt * +pdump_get_entry (const void *obj) +{ + int pos = pdump_make_hash (obj); + pdump_entry_list_elmt *e; + + assert (obj != 0); + + while ((e = pdump_hash[pos]) != 0) + { + if (e->obj == obj) + return e; + + pos++; + if (pos == PDUMP_HASHSIZE) + pos = 0; + } + return 0; +} + +static void +pdump_add_entry (pdump_entry_list *list, const void *obj, size_t size, int count, int is_lrecord) +{ + pdump_entry_list_elmt *e; + int align; + int pos = pdump_make_hash (obj); + + while ((e = pdump_hash[pos]) != 0) + { + if (e->obj == obj) + return; + + pos++; + if (pos == PDUMP_HASHSIZE) + pos = 0; + } + + e = xnew (pdump_entry_list_elmt); + + e->next = list->first; + e->obj = obj; + e->size = size; + e->count = count; + e->is_lrecord = is_lrecord; + list->first = e; + + list->count += count; + pdump_hash[pos] = e; + + align = align_table[size & 255]; + if (align < 2 && is_lrecord) + align = 2; + + if (align < list->align) + list->align = align; +} + +static pdump_entry_list * +pdump_get_entry_list (const struct struct_description *sdesc) +{ + int i; + for (i=0; i<pdump_struct_table.count; i++) + if (pdump_struct_table.list[i].sdesc == sdesc) + return &pdump_struct_table.list[i].list; + + if (pdump_struct_table.size <= pdump_struct_table.count) + { + if (pdump_struct_table.size == -1) + pdump_struct_table.size = 10; + else + pdump_struct_table.size = pdump_struct_table.size * 2; + pdump_struct_table.list = (pdump_struct_list_elmt *) + xrealloc (pdump_struct_table.list, + pdump_struct_table.size * sizeof (pdump_struct_list_elmt)); + } + pdump_struct_table.list[pdump_struct_table.count].list.first = 0; + pdump_struct_table.list[pdump_struct_table.count].list.align = 8; + pdump_struct_table.list[pdump_struct_table.count].list.count = 0; + pdump_struct_table.list[pdump_struct_table.count].sdesc = sdesc; + + return &pdump_struct_table.list[pdump_struct_table.count++].list; +} + +static struct +{ + struct lrecord_header *obj; + int position; + int offset; +} backtrace[65536]; + +static int depth; + +static void pdump_backtrace (void) +{ + int i; + fprintf (stderr, "pdump backtrace :\n"); + for (i=0;i<depth;i++) + { + if (!backtrace[i].obj) + fprintf (stderr, " - ind. (%d, %d)\n", backtrace[i].position, backtrace[i].offset); + else + { + fprintf (stderr, " - %s (%d, %d)\n", + LHEADER_IMPLEMENTATION (backtrace[i].obj)->name, + backtrace[i].position, + backtrace[i].offset); + } + } +} + +static void pdump_register_object (Lisp_Object obj); +static void pdump_register_struct (const void *data, const struct struct_description *sdesc, int count); + +static EMACS_INT +pdump_get_indirect_count (EMACS_INT code, const struct lrecord_description *idesc, const void *idata) +{ + EMACS_INT count; + const void *irdata; + + int line = XD_INDIRECT_VAL (code); + int delta = XD_INDIRECT_DELTA (code); + + irdata = ((char *)idata) + idesc[line].offset; + switch (idesc[line].type) + { + case XD_SIZE_T: + count = *(size_t *)irdata; + break; + case XD_INT: + count = *(int *)irdata; + break; + case XD_LONG: + count = *(long *)irdata; + break; + case XD_BYTECOUNT: + count = *(Bytecount *)irdata; + break; + default: + fprintf (stderr, "Unsupported count type : %d (line = %d, code=%ld)\n", idesc[line].type, line, (long)code); + pdump_backtrace (); + abort (); + } + count += delta; + return count; +} + +static void +pdump_register_sub (const void *data, const struct lrecord_description *desc, int me) +{ + int pos; + + restart: + for (pos = 0; desc[pos].type != XD_END; pos++) + { + const void *rdata = (const char *)data + desc[pos].offset; + + backtrace[me].position = pos; + backtrace[me].offset = desc[pos].offset; + + switch (desc[pos].type) + { + case XD_SPECIFIER_END: + pos = 0; + desc = ((const Lisp_Specifier *)data)->methods->extra_description; + goto restart; + case XD_SIZE_T: + case XD_INT: + case XD_LONG: + case XD_BYTECOUNT: + case XD_LO_RESET_NIL: + case XD_INT_RESET: + case XD_LO_LINK: + break; + case XD_OPAQUE_DATA_PTR: + { + EMACS_INT count = desc[pos].data1; + if (XD_IS_INDIRECT (count)) + count = pdump_get_indirect_count (count, desc, data); + + pdump_add_entry (&pdump_opaque_data_list, + *(void **)rdata, + count, + 1, + 0); + break; + } + case XD_C_STRING: + { + const char *str = *(const char **)rdata; + if (str) + pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1, 0); + break; + } + case XD_DOC_STRING: + { + const char *str = *(const char **)rdata; + if ((EMACS_INT)str > 0) + pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1, 0); + break; + } + case XD_LISP_OBJECT: + { + const Lisp_Object *pobj = (const Lisp_Object *)rdata; + + assert (desc[pos].data1 == 0); + + backtrace[me].offset = (const char *)pobj - (const char *)data; + pdump_register_object (*pobj); + break; + } + case XD_LISP_OBJECT_ARRAY: + { + int i; + EMACS_INT count = desc[pos].data1; + if (XD_IS_INDIRECT (count)) + count = pdump_get_indirect_count (count, desc, data); + + for (i = 0; i < count; i++) + { + const Lisp_Object *pobj = ((const Lisp_Object *)rdata) + i; + Lisp_Object dobj = *pobj; + + backtrace[me].offset = (const char *)pobj - (const char *)data; + pdump_register_object (dobj); + } + break; + } + case XD_STRUCT_PTR: + { + EMACS_INT count = desc[pos].data1; + const struct struct_description *sdesc = desc[pos].data2; + const char *dobj = *(const char **)rdata; + if (dobj) + { + if (XD_IS_INDIRECT (count)) + count = pdump_get_indirect_count (count, desc, data); + + pdump_register_struct (dobj, sdesc, count); + } + break; + } + default: + fprintf (stderr, "Unsupported dump type : %d\n", desc[pos].type); + pdump_backtrace (); + abort (); + }; + } +} + +static void +pdump_register_object (Lisp_Object obj) +{ + struct lrecord_header *objh; + + if (!POINTER_TYPE_P (XTYPE (obj))) + return; + + objh = XRECORD_LHEADER (obj); + if (!objh) + return; + + if (pdump_get_entry (objh)) + return; + + if (LHEADER_IMPLEMENTATION (objh)->description) + { + int me = depth++; + if (me>65536) + { + fprintf (stderr, "Backtrace overflow, loop ?\n"); + abort (); + } + backtrace[me].obj = objh; + backtrace[me].position = 0; + backtrace[me].offset = 0; + + pdump_add_entry (pdump_object_table + objh->type, + objh, + LHEADER_IMPLEMENTATION (objh)->static_size ? + LHEADER_IMPLEMENTATION (objh)->static_size : + LHEADER_IMPLEMENTATION (objh)->size_in_bytes_method (objh), + 1, + 1); + pdump_register_sub (objh, + LHEADER_IMPLEMENTATION (objh)->description, + me); + --depth; + } + else + { + pdump_alert_undump_object[objh->type]++; + fprintf (stderr, "Undumpable object type : %s\n", LHEADER_IMPLEMENTATION (objh)->name); + pdump_backtrace (); + } +} + +static void +pdump_register_struct (const void *data, const struct struct_description *sdesc, int count) +{ + if (data && !pdump_get_entry (data)) + { + int me = depth++; + int i; + if (me>65536) + { + fprintf (stderr, "Backtrace overflow, loop ?\n"); + abort (); + } + backtrace[me].obj = 0; + backtrace[me].position = 0; + backtrace[me].offset = 0; + + pdump_add_entry (pdump_get_entry_list (sdesc), + data, + sdesc->size, + count, + 0); + for (i=0; i<count; i++) + { + pdump_register_sub (((char *)data) + sdesc->size*i, + sdesc->description, + me); + } + --depth; + } +} + +static void +pdump_dump_data (pdump_entry_list_elmt *elmt, const struct lrecord_description *desc) +{ + size_t size = elmt->size; + int count = elmt->count; + if (desc) + { + int pos, i; + memcpy (pdump_buf, elmt->obj, size*count); + + for (i=0; i<count; i++) + { + char *cur = ((char *)pdump_buf) + i*size; + restart: + for (pos = 0; desc[pos].type != XD_END; pos++) + { + void *rdata = cur + desc[pos].offset; + switch (desc[pos].type) + { + case XD_SPECIFIER_END: + desc = ((const Lisp_Specifier *)(elmt->obj))->methods->extra_description; + goto restart; + case XD_SIZE_T: + case XD_INT: + case XD_LONG: + case XD_BYTECOUNT: + break; + case XD_LO_RESET_NIL: + { + EMACS_INT count = desc[pos].data1; + int i; + if (XD_IS_INDIRECT (count)) + count = pdump_get_indirect_count (count, desc, elmt->obj); + for (i=0; i<count; i++) + ((EMACS_INT *)rdata)[i] = pdump_qnil->save_offset; + break; + } + case XD_INT_RESET: + { + EMACS_INT val = desc[pos].data1; + if (XD_IS_INDIRECT (val)) + val = pdump_get_indirect_count (val, desc, elmt->obj); + *(int *)rdata = val; + break; + } + case XD_OPAQUE_DATA_PTR: + case XD_C_STRING: + case XD_STRUCT_PTR: + { + void *ptr = *(void **)rdata; + if (ptr) + *(EMACS_INT *)rdata = pdump_get_entry (ptr)->save_offset; + break; + } + case XD_LO_LINK: + { + Lisp_Object obj = *(Lisp_Object *)rdata; + pdump_entry_list_elmt *elmt1; + for (;;) + { + elmt1 = pdump_get_entry (XRECORD_LHEADER (obj)); + if (elmt1) + break; + obj = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj))); + } + *(EMACS_INT *)rdata = elmt1->save_offset; + break; + } + case XD_LISP_OBJECT: + { + Lisp_Object *pobj = (Lisp_Object *) rdata; + + assert (desc[pos].data1 == 0); + + if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj)) + *(EMACS_INT *)pobj = + pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset; + break; + } + case XD_LISP_OBJECT_ARRAY: + { + EMACS_INT count = desc[pos].data1; + int i; + if (XD_IS_INDIRECT (count)) + count = pdump_get_indirect_count (count, desc, elmt->obj); + + for (i=0; i<count; i++) + { + Lisp_Object *pobj = ((Lisp_Object *)rdata) + i; + if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj)) + *(EMACS_INT *)pobj = + pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset; + } + break; + } + case XD_DOC_STRING: + { + EMACS_INT str = *(EMACS_INT *)rdata; + if (str > 0) + *(EMACS_INT *)rdata = pdump_get_entry ((void *)str)->save_offset; + break; + } + default: + fprintf (stderr, "Unsupported dump type : %d\n", desc[pos].type); + abort (); + }; + } + } + } + write (pdump_fd, desc ? pdump_buf : elmt->obj, size*count); + if (elmt->is_lrecord && ((size*count) & 3)) + write (pdump_fd, "\0\0\0", 4-((size*count) & 3)); +} + +static void +pdump_reloc_one (void *data, EMACS_INT delta, const struct lrecord_description *desc) +{ + int pos; + + restart: + for (pos = 0; desc[pos].type != XD_END; pos++) + { + void *rdata = (char *)data + desc[pos].offset; + switch (desc[pos].type) + { + case XD_SPECIFIER_END: + pos = 0; + desc = ((const Lisp_Specifier *)data)->methods->extra_description; + goto restart; + case XD_SIZE_T: + case XD_INT: + case XD_LONG: + case XD_BYTECOUNT: + case XD_INT_RESET: + break; + case XD_OPAQUE_DATA_PTR: + case XD_C_STRING: + case XD_STRUCT_PTR: + case XD_LO_LINK: + { + EMACS_INT ptr = *(EMACS_INT *)rdata; + if (ptr) + *(EMACS_INT *)rdata = ptr+delta; + break; + } + case XD_LISP_OBJECT: + { + Lisp_Object *pobj = (Lisp_Object *) rdata; + + assert (desc[pos].data1 == 0); + + if (POINTER_TYPE_P (XTYPE (*pobj)) + && ! EQ (*pobj, Qnull_pointer)) + XSETOBJ (*pobj, XTYPE (*pobj), (char *) XPNTR (*pobj) + delta); + + break; + } + case XD_LISP_OBJECT_ARRAY: + case XD_LO_RESET_NIL: + { + EMACS_INT count = desc[pos].data1; + int i; + if (XD_IS_INDIRECT (count)) + count = pdump_get_indirect_count (count, desc, data); + + for (i=0; i<count; i++) + { + Lisp_Object *pobj = (Lisp_Object *) rdata + i; + + if (POINTER_TYPE_P (XTYPE (*pobj)) + && ! EQ (*pobj, Qnull_pointer)) + XSETOBJ (*pobj, XTYPE (*pobj), (char *) XPNTR (*pobj) + delta); + } + break; + } + case XD_DOC_STRING: + { + EMACS_INT str = *(EMACS_INT *)rdata; + if (str > 0) + *(EMACS_INT *)rdata = str + delta; + break; + } + default: + fprintf (stderr, "Unsupported dump type : %d\n", desc[pos].type); + abort (); + }; + } +} + +static void +pdump_allocate_offset (pdump_entry_list_elmt *elmt, const struct lrecord_description *desc) +{ + size_t size = (elmt->is_lrecord ? (elmt->size + 3) & ~3 : elmt->size)*elmt->count; + elmt->save_offset = cur_offset; + if (size>max_size) + max_size = size; + cur_offset += size; +} + +static void +pdump_scan_by_alignment (void (*f)(pdump_entry_list_elmt *, const struct lrecord_description *)) +{ + int align, i; + const struct lrecord_description *idesc; + pdump_entry_list_elmt *elmt; + for (align=8; align>=0; align--) + { + for (i=0; i<=last_lrecord_type_index_assigned; i++) + if (pdump_object_table[i].align == align) + { + elmt = pdump_object_table[i].first; + if (!elmt) + continue; + idesc = lrecord_implementations_table[i]->description; + while (elmt) + { + f (elmt, idesc); + elmt = elmt->next; + } + } + + for (i=0; i<pdump_struct_table.count; i++) + if (pdump_struct_table.list[i].list.align == align) + { + elmt = pdump_struct_table.list[i].list.first; + idesc = pdump_struct_table.list[i].sdesc->description; + while (elmt) + { + f (elmt, idesc); + elmt = elmt->next; + } + } + + elmt = pdump_opaque_data_list.first; + while (elmt) + { + if (align_table[elmt->size & 255] == align) + f (elmt, 0); + elmt = elmt->next; + } + } +} + +static void +pdump_dump_staticvec (void) +{ + EMACS_INT *reloc = xnew_array (EMACS_INT, staticidx); + int i; + write (pdump_fd, staticvec, staticidx*sizeof (Lisp_Object *)); + + for (i=0; i<staticidx; i++) + { + Lisp_Object obj = *staticvec[i]; + if (POINTER_TYPE_P (XTYPE (obj))) + reloc[i] = pdump_get_entry (XRECORD_LHEADER (obj))->save_offset; + else + reloc[i] = *(EMACS_INT *)(staticvec[i]); + } + write (pdump_fd, reloc, staticidx*sizeof (Lisp_Object)); + free (reloc); +} + +static void +pdump_dump_structvec (void) +{ + int i; + for (i=0; i<dumpstructidx; i++) + { + EMACS_INT adr; + write (pdump_fd, &(dumpstructvec[i].data), sizeof (void *)); + adr = pdump_get_entry (*(void **)(dumpstructvec[i].data))->save_offset; + write (pdump_fd, &adr, sizeof (adr)); + } +} + +static void +pdump_dump_opaquevec (void) +{ + int i; + for (i=0; i<dumpopaqueidx; i++) + { + write (pdump_fd, &(dumpopaquevec[i]), sizeof (dumpopaquevec[i])); + write (pdump_fd, dumpopaquevec[i].data, dumpopaquevec[i].size); + } +} + +static void +pdump_dump_itable (void) +{ + write (pdump_fd, lrecord_implementations_table, sizeof (lrecord_implementations_table)); +} + +static void +pdump_dump_rtables (void) +{ + int i, j; + pdump_entry_list_elmt *elmt; + pdump_reloc_table rt; + + for (i=0; i<=last_lrecord_type_index_assigned; i++) + { + elmt = pdump_object_table[i].first; + if (!elmt) + continue; + rt.desc = lrecord_implementations_table[i]->description; + rt.count = pdump_object_table[i].count; + write (pdump_fd, &rt, sizeof (rt)); + while (elmt) + { + EMACS_INT rdata = pdump_get_entry (elmt->obj)->save_offset; + write (pdump_fd, &rdata, sizeof (rdata)); + elmt = elmt->next; + } + } + + rt.desc = 0; + rt.count = 0; + write (pdump_fd, &rt, sizeof (rt)); + + for (i=0; i<pdump_struct_table.count; i++) + { + elmt = pdump_struct_table.list[i].list.first; + rt.desc = pdump_struct_table.list[i].sdesc->description; + rt.count = pdump_struct_table.list[i].list.count; + write (pdump_fd, &rt, sizeof (rt)); + while (elmt) + { + EMACS_INT rdata = pdump_get_entry (elmt->obj)->save_offset; + for (j=0; j<elmt->count; j++) + { + write (pdump_fd, &rdata, sizeof (rdata)); + rdata += elmt->size; + } + elmt = elmt->next; + } + } + rt.desc = 0; + rt.count = 0; + write (pdump_fd, &rt, sizeof (rt)); +} + +static void +pdump_dump_wired (void) +{ + EMACS_INT count = pdump_wireidx + pdump_wireidx_list; + int i; + + write (pdump_fd, &count, sizeof (count)); + + for (i=0; i<pdump_wireidx; i++) + { + EMACS_INT obj = pdump_get_entry (XRECORD_LHEADER (*(pdump_wirevec[i])))->save_offset; + write (pdump_fd, &pdump_wirevec[i], sizeof (pdump_wirevec[i])); + write (pdump_fd, &obj, sizeof (obj)); + } + + for (i=0; i<pdump_wireidx_list; i++) + { + Lisp_Object obj = *(pdump_wirevec_list[i]); + pdump_entry_list_elmt *elmt; + EMACS_INT res; + + for (;;) + { + const struct lrecord_description *desc; + int pos; + elmt = pdump_get_entry (XRECORD_LHEADER (obj)); + if (elmt) + break; + desc = XRECORD_LHEADER_IMPLEMENTATION (obj)->description; + for (pos = 0; desc[pos].type != XD_LO_LINK; pos++) + if (desc[pos].type == XD_END) + abort (); + + obj = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj))); + } + res = elmt->save_offset; + + write (pdump_fd, &pdump_wirevec_list[i], sizeof (pdump_wirevec_list[i])); + write (pdump_fd, &res, sizeof (res)); + } +} + +void +pdump (void) +{ + int i; + Lisp_Object t_console, t_device, t_frame; + int none; + dump_header hd; + + /* These appear in a DEFVAR_LISP, which does a staticpro() */ + t_console = Vterminal_console; + t_frame = Vterminal_frame; + t_device = Vterminal_device; + + Vterminal_console = Qnil; + Vterminal_frame = Qnil; + Vterminal_device = Qnil; + + pdump_hash = xnew_array_and_zero (pdump_entry_list_elmt *, PDUMP_HASHSIZE); + + for (i=0; i<=last_lrecord_type_index_assigned; i++) + { + pdump_object_table[i].first = 0; + pdump_object_table[i].align = 8; + pdump_object_table[i].count = 0; + pdump_alert_undump_object[i] = 0; + } + pdump_struct_table.count = 0; + pdump_struct_table.size = -1; + + pdump_opaque_data_list.first = 0; + pdump_opaque_data_list.align = 8; + pdump_opaque_data_list.count = 0; + depth = 0; + + for (i=0; i<staticidx; i++) + pdump_register_object (*staticvec[i]); + for (i=0; i<pdump_wireidx; i++) + pdump_register_object (*pdump_wirevec[i]); + + none = 1; + for (i=0; i<=last_lrecord_type_index_assigned; i++) + if (pdump_alert_undump_object[i]) + { + if (none) + printf ("Undumpable types list :\n"); + none = 0; + printf (" - %s (%d)\n", lrecord_implementations_table[i]->name, pdump_alert_undump_object[i]); + } + if (!none) + return; + + for (i=0; i<dumpstructidx; i++) + pdump_register_struct (*(void **)(dumpstructvec[i].data), dumpstructvec[i].desc, 1); + + memcpy (hd.signature, "XEmacsDP", 8); + hd.reloc_address = 0; + hd.nb_staticpro = staticidx; + hd.nb_structdmp = dumpstructidx; + hd.nb_opaquedmp = dumpopaqueidx; + hd.last_type = last_lrecord_type_index_assigned; + + cur_offset = 256; + max_size = 0; + + pdump_scan_by_alignment (pdump_allocate_offset); + pdump_qnil = pdump_get_entry (XRECORD_LHEADER (Qnil)); + + pdump_buf = xmalloc (max_size); + /* Avoid use of the `open' macro. We want the real function. */ +#undef open + pdump_fd = open ("xemacs.dmp", + O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, 0666); + hd.stab_offset = (cur_offset + 3) & ~3; + + write (pdump_fd, &hd, sizeof (hd)); + lseek (pdump_fd, 256, SEEK_SET); + + pdump_scan_by_alignment (pdump_dump_data); + + lseek (pdump_fd, hd.stab_offset, SEEK_SET); + + pdump_dump_staticvec (); + pdump_dump_structvec (); + pdump_dump_opaquevec (); + pdump_dump_itable (); + pdump_dump_rtables (); + pdump_dump_wired (); + + close (pdump_fd); + free (pdump_buf); + + free (pdump_hash); + + Vterminal_console = t_console; + Vterminal_frame = t_frame; + Vterminal_device = t_device; +} + +int +pdump_load (void) +{ + size_t length; + int i; + char *p; + EMACS_INT delta; + EMACS_INT count; + +#define PDUMP_READ(p, type) (p = (char*) (((type *) p) + 1), *((type *) p - 1)) + + pdump_start = pdump_end = 0; + + pdump_fd = open ("xemacs.dmp", O_RDONLY | OPEN_BINARY); + if (pdump_fd<0) + return 0; + + length = lseek (pdump_fd, 0, SEEK_END); + lseek (pdump_fd, 0, SEEK_SET); + +#ifdef HAVE_MMAP + pdump_start = (char *) mmap (0, length, PROT_READ|PROT_WRITE, MAP_PRIVATE, pdump_fd, 0); + if (pdump_start == MAP_FAILED) + pdump_start = 0; +#endif + + if (!pdump_start) + { + pdump_start = (char *)((((unsigned long)(xmalloc(length+255))) + 255) & ~255); + read (pdump_fd, pdump_start, length); + } + + close (pdump_fd); + + pdump_end = pdump_start + length; + + staticidx = ((dump_header *)(pdump_start))->nb_staticpro; + last_lrecord_type_index_assigned = ((dump_header *)pdump_start)->last_type; + delta = ((EMACS_INT)pdump_start) - ((dump_header *)pdump_start)->reloc_address; + p = pdump_start + ((dump_header *)pdump_start)->stab_offset; + + /* Put back the staticvec in place */ + memcpy (staticvec, p, staticidx*sizeof (Lisp_Object *)); + p += staticidx*sizeof (Lisp_Object *); + for (i=0; i<staticidx; i++) + { + Lisp_Object obj = PDUMP_READ (p, Lisp_Object); + if (POINTER_TYPE_P (XTYPE (obj))) + XSETOBJ (obj, XTYPE (obj), (char *) XPNTR (obj) + delta); + *staticvec[i] = obj; + } + + /* Put back the dumpstructs */ + for (i=0; i<((dump_header *)pdump_start)->nb_structdmp; i++) + { + void **adr = PDUMP_READ (p, void **); + *adr = (void *) (PDUMP_READ (p, char *) + delta); + } + + /* Put back the opaques */ + for (i=0; i<((dump_header *)pdump_start)->nb_opaquedmp; i++) + { + struct dumpopaque_info di = PDUMP_READ (p, struct dumpopaque_info); + memcpy (di.data, p, di.size); + p += di.size; + } + + /* Put back the lrecord_implementations_table */ + memcpy (lrecord_implementations_table, p, sizeof (lrecord_implementations_table)); + p += sizeof (lrecord_implementations_table); + + /* Give back their numbers to the lrecord implementations */ + for (i = 0; i < countof (lrecord_implementations_table); i++) + if (lrecord_implementations_table[i]) + { + *(lrecord_implementations_table[i]->lrecord_type_index) = i; + last_lrecord_type_index_assigned = i; + } + + /* Do the relocations */ + pdump_rt_list = p; + count = 2; + for (;;) + { + pdump_reloc_table rt = PDUMP_READ (p, pdump_reloc_table); + if (rt.desc) + { + for (i=0; i < rt.count; i++) + { + char *adr = delta + *(char **)p; + *(char **)p = adr; + pdump_reloc_one (adr, delta, rt.desc); + p += sizeof (char *); + } + } else + if (!(--count)) + break; + } + + /* Put the pdump_wire variables in place */ + count = PDUMP_READ (p, EMACS_INT); + + for (i=0; i<count; i++) + { + Lisp_Object *var = PDUMP_READ (p, Lisp_Object *); + Lisp_Object obj = PDUMP_READ (p, Lisp_Object); + + if (POINTER_TYPE_P (XTYPE (obj))) + XSETOBJ (obj, XTYPE (obj), (char *) XPNTR (obj) + delta); + + *var = obj; + } + + /* Final cleanups */ + /* reorganize hash tables */ + p = pdump_rt_list; + for (;;) + { + pdump_reloc_table rt = PDUMP_READ (p, pdump_reloc_table); + if (!rt.desc) + break; + if (rt.desc == hash_table_description) + { + for (i=0; i < rt.count; i++) + pdump_reorganize_hash_table (PDUMP_READ (p, Lisp_Object)); + break; + } else + p += sizeof (Lisp_Object) * rt.count; + } + + /* Put back noninteractive1 to its real value */ + noninteractive1 = noninteractive; + + return 1; +} + +#endif /* PDUMP */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/backtrace.h --- a/src/backtrace.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/backtrace.h Mon Aug 13 11:13:30 2007 +0200 @@ -30,8 +30,8 @@ Mly (probably) or JWZ: Some changes. */ -#ifndef _XEMACS_BACKTRACE_H_ -#define _XEMACS_BACKTRACE_H_ +#ifndef INCLUDED_backtrace_h_ +#define INCLUDED_backtrace_h_ #include <setjmp.h> @@ -158,7 +158,7 @@ Lisp_Object SB_symbol = (symbol_object); \ Lisp_Object SB_newval = (value_object); \ Lisp_Object SB_oldval; \ - struct Lisp_Symbol *SB_sym; \ + Lisp_Symbol *SB_sym; \ \ SPECPDL_RESERVE (1); \ \ @@ -168,7 +168,7 @@ \ if (!SYMBOL_VALUE_MAGIC_P (SB_oldval) || UNBOUNDP (SB_oldval)) \ { \ - /* ### the following test will go away when we have a constant \ + /* #### the following test will go away when we have a constant \ symbol magic object */ \ if (EQ (SB_symbol, Qnil) || \ EQ (SB_symbol, Qt) || \ @@ -197,7 +197,7 @@ #define SPECBIND_FAST_UNSAFE(symbol_object, value_object) do { \ Lisp_Object SFU_symbol = (symbol_object); \ Lisp_Object SFU_newval = (value_object); \ - struct Lisp_Symbol *SFU_sym = XSYMBOL (SFU_symbol); \ + Lisp_Symbol *SFU_sym = XSYMBOL (SFU_symbol); \ Lisp_Object SFU_oldval = SFU_sym->value; \ if (!SYMBOL_VALUE_MAGIC_P (SFU_oldval) || UNBOUNDP (SFU_oldval)) \ { \ @@ -230,7 +230,7 @@ int UNBIND_TO_count = (count); \ while (specpdl_depth_counter != UNBIND_TO_count) \ { \ - struct Lisp_Symbol *sym; \ + Lisp_Symbol *sym; \ --specpdl_ptr; \ --specpdl_depth_counter; \ \ @@ -255,7 +255,7 @@ int UNBIND_TO_count = (count); \ while (specpdl_depth_counter != UNBIND_TO_count) \ { \ - struct Lisp_Symbol *sym; \ + Lisp_Symbol *sym; \ --specpdl_ptr; \ --specpdl_depth_counter; \ \ @@ -288,7 +288,7 @@ int UNBIND_TO_count = (count); \ while (specpdl_depth_counter != UNBIND_TO_count) \ { \ - struct Lisp_Symbol *sym; \ + Lisp_Symbol *sym; \ --specpdl_ptr; \ --specpdl_depth_counter; \ \ @@ -315,7 +315,7 @@ #define FSET_FAST_UNSAFE(sym, newval) do { \ Lisp_Object FFU_sym = (sym); \ Lisp_Object FFU_newval = (newval); \ - struct Lisp_Symbol *FFU_symbol = XSYMBOL (FFU_sym); \ + Lisp_Symbol *FFU_symbol = XSYMBOL (FFU_sym); \ Lisp_Object FFU_oldval = FFU_symbol->value; \ if (!SYMBOL_VALUE_MAGIC_P (FFU_oldval) || UNBOUNDP (FFU_oldval)) \ FFU_symbol->value = FFU_newval; \ @@ -323,4 +323,4 @@ Fset (FFU_sym, FFU_newval); \ } while (0) -#endif /* _XEMACS_BACKTRACE_H_ */ +#endif /* INCLUDED_backtrace_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/balloon-x.c --- a/src/balloon-x.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/balloon-x.c Mon Aug 13 11:13:30 2007 +0200 @@ -29,10 +29,10 @@ #include "balloon_help.h" -/* ### start of hack */ +/* #### start of hack */ static unsigned long -alloc_color (Display* dpy, CONST char* colorname, int light) +alloc_color (Display* dpy, const char* colorname, int light) { Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(Vdefault_x_device)); unsigned long pixel = 0; @@ -61,7 +61,7 @@ } static XFontStruct * -open_font (Display* dpy, CONST char* font_name) +open_font (Display* dpy, const char* font_name) { XFontStruct* fontStruct = NULL; @@ -99,7 +99,7 @@ } } -/* ### end of hack */ +/* #### end of hack */ DEFUN ("show-balloon-help", Fshow_balloon_help, 1, 1, 0, /* Show balloon help. diff -r f4aeb21a5bad -r 74fd4e045ea6 src/balloon_help.c --- a/src/balloon_help.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/balloon_help.c Mon Aug 13 11:13:30 2007 +0200 @@ -83,7 +83,7 @@ static int b_maskWidth, b_maskHeight; static GC b_maskGC; -static CONST char* b_text; +static const char* b_text; static int b_width, b_height; static XtIntervalId b_timer; @@ -214,7 +214,7 @@ ============================================================================*/ static void -text_extent (XFontStruct* fontStruct, CONST char* text, int len, +text_extent (XFontStruct* fontStruct, const char* text, int len, int* width, int* height) { XCharStruct extent; @@ -227,13 +227,13 @@ } static void -get_text_size (Display* dpy, XFontStruct* fontStruct, CONST char* text, +get_text_size (Display* dpy, XFontStruct* fontStruct, const char* text, int* max_width, int* max_height) { int width; int height; - CONST char* start; - CONST char* end; + const char* start; + const char* end; *max_width = *max_height = 0; @@ -257,10 +257,10 @@ static void draw_text (Display* dpy, Window win, GC gc, XFontStruct* fontStruct, - int x, int y, CONST char* text) + int x, int y, const char* text) { - CONST char* start; - CONST char* end; + const char* start; + const char* end; int font_height; y += fontStruct->ascent; @@ -538,7 +538,7 @@ } void -balloon_help_show (CONST char* text) +balloon_help_show (const char* text) { assert (b_dpy != NULL); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/balloon_help.h --- a/src/balloon_help.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/balloon_help.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,8 +20,8 @@ /* Synched up with: Not in FSF. */ -#ifndef BALLOON_HELP_H -#define BALLOON_HELP_H +#ifndef INCLUDED_balloon_help_h_ +#define INCLUDED_balloon_help_h_ #include "xintrinsic.h" @@ -29,8 +29,8 @@ Pixel fg, Pixel bg, Pixel shine, Pixel shadow, XFontStruct* font); void balloon_help_set_delay (unsigned long milliseconds); -void balloon_help_show (CONST char* text); +void balloon_help_show (const char* text); void balloon_help_hide (void); void balloon_help_move_to_pointer (void); -#endif /* BALLOON_HELP_H */ +#endif /* INCLUDED_balloon_help_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/bitmaps.h --- a/src/bitmaps.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/bitmaps.h Mon Aug 13 11:13:30 2007 +0200 @@ -22,8 +22,8 @@ JWZ (?): 1992?. */ -#ifndef _XEMACS_BITMAPS_H_ -#define _XEMACS_BITMAPS_H_ +#ifndef INCLUDED_bitmaps_h_ +#define INCLUDED_bitmaps_h_ #if 0 /* A gnu, like on the back of the emacs manual, for icons. */ @@ -164,4 +164,4 @@ 0x00, 0x00, 0x22, 0x22, 0x22, 0x22, 0x00, 0x00}; #endif -#endif /* _XEMACS_BITMAPS_H_ */ +#endif /* INCLUDED_bitmaps_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/blocktype.h --- a/src/blocktype.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/blocktype.h Mon Aug 13 11:13:30 2007 +0200 @@ -26,8 +26,8 @@ Ben Wing: December 1994, for 19.12. */ -#ifndef _XEMACS_BLOCKTYPE_H_ -#define _XEMACS_BLOCKTYPE_H_ +#ifndef INCLUDED_blocktype_h_ +#define INCLUDED_blocktype_h_ #define Blocktype_declare(type) \ type *free; \ @@ -42,4 +42,4 @@ (structype *) Blocktype_newf (sizeof(*(((structype *) NULL)->free))) #define Blocktype_alloc(b) (Blocktype_allocf (b), (b)->tempel) -#endif /* _XEMACS_BLOCKTYPE_H_ */ +#endif /* INCLUDED_blocktype_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/broken-sun.h --- a/src/broken-sun.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/broken-sun.h Mon Aug 13 11:13:30 2007 +0200 @@ -25,8 +25,8 @@ /* Sun's standard and GCC's header files leave out prototypes for all sorts of functions. */ -#ifndef _XEMACS_BROKEN_SUN_H_ -#define _XEMACS_BROKEN_SUN_H_ +#ifndef INCLUDED_broken_sun_h_ +#define INCLUDED_broken_sun_h_ #ifdef __GNUC__ #include <stdlib.h> @@ -34,15 +34,15 @@ /*********************** stdlib functions *********************/ -/* void * memchr (CONST void *, int, size_t); */ +/* void * memchr (const void *, int, size_t); */ -/* int memcmp (CONST void *, CONST void *, size_t); */ -/* void * memcpy (void *, CONST void *, size_t); */ -/* void * memmove (void *, CONST void *, size_t);*/ +/* int memcmp (const void *, const void *, size_t); */ +/* void * memcpy (void *, const void *, size_t); */ +/* void * memmove (void *, const void *, size_t);*/ /* void * memset (void *, int, int); */ -/* char * strcat (char *, CONST char *); */ -/* char * strchr (CONST char *, int); */ -/* int strcmp (CONST char *, CONST char *); */ +/* char * strcat (char *, const char *); */ +/* char * strchr (const char *, int); */ +/* int strcmp (const char *, const char *); */ int strcasecmp (char *, char *); /* Yes, they even left these functions out! */ @@ -53,39 +53,39 @@ #include <stdio.h> /* else can't declare FILE */ -/* FILE *fopen (CONST char *, CONST char *); */ -/* FILE *freopen (CONST char *, CONST char *, FILE *); */ +/* FILE *fopen (const char *, const char *); */ +/* FILE *freopen (const char *, const char *, FILE *); */ FILE *tmpfile (void); int fclose (FILE *); char *fgets (char *, int, FILE *); int fgetc (FILE *); int fflush (FILE *); -int fprintf (FILE *, CONST char *, ...); +int fprintf (FILE *, const char *, ...); int fputc (char, FILE *); -int fputs (CONST char *, FILE *); +int fputs (const char *, FILE *); size_t fread (void *, size_t, size_t, FILE *); -int fscanf (FILE *, CONST char *, ...); +int fscanf (FILE *, const char *, ...); int fgetpos (FILE *, long *); int fseek (FILE *, long, int); -int fsetpos (FILE *, CONST long *); +int fsetpos (FILE *, const long *); long ftell (FILE *); -size_t fwrite (CONST void *, size_t, size_t, FILE *); +size_t fwrite (const void *, size_t, size_t, FILE *); char *gets (char *); int pclose (FILE *); -void perror (CONST char *); -int printf (CONST char *, ...); -int puts (CONST char *); -int remove (CONST char *); -int rename (CONST char *, CONST char *); +void perror (const char *); +int printf (const char *, ...); +int puts (const char *); +int remove (const char *); +int rename (const char *, const char *); int rewind (FILE *); -int scanf (CONST char *, ...); -int sscanf (CONST char *, CONST char *, ...); +int scanf (const char *, ...); +int sscanf (const char *, const char *, ...); void setbuf (FILE *, char *); int setvbuf (FILE *, char *, int, size_t); int ungetc (int, FILE *); -int vprintf (CONST char *, void *); -int vfprintf (FILE *, CONST char *, void *); -char *vsprintf (char *, CONST char *, void *); +int vprintf (const char *, void *); +int vfprintf (FILE *, const char *, void *); +char *vsprintf (char *, const char *, void *); /*********************** signal functions *********************/ @@ -101,7 +101,7 @@ struct timeval; struct timezone; -int utimes (CONST char *, struct timeval *); +int utimes (const char *, struct timeval *); void tzset (void); time_t time (time_t *); int gettimeofday (struct timeval *, struct timezone *); @@ -112,12 +112,12 @@ #include </usr/include/sys/types.h> int fsync (int); -int lstat (CONST char *, struct stat *); +int lstat (const char *, struct stat *); int fchmod (int, mode_t); char *mktemp (char *); -/* int creat (CONST char *, mode_t); better no decl than a conflicting one... */ -int symlink (CONST char *, CONST char *); -int readlink (CONST char *, char *, int); +/* int creat (const char *, mode_t); better no decl than a conflicting one... */ +int symlink (const char *, const char *); +int readlink (const char *, char *, int); void sync (void); int select (int, fd_set *, fd_set *, fd_set *, struct timeval *); char * getwd (char *); @@ -146,7 +146,7 @@ int ioctl (int, int, ...); struct nlist; -int nlist (CONST char *, struct nlist *); +int nlist (const char *, struct nlist *); int munmap (void *, int); int brk (void *); void * sbrk (int); @@ -158,10 +158,10 @@ /*********************** miscellaneous functions *********************/ -void tputs (CONST char *cp, int affcnt, void (*)(int)); +void tputs (const char *cp, int affcnt, void (*)(int)); long random (void); int srandom (int seed); #endif /* __GNUC__ */ -#endif /* _XEMACS_BROKEN_SUN_H_ */ +#endif /* INCLUDED_broken_sun_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/buffer.c --- a/src/buffer.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/buffer.c Mon Aug 13 11:13:30 2007 +0200 @@ -74,8 +74,12 @@ #include "elhash.h" #include "extents.h" #include "faces.h" +#ifdef FILE_CODING +#include "file-coding.h" +#endif #include "frame.h" #include "insdel.h" +#include "lstream.h" #include "process.h" /* for kill_buffer_processes */ #ifdef REGION_CACHE_NEEDS_WORK #include "region-cache.h" @@ -96,6 +100,7 @@ Setting the default value also goes through the alist of buffers and stores into each buffer that does not say it has a local value. */ Lisp_Object Vbuffer_defaults; +static void *buffer_defaults_saved_slots; /* This structure marks which slots in a buffer have corresponding default values in Vbuffer_defaults. @@ -133,6 +138,7 @@ /* This structure holds the names of symbols whose values may be buffer-local. It is indexed and accessed in the same way as the above. */ static Lisp_Object Vbuffer_local_symbols; +static void *buffer_local_symbols_saved_slots; /* Alist of all buffer names vs the buffers. */ /* This used to be a variable, but is no longer, @@ -189,7 +195,7 @@ Lisp_Object Qdefault_directory; Lisp_Object Qkill_buffer_hook; -Lisp_Object Qbuffer_file_name, Qbuffer_undo_list; +Lisp_Object Qrecord_buffer_hook; Lisp_Object Qrename_auto_save_file; @@ -220,7 +226,7 @@ } static Lisp_Object -mark_buffer (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_buffer (Lisp_Object obj) { struct buffer *buf = XBUFFER (obj); @@ -229,13 +235,13 @@ undo_threshold, undo_high_threshold); -#define MARKED_SLOT(x) ((void) (markobj (buf->x))); +#define MARKED_SLOT(x) mark_object (buf->x) #include "bufslots.h" #undef MARKED_SLOT - markobj (buf->extent_info); + mark_object (buf->extent_info); if (buf->text) - markobj (buf->text->line_number_cache); + mark_object (buf->text->line_number_cache); /* Don't mark normally through the children slot. (Actually, in this case, it doesn't matter.) */ @@ -276,7 +282,7 @@ because all buffers have `kill-buffer' applied to them before they disappear, and the children removal happens then. */ DEFINE_LRECORD_IMPLEMENTATION ("buffer", buffer, - mark_buffer, print_buffer, 0, 0, 0, + mark_buffer, print_buffer, 0, 0, 0, 0, struct buffer); DEFUN ("bufferp", Fbufferp, 1, 1, 0, /* @@ -541,7 +547,7 @@ static struct buffer * allocate_buffer (void) { - struct buffer *b = alloc_lcrecord_type (struct buffer, lrecord_buffer); + struct buffer *b = alloc_lcrecord_type (struct buffer, &lrecord_buffer); copy_lcrecord (b, XBUFFER (Vbuffer_defaults)); @@ -1180,7 +1186,7 @@ killp = call1 (Qyes_or_no_p, (emacs_doprnt_string_c - ((CONST Bufbyte *) GETTEXT ("Buffer %s modified; kill anyway? "), + ((const Bufbyte *) GETTEXT ("Buffer %s modified; kill anyway? "), Qnil, -1, XSTRING_DATA (b->name)))); UNGCPRO; if (NILP (killp)) @@ -1406,6 +1412,9 @@ XCDR (prev) = XCDR (XCDR (prev)); XCDR (lynk) = f->buffer_alist; f->buffer_alist = lynk; + + va_run_hook_with_args (Qrecord_buffer_hook, 1, buffer); + return Qnil; } @@ -1619,6 +1628,8 @@ If BUFFER is nil or omitted, bury the current buffer. Also, if BUFFER is nil or omitted, remove the current buffer from the selected window if it is displayed there. +Because of this, you may need to specify (current-buffer) as +BUFFER when calling from minibuffer. If BEFORE is non-nil, it specifies a buffer before which BUFFER will be placed, instead of being placed at the end. */ @@ -1798,6 +1809,342 @@ #endif /* MEMORY_USAGE_STATS */ + +/************************************************************************/ +/* Implement TO_EXTERNAL_FORMAT, TO_INTERNAL_FORMAT */ +/************************************************************************/ + +/* This implementation should probably be elsewhere, but it can't be + in file-coding.c since that file is only available if FILE_CODING + is defined. */ +#ifdef FILE_CODING +static int +coding_system_is_binary (Lisp_Object coding_system) +{ + Lisp_Coding_System *cs = XCODING_SYSTEM (coding_system); + return + (CODING_SYSTEM_TYPE (cs) == CODESYS_NO_CONVERSION && + CODING_SYSTEM_EOL_TYPE (cs) == EOL_LF && + EQ (CODING_SYSTEM_POST_READ_CONVERSION (cs), Qnil) && + EQ (CODING_SYSTEM_PRE_WRITE_CONVERSION (cs), Qnil)); +} +#else +#define coding_system_is_binary(coding_system) 1 +#endif + +static Extbyte_dynarr *conversion_out_dynarr; +static Bufbyte_dynarr *conversion_in_dynarr; + +static int dfc_convert_to_external_format_in_use; +static int dfc_convert_to_internal_format_in_use; + +static Lisp_Object +dfc_convert_to_external_format_reset_in_use (Lisp_Object value) +{ + dfc_convert_to_external_format_in_use = XINT (value); + return Qnil; +} + +static Lisp_Object +dfc_convert_to_internal_format_reset_in_use (Lisp_Object value) +{ + dfc_convert_to_internal_format_in_use = XINT (value); + return Qnil; +} + +void +dfc_convert_to_external_format (dfc_conversion_type source_type, + dfc_conversion_data *source, +#ifdef FILE_CODING + Lisp_Object coding_system, +#endif + dfc_conversion_type sink_type, + dfc_conversion_data *sink) +{ + int count = specpdl_depth (); + + type_checking_assert + (((source_type == DFC_TYPE_DATA) || + (source_type == DFC_TYPE_LISP_LSTREAM && LSTREAMP (source->lisp_object)) || + (source_type == DFC_TYPE_LISP_STRING && STRINGP (source->lisp_object))) + && + ((sink_type == DFC_TYPE_DATA) || + (sink_type == DFC_TYPE_LISP_LSTREAM && LSTREAMP (source->lisp_object)))); + + if (dfc_convert_to_external_format_in_use != 0) + error ("Can't call a conversion function from a conversion function"); + else + dfc_convert_to_external_format_in_use = 1; + + record_unwind_protect (dfc_convert_to_external_format_reset_in_use, + Qzero); + +#ifdef FILE_CODING + coding_system = Fget_coding_system (coding_system); +#endif + + Dynarr_reset (conversion_out_dynarr); + + /* Here we optimize in the case where the coding system does no + conversion. However, we don't want to optimize in case the source + or sink is an lstream, since writing to an lstream can cause a + garbage collection, and this could be problematic if the source + is a lisp string. */ + if (source_type != DFC_TYPE_LISP_LSTREAM && + sink_type != DFC_TYPE_LISP_LSTREAM && + coding_system_is_binary (coding_system)) + { + const Bufbyte *ptr; + Bytecount len; + + if (source_type == DFC_TYPE_LISP_STRING) + { + ptr = XSTRING_DATA (source->lisp_object); + len = XSTRING_LENGTH (source->lisp_object); + } + else + { + ptr = (Bufbyte *) source->data.ptr; + len = source->data.len; + } + +#ifdef MULE + { + const Bufbyte *end; + for (end = ptr + len; ptr < end;) + { + Bufbyte c = + (BYTE_ASCII_P (*ptr)) ? *ptr : + (*ptr == LEADING_BYTE_CONTROL_1) ? (*(ptr+1) - 0x20) : + (*ptr == LEADING_BYTE_LATIN_ISO8859_1) ? (*(ptr+1)) : + '~'; + + Dynarr_add (conversion_out_dynarr, (Extbyte) c); + INC_CHARPTR (ptr); + } + bufpos_checking_assert (ptr == end); + } +#else + Dynarr_add_many (conversion_out_dynarr, ptr, len); +#endif + + } + else + { + Lisp_Object streams_to_delete[3]; + int delete_count = 0; + Lisp_Object instream, outstream; + Lstream *reader, *writer; + struct gcpro gcpro1, gcpro2; + + if (source_type == DFC_TYPE_LISP_LSTREAM) + instream = source->lisp_object; + else if (source_type == DFC_TYPE_DATA) + streams_to_delete[delete_count++] = instream = + make_fixed_buffer_input_stream (source->data.ptr, source->data.len); + else + { + type_checking_assert (source_type == DFC_TYPE_LISP_STRING); + streams_to_delete[delete_count++] = instream = + make_lisp_string_input_stream (source->lisp_object, 0, -1); + } + + if (sink_type == DFC_TYPE_LISP_LSTREAM) + outstream = sink->lisp_object; + else + { + type_checking_assert (sink_type == DFC_TYPE_DATA); + streams_to_delete[delete_count++] = outstream = + make_dynarr_output_stream + ((unsigned_char_dynarr *) conversion_out_dynarr); + } + +#ifdef FILE_CODING + streams_to_delete[delete_count++] = outstream = + make_encoding_output_stream (XLSTREAM (outstream), coding_system); +#endif + + reader = XLSTREAM (instream); + writer = XLSTREAM (outstream); + /* decoding_stream will gc-protect outstream */ + GCPRO2 (instream, outstream); + + while (1) + { + ssize_t size_in_bytes; + char tempbuf[1024]; /* some random amount */ + + size_in_bytes = Lstream_read (reader, tempbuf, sizeof (tempbuf)); + + if (size_in_bytes == 0) + break; + else if (size_in_bytes < 0) + error ("Error converting to external format"); + + size_in_bytes = Lstream_write (writer, tempbuf, size_in_bytes); + + if (size_in_bytes <= 0) + error ("Error converting to external format"); + } + + /* Closing writer will close any stream at the other end of writer. */ + Lstream_close (writer); + Lstream_close (reader); + UNGCPRO; + + /* The idea is that this function will create no garbage. */ + while (delete_count) + Lstream_delete (XLSTREAM (streams_to_delete [--delete_count])); + } + + unbind_to (count, Qnil); + + if (sink_type != DFC_TYPE_LISP_LSTREAM) + { + sink->data.len = Dynarr_length (conversion_out_dynarr); + Dynarr_add (conversion_out_dynarr, 0); + sink->data.ptr = Dynarr_atp (conversion_out_dynarr, 0); + } +} + +void +dfc_convert_to_internal_format (dfc_conversion_type source_type, + dfc_conversion_data *source, +#ifdef FILE_CODING + Lisp_Object coding_system, +#endif + dfc_conversion_type sink_type, + dfc_conversion_data *sink) +{ + int count = specpdl_depth (); + + type_checking_assert + ((source_type == DFC_TYPE_DATA || + source_type == DFC_TYPE_LISP_LSTREAM) + && + (sink_type == DFC_TYPE_DATA || + sink_type == DFC_TYPE_LISP_LSTREAM)); + + if (dfc_convert_to_internal_format_in_use != 0) + error ("Can't call a conversion function from a conversion function"); + else + dfc_convert_to_internal_format_in_use = 1; + + record_unwind_protect (dfc_convert_to_internal_format_reset_in_use, + Qzero); + +#ifdef FILE_CODING + coding_system = Fget_coding_system (coding_system); +#endif + + Dynarr_reset (conversion_in_dynarr); + + if (source_type != DFC_TYPE_LISP_LSTREAM && + sink_type != DFC_TYPE_LISP_LSTREAM && + coding_system_is_binary (coding_system)) + { +#ifdef MULE + const Bufbyte *ptr = (const Bufbyte *) source->data.ptr; + Bytecount len = source->data.len; + const Bufbyte *end = ptr + len; + + for (; ptr < end; ptr++) + { + Extbyte c = *ptr; + + if (BYTE_ASCII_P (c)) + Dynarr_add (conversion_in_dynarr, c); + else if (BYTE_C1_P (c)) + { + Dynarr_add (conversion_in_dynarr, LEADING_BYTE_CONTROL_1); + Dynarr_add (conversion_in_dynarr, c + 0x20); + } + else + { + Dynarr_add (conversion_in_dynarr, LEADING_BYTE_LATIN_ISO8859_1); + Dynarr_add (conversion_in_dynarr, c); + } + } +#else + Dynarr_add_many (conversion_in_dynarr, source->data.ptr, source->data.len); +#endif + } + else + { + Lisp_Object streams_to_delete[3]; + int delete_count = 0; + Lisp_Object instream, outstream; + Lstream *reader, *writer; + struct gcpro gcpro1, gcpro2; + + if (source_type == DFC_TYPE_LISP_LSTREAM) + instream = source->lisp_object; + else + { + type_checking_assert (source_type == DFC_TYPE_DATA); + streams_to_delete[delete_count++] = instream = + make_fixed_buffer_input_stream (source->data.ptr, source->data.len); + } + + if (sink_type == DFC_TYPE_LISP_LSTREAM) + outstream = sink->lisp_object; + else + { + type_checking_assert (sink_type == DFC_TYPE_DATA); + streams_to_delete[delete_count++] = outstream = + make_dynarr_output_stream + ((unsigned_char_dynarr *) conversion_in_dynarr); + } + +#ifdef FILE_CODING + streams_to_delete[delete_count++] = outstream = + make_decoding_output_stream (XLSTREAM (outstream), coding_system); +#endif + + reader = XLSTREAM (instream); + writer = XLSTREAM (outstream); + /* outstream will gc-protect its sink stream, if necessary */ + GCPRO2 (instream, outstream); + + while (1) + { + ssize_t size_in_bytes; + char tempbuf[1024]; /* some random amount */ + + size_in_bytes = Lstream_read (reader, tempbuf, sizeof (tempbuf)); + + if (size_in_bytes == 0) + break; + else if (size_in_bytes < 0) + error ("Error converting to internal format"); + + size_in_bytes = Lstream_write (writer, tempbuf, size_in_bytes); + + if (size_in_bytes <= 0) + error ("Error converting to internal format"); + } + + /* Closing writer will close any stream at the other end of writer. */ + Lstream_close (writer); + Lstream_close (reader); + UNGCPRO; + + /* The idea is that this function will create no garbage. */ + while (delete_count) + Lstream_delete (XLSTREAM (streams_to_delete [--delete_count])); + } + + unbind_to (count, Qnil); + + if (sink_type != DFC_TYPE_LISP_LSTREAM) + { + sink->data.len = Dynarr_length (conversion_in_dynarr); + Dynarr_add (conversion_in_dynarr, 0); /* remember to zero-terminate! */ + sink->data.ptr = Dynarr_atp (conversion_in_dynarr, 0); + } +} + + void syms_of_buffer (void) { @@ -1806,6 +2153,7 @@ defsymbol (&Qmode_class, "mode-class"); defsymbol (&Qrename_auto_save_file, "rename-auto-save-file"); defsymbol (&Qkill_buffer_hook, "kill-buffer-hook"); + defsymbol (&Qrecord_buffer_hook, "record-buffer-hook"); defsymbol (&Qpermanent_local, "permanent-local"); defsymbol (&Qfirst_change_hook, "first-change-hook"); @@ -1816,8 +2164,6 @@ defsymbol (&Qbefore_change_function, "before-change-function"); defsymbol (&Qafter_change_function, "after-change-function"); - defsymbol (&Qbuffer_file_name, "buffer-file-name"); - defsymbol (&Qbuffer_undo_list, "buffer-undo-list"); defsymbol (&Qdefault_directory, "default-directory"); defsymbol (&Qget_file_buffer, "get-file-buffer"); @@ -1870,20 +2216,29 @@ "Attempt to modify a protected field", Qerror); } +void +reinit_vars_of_buffer (void) +{ + conversion_in_dynarr = Dynarr_new (Bufbyte); + conversion_out_dynarr = Dynarr_new (Extbyte); + + staticpro_nodump (&Vbuffer_alist); + Vbuffer_alist = Qnil; + current_buffer = 0; +} + /* initialize the buffer routines */ void vars_of_buffer (void) { /* This function can GC */ + reinit_vars_of_buffer (); + staticpro (&QSFundamental); staticpro (&QSscratch); - staticpro (&Vbuffer_alist); - - QSFundamental = Fpurecopy (build_string ("Fundamental")); - QSscratch = Fpurecopy (build_string (DEFER_GETTEXT ("*scratch*"))); - - Vbuffer_alist = Qnil; - current_buffer = 0; + + QSFundamental = build_string ("Fundamental"); + QSscratch = build_string (DEFER_GETTEXT ("*scratch*")); DEFVAR_LISP ("change-major-mode-hook", &Vchange_major_mode_hook /* List of hooks to be run before killing local variables in a buffer. @@ -2023,10 +2378,26 @@ from SunPro C's fix-and-continue feature (a way neato feature that makes debugging unbelievably more bearable) */ #define DEFVAR_BUFFER_LOCAL_1(lname, field_name, forward_type, magicfun) do { \ - static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { symbol_value_forward_lheader_initializer, \ - (struct lcrecord_header *) &(buffer_local_flags.field_name), 69 }, \ - forward_type }, magicfun }; \ + static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C = \ + { /* struct symbol_value_forward */ \ + { /* struct symbol_value_magic */ \ + { /* struct lcrecord_header */ \ + { /* struct lrecord_header */ \ + 1, /* type - index into lrecord_implementations_table */ \ + 0, /* mark bit */ \ + 0, /* c_readonly bit */ \ + 0 /* lisp_readonly bit */ \ + }, \ + 0, /* next */ \ + 0, /* uid */ \ + 0 /* free */ \ + }, \ + &(buffer_local_flags.field_name), \ + forward_type \ + }, \ + magicfun \ + }; \ + \ { \ int offset = ((char *)symbol_value_forward_forward (&I_hate_C) - \ (char *)&buffer_local_flags); \ @@ -2063,21 +2434,21 @@ b->indirect_children = Qnil; b->own_text.line_number_cache = Qnil; -#define MARKED_SLOT(x) b->x = (zap); +#define MARKED_SLOT(x) b->x = zap #include "bufslots.h" #undef MARKED_SLOT } -void -complex_vars_of_buffer (void) +static void +common_init_complex_vars_of_buffer (void) { /* Make sure all markable slots in buffer_defaults are initialized reasonably, so mark_buffer won't choke. */ - struct buffer *defs = alloc_lcrecord_type (struct buffer, lrecord_buffer); - struct buffer *syms = alloc_lcrecord_type (struct buffer, lrecord_buffer); - - staticpro (&Vbuffer_defaults); - staticpro (&Vbuffer_local_symbols); + struct buffer *defs = alloc_lcrecord_type (struct buffer, &lrecord_buffer); + struct buffer *syms = alloc_lcrecord_type (struct buffer, &lrecord_buffer); + + staticpro_nodump (&Vbuffer_defaults); + staticpro_nodump (&Vbuffer_local_symbols); XSETBUFFER (Vbuffer_defaults, defs); XSETBUFFER (Vbuffer_local_symbols, syms); @@ -2193,10 +2564,56 @@ buffer_local_flags.buffer_file_coding_system = make_int (1<<14); #endif - /* #### Warning: 1<<28 is the largest number currently allowable + /* #### Warning: 1<<31 is the largest number currently allowable due to the XINT() handling of this value. With some rearrangement you can get 3 more bits. */ } +} + +#define BUFFER_SLOTS_SIZE (offsetof (struct buffer, BUFFER_SLOTS_LAST_NAME) - offsetof (struct buffer, BUFFER_SLOTS_FIRST_NAME) + sizeof (Lisp_Object)) +#define BUFFER_SLOTS_COUNT (BUFFER_SLOTS_SIZE / sizeof (Lisp_Object)) + +void +reinit_complex_vars_of_buffer (void) +{ + struct buffer *defs, *syms; + + common_init_complex_vars_of_buffer (); + + defs = XBUFFER (Vbuffer_defaults); + syms = XBUFFER (Vbuffer_local_symbols); + memcpy (&defs->BUFFER_SLOTS_FIRST_NAME, + buffer_defaults_saved_slots, + BUFFER_SLOTS_SIZE); + memcpy (&syms->BUFFER_SLOTS_FIRST_NAME, + buffer_local_symbols_saved_slots, + BUFFER_SLOTS_SIZE); +} + + +static const struct lrecord_description buffer_slots_description_1[] = { + { XD_LISP_OBJECT_ARRAY, 0, BUFFER_SLOTS_COUNT }, + { XD_END } +}; + +static const struct struct_description buffer_slots_description = { + BUFFER_SLOTS_SIZE, + buffer_slots_description_1 +}; + +void +complex_vars_of_buffer (void) +{ + struct buffer *defs, *syms; + + common_init_complex_vars_of_buffer (); + + defs = XBUFFER (Vbuffer_defaults); + syms = XBUFFER (Vbuffer_local_symbols); + buffer_defaults_saved_slots = &defs->BUFFER_SLOTS_FIRST_NAME; + buffer_local_symbols_saved_slots = &syms->BUFFER_SLOTS_FIRST_NAME; + dumpstruct (&buffer_defaults_saved_slots, &buffer_slots_description); + dumpstruct (&buffer_local_symbols_saved_slots, &buffer_slots_description); DEFVAR_BUFFER_DEFAULTS ("default-modeline-format", modeline_format /* Default value of `modeline-format' for buffers that don't override it. @@ -2690,19 +3107,22 @@ /* Is PWD another name for `.' ? */ static int -directory_is_current_directory (char *pwd) +directory_is_current_directory (Extbyte *pwd) { Bufbyte *pwd_internal; + Bytecount pwd_internal_len; struct stat dotstat, pwdstat; - GET_C_CHARPTR_INT_FILENAME_DATA_ALLOCA (pwd, pwd_internal); + TO_INTERNAL_FORMAT (DATA, (pwd, strlen ((char *)pwd) + 1), + ALLOCA, (pwd_internal, pwd_internal_len), + Qfile_name); return (IS_DIRECTORY_SEP (*pwd_internal) && stat ((char *) pwd_internal, &pwdstat) == 0 && stat (".", &dotstat) == 0 && dotstat.st_ino == pwdstat.st_ino && dotstat.st_dev == pwdstat.st_dev - && (int) strlen ((char *) pwd_internal) < MAXPATHLEN); + && pwd_internal_len < MAXPATHLEN); } void @@ -2710,15 +3130,15 @@ { /* This function can GC */ - char *pwd; + Extbyte *pwd; initial_directory[0] = 0; /* If PWD is accurate, use it instead of calling getcwd. This is faster when PWD is right, and may avoid a fatal error. */ - if ((pwd = getenv ("PWD")) != NULL + if ((pwd = (Extbyte *) getenv ("PWD")) != NULL && directory_is_current_directory (pwd)) - strcpy (initial_directory, pwd); + strcpy (initial_directory, (char *) pwd); else if (getcwd (initial_directory, MAXPATHLEN) == NULL) fatal ("`getcwd' failed: %s\n", strerror (errno)); @@ -2756,7 +3176,7 @@ Fset_buffer (Fget_buffer_create (QSscratch)); current_buffer->directory = - build_ext_string (initial_directory, FORMAT_FILENAME); + build_ext_string (initial_directory, Qfile_name); #if 0 /* FSFmacs */ /* #### is this correct? */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/buffer.h --- a/src/buffer.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/buffer.h Mon Aug 13 11:13:30 2007 +0200 @@ -29,8 +29,8 @@ Ben Wing: almost completely rewritten for Mule, 19.12. */ -#ifndef _XEMACS_BUFFER_H_ -#define _XEMACS_BUFFER_H_ +#ifndef INCLUDED_buffer_h_ +#define INCLUDED_buffer_h_ #ifdef MULE #include "mule-charset.h" @@ -166,7 +166,7 @@ /* The markers that refer to this buffer. This is actually a single marker -- successive elements in its marker `chain' are the other markers referring to this buffer */ - struct Lisp_Marker *markers; + Lisp_Marker *markers; /* The buffer's extent info. This is its own type, an extent-info object (done this way for ease in marking / finalizing). */ @@ -219,7 +219,6 @@ #define XBUFFER(x) XRECORD (x, buffer, struct buffer) #define XSETBUFFER(x, p) XSETRECORD (x, p, buffer) #define BUFFERP(x) RECORDP (x, buffer) -#define GC_BUFFERP(x) GC_RECORDP (x, buffer) #define CHECK_BUFFER(x) CHECK_RECORD (x, buffer) #define CONCHECK_BUFFER(x) CONCHECK_RECORD (x, buffer) @@ -409,6 +408,9 @@ #define REAL_INC_CHARPTR(ptr) \ ((void) ((ptr) += REP_BYTES_BY_FIRST_BYTE (* (unsigned char *) (ptr)))) +#define REAL_INC_CHARBYTIND(ptr,pos) \ + (pos += REP_BYTES_BY_FIRST_BYTE (* (unsigned char *) (ptr))) + #define REAL_DEC_CHARPTR(ptr) do { \ (ptr)--; \ } while (!VALID_CHARPTR_P (ptr)) @@ -419,9 +421,14 @@ REAL_INC_CHARPTR (ptr); \ } while (0) +#define INC_CHARBYTIND(ptr,pos) do { \ + ASSERT_VALID_CHARPTR (ptr); \ + REAL_INC_CHARBYTIND (ptr,pos); \ +} while (0) + #define DEC_CHARPTR(ptr) do { \ - CONST Bufbyte *dc_ptr1 = (ptr); \ - CONST Bufbyte *dc_ptr2 = dc_ptr1; \ + const Bufbyte *dc_ptr1 = (ptr); \ + const Bufbyte *dc_ptr2 = dc_ptr1; \ REAL_DEC_CHARPTR (dc_ptr2); \ assert (dc_ptr1 - dc_ptr2 == \ REP_BYTES_BY_FIRST_BYTE (*dc_ptr2)); \ @@ -429,6 +436,7 @@ } while (0) #else /* ! ERROR_CHECK_BUFPOS */ +#define INC_CHARBYTIND(ptr,pos) REAL_INC_CHARBYTIND (ptr,pos) #define INC_CHARPTR(ptr) REAL_INC_CHARPTR (ptr) #define DEC_CHARPTR(ptr) REAL_DEC_CHARPTR (ptr) #endif /* ! ERROR_CHECK_BUFPOS */ @@ -462,9 +470,9 @@ /* section of internally-formatted text */ /* -------------------------------------------------------------- */ -INLINE CONST Bufbyte *charptr_n_addr (CONST Bufbyte *ptr, Charcount offset); -INLINE CONST Bufbyte * -charptr_n_addr (CONST Bufbyte *ptr, Charcount offset) +INLINE const Bufbyte *charptr_n_addr (const Bufbyte *ptr, Charcount offset); +INLINE const Bufbyte * +charptr_n_addr (const Bufbyte *ptr, Charcount offset) { return ptr + charcount_to_bytecount (ptr, offset); } @@ -479,13 +487,13 @@ #ifdef MULE -Emchar non_ascii_charptr_emchar (CONST Bufbyte *ptr); +Emchar non_ascii_charptr_emchar (const Bufbyte *ptr); Bytecount non_ascii_set_charptr_emchar (Bufbyte *ptr, Emchar c); -Bytecount non_ascii_charptr_copy_char (CONST Bufbyte *ptr, Bufbyte *ptr2); +Bytecount non_ascii_charptr_copy_char (const Bufbyte *ptr, Bufbyte *ptr2); -INLINE Emchar charptr_emchar (CONST Bufbyte *ptr); +INLINE Emchar charptr_emchar (const Bufbyte *ptr); INLINE Emchar -charptr_emchar (CONST Bufbyte *ptr) +charptr_emchar (const Bufbyte *ptr) { return BYTE_ASCII_P (*ptr) ? simple_charptr_emchar (ptr) : @@ -501,9 +509,9 @@ non_ascii_set_charptr_emchar (ptr, x); } -INLINE Bytecount charptr_copy_char (CONST Bufbyte *ptr, Bufbyte *ptr2); +INLINE Bytecount charptr_copy_char (const Bufbyte *ptr, Bufbyte *ptr2); INLINE Bytecount -charptr_copy_char (CONST Bufbyte *ptr, Bufbyte *ptr2) +charptr_copy_char (const Bufbyte *ptr, Bufbyte *ptr2) { return BYTE_ASCII_P (*ptr) ? simple_charptr_copy_char (ptr, ptr2) : @@ -559,7 +567,7 @@ #else -#define XCHAR_OR_CHAR_INT(obj) (CHARP ((obj)) ? XCHAR ((obj)) : XINT ((obj))) +#define XCHAR_OR_CHAR_INT(obj) (CHARP (obj) ? XCHAR (obj) : XINT (obj)) #endif @@ -618,9 +626,9 @@ INLINE Bytind BI_BUF_PTR_BYTE_POS (struct buffer *buf, Bufbyte *ptr) { - return ((ptr) - (buf)->text->beg + 1 - - ((ptr - (buf)->text->beg + 1) > (buf)->text->gpt - ? (buf)->text->gap_size : 0)); + return (ptr - buf->text->beg + 1 + - ((ptr - buf->text->beg + 1) > buf->text->gpt + ? buf->text->gap_size : 0)); } #define BUF_PTR_BYTE_POS(buf, ptr) \ @@ -631,8 +639,8 @@ INLINE Bufbyte * BI_BUF_BYTE_ADDRESS (struct buffer *buf, Bytind pos) { - return ((buf)->text->beg + - ((pos >= (buf)->text->gpt ? (pos + (buf)->text->gap_size) : pos) + return (buf->text->beg + + ((pos >= buf->text->gpt ? (pos + buf->text->gap_size) : pos) - 1)); } @@ -644,8 +652,8 @@ INLINE Bufbyte * BI_BUF_BYTE_ADDRESS_BEFORE (struct buffer *buf, Bytind pos) { - return ((buf)->text->beg + - ((pos > (buf)->text->gpt ? (pos + (buf)->text->gap_size) : pos) + return (buf->text->beg + + ((pos > buf->text->gpt ? (pos + buf->text->gap_size) : pos) - 2)); } @@ -660,16 +668,16 @@ INLINE int valid_memind_p (struct buffer *buf, Memind x) { - return ((x >= 1 && x <= (Memind) (buf)->text->gpt) || - (x > (Memind) ((buf)->text->gpt + (buf)->text->gap_size) && - x <= (Memind) ((buf)->text->z + (buf)->text->gap_size))); + return ((x >= 1 && x <= (Memind) buf->text->gpt) || + (x > (Memind) (buf->text->gpt + buf->text->gap_size) && + x <= (Memind) (buf->text->z + buf->text->gap_size))); } INLINE Memind bytind_to_memind (struct buffer *buf, Bytind x); INLINE Memind bytind_to_memind (struct buffer *buf, Bytind x) { - return (Memind) ((x > (buf)->text->gpt) ? (x + (buf)->text->gap_size) : x); + return (Memind) ((x > buf->text->gpt) ? (x + buf->text->gap_size) : x); } @@ -680,8 +688,8 @@ #ifdef ERROR_CHECK_BUFPOS assert (valid_memind_p (buf, x)); #endif - return (Bytind) ((x > (Memind) (buf)->text->gpt) ? - x - (buf)->text->gap_size : + return (Bytind) ((x > (Memind) buf->text->gpt) ? + x - buf->text->gap_size : x); } @@ -1030,304 +1038,270 @@ #define BUF_CHARPTR_COPY_CHAR(buf, pos, str) \ BI_BUF_CHARPTR_COPY_CHAR (buf, bufpos_to_bytind (buf, pos), str) - - /************************************************************************/ -/* */ -/* working with externally-formatted data */ -/* */ +/* */ +/* Converting between internal and external format */ +/* */ /************************************************************************/ +/* + All client code should use only the two macros -/* Sometimes strings need to be converted into one or another - external format, for passing to a library function. (Note - that we encapsulate and automatically convert the arguments - of some functions, but not others.) At times this conversion - also has to go the other way -- i.e. when we get external- - format strings back from a library function. -*/ + TO_EXTERNAL_FORMAT (source_type, source, sink_type, sink, coding_system) + TO_INTERNAL_FORMAT (source_type, source, sink_type, sink, coding_system) + + Typical use is -#ifdef FILE_CODING + TO_EXTERNAL_FORMAT (DATA, (ptr, len), + LISP_BUFFER, buffer, + Qfile_name); -/* WARNING: These use a static buffer. This can lead to disaster if - these functions are not used *very* carefully. Under normal - circumstances, do not call these functions; call the front ends - below. */ + The source or sink can be specified in one of these ways: -Extbyte *convert_to_external_format (CONST Bufbyte *ptr, - Bytecount len, - Extcount *len_out, - enum external_data_format fmt); -Bufbyte *convert_from_external_format (CONST Extbyte *ptr, - Extcount len, - Bytecount *len_out, - enum external_data_format fmt); - -#else /* ! MULE */ + DATA, (ptr, len), // input data is a fixed buffer of size len + ALLOCA, (ptr, len), // output data is in a alloca()ed buffer of size len + MALLOC, (ptr, len), // output data is in a malloc()ed buffer of size len + C_STRING_ALLOCA, ptr, // equivalent to ALLOCA (ptr, len_ignored) on output. + C_STRING_MALLOC, ptr, // equivalent to MALLOC (ptr, len_ignored) on output. + C_STRING, ptr, // equivalent to DATA, (ptr, strlen (ptr) + 1) on input + LISP_STRING, string, // input or output is a Lisp_Object of type string + LISP_BUFFER, buffer, // output is written to (point) in lisp buffer + LISP_LSTREAM, lstream, // input or output is a Lisp_Object of type lstream + LISP_OPAQUE, object, // input or output is a Lisp_Object of type opaque -#define convert_to_external_format(ptr, len, len_out, fmt) \ - (*(len_out) = (int) (len), (Extbyte *) (ptr)) -#define convert_from_external_format(ptr, len, len_out, fmt) \ - (*(len_out) = (Bytecount) (len), (Bufbyte *) (ptr)) + When specifying the sink, use lvalues, since the macro will assign to them, + except when the sink is an lstream or a lisp buffer. -#endif /* ! MULE */ + The macros accept the kinds of sources and sinks appropriate for + internal and external data representation. See the type_checking_assert + macros below for the actual allowed types. -/* In all of the following macros we use the following general principles: - - -- Functions that work with charptr's accept two sorts of charptr's: + Since some sources and sinks use one argument (a Lisp_Object) to + specify them, while others take a (pointer, length) pair, we use + some C preprocessor trickery to allow pair arguments to be specified + by parenthesizing them, as in the examples above. - a) Pointers to memory with a length specified. The pointer will be - fundamentally of type `unsigned char *' (although labelled - as `Bufbyte *' for internal-format data and `Extbyte *' for - external-format data) and the length will be fundamentally of - type `int' (although labelled as `Bytecount' for internal-format - data and `Extcount' for external-format data). The length is - always a count in bytes. - b) Zero-terminated pointers; no length specified. The pointer - is of type `char *', whether the data pointed to is internal-format - or external-format. These sorts of pointers are available for - convenience in working with C library functions and literal - strings. In general you should use these sorts of pointers only - to interface to library routines and not for general manipulation, - as you are liable to lose embedded nulls and such. This could - be a big problem for routines that want Unicode-formatted data, - which is likely to have lots of embedded nulls in it. - (In the real world, though, external Unicode data will be UTF-8, - which will not have embedded nulls and is ASCII-compatible - martin) + Anything prefixed by dfc_ (`data format conversion') is private. + They are only used to implement these macros. - -- Functions that work with Lisp strings accept strings as Lisp Objects - (as opposed to the `struct Lisp_String *' for some of the other - string accessors). This is for convenience in working with the - functions, as otherwise you will almost always have to call - XSTRING() on the object. + Using C_STRING* is appropriate for using with external APIs that take + null-terminated strings. For internal data, we should try to be + '\0'-clean - i.e. allow arbitrary data to contain embedded '\0'. - -- Functions that work with charptr's are not guaranteed to copy - their data into alloca()ed space. Functions that work with - Lisp strings are, however. The reason is that Lisp strings can - be relocated any time a GC happens, and it could happen at some - rather unexpected times. The internal-external conversion is - rarely done in time-critical functions, and so the slight - extra time required for alloca() and copy is well-worth the - safety of knowing your string data won't be relocated out from - under you. - */ - + Sometime in the future we might allow output to C_STRING_ALLOCA or + C_STRING_MALLOC _only_ with TO_EXTERNAL_FORMAT(), not + TO_INTERNAL_FORMAT(). */ -/* Maybe convert charptr's data into ext-format and store the result in - alloca()'ed space. - - You may wonder why this is written in this fashion and not as a - function call. With a little trickery it could certainly be - written this way, but it won't work because of those DAMN GCC WANKERS - who couldn't be bothered to handle alloca() properly on the x86 - architecture. (If you put a call to alloca() in the argument to - a function call, the stack space gets allocated right in the - middle of the arguments to the function call and you are unbelievably - hosed.) */ - -#ifdef MULE - -#define GET_CHARPTR_EXT_DATA_ALLOCA(ptr, len, fmt, ptr_out, len_out) do \ -{ \ - Bytecount gceda_len_in = (Bytecount) (len); \ - Extcount gceda_len_out; \ - CONST Bufbyte *gceda_ptr_in = (ptr); \ - Extbyte *gceda_ptr_out = \ - convert_to_external_format (gceda_ptr_in, gceda_len_in, \ - &gceda_len_out, fmt); \ - /* If the new string is identical to the old (will be the case most \ - of the time), just return the same string back. This saves \ - on alloca()ing, which can be useful on C alloca() machines and \ - on stack-space-challenged environments. */ \ - \ - if (gceda_len_in == gceda_len_out && \ - !memcmp (gceda_ptr_in, gceda_ptr_out, gceda_len_out)) \ - { \ - (ptr_out) = (Extbyte *) gceda_ptr_in; \ - } \ - else \ - { \ - (ptr_out) = (Extbyte *) alloca (1 + gceda_len_out); \ - memcpy ((void *) ptr_out, gceda_ptr_out, 1 + gceda_len_out); \ - } \ - (len_out) = gceda_len_out; \ +#define TO_EXTERNAL_FORMAT(source_type, source, sink_type, sink, coding_system) \ +do { \ + dfc_conversion_type dfc_simplified_source_type; \ + dfc_conversion_type dfc_simplified_sink_type; \ + dfc_conversion_data dfc_source; \ + dfc_conversion_data dfc_sink; \ + \ + type_checking_assert \ + ((DFC_TYPE_##source_type == DFC_TYPE_DATA || \ + DFC_TYPE_##source_type == DFC_TYPE_C_STRING || \ + DFC_TYPE_##source_type == DFC_TYPE_LISP_STRING || \ + DFC_TYPE_##source_type == DFC_TYPE_LISP_OPAQUE || \ + DFC_TYPE_##source_type == DFC_TYPE_LISP_LSTREAM) \ + && \ + (DFC_TYPE_##sink_type == DFC_TYPE_ALLOCA || \ + DFC_TYPE_##sink_type == DFC_TYPE_MALLOC || \ + DFC_TYPE_##sink_type == DFC_TYPE_C_STRING_ALLOCA || \ + DFC_TYPE_##sink_type == DFC_TYPE_C_STRING_MALLOC || \ + DFC_TYPE_##sink_type == DFC_TYPE_LISP_LSTREAM || \ + DFC_TYPE_##sink_type == DFC_TYPE_LISP_OPAQUE)); \ + \ + DFC_SOURCE_##source_type##_TO_ARGS (source); \ + DFC_SINK_##sink_type##_TO_ARGS (sink); \ + \ + DFC_CONVERT_TO_EXTERNAL_FORMAT (dfc_simplified_source_type, &dfc_source, \ + coding_system, \ + dfc_simplified_sink_type, &dfc_sink); \ + \ + DFC_##sink_type##_USE_CONVERTED_DATA (sink); \ } while (0) -#else /* ! MULE */ - -#define GET_CHARPTR_EXT_DATA_ALLOCA(ptr, len, fmt, ptr_out, len_out) do \ -{ \ - (ptr_out) = (Extbyte *) (ptr); \ - (len_out) = (Extcount) (len); \ -} while (0) - -#endif /* ! MULE */ - -#define GET_C_CHARPTR_EXT_DATA_ALLOCA(ptr, fmt, ptr_out) do \ -{ \ - Extcount gcceda_ignored_len; \ - CONST Bufbyte *gcceda_ptr_in = (CONST Bufbyte *) (ptr); \ - Extbyte *gcceda_ptr_out; \ - \ - GET_CHARPTR_EXT_DATA_ALLOCA (gcceda_ptr_in, \ - strlen ((char *) gcceda_ptr_in), \ - fmt, \ - gcceda_ptr_out, \ - gcceda_ignored_len); \ - (ptr_out) = (char *) gcceda_ptr_out; \ +#define TO_INTERNAL_FORMAT(source_type, source, sink_type, sink, coding_system) \ +do { \ + dfc_conversion_type dfc_simplified_source_type; \ + dfc_conversion_type dfc_simplified_sink_type; \ + dfc_conversion_data dfc_source; \ + dfc_conversion_data dfc_sink; \ + \ + type_checking_assert \ + ((DFC_TYPE_##source_type == DFC_TYPE_DATA || \ + DFC_TYPE_##source_type == DFC_TYPE_C_STRING || \ + DFC_TYPE_##source_type == DFC_TYPE_LISP_OPAQUE || \ + DFC_TYPE_##source_type == DFC_TYPE_LISP_LSTREAM) \ + && \ + (DFC_TYPE_##sink_type == DFC_TYPE_ALLOCA || \ + DFC_TYPE_##sink_type == DFC_TYPE_MALLOC || \ + DFC_TYPE_##sink_type == DFC_TYPE_C_STRING_ALLOCA || \ + DFC_TYPE_##sink_type == DFC_TYPE_C_STRING_MALLOC || \ + DFC_TYPE_##sink_type == DFC_TYPE_LISP_STRING || \ + DFC_TYPE_##sink_type == DFC_TYPE_LISP_LSTREAM || \ + DFC_TYPE_##sink_type == DFC_TYPE_LISP_BUFFER)); \ + \ + DFC_SOURCE_##source_type##_TO_ARGS (source); \ + DFC_SINK_##sink_type##_TO_ARGS (sink); \ + \ + DFC_CONVERT_TO_INTERNAL_FORMAT (dfc_simplified_source_type, &dfc_source, \ + coding_system, \ + dfc_simplified_sink_type, &dfc_sink); \ + \ + DFC_##sink_type##_USE_CONVERTED_DATA (sink); \ } while (0) -#define GET_C_CHARPTR_EXT_BINARY_DATA_ALLOCA(ptr, ptr_out) \ - GET_C_CHARPTR_EXT_DATA_ALLOCA (ptr, FORMAT_BINARY, ptr_out) -#define GET_CHARPTR_EXT_BINARY_DATA_ALLOCA(ptr, len, ptr_out, len_out) \ - GET_CHARPTR_EXT_DATA_ALLOCA (ptr, len, FORMAT_BINARY, ptr_out, len_out) - -#define GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA(ptr, ptr_out) \ - GET_C_CHARPTR_EXT_DATA_ALLOCA (ptr, FORMAT_FILENAME, ptr_out) -#define GET_CHARPTR_EXT_FILENAME_DATA_ALLOCA(ptr, len, ptr_out, len_out) \ - GET_CHARPTR_EXT_DATA_ALLOCA (ptr, len, FORMAT_FILENAME, ptr_out, len_out) +#ifdef FILE_CODING +#define DFC_CONVERT_TO_EXTERNAL_FORMAT dfc_convert_to_external_format +#define DFC_CONVERT_TO_INTERNAL_FORMAT dfc_convert_to_internal_format +#else +/* ignore coding_system argument */ +#define DFC_CONVERT_TO_EXTERNAL_FORMAT(a, b, coding_system, c, d) \ + dfc_convert_to_external_format (a, b, c, d) +#define DFC_CONVERT_TO_INTERNAL_FORMAT(a, b, coding_system, c, d) \ + dfc_convert_to_internal_format (a, b, c, d) +#endif -#define GET_C_CHARPTR_EXT_CTEXT_DATA_ALLOCA(ptr, ptr_out) \ - GET_C_CHARPTR_EXT_DATA_ALLOCA (ptr, FORMAT_CTEXT, ptr_out) -#define GET_CHARPTR_EXT_CTEXT_DATA_ALLOCA(ptr, len, ptr_out, len_out) \ - GET_CHARPTR_EXT_DATA_ALLOCA (ptr, len, FORMAT_CTEXT, ptr_out, len_out) - -/* Maybe convert external charptr's data into internal format and store - the result in alloca()'ed space. +typedef union +{ + struct { const void *ptr; size_t len; } data; + Lisp_Object lisp_object; +} dfc_conversion_data; - You may wonder why this is written in this fashion and not as a - function call. With a little trickery it could certainly be - written this way, but it won't work because of those DAMN GCC WANKERS - who couldn't be bothered to handle alloca() properly on the x86 - architecture. (If you put a call to alloca() in the argument to - a function call, the stack space gets allocated right in the - middle of the arguments to the function call and you are unbelievably - hosed.) */ - -#ifdef MULE +enum dfc_conversion_type +{ + DFC_TYPE_DATA, + DFC_TYPE_ALLOCA, + DFC_TYPE_MALLOC, + DFC_TYPE_C_STRING, + DFC_TYPE_C_STRING_ALLOCA, + DFC_TYPE_C_STRING_MALLOC, + DFC_TYPE_LISP_STRING, + DFC_TYPE_LISP_LSTREAM, + DFC_TYPE_LISP_OPAQUE, + DFC_TYPE_LISP_BUFFER +}; +typedef enum dfc_conversion_type dfc_conversion_type; -#define GET_CHARPTR_INT_DATA_ALLOCA(ptr, len, fmt, ptr_out, len_out) do \ -{ \ - Extcount gcida_len_in = (Extcount) (len); \ - Bytecount gcida_len_out; \ - CONST Extbyte *gcida_ptr_in = (ptr); \ - Bufbyte *gcida_ptr_out = \ - convert_from_external_format (gcida_ptr_in, gcida_len_in, \ - &gcida_len_out, fmt); \ - /* If the new string is identical to the old (will be the case most \ - of the time), just return the same string back. This saves \ - on alloca()ing, which can be useful on C alloca() machines and \ - on stack-space-challenged environments. */ \ - \ - if (gcida_len_in == gcida_len_out && \ - !memcmp (gcida_ptr_in, gcida_ptr_out, gcida_len_out)) \ - { \ - (ptr_out) = (Bufbyte *) gcida_ptr_in; \ - } \ - else \ - { \ - (ptr_out) = (Extbyte *) alloca (1 + gcida_len_out); \ - memcpy ((void *) ptr_out, gcida_ptr_out, 1 + gcida_len_out); \ - } \ - (len_out) = gcida_len_out; \ +/* WARNING: These use a static buffer. This can lead to disaster if + these functions are not used *very* carefully. Another reason to only use + TO_EXTERNAL_FORMATf() and TO_INTERNAL_FORMAT(). */ +void +dfc_convert_to_external_format (dfc_conversion_type source_type, + dfc_conversion_data *source, +#ifdef FILE_CODING + Lisp_Object coding_system, +#endif + dfc_conversion_type sink_type, + dfc_conversion_data *sink); +void +dfc_convert_to_internal_format (dfc_conversion_type source_type, + dfc_conversion_data *source, +#ifdef FILE_CODING + Lisp_Object coding_system, +#endif + dfc_conversion_type sink_type, + dfc_conversion_data *sink); +/* CPP Trickery */ +#define DFC_CPP_CAR(x,y) (x) +#define DFC_CPP_CDR(x,y) (y) + +/* Convert `source' to args for dfc_convert_to_*_format() */ +#define DFC_SOURCE_DATA_TO_ARGS(val) do { \ + dfc_source.data.ptr = DFC_CPP_CAR val; \ + dfc_source.data.len = DFC_CPP_CDR val; \ + dfc_simplified_source_type = DFC_TYPE_DATA; \ } while (0) - -#else /* ! MULE */ - -#define GET_CHARPTR_INT_DATA_ALLOCA(ptr, len, fmt, ptr_out, len_out) do \ -{ \ - (ptr_out) = (Bufbyte *) (ptr); \ - (len_out) = (Bytecount) (len); \ +#define DFC_SOURCE_C_STRING_TO_ARGS(val) do { \ + dfc_source.data.len = \ + strlen ((char *) (dfc_source.data.ptr = (val))); \ + dfc_simplified_source_type = DFC_TYPE_DATA; \ +} while (0) +#define DFC_SOURCE_LISP_STRING_TO_ARGS(val) do { \ + Lisp_Object dfc_slsta = (val); \ + type_checking_assert (STRINGP (dfc_slsta)); \ + dfc_source.lisp_object = dfc_slsta; \ + dfc_simplified_source_type = DFC_TYPE_LISP_STRING; \ +} while (0) +#define DFC_SOURCE_LISP_LSTREAM_TO_ARGS(val) do { \ + Lisp_Object dfc_sllta = (val); \ + type_checking_assert (LSTREAMP (dfc_sllta)); \ + dfc_source.lisp_object = dfc_sllta; \ + dfc_simplified_source_type = DFC_TYPE_LISP_LSTREAM; \ +} while (0) +#define DFC_SOURCE_LISP_OPAQUE_TO_ARGS(val) do { \ + Lisp_Opaque *dfc_slota = XOPAQUE (val); \ + dfc_source.data.ptr = OPAQUE_DATA (dfc_slota); \ + dfc_source.data.len = OPAQUE_SIZE (dfc_slota); \ + dfc_simplified_source_type = DFC_TYPE_DATA; \ } while (0) -#endif /* ! MULE */ - -#define GET_C_CHARPTR_INT_DATA_ALLOCA(ptr, fmt, ptr_out) do \ -{ \ - Bytecount gccida_ignored_len; \ - CONST Extbyte *gccida_ptr_in = (CONST Extbyte *) (ptr); \ - Bufbyte *gccida_ptr_out; \ - \ - GET_CHARPTR_INT_DATA_ALLOCA (gccida_ptr_in, \ - strlen ((char *) gccida_ptr_in), \ - fmt, \ - gccida_ptr_out, \ - gccida_ignored_len); \ - (ptr_out) = gccida_ptr_out; \ +/* Convert `sink' to args for dfc_convert_to_*_format() */ +#define DFC_SINK_ALLOCA_TO_ARGS(val) \ + dfc_simplified_sink_type = DFC_TYPE_DATA +#define DFC_SINK_C_STRING_ALLOCA_TO_ARGS(val) \ + dfc_simplified_sink_type = DFC_TYPE_DATA +#define DFC_SINK_MALLOC_TO_ARGS(val) \ + dfc_simplified_sink_type = DFC_TYPE_DATA +#define DFC_SINK_C_STRING_MALLOC_TO_ARGS(val) \ + dfc_simplified_sink_type = DFC_TYPE_DATA +#define DFC_SINK_LISP_STRING_TO_ARGS(val) \ + dfc_simplified_sink_type = DFC_TYPE_DATA +#define DFC_SINK_LISP_OPAQUE_TO_ARGS(val) \ + dfc_simplified_sink_type = DFC_TYPE_DATA +#define DFC_SINK_LISP_LSTREAM_TO_ARGS(val) do { \ + Lisp_Object dfc_sllta = (val); \ + type_checking_assert (LSTREAMP (dfc_sllta)); \ + dfc_sink.lisp_object = dfc_sllta; \ + dfc_simplified_sink_type = DFC_TYPE_LISP_LSTREAM; \ +} while (0) +#define DFC_SINK_LISP_BUFFER_TO_ARGS(val) do { \ + struct buffer *dfc_slbta = XBUFFER (val); \ + dfc_sink.lisp_object = \ + make_lisp_buffer_output_stream \ + (dfc_slbta, BUF_PT (dfc_slbta), 0); \ + dfc_simplified_sink_type = DFC_TYPE_LISP_LSTREAM; \ } while (0) -#define GET_C_CHARPTR_INT_BINARY_DATA_ALLOCA(ptr, ptr_out) \ - GET_C_CHARPTR_INT_DATA_ALLOCA (ptr, FORMAT_BINARY, ptr_out) -#define GET_CHARPTR_INT_BINARY_DATA_ALLOCA(ptr, len, ptr_out, len_out) \ - GET_CHARPTR_INT_DATA_ALLOCA (ptr, len, FORMAT_BINARY, ptr_out, len_out) - -#define GET_C_CHARPTR_INT_FILENAME_DATA_ALLOCA(ptr, ptr_out) \ - GET_C_CHARPTR_INT_DATA_ALLOCA (ptr, FORMAT_FILENAME, ptr_out) -#define GET_CHARPTR_INT_FILENAME_DATA_ALLOCA(ptr, len, ptr_out, len_out) \ - GET_CHARPTR_INT_DATA_ALLOCA (ptr, len, FORMAT_FILENAME, ptr_out, len_out) - -#define GET_C_CHARPTR_INT_CTEXT_DATA_ALLOCA(ptr, ptr_out) \ - GET_C_CHARPTR_INT_DATA_ALLOCA (ptr, FORMAT_CTEXT, ptr_out) -#define GET_CHARPTR_INT_CTEXT_DATA_ALLOCA(ptr, len, ptr_out, len_out) \ - GET_CHARPTR_INT_DATA_ALLOCA (ptr, len, FORMAT_CTEXT, ptr_out, len_out) - - -/* Maybe convert Lisp string's data into ext-format and store the result in - alloca()'ed space. - - You may wonder why this is written in this fashion and not as a - function call. With a little trickery it could certainly be - written this way, but it won't work because of those DAMN GCC WANKERS - who couldn't be bothered to handle alloca() properly on the x86 - architecture. (If you put a call to alloca() in the argument to - a function call, the stack space gets allocated right in the - middle of the arguments to the function call and you are unbelievably - hosed.) */ +/* Assign to the `sink' lvalue(s) using the converted data. */ +#define DFC_ALLOCA_USE_CONVERTED_DATA(sink) do { \ + void * dfc_sink_ret = alloca (dfc_sink.data.len + 1); \ + memcpy (dfc_sink_ret, dfc_sink.data.ptr, dfc_sink.data.len + 1); \ + (DFC_CPP_CAR sink) = (unsigned char *) dfc_sink_ret; \ + (DFC_CPP_CDR sink) = dfc_sink.data.len; \ +} while (0) +#define DFC_MALLOC_USE_CONVERTED_DATA(sink) do { \ + void * dfc_sink_ret = xmalloc (dfc_sink.data.len + 1); \ + memcpy (dfc_sink_ret, dfc_sink.data.ptr, dfc_sink.data.len + 1); \ + (DFC_CPP_CAR sink) = (unsigned char *) dfc_sink_ret; \ + (DFC_CPP_CDR sink) = dfc_sink.data.len; \ +} while (0) +#define DFC_C_STRING_ALLOCA_USE_CONVERTED_DATA(sink) do { \ + void * dfc_sink_ret = alloca (dfc_sink.data.len + 1); \ + memcpy (dfc_sink_ret, dfc_sink.data.ptr, dfc_sink.data.len + 1); \ + (sink) = (char *) dfc_sink_ret; \ +} while (0) +#define DFC_C_STRING_MALLOC_USE_CONVERTED_DATA(sink) do { \ + void * dfc_sink_ret = xmalloc (dfc_sink.data.len + 1); \ + memcpy (dfc_sink_ret, dfc_sink.data.ptr, dfc_sink.data.len + 1); \ + (sink) = (char *) dfc_sink_ret; \ +} while (0) +#define DFC_LISP_STRING_USE_CONVERTED_DATA(sink) \ + sink = make_string ((Bufbyte *) dfc_sink.data.ptr, dfc_sink.data.len) +#define DFC_LISP_OPAQUE_USE_CONVERTED_DATA(sink) \ + sink = make_opaque (dfc_sink.data.ptr, dfc_sink.data.len) +#define DFC_LISP_LSTREAM_USE_CONVERTED_DATA(sink) /* data already used */ +#define DFC_LISP_BUFFER_USE_CONVERTED_DATA(sink) \ + Lstream_delete (XLSTREAM (dfc_sink.lisp_object)) -#define GET_STRING_EXT_DATA_ALLOCA(s, fmt, ptr_out, len_out) do \ -{ \ - Extcount gseda_len_out; \ - struct Lisp_String *gseda_s = XSTRING (s); \ - Extbyte * gseda_ptr_out = \ - convert_to_external_format (string_data (gseda_s), \ - string_length (gseda_s), \ - &gseda_len_out, fmt); \ - (ptr_out) = (Extbyte *) alloca (1 + gseda_len_out); \ - memcpy ((void *) ptr_out, gseda_ptr_out, 1 + gseda_len_out); \ - (len_out) = gseda_len_out; \ -} while (0) - - -#define GET_C_STRING_EXT_DATA_ALLOCA(s, fmt, ptr_out) do \ -{ \ - Extcount gcseda_ignored_len; \ - Extbyte *gcseda_ptr_out; \ - \ - GET_STRING_EXT_DATA_ALLOCA (s, fmt, gcseda_ptr_out, \ - gcseda_ignored_len); \ - (ptr_out) = (char *) gcseda_ptr_out; \ -} while (0) - -#define GET_STRING_BINARY_DATA_ALLOCA(s, ptr_out, len_out) \ - GET_STRING_EXT_DATA_ALLOCA (s, FORMAT_BINARY, ptr_out, len_out) -#define GET_C_STRING_BINARY_DATA_ALLOCA(s, ptr_out) \ - GET_C_STRING_EXT_DATA_ALLOCA (s, FORMAT_BINARY, ptr_out) - -#define GET_STRING_FILENAME_DATA_ALLOCA(s, ptr_out, len_out) \ - GET_STRING_EXT_DATA_ALLOCA (s, FORMAT_FILENAME, ptr_out, len_out) -#define GET_C_STRING_FILENAME_DATA_ALLOCA(s, ptr_out) \ - GET_C_STRING_EXT_DATA_ALLOCA (s, FORMAT_FILENAME, ptr_out) - -#define GET_STRING_OS_DATA_ALLOCA(s, ptr_out, len_out) \ - GET_STRING_EXT_DATA_ALLOCA (s, FORMAT_OS, ptr_out, len_out) -#define GET_C_STRING_OS_DATA_ALLOCA(s, ptr_out) \ - GET_C_STRING_EXT_DATA_ALLOCA (s, FORMAT_OS, ptr_out) - -#define GET_STRING_CTEXT_DATA_ALLOCA(s, ptr_out, len_out) \ - GET_STRING_EXT_DATA_ALLOCA (s, FORMAT_CTEXT, ptr_out, len_out) -#define GET_C_STRING_CTEXT_DATA_ALLOCA(s, ptr_out) \ - GET_C_STRING_EXT_DATA_ALLOCA (s, FORMAT_CTEXT, ptr_out) - +/* Someday we might want to distinguish between Qnative and Qfile_name + by using coding-system aliases, but for now it suffices to have + these be identical. Qnative can be used as the coding_system + argument to TO_EXTERNAL_FORMAT() and TO_INTERNAL_FORMAT(). */ +#define Qnative Qfile_name /************************************************************************/ @@ -1433,7 +1407,7 @@ #define POINT_MARKER_P(marker) \ (XMARKER (marker)->buffer != 0 && \ - EQ ((marker), XMARKER (marker)->buffer->point_marker)) + EQ (marker, XMARKER (marker)->buffer->point_marker)) #define BUF_MARKERS(buf) ((buf)->markers) @@ -1560,8 +1534,8 @@ #ifdef REL_ALLOC -char *r_alloc (unsigned char **, unsigned long); -char *r_re_alloc (unsigned char **, unsigned long); +char *r_alloc (unsigned char **, size_t); +char *r_re_alloc (unsigned char **, size_t); void r_alloc_free (unsigned char **); #define BUFFER_ALLOC(data, size) \ @@ -1594,17 +1568,17 @@ /* from insdel.c */ void set_buffer_point (struct buffer *buf, Bufpos pos, Bytind bipos); void find_charsets_in_bufbyte_string (unsigned char *charsets, - CONST Bufbyte *str, + const Bufbyte *str, Bytecount len); void find_charsets_in_emchar_string (unsigned char *charsets, - CONST Emchar *str, + const Emchar *str, Charcount len); -int bufbyte_string_displayed_columns (CONST Bufbyte *str, Bytecount len); -int emchar_string_displayed_columns (CONST Emchar *str, Charcount len); -void convert_bufbyte_string_into_emchar_dynarr (CONST Bufbyte *str, +int bufbyte_string_displayed_columns (const Bufbyte *str, Bytecount len); +int emchar_string_displayed_columns (const Emchar *str, Charcount len); +void convert_bufbyte_string_into_emchar_dynarr (const Bufbyte *str, Bytecount len, Emchar_dynarr *dyn); -Charcount convert_bufbyte_string_into_emchar_string (CONST Bufbyte *str, +Charcount convert_bufbyte_string_into_emchar_string (const Bufbyte *str, Bytecount len, Emchar *arr); void convert_emchar_string_into_bufbyte_dynarr (Emchar *arr, int nels, @@ -1700,7 +1674,7 @@ set_string_char (XSTRING (table), (Charcount) ch1, ch2) #ifdef MULE -# define MAKE_MIRROR_TRT_TABLE() make_opaque (256, 0) +# define MAKE_MIRROR_TRT_TABLE() make_opaque (OPAQUE_CLEAR, 256) # define MIRROR_TRT_TABLE_AS_STRING(table) ((Bufbyte *) XOPAQUE_DATA (table)) # define MIRROR_TRT_TABLE_CHAR_1(table, ch) \ ((Emchar) (MIRROR_TRT_TABLE_AS_STRING (table)[ch])) @@ -1786,4 +1760,4 @@ #define DOWNCASE(buf, ch) DOWNCASE_TABLE_OF (buf, ch) -#endif /* _XEMACS_BUFFER_H_ */ +#endif /* INCLUDED_buffer_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/bufslots.h --- a/src/bufslots.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/bufslots.h Mon Aug 13 11:13:30 2007 +0200 @@ -32,6 +32,10 @@ definition. In the garbage collector this file is included after defining MARKED_SLOT(x) to be mark_object(buffer->x). */ +#ifndef BUFFER_SLOTS_FIRST_NAME +#define BUFFER_SLOTS_FIRST_NAME name +#endif + /* The name of this buffer. */ MARKED_SLOT (name); @@ -235,6 +239,11 @@ /* A hash table that maps from a "generic extent" (an extent in `modeline-format') into a buffer-specific extent. */ MARKED_SLOT (modeline_extent_table); + +#ifndef BUFFER_SLOTS_LAST_NAME +#define BUFFER_SLOTS_LAST_NAME modeline_extent_table +#endif + #if 0 /* FSFmacs */ /* This is silly and stupid */ /* These are so we don't have to recompile everything diff -r f4aeb21a5bad -r 74fd4e045ea6 src/bytecode.c --- a/src/bytecode.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/bytecode.c Mon Aug 13 11:13:30 2007 +0200 @@ -28,7 +28,7 @@ FSF: long ago. -hacked on by jwz@netscape.com 1991-06 +hacked on by jwz@jwz.org 1991-06 o added a compile-time switch to turn on simple sanity checking; o put back the obsolete byte-codes for error-detection; o added a new instruction, unbind_all, which I will use for @@ -56,7 +56,6 @@ #include "opaque.h" #include "syntax.h" -#include <stddef.h> #include <limits.h> EXFUN (Ffetch_bytecode, 1); @@ -217,21 +216,15 @@ static void invalid_byte_code_error (char *error_message, ...); Lisp_Object * execute_rare_opcode (Lisp_Object *stack_ptr, - CONST Opbyte *program_ptr, + const Opbyte *program_ptr, Opcode opcode); -static Lisp_Object execute_optimized_program (CONST Opbyte *program, +static Lisp_Object execute_optimized_program (const Opbyte *program, int stack_depth, Lisp_Object *constants_data); extern Lisp_Object Qand_rest, Qand_optional; -/* Define ERROR_CHECK_BYTE_CODE to enable some minor sanity checking. - Useful for debugging the byte compiler. */ -#ifdef DEBUG_XEMACS -#define ERROR_CHECK_BYTE_CODE -#endif - /* Define BYTE_CODE_METER to enable generation of a byte-op usage histogram. This isn't defined in FSF Emacs and isn't defined in XEmacs v19. */ /* #define BYTE_CODE_METER */ @@ -242,21 +235,17 @@ Lisp_Object Vbyte_code_meter, Qbyte_code_meter; int byte_metering_on; -#define METER_2(code1, code2) \ - XINT (XVECTOR_DATA (XVECTOR_DATA (Vbyte_code_meter)[(code1)])[(code2)]) - -#define METER_1(code) METER_2 (0, (code)) - -#define METER_CODE(last_code, this_code) do { \ - if (byte_metering_on) \ - { \ - if (METER_1 (this_code) != ((1<<VALBITS)-1)) \ - METER_1 (this_code)++; \ - if (last_code \ - && METER_2 (last_code, this_code) != ((1<<VALBITS)-1)) \ - METER_2 (last_code, this_code)++; \ - } \ -} while (0) +static void +meter_code (Opcode prev_opcode, Opcode this_opcode) +{ + if (byte_metering_on) + { + Lisp_Object *p = XVECTOR_DATA (XVECTOR_DATA (Vbyte_code_meter)[this_opcode]); + p[0] = INT_PLUS1 (p[0]); + if (prev_opcode) + p[prev_opcode] = INT_PLUS1 (p[prev_opcode]); + } +} #endif /* BYTE_CODE_METER */ @@ -266,12 +255,12 @@ { retry: + if (INTP (obj)) return make_int (- XINT (obj)); #ifdef LISP_FLOAT_TYPE if (FLOATP (obj)) return make_float (- XFLOAT_DATA (obj)); #endif if (CHARP (obj)) return make_int (- ((int) XCHAR (obj))); if (MARKERP (obj)) return make_int (- ((int) marker_position (obj))); - if (INTP (obj)) return make_int (- XINT (obj)); obj = wrong_type_argument (Qnumber_char_or_marker_p, obj); goto retry; @@ -305,7 +294,7 @@ #ifdef LISP_FLOAT_TYPE { - int ival1, ival2; + EMACS_INT ival1, ival2; if (INTP (obj1)) ival1 = XINT (obj1); else if (CHARP (obj1)) ival1 = XCHAR (obj1); @@ -349,7 +338,7 @@ } #else /* !LISP_FLOAT_TYPE */ { - int ival1, ival2; + EMACS_INT ival1, ival2; if (INTP (obj1)) ival1 = XINT (obj1); else if (CHARP (obj1)) ival1 = XCHAR (obj1); @@ -378,7 +367,7 @@ bytecode_arithop (Lisp_Object obj1, Lisp_Object obj2, Opcode opcode) { #ifdef LISP_FLOAT_TYPE - int ival1, ival2; + EMACS_INT ival1, ival2; int float_p; retry: @@ -440,7 +429,7 @@ return make_float (dval1); } #else /* !LISP_FLOAT_TYPE */ - int ival1, ival2; + EMACS_INT ival1, ival2; retry: @@ -538,6 +527,10 @@ } wrong_number_of_arguments: + /* The actual printed compiled_function object is incomprehensible. + Check the backtrace to see if we can get a more meaningful symbol. */ + if (EQ (fun, indirect_function (*backtrace_list->function, 0))) + fun = *backtrace_list->function; return Fsignal (Qwrong_number_of_arguments, list2 (fun, make_int (nargs))); } @@ -603,12 +596,12 @@ static Lisp_Object -execute_optimized_program (CONST Opbyte *program, +execute_optimized_program (const Opbyte *program, int stack_depth, Lisp_Object *constants_data) { /* This function can GC */ - REGISTER CONST Opbyte *program_ptr = (Opbyte *) program; + REGISTER const Opbyte *program_ptr = (Opbyte *) program; REGISTER Lisp_Object *stack_ptr = alloca_array (Lisp_Object, stack_depth + 1); int speccount = specpdl_depth (); @@ -650,7 +643,7 @@ #ifdef BYTE_CODE_METER prev_opcode = this_opcode; this_opcode = opcode; - METER_CODE (prev_opcode, this_opcode); + meter_code (prev_opcode, this_opcode); #endif switch (opcode) @@ -693,7 +686,7 @@ do_varset: { Lisp_Object symbol = constants_data[n]; - struct Lisp_Symbol *symbol_ptr = XSYMBOL (symbol); + Lisp_Symbol *symbol_ptr = XSYMBOL (symbol); Lisp_Object old_value = symbol_ptr->value; Lisp_Object new_value = POP; if (!SYMBOL_VALUE_MAGIC_P (old_value) || UNBOUNDP (old_value)) @@ -714,7 +707,7 @@ do_varbind: { Lisp_Object symbol = constants_data[n]; - struct Lisp_Symbol *symbol_ptr = XSYMBOL (symbol); + Lisp_Symbol *symbol_ptr = XSYMBOL (symbol); Lisp_Object old_value = symbol_ptr->value; Lisp_Object new_value = POP; if (!SYMBOL_VALUE_MAGIC_P (old_value) || UNBOUNDP (old_value)) @@ -767,6 +760,7 @@ opcode == Bunbind+6 ? READ_UINT_1 : READ_UINT_2)); break; + case Bgoto: JUMP; break; @@ -1004,11 +998,11 @@ } case Bsub1: - TOP = INTP (TOP) ? make_int (XINT (TOP) - 1) : Fsub1 (TOP); + TOP = INTP (TOP) ? INT_MINUS1 (TOP) : Fsub1 (TOP); break; case Badd1: - TOP = INTP (TOP) ? make_int (XINT (TOP) + 1) : Fadd1 (TOP); + TOP = INTP (TOP) ? INT_PLUS1 (TOP) : Fadd1 (TOP); break; @@ -1062,7 +1056,7 @@ Lisp_Object arg2 = POP; Lisp_Object arg1 = TOP; TOP = INTP (arg1) && INTP (arg2) ? - make_int (XINT (arg1) + XINT (arg2)) : + INT_PLUS (arg1, arg2) : bytecode_arithop (arg1, arg2, opcode); break; } @@ -1072,7 +1066,7 @@ Lisp_Object arg2 = POP; Lisp_Object arg1 = TOP; TOP = INTP (arg1) && INTP (arg2) ? - make_int (XINT (arg1) - XINT (arg2)) : + INT_MINUS (arg1, arg2) : bytecode_arithop (arg1, arg2, opcode); break; } @@ -1115,7 +1109,6 @@ break; } - case Bset: { Lisp_Object arg = POP; @@ -1228,7 +1221,7 @@ Don't make this function static, since then the compiler might inline it. */ Lisp_Object * execute_rare_opcode (Lisp_Object *stack_ptr, - CONST Opbyte *program_ptr, + const Opbyte *program_ptr, Opcode opcode) { switch (opcode) @@ -1498,7 +1491,7 @@ sprintf (buf, "%s", error_message); va_start (args, error_message); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (buf), Qnil, -1, + obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (buf), Qnil, -1, args); va_end (args); @@ -1614,14 +1607,14 @@ Lisp_Object instructions, Lisp_Object constants, /* out */ - Opbyte * CONST program, - int * CONST program_length, - int * CONST varbind_count) + Opbyte * const program, + int * const program_length, + int * const varbind_count) { size_t instructions_length = XSTRING_LENGTH (instructions); size_t comfy_size = 2 * instructions_length; - int * CONST icounts = alloca_array (int, comfy_size); + int * const icounts = alloca_array (int, comfy_size); int * icounts_ptr = icounts; /* We maintain a table of jumps in the source code. */ @@ -1630,13 +1623,13 @@ int from; int to; }; - struct jump * CONST jumps = alloca_array (struct jump, comfy_size); + struct jump * const jumps = alloca_array (struct jump, comfy_size); struct jump *jumps_ptr = jumps; Opbyte *program_ptr = program; - CONST Bufbyte *ptr = XSTRING_DATA (instructions); - CONST Bufbyte * CONST end = ptr + instructions_length; + const Bufbyte *ptr = XSTRING_DATA (instructions); + const Bufbyte * const end = ptr + instructions_length; *varbind_count = 0; @@ -1901,8 +1894,7 @@ program, &program_length, &varbind_count); f->specpdl_depth = XINT (Flength (f->arglist)) + varbind_count; f->instructions = - Fpurecopy (make_opaque (program_length * sizeof (Opbyte), - (CONST void *) program)); + make_opaque (program, program_length * sizeof (Opbyte)); } assert (OPAQUEP (f->instructions)); @@ -1988,15 +1980,15 @@ static Lisp_Object -mark_compiled_function (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_compiled_function (Lisp_Object obj) { Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (obj); - markobj (f->instructions); - markobj (f->arglist); - markobj (f->doc_and_interactive); + mark_object (f->instructions); + mark_object (f->arglist); + mark_object (f->doc_and_interactive); #ifdef COMPILED_FUNCTION_ANNOTATION_HACK - markobj (f->annotated); + mark_object (f->annotated); #endif /* tail-recurse on constants */ return f->constants; @@ -2030,11 +2022,23 @@ internal_hash (f->constants, depth + 1)); } +static const struct lrecord_description compiled_function_description[] = { + { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, instructions) }, + { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, constants) }, + { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, arglist) }, + { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, doc_and_interactive) }, +#ifdef COMPILED_FUNCTION_ANNOTATION_HACK + { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, annotated) }, +#endif + { XD_END } +}; + DEFINE_BASIC_LRECORD_IMPLEMENTATION ("compiled-function", compiled_function, mark_compiled_function, print_compiled_function, 0, compiled_function_equal, compiled_function_hash, + compiled_function_description, Lisp_Compiled_Function); DEFUN ("compiled-function-p", Fcompiled_function_p, 1, 1, 0, /* @@ -2065,13 +2069,13 @@ /* Invert action performed by optimize_byte_code() */ Lisp_Opaque *opaque = XOPAQUE (f->instructions); - Bufbyte * CONST buffer = + Bufbyte * const buffer = alloca_array (Bufbyte, OPAQUE_SIZE (opaque) * MAX_EMCHAR_LEN); Bufbyte *bp = buffer; - CONST Opbyte * CONST program = (CONST Opbyte *) OPAQUE_DATA (opaque); - CONST Opbyte *program_ptr = program; - CONST Opbyte * CONST program_end = program_ptr + OPAQUE_SIZE (opaque); + const Opbyte * const program = (const Opbyte *) OPAQUE_DATA (opaque); + const Opbyte *program_ptr = program; + const Opbyte * const program_end = program_ptr + OPAQUE_SIZE (opaque); while (program_ptr < program_end) { @@ -2348,10 +2352,8 @@ /* v18 or v19 bytecode file. Need to Ebolify. */ if (f->flags.ebolified && VECTORP (XCDR (tem))) ebolify_bytecode_constants (XCDR (tem)); - /* VERY IMPORTANT to purecopy here!!!!! - See load_force_doc_string_unwind. */ - f->instructions = Fpurecopy (XCAR (tem)); - f->constants = Fpurecopy (XCDR (tem)); + f->instructions = XCAR (tem); + f->constants = XCDR (tem); return function; } abort (); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/bytecode.h --- a/src/bytecode.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/bytecode.h Mon Aug 13 11:13:30 2007 +0200 @@ -27,8 +27,8 @@ Jon Reid: some changes for I18N3 (domain, etc), for 19.8. */ -#ifndef _XEMACS_BYTECODE_H_ -#define _XEMACS_BYTECODE_H_ +#ifndef INCLUDED_bytecode_h_ +#define INCLUDED_bytecode_h_ /* Meanings of slots in a Lisp_Compiled_Function. Don't use these! For backward compatibility only. */ @@ -93,7 +93,6 @@ Lisp_Compiled_Function) #define XSETCOMPILED_FUNCTION(x, p) XSETRECORD (x, p, compiled_function) #define COMPILED_FUNCTIONP(x) RECORDP (x, compiled_function) -#define GC_COMPILED_FUNCTIONP(x) GC_RECORDP (x, compiled_function) #define CHECK_COMPILED_FUNCTION(x) CHECK_RECORD (x, compiled_function) #define CONCHECK_COMPILED_FUNCTION(x) CONCHECK_RECORD (x, compiled_function) @@ -120,5 +119,5 @@ neither - : (* 559 0) = 0 = 3530 */ -#endif /* _XEMACS_BYTECODE_H_ */ +#endif /* INCLUDED_bytecode_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/callint.c --- a/src/callint.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/callint.c Mon Aug 13 11:13:30 2007 +0200 @@ -58,9 +58,6 @@ Lisp_Object Qlet, QletX, Qsave_excursion; -Lisp_Object Qcurrent_prefix_arg; - -Lisp_Object Quser_variable_p; Lisp_Object Qread_from_minibuffer; Lisp_Object Qread_file_name; Lisp_Object Qread_directory_name; @@ -170,8 +167,8 @@ static Lisp_Object quotify_args (Lisp_Object expr) { - REGISTER Lisp_Object tail; - REGISTER struct Lisp_Cons *ptr; + Lisp_Object tail; + Lisp_Cons *ptr; for (tail = expr; CONSP (tail); tail = ptr->cdr) { ptr = XCONS (tail); @@ -196,8 +193,8 @@ } static Lisp_Object -callint_prompt (CONST Bufbyte *prompt_start, Bytecount prompt_length, - CONST Lisp_Object *args, int nargs) +callint_prompt (const Bufbyte *prompt_start, Bytecount prompt_length, + const Lisp_Object *args, int nargs) { Lisp_Object s = make_string (prompt_start, prompt_length); struct gcpro gcpro1; @@ -244,7 +241,7 @@ #endif /* If SPECS is a string, we reset prompt_data to string_data * (XSTRING (specs)) every time a GC might have occurred */ - CONST char *prompt_data = 0; + const char *prompt_data = 0; int prompt_index = 0; int argcount; int set_zmacs_region_stays = 0; @@ -428,7 +425,7 @@ for (;;) { if (STRINGP (specs)) - prompt_data = (CONST char *) XSTRING_DATA (specs); + prompt_data = (const char *) XSTRING_DATA (specs); if (prompt_data[prompt_index] == '+') error ("`+' is not used in `interactive' for ordinary commands"); @@ -489,7 +486,7 @@ us give to the function. */ argcount = 0; { - CONST char *tem; + const char *tem; for (tem = prompt_data + prompt_index; *tem; ) { /* 'r' specifications ("point and mark as 2 numeric args") @@ -498,7 +495,7 @@ argcount += 2; else argcount += 1; - tem = (CONST char *) strchr (tem + 1, '\n'); + tem = (const char *) strchr (tem + 1, '\n'); if (!tem) break; tem++; @@ -568,8 +565,8 @@ for (argnum = 0; ; argnum++) { - CONST char *prompt_start = prompt_data + prompt_index + 1; - CONST char *prompt_limit = (CONST char *) strchr (prompt_start, '\n'); + const char *prompt_start = prompt_data + prompt_index + 1; + const char *prompt_limit = (const char *) strchr (prompt_start, '\n'); int prompt_length; prompt_length = ((prompt_limit) ? (prompt_limit - prompt_start) @@ -583,7 +580,7 @@ prompts with "Set key C-x C-f to command: "instead of printing event objects in there. */ -#define PROMPT() callint_prompt ((CONST Bufbyte *) prompt_start, prompt_length, visargs, argnum) +#define PROMPT() callint_prompt ((const Bufbyte *) prompt_start, prompt_length, visargs, argnum) switch (prompt_data[prompt_index]) { case 'a': /* Symbol defined as a function */ @@ -912,7 +909,7 @@ if (!prompt_limit) break; if (STRINGP (specs)) - prompt_data = (CONST char *) XSTRING_DATA (specs); + prompt_data = (const char *) XSTRING_DATA (specs); prompt_index += prompt_length + 1 + 1; /* +1 to skip spec, +1 for \n */ } unbind_to (speccount, Qnil); @@ -995,8 +992,6 @@ defsymbol (&Qevents_to_keys, "events-to-keys"); defsymbol (&Qcommand_debug_status, "command-debug-status"); defsymbol (&Qenable_recursive_minibuffers, "enable-recursive-minibuffers"); - defsymbol (&Quser_variable_p, "user-variable-p"); - defsymbol (&Qcurrent_prefix_arg, "current-prefix-arg"); defsymbol (&Qlet, "let"); defsymbol (&QletX, "let*"); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/callproc.c --- a/src/callproc.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/callproc.c Mon Aug 13 11:13:30 2007 +0200 @@ -43,7 +43,6 @@ #ifdef WINDOWSNT #define _P_NOWAIT 1 /* from process.h */ -#include <windows.h> #include "nt.h" #endif @@ -68,7 +67,7 @@ volatile int synch_process_alive; /* Nonzero => this is a string explaining death of synchronous subprocess. */ -CONST char *synch_process_death; +const char *synch_process_death; /* If synch_process_death is zero, this is exit code of synchronous subprocess. */ @@ -81,6 +80,7 @@ /* Nonzero if this is termination due to exit. */ static int call_process_exited; +Lisp_Object Vlisp_EXEC_SUFFIXES; static Lisp_Object call_process_kill (Lisp_Object fdpid) @@ -101,7 +101,7 @@ static Lisp_Object call_process_cleanup (Lisp_Object fdpid) { - int fd = XINT (Fcar (fdpid)); + int fd = XINT (Fcar (fdpid)); int pid = XINT (Fcdr (fdpid)); if (!call_process_exited && @@ -113,7 +113,18 @@ /* #### "c-G" -- need non-consing Single-key-description */ message ("Waiting for process to die...(type C-g again to kill it instantly)"); +#ifdef WINDOWSNT + { + HANDLE pHandle = OpenProcess (PROCESS_ALL_ACCESS, 0, pid); + if (pHandle == NULL) + warn_when_safe (Qprocess, Qwarning, + "cannot open process (PID %d) for cleanup", pid); + else + wait_for_termination (pHandle); + } +#else wait_for_termination (pid); +#endif /* "Discard" the unwind protect. */ XCAR (fdpid) = Qnil; @@ -169,6 +180,9 @@ Lisp_Object infile, buffer, current_dir, display, path; int fd[2]; int filefd; +#ifdef WINDOWSNT + HANDLE pHandle; +#endif int pid; char buf[16384]; char *bufptr = buf; @@ -193,7 +207,7 @@ /* Do this before building new_argv because GC in Lisp code * called by various filename-hacking routines might relocate strings */ - locate_file (Vexec_path, args[0], EXEC_SUFFIXES, &path, X_OK); + locate_file (Vexec_path, args[0], Vlisp_EXEC_SUFFIXES, &path, X_OK); /* Make sure that the child will be able to chdir to the current buffer's current directory, or its unhandled equivalent. We @@ -286,8 +300,8 @@ CHECK_STRING (args[i]); new_argv[i - 3] = (char *) XSTRING_DATA (args[i]); } - new_argv[nargs - 3] = 0; } + new_argv[max(nargs - 3,1)] = 0; if (NILP (path)) report_file_error ("Searching for program", Fcons (args[0], Qnil)); @@ -334,7 +348,7 @@ fd_error = open (NULL_DEVICE, O_WRONLY | OPEN_BINARY); else if (STRINGP (error_file)) { - fd_error = open ((CONST char *) XSTRING_DATA (error_file), + fd_error = open ((const char *) XSTRING_DATA (error_file), #ifdef DOS_NT O_WRONLY | O_TRUNC | O_CREAT | O_TEXT, S_IREAD | S_IWRITE @@ -358,6 +372,23 @@ #ifdef WINDOWSNT pid = child_setup (filefd, fd1, fd_error, new_argv, (char *) XSTRING_DATA (current_dir)); + if (!INTP (buffer)) + { + /* OpenProcess() as soon after child_setup as possible. It's too + late once the process terminated. */ + pHandle = OpenProcess(PROCESS_ALL_ACCESS, 0, pid); +#if 0 + if (pHandle == NULL) + { + /* #### seems to cause crash in unbind_to(...) below. APA */ + warn_when_safe (Qprocess, Qwarning, + "cannot open process to wait for"); + } +#endif + } + /* Close STDERR into the parent process. We no longer need it. */ + if (fd_error >= 0) + close (fd_error); #else /* not WINDOWSNT */ pid = fork (); @@ -393,12 +424,14 @@ if (!NILP (fork_error)) signal_error (Qfile_error, fork_error); +#ifndef WINDOWSNT if (pid < 0) { if (fd[0] >= 0) close (fd[0]); report_file_error ("Doing fork", Qnil); } +#endif if (INTP (buffer)) { @@ -449,7 +482,7 @@ nread = 0; while (nread < bufsize - 1024) { - int this_read + ssize_t this_read = Lstream_read (XLSTREAM (instream), bufptr + nread, bufsize - nread); @@ -468,10 +501,12 @@ if (nread == 0) break; +#if 0 #ifdef DOS_NT /* Until we pull out of MULE things like make_decoding_input_stream(), we do the following which is less elegant. --marcpa */ + /* We did. -- kkm */ { int lf_count = 0; if (NILP (Vbinary_process_output)) { @@ -479,6 +514,7 @@ } } #endif +#endif total_read += nread; @@ -506,7 +542,11 @@ QUIT; /* Wait for it to terminate, unless it already has. */ +#ifdef WINDOWSNT + wait_for_termination (pHandle); +#else wait_for_termination (pid); +#endif /* Don't kill any children that the subprocess may have left behind when exiting. */ @@ -568,7 +608,7 @@ void #endif child_setup (int in, int out, int err, char **new_argv, - CONST char *current_dir) + const char *current_dir) { char **env; char *pwd; @@ -644,9 +684,10 @@ { char **ep = env; char *envvar_external; - Bufbyte *envvar_internal = XSTRING_DATA (XCAR (tail)); - GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (envvar_internal, envvar_external); + TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (tail), + C_STRING_ALLOCA, envvar_external, + Qfile_name); /* See if envvar_external duplicates any string already in the env. If so, don't put it in. @@ -722,7 +763,8 @@ #ifdef WINDOWSNT /* Spawn the child. (See ntproc.c:Spawnve). */ - cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env); + cpid = spawnve (_P_NOWAIT, new_argv[0], (const char* const*)new_argv, + (const char* const*)env); if (cpid == -1) /* An error occurred while trying to spawn the process. */ report_file_error ("Spawning child process", Qnil); @@ -741,7 +783,7 @@ } static int -getenv_internal (CONST Bufbyte *var, +getenv_internal (const Bufbyte *var, Bytecount varlen, Bufbyte **value, Bytecount *valuelen) @@ -804,12 +846,12 @@ /* A version of getenv that consults process_environment, easily callable from C. */ char * -egetenv (CONST char *var) +egetenv (const char *var) { Bufbyte *value; Bytecount valuelen; - if (getenv_internal ((CONST Bufbyte *) var, strlen (var), &value, &valuelen)) + if (getenv_internal ((const Bufbyte *) var, strlen (var), &value, &valuelen)) return (char *) value; else return 0; @@ -827,19 +869,17 @@ char **envp; Vprocess_environment = Qnil; for (envp = environ; envp && *envp; envp++) - { - Vprocess_environment = Fcons (build_ext_string (*envp, FORMAT_OS), - Vprocess_environment); - } + Vprocess_environment = + Fcons (build_ext_string (*envp, Qfile_name), Vprocess_environment); } { /* Initialize shell-file-name from environment variables or best guess. */ #ifdef WINDOWSNT - CONST char *shell = egetenv ("COMSPEC"); + const char *shell = egetenv ("COMSPEC"); if (!shell) shell = "\\WINNT\\system32\\cmd.exe"; #else /* not WINDOWSNT */ - CONST char *shell = egetenv ("SHELL"); + const char *shell = egetenv ("SHELL"); if (!shell) shell = "/bin/sh"; #endif @@ -897,4 +937,7 @@ The environment which Emacs inherits is placed in this variable when Emacs starts. */ ); + + Vlisp_EXEC_SUFFIXES = build_string (EXEC_SUFFIXES); + staticpro (&Vlisp_EXEC_SUFFIXES); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/casefiddle.c --- a/src/casefiddle.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/casefiddle.c Mon Aug 13 11:13:30 2007 +0200 @@ -47,8 +47,7 @@ if (STRINGP (obj)) { - struct Lisp_Char_Table *syntax_table = - XCHAR_TABLE (buf->mirror_syntax_table); + Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table); Bufbyte *storage = alloca_array (Bufbyte, XSTRING_LENGTH (obj) * MAX_EMCHAR_LEN); Bufbyte *newp = storage; @@ -156,7 +155,7 @@ /* This function can GC */ REGISTER Bufpos i; Bufpos start, end; - struct Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table); + Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table); int mccount; Emchar oldc, c; int wordp = 0, wordp_prev; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/casetab.c --- a/src/casetab.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/casetab.c Mon Aug 13 11:13:30 2007 +0200 @@ -42,14 +42,13 @@ #include "buffer.h" #include "opaque.h" -Lisp_Object Qcase_table_p; +Lisp_Object Qcase_tablep; Lisp_Object Vascii_downcase_table, Vascii_upcase_table; Lisp_Object Vascii_canon_table, Vascii_eqv_table; #ifdef MULE Lisp_Object Vmirror_ascii_downcase_table, Vmirror_ascii_upcase_table; Lisp_Object Vmirror_ascii_canon_table, Vmirror_ascii_eqv_table; #endif -Lisp_Object Qtranslate_table; static void compute_trt_inverse (Lisp_Object trt, Lisp_Object inverse); @@ -81,7 +80,7 @@ REGISTER Lisp_Object tem; while (tem = Fcase_table_p (obj), NILP (tem)) - obj = wrong_type_argument (Qcase_table_p, obj); + obj = wrong_type_argument (Qcase_tablep, obj); return (obj); } @@ -289,8 +288,7 @@ void syms_of_casetab (void) { - defsymbol (&Qcase_table_p, "case-table-p"); - defsymbol (&Qtranslate_table, "translate-table"); + defsymbol (&Qcase_tablep, "case-table-p"); DEFSUBR (Fcase_table_p); DEFSUBR (Fcurrent_case_table); @@ -310,6 +308,13 @@ staticpro (&Vascii_canon_table); staticpro (&Vascii_eqv_table); +#ifdef MULE + staticpro (&Vmirror_ascii_downcase_table); + staticpro (&Vmirror_ascii_upcase_table); + staticpro (&Vmirror_ascii_canon_table); + staticpro (&Vmirror_ascii_eqv_table); +#endif + tem = MAKE_TRT_TABLE (); Vascii_downcase_table = tem; Vascii_canon_table = tem; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/chartab.c --- a/src/chartab.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/chartab.c Mon Aug 13 11:13:30 2007 +0200 @@ -2,6 +2,8 @@ Copyright (C) 1992, 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. Copyright (C) 1995, 1996 Ben Wing. + Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN. + Licensed to the Free Software Foundation. This file is part of XEmacs. @@ -50,6 +52,9 @@ Lisp_Object Qcategory_table_value_p; Lisp_Object Vstandard_category_table; + +/* Variables to determine word boundary. */ +Lisp_Object Vword_combining_categories, Vword_separating_categories; #endif /* MULE */ @@ -90,14 +95,14 @@ #ifdef MULE static Lisp_Object -mark_char_table_entry (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_char_table_entry (Lisp_Object obj) { - struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); + Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); int i; for (i = 0; i < 96; i++) { - markobj (cte->level2[i]); + mark_object (cte->level2[i]); } return Qnil; } @@ -105,8 +110,8 @@ static int char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { - struct Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1); - struct Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2); + Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1); + Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2); int i; for (i = 0; i < 96; i++) @@ -119,29 +124,35 @@ static unsigned long char_table_entry_hash (Lisp_Object obj, int depth) { - struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); + Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); return internal_array_hash (cte->level2, 96, depth); } +static const struct lrecord_description char_table_entry_description[] = { + { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 }, + { XD_END } +}; + DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry, mark_char_table_entry, internal_object_printer, 0, char_table_entry_equal, char_table_entry_hash, - struct Lisp_Char_Table_Entry); + char_table_entry_description, + Lisp_Char_Table_Entry); #endif /* MULE */ static Lisp_Object -mark_char_table (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_char_table (Lisp_Object obj) { - struct Lisp_Char_Table *ct = XCHAR_TABLE (obj); + Lisp_Char_Table *ct = XCHAR_TABLE (obj); int i; for (i = 0; i < NUM_ASCII_CHARS; i++) - markobj (ct->ascii[i]); + mark_object (ct->ascii[i]); #ifdef MULE for (i = 0; i < NUM_LEADING_BYTES; i++) - markobj (ct->level1[i]); + mark_object (ct->level1[i]); #endif return ct->mirror_table; } @@ -151,18 +162,18 @@ and prune_weak_hash_tables(). */ void -prune_syntax_tables (int (*obj_marked_p) (Lisp_Object)) +prune_syntax_tables (void) { Lisp_Object rest, prev = Qnil; for (rest = Vall_syntax_tables; - !GC_NILP (rest); + !NILP (rest); rest = XCHAR_TABLE (rest)->next_table) { - if (! obj_marked_p (rest)) + if (! marked_p (rest)) { /* This table is garbage. Remove it from the list. */ - if (GC_NILP (prev)) + if (NILP (prev)) Vall_syntax_tables = XCHAR_TABLE (rest)->next_table; else XCHAR_TABLE (prev)->next_table = @@ -230,7 +241,7 @@ static void print_chartab_charset_row (Lisp_Object charset, int row, - struct Lisp_Char_Table_Entry *cte, + Lisp_Char_Table_Entry *cte, Lisp_Object printcharfun) { int i; @@ -278,7 +289,7 @@ static void print_chartab_two_byte_charset (Lisp_Object charset, - struct Lisp_Char_Table_Entry *cte, + Lisp_Char_Table_Entry *cte, Lisp_Object printcharfun) { int i; @@ -308,7 +319,7 @@ static void print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { - struct Lisp_Char_Table *ct = XCHAR_TABLE (obj); + Lisp_Char_Table *ct = XCHAR_TABLE (obj); char buf[200]; sprintf (buf, "#s(char-table type %s data (", @@ -366,7 +377,7 @@ } else { - struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann); + Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann); if (XCHARSET_DIMENSION (charset) == 1) print_chartab_charset_row (charset, -1, cte, printcharfun); else @@ -382,8 +393,8 @@ static int char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { - struct Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1); - struct Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2); + Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1); + Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2); int i; if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2)) @@ -405,7 +416,7 @@ static unsigned long char_table_hash (Lisp_Object obj, int depth) { - struct Lisp_Char_Table *ct = XCHAR_TABLE (obj); + Lisp_Char_Table *ct = XCHAR_TABLE (obj); unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS, depth); #ifdef MULE @@ -415,10 +426,21 @@ return hashval; } +static const struct lrecord_description char_table_description[] = { + { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS }, +#ifdef MULE + { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES }, +#endif + { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) }, + { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) }, + { XD_END } +}; + DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table, mark_char_table, print_char_table, 0, char_table_equal, char_table_hash, - struct Lisp_Char_Table); + char_table_description, + Lisp_Char_Table); DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /* Return non-nil if OBJECT is a char table. @@ -521,7 +543,7 @@ } void -fill_char_table (struct Lisp_Char_Table *ct, Lisp_Object value) +fill_char_table (Lisp_Char_Table *ct, Lisp_Object value) { int i; @@ -541,7 +563,7 @@ */ (table)) { - struct Lisp_Char_Table *ct; + Lisp_Char_Table *ct; CHECK_CHAR_TABLE (table); ct = XCHAR_TABLE (table); @@ -577,11 +599,11 @@ */ (type)) { - struct Lisp_Char_Table *ct; + Lisp_Char_Table *ct; Lisp_Object obj; enum char_table_type ty = symbol_to_char_table_type (type); - ct = alloc_lcrecord_type (struct Lisp_Char_Table, lrecord_char_table); + ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table); ct->type = ty; if (ty == CHAR_TABLE_TYPE_SYNTAX) { @@ -609,9 +631,8 @@ { Lisp_Object obj; int i; - struct Lisp_Char_Table_Entry *cte = - alloc_lcrecord_type (struct Lisp_Char_Table_Entry, - lrecord_char_table_entry); + Lisp_Char_Table_Entry *cte = + alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry); for (i = 0; i < 96; i++) cte->level2[i] = initval; @@ -623,12 +644,11 @@ static Lisp_Object copy_char_table_entry (Lisp_Object entry) { - struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry); + Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry); Lisp_Object obj; int i; - struct Lisp_Char_Table_Entry *ctenew = - alloc_lcrecord_type (struct Lisp_Char_Table_Entry, - lrecord_char_table_entry); + Lisp_Char_Table_Entry *ctenew = + alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry); for (i = 0; i < 96; i++) { @@ -652,13 +672,13 @@ */ (old_table)) { - struct Lisp_Char_Table *ct, *ctnew; + Lisp_Char_Table *ct, *ctnew; Lisp_Object obj; int i; CHECK_CHAR_TABLE (old_table); ct = XCHAR_TABLE (old_table); - ctnew = alloc_lcrecord_type (struct Lisp_Char_Table, lrecord_char_table); + ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table); ctnew->type = ct->type; for (i = 0; i < NUM_ASCII_CHARS; i++) @@ -687,7 +707,13 @@ ctnew->mirror_table = Fcopy_char_table (ct->mirror_table); else ctnew->mirror_table = ct->mirror_table; + ctnew->next_table = Qnil; XSETCHAR_TABLE (obj, ctnew); + if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX) + { + ctnew->next_table = Vall_syntax_tables; + Vall_syntax_tables = obj; + } return obj; } @@ -707,7 +733,7 @@ #else /* MULE */ else if (VECTORP (range)) { - struct Lisp_Vector *vec = XVECTOR (range); + Lisp_Vector *vec = XVECTOR (range); Lisp_Object *elts = vector_data (vec); if (vector_length (vec) != 2) signal_simple_error ("Length of charset row vector must be 2", @@ -747,7 +773,7 @@ /* called from CHAR_TABLE_VALUE(). */ Lisp_Object -get_non_ascii_char_table_value (struct Lisp_Char_Table *ct, int leading_byte, +get_non_ascii_char_table_value (Lisp_Char_Table *ct, int leading_byte, Emchar c) { Lisp_Object val; @@ -758,7 +784,7 @@ val = ct->level1[leading_byte - MIN_LEADING_BYTE]; if (CHAR_TABLE_ENTRYP (val)) { - struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); + Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); val = cte->level2[byte1 - 32]; if (CHAR_TABLE_ENTRYP (val)) { @@ -775,7 +801,7 @@ #endif /* MULE */ Lisp_Object -get_char_table (Emchar ch, struct Lisp_Char_Table *ct) +get_char_table (Emchar ch, Lisp_Char_Table *ct) { #ifdef MULE { @@ -795,7 +821,7 @@ val = ct->level1[lb]; if (CHAR_TABLE_ENTRYP (val)) { - struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); + Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); val = cte->level2[byte1 - 32]; if (CHAR_TABLE_ENTRYP (val)) { @@ -820,7 +846,7 @@ */ (ch, table)) { - struct Lisp_Char_Table *ct; + Lisp_Char_Table *ct; CHECK_CHAR_TABLE (table); ct = XCHAR_TABLE (table); @@ -835,7 +861,7 @@ */ (range, table, multi)) { - struct Lisp_Char_Table *ct; + Lisp_Char_Table *ct; struct chartab_range rainj; if (CHAR_OR_CHAR_INTP (range)) @@ -1020,7 +1046,7 @@ /* Assign VAL to all characters in RANGE in char table CT. */ void -put_char_table (struct Lisp_Char_Table *ct, struct chartab_range *range, +put_char_table (Lisp_Char_Table *ct, struct chartab_range *range, Lisp_Object val) { switch (range->type) @@ -1053,7 +1079,7 @@ case CHARTAB_RANGE_ROW: { - struct Lisp_Char_Table_Entry *cte; + Lisp_Char_Table_Entry *cte; int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE; /* make sure that there is a separate entry for the row. */ if (!CHAR_TABLE_ENTRYP (ct->level1[lb])) @@ -1077,7 +1103,7 @@ ct->ascii[byte1 + 128] = val; else { - struct Lisp_Char_Table_Entry *cte; + Lisp_Char_Table_Entry *cte; int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE; /* make sure that there is a separate entry for the row. */ if (!CHAR_TABLE_ENTRYP (ct->level1[lb])) @@ -1128,7 +1154,7 @@ */ (range, val, table)) { - struct Lisp_Char_Table *ct; + Lisp_Char_Table *ct; struct chartab_range rainj; CHECK_CHAR_TABLE (table); @@ -1143,7 +1169,7 @@ /* Map FN over the ASCII chars in CT. */ static int -map_over_charset_ascii (struct Lisp_Char_Table *ct, +map_over_charset_ascii (Lisp_Char_Table *ct, int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg), void *arg) @@ -1173,7 +1199,7 @@ /* Map FN over the Control-1 chars in CT. */ static int -map_over_charset_control_1 (struct Lisp_Char_Table *ct, +map_over_charset_control_1 (Lisp_Char_Table *ct, int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg), void *arg) @@ -1199,7 +1225,7 @@ CTE specifies the char table entry for CHARSET. */ static int -map_over_charset_row (struct Lisp_Char_Table_Entry *cte, +map_over_charset_row (Lisp_Char_Table_Entry *cte, Lisp_Object charset, int row, int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg), @@ -1239,7 +1265,7 @@ static int -map_over_other_charset (struct Lisp_Char_Table *ct, int lb, +map_over_other_charset (Lisp_Char_Table *ct, int lb, int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg), void *arg) @@ -1262,7 +1288,7 @@ } { - struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); + Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); int charset94_p = (XCHARSET_CHARS (charset) == 94); int start = charset94_p ? 33 : 32; int stop = charset94_p ? 127 : 128; @@ -1296,7 +1322,7 @@ becomes the return value of map_char_table(). */ int -map_char_table (struct Lisp_Char_Table *ct, +map_char_table (Lisp_Char_Table *ct, struct chartab_range *range, int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg), @@ -1423,7 +1449,7 @@ */ (function, table, range)) { - struct Lisp_Char_Table *ct; + Lisp_Char_Table *ct; struct slow_map_char_table_arg slarg; struct gcpro gcpro1, gcpro2; struct chartab_range rainj; @@ -1591,7 +1617,7 @@ unsigned int designator, unsigned int not) { REGISTER Lisp_Object temp; - struct Lisp_Char_Table *ctbl; + Lisp_Char_Table *ctbl; #ifdef ERROR_CHECK_TYPECHECK if (NILP (Fcategory_table_p (table))) signal_simple_error ("Expected category table", table); @@ -1709,6 +1735,69 @@ return CATEGORY_TABLE_VALUEP (obj) ? Qt : Qnil; } + +#define CATEGORYP(x) \ + (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E) + +#define CATEGORY_SET(c) \ + (get_char_table(c, XCHAR_TABLE(current_buffer->category_table))) + +/* Return 1 if CATEGORY_SET contains CATEGORY, else return 0. + The faster version of `!NILP (Faref (category_set, category))'. */ +#define CATEGORY_MEMBER(category, category_set) \ + (bit_vector_bit(XBIT_VECTOR (category_set), category - 32)) + +/* Return 1 if there is a word boundary between two word-constituent + characters C1 and C2 if they appear in this order, else return 0. + Use the macro WORD_BOUNDARY_P instead of calling this function + directly. */ + +int word_boundary_p (Emchar c1, Emchar c2); +int +word_boundary_p (Emchar c1, Emchar c2) +{ + Lisp_Object category_set1, category_set2; + Lisp_Object tail; + int default_result; + +#if 0 + if (COMPOSITE_CHAR_P (c1)) + c1 = cmpchar_component (c1, 0, 1); + if (COMPOSITE_CHAR_P (c2)) + c2 = cmpchar_component (c2, 0, 1); +#endif + + if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2))) + { + tail = Vword_separating_categories; + default_result = 0; + } + else + { + tail = Vword_combining_categories; + default_result = 1; + } + + category_set1 = CATEGORY_SET (c1); + if (NILP (category_set1)) + return default_result; + category_set2 = CATEGORY_SET (c2); + if (NILP (category_set2)) + return default_result; + + for (; CONSP (tail); tail = XCONS (tail)->cdr) + { + Lisp_Object elt = XCONS(tail)->car; + + if (CONSP (elt) + && CATEGORYP (XCONS (elt)->car) + && CATEGORYP (XCONS (elt)->cdr) + && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1) + && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2)) + return !default_result; + } + return default_result; +} #endif /* MULE */ @@ -1750,8 +1839,14 @@ DEFSUBR (Fcategory_table_value_p); #endif /* MULE */ +} + +void +vars_of_chartab (void) +{ /* DO NOT staticpro this. It works just like Vweak_hash_tables. */ Vall_syntax_tables = Qnil; + pdump_wire_list (&Vall_syntax_tables); } void @@ -1775,5 +1870,50 @@ Vstandard_category_table = Qnil; Vstandard_category_table = Fcopy_category_table (Qnil); staticpro (&Vstandard_category_table); + + DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /* +List of pair (cons) of categories to determine word boundary. + +Emacs treats a sequence of word constituent characters as a single +word (i.e. finds no word boundary between them) iff they belongs to +the same charset. But, exceptions are allowed in the following cases. + +(1) The case that characters are in different charsets is controlled +by the variable `word-combining-categories'. + +Emacs finds no word boundary between characters of different charsets +if they have categories matching some element of this list. + +More precisely, if an element of this list is a cons of category CAT1 +and CAT2, and a multibyte character C1 which has CAT1 is followed by +C2 which has CAT2, there's no word boundary between C1 and C2. + +For instance, to tell that ASCII characters and Latin-1 characters can +form a single word, the element `(?l . ?l)' should be in this list +because both characters have the category `l' (Latin characters). + +(2) The case that character are in the same charset is controlled by +the variable `word-separating-categories'. + +Emacs find a word boundary between characters of the same charset +if they have categories matching some element of this list. + +More precisely, if an element of this list is a cons of category CAT1 +and CAT2, and a multibyte character C1 which has CAT1 is followed by +C2 which has CAT2, there's a word boundary between C1 and C2. + +For instance, to tell that there's a word boundary between Japanese +Hiragana and Japanese Kanji (both are in the same charset), the +element `(?H . ?C) should be in this list. +*/ ); + + Vword_combining_categories = Qnil; + + DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /* +List of pair (cons) of categories to determine word boundary. +See the documentation of the variable `word-combining-categories'. +*/ ); + + Vword_separating_categories = Qnil; #endif /* MULE */ } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/chartab.h --- a/src/chartab.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/chartab.h Mon Aug 13 11:13:30 2007 +0200 @@ -24,8 +24,8 @@ This file was written independently of the FSF implementation, and is not compatible. */ -#ifndef _MULE_CHARTAB_H -#define _MULE_CHARTAB_H +#ifndef INCLUDED_chartab_h_ +#define INCLUDED_chartab_h_ /************************************************************************/ /* Char Tables */ @@ -37,15 +37,6 @@ #ifdef MULE -DECLARE_LRECORD (char_table_entry, struct Lisp_Char_Table_Entry); -#define XCHAR_TABLE_ENTRY(x) \ - XRECORD (x, char_table_entry, struct Lisp_Char_Table_Entry) -#define XSETCHAR_TABLE_ENTRY(x, p) XSETRECORD (x, p, char_table_entry) -#define CHAR_TABLE_ENTRYP(x) RECORDP (x, char_table_entry) -#define GC_CHAR_TABLE_ENTRYP(x) GC_RECORDP (x, char_table_entry) -/* #define CHECK_CHAR_TABLE_ENTRY(x) CHECK_RECORD (x, char_table_entry) - char table entries should never escape to Lisp */ - struct Lisp_Char_Table_Entry { struct lcrecord_header header; @@ -55,21 +46,18 @@ variable-size and add an offset value into this structure. */ Lisp_Object level2[96]; }; +typedef struct Lisp_Char_Table_Entry Lisp_Char_Table_Entry; + +DECLARE_LRECORD (char_table_entry, Lisp_Char_Table_Entry); +#define XCHAR_TABLE_ENTRY(x) \ + XRECORD (x, char_table_entry, Lisp_Char_Table_Entry) +#define XSETCHAR_TABLE_ENTRY(x, p) XSETRECORD (x, p, char_table_entry) +#define CHAR_TABLE_ENTRYP(x) RECORDP (x, char_table_entry) +/* #define CHECK_CHAR_TABLE_ENTRY(x) CHECK_RECORD (x, char_table_entry) + char table entries should never escape to Lisp */ #endif /* MULE */ -DECLARE_LRECORD (char_table, struct Lisp_Char_Table); -#define XCHAR_TABLE(x) \ - XRECORD (x, char_table, struct Lisp_Char_Table) -#define XSETCHAR_TABLE(x, p) XSETRECORD (x, p, char_table) -#define CHAR_TABLEP(x) RECORDP (x, char_table) -#define GC_CHAR_TABLEP(x) GC_RECORDP (x, char_table) -#define CHECK_CHAR_TABLE(x) CHECK_RECORD (x, char_table) -#define CONCHECK_CHAR_TABLE(x) CONCHECK_RECORD (x, char_table) - -#define CHAR_TABLE_TYPE(ct) ((ct)->type) -#define XCHAR_TABLE_TYPE(ct) CHAR_TABLE_TYPE (XCHAR_TABLE (ct)) - enum char_table_type { CHAR_TABLE_TYPE_GENERIC, @@ -129,17 +117,28 @@ Lisp_Object mirror_table; Lisp_Object next_table; /* DO NOT mark through this. */ }; +typedef struct Lisp_Char_Table Lisp_Char_Table; + +DECLARE_LRECORD (char_table, Lisp_Char_Table); +#define XCHAR_TABLE(x) XRECORD (x, char_table, Lisp_Char_Table) +#define XSETCHAR_TABLE(x, p) XSETRECORD (x, p, char_table) +#define CHAR_TABLEP(x) RECORDP (x, char_table) +#define CHECK_CHAR_TABLE(x) CHECK_RECORD (x, char_table) +#define CONCHECK_CHAR_TABLE(x) CONCHECK_RECORD (x, char_table) + +#define CHAR_TABLE_TYPE(ct) ((ct)->type) +#define XCHAR_TABLE_TYPE(ct) CHAR_TABLE_TYPE (XCHAR_TABLE (ct)) #ifdef MULE -Lisp_Object get_non_ascii_char_table_value (struct Lisp_Char_Table *ct, - int leading_byte, - Emchar c); +Lisp_Object get_non_ascii_char_table_value (Lisp_Char_Table *ct, + int leading_byte, + Emchar c); INLINE Lisp_Object -CHAR_TABLE_NON_ASCII_VALUE_UNSAFE (struct Lisp_Char_Table *ct, Emchar ch); +CHAR_TABLE_NON_ASCII_VALUE_UNSAFE (Lisp_Char_Table *ct, Emchar ch); INLINE Lisp_Object -CHAR_TABLE_NON_ASCII_VALUE_UNSAFE (struct Lisp_Char_Table *ct, Emchar ch) +CHAR_TABLE_NON_ASCII_VALUE_UNSAFE (Lisp_Char_Table *ct, Emchar ch) { unsigned char lb = CHAR_LEADING_BYTE (ch); if (!CHAR_TABLE_ENTRYP ((ct)->level1[lb - MIN_LEADING_BYTE])) @@ -177,16 +176,16 @@ int row; }; -void fill_char_table (struct Lisp_Char_Table *ct, Lisp_Object value); -void put_char_table (struct Lisp_Char_Table *ct, struct chartab_range *range, +void fill_char_table (Lisp_Char_Table *ct, Lisp_Object value); +void put_char_table (Lisp_Char_Table *ct, struct chartab_range *range, Lisp_Object val); -Lisp_Object get_char_table (Emchar, struct Lisp_Char_Table *); -int map_char_table (struct Lisp_Char_Table *ct, +Lisp_Object get_char_table (Emchar, Lisp_Char_Table *); +int map_char_table (Lisp_Char_Table *ct, struct chartab_range *range, int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg), void *arg); -void prune_syntax_tables (int (*obj_marked_p) (Lisp_Object)); +void prune_syntax_tables (void); EXFUN (Fcopy_char_table, 1); EXFUN (Fmake_char_table, 1); @@ -231,4 +230,4 @@ #endif /* MULE */ -#endif /* _MULE_CHARTAB_H */ +#endif /* INCLUDED_chartab_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/cm.c --- a/src/cm.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/cm.c Mon Aug 13 11:13:30 2007 +0200 @@ -36,8 +36,8 @@ #ifdef __cplusplus extern "C" { #endif -extern char *tgoto (CONST char *cm, int hpos, int vpos); -extern void tputs (CONST char *, int, void (*)(int)); +extern char *tgoto (const char *cm, int hpos, int vpos); +extern void tputs (const char *, int, void (*)(int)); #ifdef __cplusplus } #endif diff -r f4aeb21a5bad -r 74fd4e045ea6 src/cm.h --- a/src/cm.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/cm.h Mon Aug 13 11:13:30 2007 +0200 @@ -23,8 +23,8 @@ /* #### Chuck -- This file should be deleted. I'm not deleting it yet because there might be something you want out of it. */ -#ifndef _XEMACS_CM_H_ -#define _XEMACS_CM_H_ +#ifndef INCLUDED_cm_h_ +#define INCLUDED_cm_h_ /* Holds the minimum and maximum costs for the parametrized capabilities. */ struct parmcap @@ -46,25 +46,25 @@ int cm_curX; /* Current column */ /* Capabilities from termcap */ - CONST char *cm_up; /* up (up) */ - CONST char *cm_down; /* down (do) */ - CONST char *cm_left; /* left (le) */ - CONST char *cm_right; /* right (nd) */ - CONST char *cm_home; /* home (ho) */ - CONST char *cm_cr; /* carriage return (cr) */ - CONST char *cm_ll; /* last line (ll) */ + const char *cm_up; /* up (up) */ + const char *cm_down; /* down (do) */ + const char *cm_left; /* left (le) */ + const char *cm_right; /* right (nd) */ + const char *cm_home; /* home (ho) */ + const char *cm_cr; /* carriage return (cr) */ + const char *cm_ll; /* last line (ll) */ #endif /* 0 */ - CONST char *cm_tab; /* tab (ta) */ - CONST char *cm_backtab; /* backtab (bt) */ + const char *cm_tab; /* tab (ta) */ + const char *cm_backtab; /* backtab (bt) */ #if 0 - CONST char *cm_abs; /* absolute (cm) */ - CONST char *cm_habs; /* horizontal absolute (ch) */ - CONST char *cm_vabs; /* vertical absolute (cv) */ - CONST char *cm_ds; /* "don't send" string (ds) */ - CONST char *cm_multiup; /* multiple up (UP) */ - CONST char *cm_multidown; /* multiple down (DO) */ - CONST char *cm_multileft; /* multiple left (LE) */ - CONST char *cm_multiright; /* multiple right (RI) */ + const char *cm_abs; /* absolute (cm) */ + const char *cm_habs; /* horizontal absolute (ch) */ + const char *cm_vabs; /* vertical absolute (cv) */ + const char *cm_ds; /* "don't send" string (ds) */ + const char *cm_multiup; /* multiple up (UP) */ + const char *cm_multidown; /* multiple down (DO) */ + const char *cm_multileft; /* multiple left (LE) */ + const char *cm_multiright; /* multiple right (RI) */ int cm_cols; /* number of cols on frame (co) */ int cm_rows; /* number of rows on frame (li) */ int cm_tabwidth; /* tab width (it) */ @@ -181,4 +181,4 @@ void Wcm_clear (void); int Wcm_init (void); -#endif /* _XEMACS_CM_H_ */ +#endif /* INCLUDED_cm_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/cmdloop.c --- a/src/cmdloop.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/cmdloop.c Mon Aug 13 11:13:30 2007 +0200 @@ -40,9 +40,6 @@ /* Current depth in recursive edits. */ int command_loop_level; -/* Total number of times command_loop has read a key sequence. */ -int num_input_keys; - #ifndef LISP_COMMAND_LOOP /* Form to evaluate (if non-nil) when Emacs is started. */ Lisp_Object Vtop_level; @@ -521,8 +518,8 @@ like the real thing. This is slightly bogus, but it's in here for compatibility with Emacs 18. It's not even clear what the "right thing" is. */ - if (!(((STRINGP (Vexecuting_macro) || VECTORP (Vexecuting_macro)) - && XINT (Flength (Vexecuting_macro)) == 1))) + if (!((STRINGP (Vexecuting_macro) || VECTORP (Vexecuting_macro)) + && XINT (Flength (Vexecuting_macro)) == 1)) Vlast_command = Qt; #ifndef LISP_COMMAND_LOOP @@ -536,7 +533,7 @@ focus is selected. */ if (focus_follows_mouse) investigate_frame_change (); - + /* Make sure the current window's buffer is selected. */ { Lisp_Object selected_window = Fselected_window (Qnil); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/cmds.c --- a/src/cmds.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/cmds.c Mon Aug 13 11:13:30 2007 +0200 @@ -327,7 +327,7 @@ REGISTER enum syntaxcode synt; REGISTER Emchar c2; Lisp_Object overwrite; - struct Lisp_Char_Table *syntax_table; + Lisp_Char_Table *syntax_table; struct buffer *buf = current_buffer; int tab_width; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/commands.h --- a/src/commands.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/commands.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,8 +20,8 @@ /* Synched up with: FSF 19.30. */ -#ifndef _XEMACS_COMMANDS_H_ -#define _XEMACS_COMMANDS_H_ +#ifndef INCLUDED_commands_h_ +#define INCLUDED_commands_h_ #if 0 /* FSFmacs */ #define Ctl(c) ((c)&037) @@ -125,4 +125,4 @@ extern Lisp_Object Vthis_command_keys; /* event-stream.c */ -#endif /* _XEMACS_COMMANDS_H_ */ +#endif /* INCLUDED_commands_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/config.h.in --- a/src/config.h.in Mon Aug 13 11:12:06 2007 +0200 +++ b/src/config.h.in Mon Aug 13 11:13:30 2007 +0200 @@ -61,6 +61,7 @@ /* The version info from version.sh. Used in #pragma ident in emacs.c */ #undef EMACS_MAJOR_VERSION #undef EMACS_MINOR_VERSION +#undef EMACS_PATCH_LEVEL #undef EMACS_BETA_VERSION #undef EMACS_VERSION #undef XEMACS_CODENAME @@ -69,12 +70,24 @@ #undef INFODOCK_MINOR_VERSION #undef INFODOCK_BUILD_VERSION +/* Make all functions from all IEEE Stds 1003.[123] available. */ +#undef _POSIX_C_SOURCE + +/* Make all functions from Unix98 available. */ +#undef _XOPEN_SOURCE + +/* Make extensions from Unix98 available. */ +#undef _XOPEN_SOURCE_EXTENDED + /* Make all functions available on AIX. See AC_AIX. */ #undef _ALL_SOURCE /* Make all functions available on GNU libc systems. See features.h. */ #undef _GNU_SOURCE +/* Make all functions available on Solaris 2 systems. */ +#undef __EXTENSIONS__ + /* Used to identify the XEmacs version in stack traces. */ #undef STACK_TRACE_EYE_CATCHER @@ -163,6 +176,8 @@ #undef THIS_IS_X11R5 #undef THIS_IS_X11R6 +#undef HAVE_XCONVERTCASE + /* Where do we find bitmaps? */ #undef BITMAPDIR @@ -266,11 +281,14 @@ #undef HAVE_FPATHCONF #undef HAVE_FREXP #undef HAVE_FTIME +#undef HAVE_GETADDRINFO #undef HAVE_GETHOSTNAME +#undef HAVE_GETNAMEINFO #undef HAVE_GETPAGESIZE #undef HAVE_GETTIMEOFDAY #undef HAVE_GETWD #undef HAVE_GETCWD +#undef HAVE_GETPT #undef HAVE_LOGB #undef HAVE_LRAND48 #undef HAVE_MATHERR @@ -293,6 +311,7 @@ #undef HAVE_SIGPROCMASK #undef HAVE_SIGSETJMP #undef HAVE_SNPRINTF +#undef HAVE_STPCPY #undef HAVE_STRCASECMP #undef HAVE_STRERROR #undef HAVE_TZSET @@ -305,6 +324,11 @@ #undef HAVE_SOCKADDR_SUN_LEN #undef HAVE_MULTICAST #undef HAVE_SYSVIPC +#undef HAVE_LOCKF +#undef HAVE_FLOCK +#undef HAVE_FSYNC +#undef HAVE_FTRUNCATE +#undef HAVE_UMASK #undef SYSV_SYSTEM_DIR #undef NONSYSTEM_DIR_LIBRARY @@ -356,10 +380,14 @@ /* Do we have LDAP support? */ #undef HAVE_LDAP -/* Do we have the LDAP library of the University of Michigan ? */ -#undef HAVE_UMICH_LDAP -/* Do we have Netscape LDAP SDK library */ -#undef HAVE_NS_LDAP +/* Does the library define ldap_set_option () ? */ +#undef HAVE_LDAP_SET_OPTION +/* Does the library define ldap_get_lderrno () ? */ +#undef HAVE_LDAP_GET_LDERRNO +/* Does the library define ldap_result2error () ? */ +#undef HAVE_LDAP_RESULT2ERROR +/* Does the library define ldap_parse_result () ? */ +#undef HAVE_LDAP_PARSE_RESULT /* Do you have the Xauth library present? This will add some extra functionality to gnuserv. */ @@ -388,18 +416,36 @@ /* Check the entire extent structure of a buffer each time an extent change is done, and do other extent-related checks. */ #undef ERROR_CHECK_EXTENTS + /* Make sure that all X... macros are dereferencing the correct type, and that all XSET... macros (as much as possible) are setting the correct type of structure. Highly recommended for all development work. */ #undef ERROR_CHECK_TYPECHECK +#ifdef ERROR_CHECK_TYPECHECK +#define type_checking_assert(assertion) assert (assertion) +#else +#define type_checking_assert(assertion) +#endif + /* Make sure valid buffer positions are passed to BUF_* macros. */ #undef ERROR_CHECK_BUFPOS +#ifdef ERROR_CHECK_BUFPOS +#define bufpos_checking_assert(assertion) assert (assertion) +#else +#define bufpos_checking_assert(assertion) +#endif + /* Attempt to catch bugs related to garbage collection (e.g. not GCPRO'ing). */ #undef ERROR_CHECK_GC + /* Attempt to catch freeing of a non-malloc()ed block, heap corruption, etc. */ #undef ERROR_CHECK_MALLOC +/* Minor sanity checking of the bytecode interpreter. Useful for + debugging the byte compiler. */ +#undef ERROR_CHECK_BYTE_CODE + /* Define DEBUG_XEMACS if you want extra debugging code compiled in. This is mainly intended for use by developers. */ #undef DEBUG_XEMACS @@ -429,11 +475,6 @@ #undef USE_GCC #undef USE_LCC -/* Allow the user to override the default value of PURESIZE at configure - time. This must come before we include the sys files in order for - it to be able to override any changes in them. */ -#undef RAW_PURESIZE - /* Define this if you want level 2 internationalization compliance (localized collation and formatting). Generally this should be defined, unless your system doesn't have the strcoll() and @@ -458,8 +499,8 @@ /* Compile in generic Drag'n'Drop API */ #undef HAVE_DRAGNDROP -/* Compile in support for proper session-management. */ -#undef HAVE_SESSION +/* Compile in support for proper handling of WM_COMMAND. */ +#undef HAVE_WMCOMMAND /* Define this if you want Mule support (multi-byte character support). There may be some performance penalty, although it should be small @@ -492,22 +533,21 @@ /* Defined by AC_C_CONST in configure.in */ #undef const -#define CONST const +/* Allow the source to use standard types. Include these before the + s&m files so that they can use them. */ +#undef ssize_t +#undef size_t +#undef pid_t +#undef mode_t +#undef off_t +#undef uid_t +#undef gid_t /* If defined, use unions instead of ints. A few systems (DEC Alpha) seem to require this, probably because something with the int definitions isn't right with 64-bit systems. */ #undef USE_UNION_TYPE -/* If defined, use a minimal number of tagbits. This allows usage of more - advanced versions of malloc (like the Doug Lea new GNU malloc) and larger - integers. */ -/* --use-minimal-tagbits */ -#undef USE_MINIMAL_TAGBITS - -/* --use-indexed-lrecord-implementation */ -#undef USE_INDEXED_LRECORD_IMPLEMENTATION - /* The configuration script defines opsysfile to be the name of the s/...h file that describes the system type you are using. The file is chosen based on the configuration name you give. @@ -554,14 +594,6 @@ #define SIGRETURN return #endif -/* Allow the source to use standard types */ -#undef size_t -#undef pid_t -#undef mode_t -#undef off_t -#undef uid_t -#undef gid_t - /* Define DYNODUMP if it is necessary to properly dump on this system. Currently this is only Solaris 2.x, for x < 6. */ #undef DYNODUMP @@ -583,6 +615,9 @@ #undef HAVE_NAS_SOUND #undef NAS_NO_ERROR_JUMP +/* Compile in support for ESD (Enlightened Sound Daemon)? */ +#undef HAVE_ESD_SOUND + /* Compile in support for SunPro usage-tracking code? */ #undef USAGE_TRACKING @@ -603,12 +638,17 @@ #undef LWLIB_DIALOGS_MOTIF #undef LWLIB_DIALOGS_ATHENA #undef LWLIB_DIALOGS_ATHENA3D +#undef LWLIB_TABS_LUCID +#undef LWLIB_WIDGETS_MOTIF +#undef LWLIB_WIDGETS_ATHENA +#undef HAVE_ATHENA_3D /* Other things that can be disabled by configure. */ #undef HAVE_MENUBARS #undef HAVE_SCROLLBARS #undef HAVE_DIALOGS #undef HAVE_TOOLBARS +#undef HAVE_WIDGETS #if defined (HAVE_MENUBARS) || defined (HAVE_DIALOGS) @@ -635,7 +675,7 @@ /* If you turn this flag on, it forces encapsulation in all circumstances; this can be used to make sure things compile OK on various systems. */ -#define DEBUG_ENCAPSULATION +#undef DEBUG_ENCAPSULATION /* basic system calls */ @@ -792,18 +832,17 @@ /* Should movemail use hesiod for getting POP server host? */ #undef HESIOD /* Determine type of mail locking. */ -/* Play preprocessor games so that configure options override s&m files */ -#undef REAL_MAIL_USE_LOCKF -#undef REAL_MAIL_USE_FLOCK -#undef MAIL_USE_LOCKF -#undef MAIL_USE_FLOCK -#ifdef REAL_MAIL_USE_FLOCK -#define MAIL_USE_FLOCK -#endif -#ifdef REAL_MAIL_USE_LOCKF -#define MAIL_USE_LOCKF -#endif +#undef MAIL_LOCK_LOCKF +#undef MAIL_LOCK_FLOCK +#undef MAIL_LOCK_DOT +#undef MAIL_LOCK_LOCKING +#undef MAIL_LOCK_MMDF +#undef PREFIX_USER_DEFINED +#undef EXEC_PREFIX_USER_DEFINED +#undef MODULEDIR_USER_DEFINED +#undef SITEMODULEDIR_USER_DEFINED +#undef DOCDIR_USER_DEFINED #undef LISPDIR_USER_DEFINED #undef PACKAGE_PATH_USER_DEFINED #undef SITELISPDIR_USER_DEFINED @@ -813,4 +852,6 @@ #undef INFODIR_USER_DEFINED #undef INFOPATH_USER_DEFINED +#undef PDUMP + #endif /* _SRC_CONFIG_H_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/conslots.h --- a/src/conslots.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/conslots.h Mon Aug 13 11:13:30 2007 +0200 @@ -25,6 +25,10 @@ definition. In the garbage collector this file is included after defining MARKED_SLOT(x) to be mark_object(console->x). */ +#ifndef CONSOLE_SLOTS_FIRST_NAME +#define CONSOLE_SLOTS_FIRST_NAME name +#endif + /* Name of this console, for resourcing and printing purposes. If not explicitly given, it's initialized in a console-specific manner. */ @@ -93,4 +97,7 @@ Initialized by the terminal-specific lisp files. */ MARKED_SLOT (function_key_map); +#ifndef CONSOLE_SLOTS_LAST_NAME +#define CONSOLE_SLOTS_LAST_NAME function_key_map +#endif diff -r f4aeb21a5bad -r 74fd4e045ea6 src/console-msw.c --- a/src/console-msw.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/console-msw.c Mon Aug 13 11:13:30 2007 +0200 @@ -31,9 +31,12 @@ #include "console-msw.h" +DEFINE_CONSOLE_TYPE (mswindows); +DEFINE_CONSOLE_TYPE (msprinter); -DEFINE_CONSOLE_TYPE (mswindows); - +/************************************************************************/ +/* mswindows console methods */ +/************************************************************************/ static int mswindows_initially_selected_for_input (struct console *con) @@ -41,7 +44,32 @@ return 1; } +static Lisp_Object +mswindows_canonicalize_console_connection (Lisp_Object connection, + Error_behavior errb) +{ + /* Do not allow more than one mswindows device, by explicitly + requiring that CONNECTION is nil, the only allowed connection in + Windows. */ + if (!NILP (connection)) + { + if (ERRB_EQ (errb, ERROR_ME)) + signal_simple_error + ("Invalid (non-nil) connection for mswindows device/console", + connection); + else + return Qunbound; + } + return Qnil; +} + +static Lisp_Object +mswindows_canonicalize_device_connection (Lisp_Object connection, + Error_behavior errb) +{ + return mswindows_canonicalize_console_connection (connection, errb); +} /************************************************************************/ @@ -63,10 +91,19 @@ /* CONSOLE_HAS_METHOD (mswindows, mark_console); */ CONSOLE_HAS_METHOD (mswindows, initially_selected_for_input); /* CONSOLE_HAS_METHOD (mswindows, delete_console); */ -/* CONSOLE_HAS_METHOD (mswindows, canonicalize_console_connection); */ -/* CONSOLE_HAS_METHOD (mswindows, canonicalize_device_connection); */ + CONSOLE_HAS_METHOD (mswindows, canonicalize_console_connection); + CONSOLE_HAS_METHOD (mswindows, canonicalize_device_connection); /* CONSOLE_HAS_METHOD (mswindows, semi_canonicalize_console_connection); */ /* CONSOLE_HAS_METHOD (mswindows, semi_canonicalize_device_connection); */ + + INITIALIZE_CONSOLE_TYPE (msprinter, "msprinter", "console-msprinter-p"); +} + +void +reinit_console_type_create_mswindows (void) +{ + REINITIALIZE_CONSOLE_TYPE (mswindows); + REINITIALIZE_CONSOLE_TYPE (msprinter); } void @@ -96,19 +133,19 @@ return OPAQUEP (obj) ? OPAQUE_DATA (XOPAQUE (obj)) : NULL; } -struct Lisp_Event * +Lisp_Event * DEVENT (Lisp_Object obj) { return EVENTP (obj) ? XEVENT (obj) : NULL; } -struct Lisp_Cons * +Lisp_Cons * DCONS (Lisp_Object obj) { return CONSP (obj) ? XCONS (obj) : NULL; } -struct Lisp_Cons * +Lisp_Cons * DCONSCDR (Lisp_Object obj) { return (CONSP (obj) && CONSP (XCDR (obj))) ? XCONS (XCDR (obj)) : 0; @@ -120,13 +157,13 @@ return STRINGP (obj) ? XSTRING_DATA (obj) : NULL; } -struct Lisp_Vector * +Lisp_Vector * DVECTOR (Lisp_Object obj) { return VECTORP (obj) ? XVECTOR (obj) : NULL; } -struct Lisp_Symbol * +Lisp_Symbol * DSYMBOL (Lisp_Object obj) { return SYMBOLP (obj) ? XSYMBOL (obj) : NULL; @@ -138,4 +175,4 @@ return SYMBOLP (obj) ? string_data (XSYMBOL (obj)->name) : NULL; } -#endif +#endif /* DEBUG_XEMACS */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/console-msw.h --- a/src/console-msw.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/console-msw.h Mon Aug 13 11:13:30 2007 +0200 @@ -29,16 +29,14 @@ Rewritten for mswindows by Jonathan Harris, November 1997 for 21.0. */ -#ifndef _XEMACS_CONSOLE_MSW_H_ -#define _XEMACS_CONSOLE_MSW_H_ +#ifndef INCLUDED_console_msw_h_ +#define INCLUDED_console_msw_h_ #include "console.h" -#ifdef CONST /* I suspect this is safe */ -#undef CONST -#endif #include <windows.h> #include <ddeml.h> /* DDE management library */ -#ifndef __CYGWIN32__ +#if !defined(__CYGWIN32__) && !defined(__MINGW32__) \ + || CYGWIN_VERSION_DLL_MAJOR > 20 #include <shellapi.h> /* FileManager/Explorer drag and drop */ #include <commctrl.h> #endif @@ -66,6 +64,7 @@ /* The name of the main window class */ #define XEMACS_CLASS "XEmacs" +#define XEMACS_CONTROL_CLASS "XEmacsControl" /* * Console @@ -78,6 +77,7 @@ int infd, outfd; }; +DECLARE_CONSOLE_TYPE (msprinter); /* * Device @@ -85,12 +85,6 @@ #define MSW_FONTSIZE (LF_FACESIZE*4+12) -struct mswindows_font_enum -{ - char fontname[MSW_FONTSIZE]; - struct mswindows_font_enum *next; -}; - struct mswindows_device { int logpixelsx, logpixelsy; @@ -98,7 +92,7 @@ int horzres, vertres; /* Size in pixels */ int horzsize, vertsize; /* Size in mm */ int bitspixel; - struct mswindows_font_enum *fontlist; + Lisp_Object fontlist; /* List of strings, device fonts */ }; #define DEVICE_MSWINDOWS_DATA(d) DEVICE_TYPE_DATA (d, mswindows) @@ -113,6 +107,38 @@ #define DEVICE_MSWINDOWS_BITSPIXEL(d) (DEVICE_MSWINDOWS_DATA (d)->bitspixel) #define DEVICE_MSWINDOWS_FONTLIST(d) (DEVICE_MSWINDOWS_DATA (d)->fontlist) +struct msprinter_device +{ + HDC hdc; + HANDLE hprinter; + Lisp_Object fontlist; + char* name; + DEVMODE *devmode, *devmode_mirror; + size_t devmode_size; +}; + +#define DEVICE_MSPRINTER_DATA(d) DEVICE_TYPE_DATA (d, msprinter) +#define DEVICE_MSPRINTER_HDC(d) (DEVICE_MSPRINTER_DATA (d)->hdc) +#define DEVICE_MSPRINTER_HPRINTER(d) (DEVICE_MSPRINTER_DATA (d)->hprinter) +#define DEVICE_MSPRINTER_FONTLIST(d) (DEVICE_MSPRINTER_DATA (d)->fontlist) +#define DEVICE_MSPRINTER_NAME(d) (DEVICE_MSPRINTER_DATA (d)->name) +#define DEVICE_MSPRINTER_DEVMODE(d) (DEVICE_MSPRINTER_DATA (d)->devmode) +#define DEVICE_MSPRINTER_DEVMODE_MIRROR(d) \ + (DEVICE_MSPRINTER_DATA (d)->devmode_mirror) +#define DEVICE_MSPRINTER_DEVMODE_SIZE(d) \ + (DEVICE_MSPRINTER_DATA (d)->devmode_size) + +#define CONSOLE_TYPESYM_MSPRINTER_P(typesym) EQ (typesym, Qmsprinter) +#define DEVICE_MSPRINTER_P(dev) CONSOLE_TYPESYM_MSPRINTER_P (DEVICE_TYPE (dev)) +#define CHECK_MSPRINTER_DEVICE(z) CHECK_DEVICE_TYPE (z, msprinter) +#define CONCHECK_MSPRINTER_DEVICE(z) CONCHECK_DEVICE_TYPE (z, msprinter) + +/* Printer functions in device-msw.c */ +DEVMODE* msprinter_get_devmode_copy (struct device *d); +void msprinter_apply_devmode (struct device *d, DEVMODE *devmode); + +/* Printer functions in frame-msw.c */ +void msprinter_start_page (struct frame *f); /* * Frame @@ -204,6 +230,33 @@ #define XWL_COUNT 1 /* Number of LONGs that we use */ #define MSWINDOWS_WINDOW_EXTRA_BYTES (XWL_COUNT*4) +/* + * Printer frame, aka printer job + */ + +struct msprinter_frame +{ + HDC hcdc; /* Compatoble DC */ + int left_margin, top_margin, /* All in twips */ + right_margin, bottom_margin; + int charheight, charwidth; /* As per proplist or -1 if not gven */ + Lisp_Object orientation, duplex; /* nil for printer's default */ + int job_started : 1; + int page_started : 1; +}; + +#define FRAME_MSPRINTER_DATA(f) FRAME_TYPE_DATA (f, msprinter) +#define FRAME_MSPRINTER_LEFT_MARGIN(f) (FRAME_MSPRINTER_DATA (f)->left_margin) +#define FRAME_MSPRINTER_RIGHT_MARGIN(f) (FRAME_MSPRINTER_DATA (f)->top_margin) +#define FRAME_MSPRINTER_TOP_MARGIN(f) (FRAME_MSPRINTER_DATA (f)->right_margin) +#define FRAME_MSPRINTER_BOTTOM_MARGIN(f) (FRAME_MSPRINTER_DATA (f)->bottom_margin) +#define FRAME_MSPRINTER_CDC(f) (FRAME_MSPRINTER_DATA (f)->hcdc) +#define FRAME_MSPRINTER_JOB_STARTED(f) (FRAME_MSPRINTER_DATA (f)->job_started) +#define FRAME_MSPRINTER_PAGE_STARTED(f) (FRAME_MSPRINTER_DATA (f)->page_started) +#define FRAME_MSPRINTER_ORIENTATION(f) (FRAME_MSPRINTER_DATA (f)->orientation) +#define FRAME_MSPRINTER_DUPLEX(f) (FRAME_MSPRINTER_DATA (f)->duplex) +#define FRAME_MSPRINTER_CHARWIDTH(f) (FRAME_MSPRINTER_DATA (f)->charheight) +#define FRAME_MSPRINTER_CHARHEIGHT(f) (FRAME_MSPRINTER_DATA (f)->charwidth) /* * Events @@ -224,11 +277,14 @@ /* win32 "Windows" procedure */ LRESULT WINAPI mswindows_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam); +LRESULT WINAPI mswindows_control_wnd_proc (HWND hwnd, + UINT msg, WPARAM wParam, + LPARAM lParam); void mswindows_redraw_exposed_area (struct frame *f, int x, int y, int width, int height); void mswindows_size_frame_internal (struct frame* f, XEMACS_RECT_WH* dest); -void mswindows_enqueue_magic_event (HWND hwnd, UINT message); +void mswindows_enqueue_magic_event (HWND hwnd, UINT msg); /* win32 DDE management library */ #define MSWINDOWS_DDE_ITEM_OPEN "Open" @@ -243,19 +299,42 @@ void mswindows_enqueue_misc_user_event (Lisp_Object channel, Lisp_Object function, Lisp_Object object); -Lisp_Object mswindows_cancel_dispatch_event (struct Lisp_Event* event); +Lisp_Object mswindows_cancel_dispatch_event (Lisp_Event* event); Lisp_Object mswindows_pump_outstanding_events (void); Lisp_Object mswindows_protect_modal_loop (Lisp_Object (*bfun) (Lisp_Object barg), Lisp_Object barg); void mswindows_unmodalize_signal_maybe (void); +#ifdef HAVE_TOOLBARS +Lisp_Object +mswindows_get_toolbar_button_text ( struct frame* f, int command_id ); +Lisp_Object +mswindows_handle_toolbar_wm_command (struct frame* f, HWND ctrl, WORD id); +#endif +Lisp_Object +mswindows_handle_gui_wm_command (struct frame* f, HWND ctrl, DWORD id); +COLORREF mswindows_string_to_color (const char *name); +USID emacs_mswindows_create_stream_pair (void* inhandle, void* outhandle, + Lisp_Object* instream, + Lisp_Object* outstream, + int flags); +USID emacs_mswindows_delete_stream_pair (Lisp_Object instream, + Lisp_Object outstream); + #ifdef HAVE_WIN32_PROCESSES -HANDLE get_nt_process_handle (struct Lisp_Process *p); +HANDLE get_nt_process_handle (Lisp_Process *p); #endif extern Lisp_Object Vmswindows_frame_being_created; extern Lisp_Object mswindows_frame_being_created; -void mswindows_enumerate_fonts (struct device *d); +Lisp_Object mswindows_enumerate_fonts (HDC hdc); -#endif /* _XEMACS_CONSOLE_MSW_H_ */ +Lisp_Object mswindows_get_toolbar_button_text (struct frame* f, + int command_id); +Lisp_Object mswindows_handle_toolbar_wm_command (struct frame* f, + HWND ctrl, WORD id); +Lisp_Object mswindows_handle_gui_wm_command (struct frame* f, + HWND ctrl, DWORD id); + +#endif /* INCLUDED_console_msw_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/console-stream.c --- a/src/console-stream.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/console-stream.c Mon Aug 13 11:13:30 2007 +0200 @@ -171,7 +171,7 @@ static int stream_text_width (struct frame *f, struct face_cachel *cachel, - CONST Emchar *str, Charcount len) + const Emchar *str, Charcount len) { return len; } @@ -298,6 +298,12 @@ } void +reinit_console_type_create_stream (void) +{ + REINITIALIZE_CONSOLE_TYPE (stream); +} + +void vars_of_console_stream (void) { DEFVAR_LISP ("terminal-console", &Vterminal_console /* @@ -320,6 +326,7 @@ staticpro (&Vstdio_str); } +#ifndef PDUMP void init_console_stream (void) { @@ -339,3 +346,22 @@ event_stream_select_console (XCONSOLE (Vterminal_console)); } } + +#else + +void +init_console_stream (void) +{ + /* This function can GC */ + Vterminal_device = Fmake_device (Qstream, Qnil, Qnil); + Vterminal_console = Fdevice_console (Vterminal_device); + Vterminal_frame = Fmake_frame (Qnil, Vterminal_device); + minibuf_window = XFRAME (Vterminal_frame)->minibuffer_window; + if (initialized) + { + stream_init_console (XCONSOLE (Vterminal_console), Qnil); + if (noninteractive) + event_stream_select_console (XCONSOLE (Vterminal_console)); + } +} +#endif diff -r f4aeb21a5bad -r 74fd4e045ea6 src/console-stream.h --- a/src/console-stream.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/console-stream.h Mon Aug 13 11:13:30 2007 +0200 @@ -23,8 +23,8 @@ /* Written by Ben Wing. */ -#ifndef _XEMACS_CONSOLE_STREAM_H_ -#define _XEMACS_CONSOLE_STREAM_H_ +#ifndef INCLUDED_console_stream_h_ +#define INCLUDED_console_stream_h_ #include "console.h" @@ -40,6 +40,8 @@ #define CONSOLE_STREAM_DATA(con) CONSOLE_TYPE_DATA (con, stream) +extern Lisp_Object Vterminal_console, Vterminal_frame, Vterminal_device; + Lisp_Object stream_semi_canonicalize_console_connection(Lisp_Object, Error_behavior); Lisp_Object stream_canonicalize_console_connection(Lisp_Object, @@ -48,4 +50,4 @@ Error_behavior); Lisp_Object stream_canonicalize_device_connection(Lisp_Object, Error_behavior); -#endif /* _XEMACS_CONSOLE_STREAM_H_ */ +#endif /* INCLUDED_console_stream_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/console-tty.c --- a/src/console-tty.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/console-tty.c Mon Aug 13 11:13:30 2007 +0200 @@ -32,16 +32,18 @@ #include "faces.h" #include "frame.h" #include "lstream.h" +#include "glyphs.h" #include "sysdep.h" #include "sysfile.h" #ifdef FILE_CODING #include "file-coding.h" #endif -#ifdef HAVE_GPM -#include "gpmevent.h" -#endif DEFINE_CONSOLE_TYPE (tty); +DECLARE_IMAGE_INSTANTIATOR_FORMAT (nothing); +DECLARE_IMAGE_INSTANTIATOR_FORMAT (string); +DECLARE_IMAGE_INSTANTIATOR_FORMAT (formatted_string); +DECLARE_IMAGE_INSTANTIATOR_FORMAT (inherit); Lisp_Object Qterminal_type; Lisp_Object Qcontrolling_process; @@ -125,10 +127,6 @@ tty_con->terminal_type = terminal_type; tty_con->controlling_process = controlling_process; -#ifdef HAVE_GPM - connect_to_gpm (con); -#endif - if (NILP (CONSOLE_NAME (con))) CONSOLE_NAME (con) = Ffile_name_nondirectory (tty); { @@ -161,12 +159,12 @@ } static void -tty_mark_console (struct console *con, void (*markobj) (Lisp_Object)) +tty_mark_console (struct console *con) { struct tty_console *tty_con = CONSOLE_TTY_DATA (con); - markobj (tty_con->terminal_type); - markobj (tty_con->instream); - markobj (tty_con->outstream); + mark_object (tty_con->terminal_type); + mark_object (tty_con->instream); + mark_object (tty_con->outstream); } static int @@ -280,10 +278,12 @@ set_encoding_stream_coding_system (XLSTREAM (CONSOLE_TTY_DATA (decode_tty_console (console))->outstream), Fget_coding_system (NILP (codesys) ? Vterminal_coding_system : codesys)); + /* Redraw tty */ + face_property_was_changed (Vdefault_face, Qfont, Qtty); return Qnil; } -/* ### Move this function to lisp */ +/* #### Move this function to lisp */ DEFUN ("set-console-tty-coding-system", Fset_console_tty_coding_system, 0, 2, 0, /* Set the input and output coding systems of tty console CONSOLE to CODESYS. @@ -367,6 +367,21 @@ } void +reinit_console_type_create_tty (void) +{ + REINITIALIZE_CONSOLE_TYPE (tty); +} + +void +image_instantiator_format_create_glyphs_tty (void) +{ + IIFORMAT_VALID_CONSOLE (tty, nothing); + IIFORMAT_VALID_CONSOLE (tty, string); + IIFORMAT_VALID_CONSOLE (tty, formatted_string); + IIFORMAT_VALID_CONSOLE (tty, inherit); +} + +void vars_of_console_tty (void) { Fprovide (Qtty); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/console-tty.h --- a/src/console-tty.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/console-tty.h Mon Aug 13 11:13:30 2007 +0200 @@ -29,8 +29,8 @@ have more than one device on a TTY console, the output stuff will have to get separated out. */ -#ifndef _XEMACS_CONSOLE_TTY_H_ -#define _XEMACS_CONSOLE_TTY_H_ +#ifndef INCLUDED_console_tty_h_ +#define INCLUDED_console_tty_h_ #include "console.h" #include "syssignal.h" /* Always include before systty.h */ @@ -41,9 +41,6 @@ struct tty_console { int infd, outfd; -#ifdef HAVE_GPM - int mouse_fd; -#endif Lisp_Object instream, outstream; Lisp_Object terminal_type; Lisp_Object controlling_process; @@ -96,31 +93,31 @@ struct { /* local cursor movement */ - CONST char *up; /* cuu1, up */ - CONST char *down; /* cud1, do */ - CONST char *left; /* cub1, le */ - CONST char *right; /* cuf1, nd */ - CONST char *home; /* home, ho */ - CONST char *low_left; /* ll, ll */ - CONST char *car_return; /* cr, cr */ + const char *up; /* cuu1, up */ + const char *down; /* cud1, do */ + const char *left; /* cub1, le */ + const char *right; /* cuf1, nd */ + const char *home; /* home, ho */ + const char *low_left; /* ll, ll */ + const char *car_return; /* cr, cr */ /* parameterized local cursor movement */ - CONST char *multi_up; /* cuu, UP */ - CONST char *multi_down; /* cud, DO */ - CONST char *multi_left; /* cub, LE */ - CONST char *multi_right; /* cuf, RI */ + const char *multi_up; /* cuu, UP */ + const char *multi_down; /* cud, DO */ + const char *multi_left; /* cub, LE */ + const char *multi_right; /* cuf, RI */ /* absolute cursor motion */ - CONST char *abs; /* cup, cm */ - CONST char *hor_abs; /* hpa, ch */ - CONST char *ver_abs; /* vpa, cv */ + const char *abs; /* cup, cm */ + const char *hor_abs; /* hpa, ch */ + const char *ver_abs; /* vpa, cv */ /* scrolling */ - CONST char *scroll_forw; /* ind, sf */ - CONST char *scroll_back; /* ri, sr */ - CONST char *multi_scroll_forw; /* indn, SF */ - CONST char *multi_scroll_back; /* rin, SR */ - CONST char *set_scroll_region; /* csr, cs */ + const char *scroll_forw; /* ind, sf */ + const char *scroll_back; /* ri, sr */ + const char *multi_scroll_forw; /* indn, SF */ + const char *multi_scroll_back; /* rin, SR */ + const char *set_scroll_region; /* csr, cs */ } cm; /* screen editing entries - each entry is commented with the @@ -128,56 +125,56 @@ struct { /* adding to the screen */ - CONST char *ins_line; /* il1, al */ - CONST char *multi_ins_line; /* il, AL */ - CONST char *repeat; /* rep, rp */ - CONST char *begin_ins_mode; /* smir, im */ - CONST char *end_ins_mode; /* rmir, ei */ - CONST char *ins_char; /* ich1, ic */ - CONST char *multi_ins_char; /* ich, IC */ - CONST char *insert_pad; /* ip, ip */ + const char *ins_line; /* il1, al */ + const char *multi_ins_line; /* il, AL */ + const char *repeat; /* rep, rp */ + const char *begin_ins_mode; /* smir, im */ + const char *end_ins_mode; /* rmir, ei */ + const char *ins_char; /* ich1, ic */ + const char *multi_ins_char; /* ich, IC */ + const char *insert_pad; /* ip, ip */ /* deleting from the screen */ - CONST char *clr_frame; /* clear, cl */ - CONST char *clr_from_cursor; /* ed, cd */ - CONST char *clr_to_eol; /* el, ce */ - CONST char *del_line; /* dl1, dl */ - CONST char *multi_del_line; /* dl, DL */ - CONST char *del_char; /* dch1, dc */ - CONST char *multi_del_char; /* dch, DC */ - CONST char *begin_del_mode; /* smdc, dm */ - CONST char *end_del_mode; /* rmdc, ed */ - CONST char *erase_at_cursor; /* ech, ec */ + const char *clr_frame; /* clear, cl */ + const char *clr_from_cursor; /* ed, cd */ + const char *clr_to_eol; /* el, ce */ + const char *del_line; /* dl1, dl */ + const char *multi_del_line; /* dl, DL */ + const char *del_char; /* dch1, dc */ + const char *multi_del_char; /* dch, DC */ + const char *begin_del_mode; /* smdc, dm */ + const char *end_del_mode; /* rmdc, ed */ + const char *erase_at_cursor; /* ech, ec */ } se; /* screen display entries - each entry is commented with the terminfo and termcap entry */ struct { - CONST char *begin_standout; /* smso, so */ - CONST char *end_standout; /* rmso, se */ - CONST char *begin_underline; /* smul, us */ - CONST char *end_underline; /* rmul, ue */ - CONST char *begin_alternate; /* smacs, as */ - CONST char *end_alternate; /* rmacs, ae */ + const char *begin_standout; /* smso, so */ + const char *end_standout; /* rmso, se */ + const char *begin_underline; /* smul, us */ + const char *end_underline; /* rmul, ue */ + const char *begin_alternate; /* smacs, as */ + const char *end_alternate; /* rmacs, ae */ - CONST char *turn_on_reverse; /* rev, mr */ - CONST char *turn_on_blinking; /* blink, mb */ - CONST char *turn_on_bold; /* bold, md */ - CONST char *turn_on_dim; /* dim, mh */ - CONST char *turn_off_attributes; /* sgr0, me */ + const char *turn_on_reverse; /* rev, mr */ + const char *turn_on_blinking; /* blink, mb */ + const char *turn_on_bold; /* bold, md */ + const char *turn_on_dim; /* dim, mh */ + const char *turn_off_attributes; /* sgr0, me */ - CONST char *visual_bell; /* flash, vb */ - CONST char *audio_bell; /* bel, bl */ + const char *visual_bell; /* flash, vb */ + const char *audio_bell; /* bel, bl */ - CONST char *cursor_visible; /* cvvis, vs */ - CONST char *cursor_normal; /* cnorm, ve */ - CONST char *init_motion; /* smcup, ti */ - CONST char *end_motion; /* rmcup, te */ - CONST char *keypad_on; /* smkx, ks */ - CONST char *keypad_off; /* rmkx, ke */ + const char *cursor_visible; /* cvvis, vs */ + const char *cursor_normal; /* cnorm, ve */ + const char *init_motion; /* smcup, ti */ + const char *end_motion; /* rmcup, te */ + const char *keypad_on; /* smkx, ks */ + const char *keypad_off; /* rmkx, ke */ - CONST char *orig_pair; /* op, op */ + const char *orig_pair; /* op, op */ } sd; /* costs of various operations */ @@ -203,9 +200,6 @@ unsigned int is_stdio :1; }; -#ifdef HAVE_GPM -#define CONSOLE_TTY_MOUSE_FD(c) (CONSOLE_TTY_DATA (c)->mouse_fd) -#endif #define CONSOLE_TTY_DATA(c) CONSOLE_TYPE_DATA (c, tty) #define CONSOLE_TTY_CURSOR_X(c) (CONSOLE_TTY_DATA (c)->cursor_x) #define CONSOLE_TTY_CURSOR_Y(c) (CONSOLE_TTY_DATA (c)->cursor_y) @@ -295,4 +289,4 @@ Error_behavior errb); struct console * tty_find_console_from_fd (int fd); -#endif /* _XEMACS_CONSOLE_TTY_H_ */ +#endif /* INCLUDED_console_tty_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/console-x.c --- a/src/console-x.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/console-x.c Mon Aug 13 11:13:30 2007 +0200 @@ -102,7 +102,7 @@ static Lisp_Object get_display_arg_connection (void) { - CONST char *disp_name; + const char *disp_name; /* If the user didn't explicitly specify a display to use when they called make-x-device, then we first check to see if a @@ -140,12 +140,12 @@ /* assert: display_arg is only set if we found the display arg earlier so we can't fail to find it now. */ assert (disp_name != NULL); - conn = build_ext_string (disp_name, FORMAT_CTEXT); + conn = build_ext_string (disp_name, Qctext); free_argc_argv (argv); return conn; } else - return build_ext_string (XDisplayName (0), FORMAT_CTEXT); + return build_ext_string (XDisplayName (0), Qctext); } /* "semi-canonicalize" means convert to a nicer form for printing, but @@ -181,7 +181,7 @@ /* Check for a couple of standard special cases */ if (string_byte (XSTRING (connection), 0) == ':') connection = concat2 (build_string ("localhost"), connection); - else if (!strncmp ((CONST char *) XSTRING_DATA (connection), + else if (!strncmp ((const char *) XSTRING_DATA (connection), "unix:", 5)) connection = concat2 (build_string ("localhost:"), Fsubstring (connection, make_int (5), Qnil)); @@ -260,7 +260,7 @@ split_up_display_spec (connection, &hostname_length, &display_length, &screen_length); - screen_str = build_string ((CONST char *) XSTRING_DATA (connection) + screen_str = build_string ((const char *) XSTRING_DATA (connection) + hostname_length + display_length); connection = x_canonicalize_console_connection (connection, errb); @@ -280,3 +280,9 @@ CONSOLE_HAS_METHOD (x, initially_selected_for_input); } + +void +reinit_console_type_create_x (void) +{ + REINITIALIZE_CONSOLE_TYPE (x); +} diff -r f4aeb21a5bad -r 74fd4e045ea6 src/console-x.h --- a/src/console-x.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/console-x.h Mon Aug 13 11:13:30 2007 +0200 @@ -29,8 +29,8 @@ multi-device work by Chuck Thompson). */ -#ifndef _XEMACS_CONSOLE_X_H_ -#define _XEMACS_CONSOLE_X_H_ +#ifndef INCLUDED_console_x_h_ +#define INCLUDED_console_x_h_ #ifdef HAVE_X_WINDOWS @@ -95,7 +95,7 @@ Atom Xatom_WM_TAKE_FOCUS; Atom Xatom_WM_STATE; - /* allocated in Xatoms_of_xselect in xselect.c */ + /* allocated in Xatoms_of_select_x in xselect.c */ Atom Xatom_CLIPBOARD; Atom Xatom_TIMESTAMP; Atom Xatom_TEXT; @@ -213,7 +213,7 @@ #define DEVICE_XATOM_WM_TAKE_FOCUS(d) (DEVICE_X_DATA (d)->Xatom_WM_TAKE_FOCUS) #define DEVICE_XATOM_WM_STATE(d) (DEVICE_X_DATA (d)->Xatom_WM_STATE) -/* allocated in Xatoms_of_xselect in xselect.c */ +/* allocated in Xatoms_of_select_x in xselect.c */ #define DEVICE_XATOM_CLIPBOARD(d) (DEVICE_X_DATA (d)->Xatom_CLIPBOARD) #define DEVICE_XATOM_TIMESTAMP(d) (DEVICE_X_DATA (d)->Xatom_TIMESTAMP) #define DEVICE_XATOM_TEXT(d) (DEVICE_X_DATA (d)->Xatom_TEXT) @@ -381,7 +381,7 @@ extern Lisp_Object Vdefault_x_device; /* Number of pixels below each line. */ -extern int x_interline_space; +extern int x_interline_space; /* #### implement me */ extern int x_selection_timeout; @@ -398,14 +398,14 @@ void x_handle_selection_clear (XSelectionClearEvent *event); void x_handle_property_notify (XPropertyEvent *event); -void Xatoms_of_xselect (struct device *d); +void Xatoms_of_select_x (struct device *d); void Xatoms_of_objects_x (struct device *d); void x_wm_set_shell_iconic_p (Widget shell, int iconic_p); void x_wm_set_cell_size (Widget wmshell, int cw, int ch); void x_wm_set_variable_size (Widget wmshell, int width, int height); -CONST char *x_event_name (int event_type); +const char *x_event_name (int event_type); int x_error_handler (Display *disp, XErrorEvent *event); void expect_x_error (Display *dpy); int x_error_occurred_p (Display *dpy); @@ -419,16 +419,15 @@ int start_pixpos, int width, face_index findex, int cursor, int cursor_start, int cursor_width, int cursor_height); -void x_output_x_pixmap (struct frame *f, struct Lisp_Image_Instance *p, - int x, int y, int clip_x, int clip_y, - int clip_width, int clip_height, int width, - int height, int pixmap_offset, +void x_output_x_pixmap (struct frame *f, Lisp_Image_Instance *p, + int x, int y, int xoffset, int yoffset, + int width, int height, unsigned long fg, unsigned long bg, GC override_gc); void x_output_shadows (struct frame *f, int x, int y, int width, int height, GC top_shadow_gc, GC bottom_shadow_gc, GC background_gc, - int shadow_thickness); + int shadow_thickness, int edges); void x_generate_shadow_pixels (struct frame *f, unsigned long *top_shadow, unsigned long *bottom_shadow, @@ -439,10 +438,10 @@ void x_init_modifier_mapping (struct device *d); #define X_ERROR_OCCURRED(dpy, body) \ - (expect_x_error ((dpy)), (body), x_error_occurred_p (dpy)) + (expect_x_error (dpy), body, x_error_occurred_p (dpy)) #define HANDLING_X_ERROR(dpy, body) \ - ( expect_x_error ((dpy)), (body), signal_if_x_error ((dpy), 0)) + (expect_x_error (dpy), body, signal_if_x_error (dpy, 0)) void Initialize_Locale (void); @@ -493,4 +492,5 @@ extern Lisp_Object Vx_initial_argv_list; /* #### ugh! */ #endif /* HAVE_X_WINDOWS */ -#endif /* _XEMACS_DEVICE_X_H_ */ + +#endif /* INCLUDED_console_x_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/console.c --- a/src/console.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/console.c Mon Aug 13 11:13:30 2007 +0200 @@ -53,6 +53,7 @@ list of consoles and stores into each console that does not say it has a local value. */ Lisp_Object Vconsole_defaults; +static void *console_defaults_saved_slots; /* This structure marks which slots in a console have corresponding default values in console_defaults. @@ -69,7 +70,7 @@ consoles. If a slot is -1, then there is a DEFVAR_CONSOLE_LOCAL for it - as well as a default value which is used to initialize newly-created + as well as a default value which is used to initialize newly-created consoles and as a reset-value when local-vars are killed. If a slot is -2, there is no DEFVAR_CONSOLE_LOCAL for it. @@ -87,6 +88,7 @@ /* This structure holds the names of symbols whose values may be console-local. It is indexed and accessed in the same way as the above. */ static Lisp_Object Vconsole_local_symbols; +static void *console_local_symbols_saved_slots; DEFINE_CONSOLE_TYPE (dead); @@ -96,19 +98,19 @@ static Lisp_Object -mark_console (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_console (Lisp_Object obj) { struct console *con = XCONSOLE (obj); -#define MARKED_SLOT(x) ((void) (markobj (con->x))); +#define MARKED_SLOT(x) mark_object (con->x) #include "conslots.h" #undef MARKED_SLOT /* Can be zero for Vconsole_defaults, Vconsole_local_symbols */ if (con->conmeths) { - markobj (con->conmeths->symbol); - MAYBE_CONMETH (con, mark_console, (con, markobj)); + mark_object (con->conmeths->symbol); + MAYBE_CONMETH (con, mark_console, (con)); } return Qnil; @@ -127,7 +129,7 @@ sprintf (buf, "#<%s-console", !CONSOLE_LIVE_P (con) ? "dead" : CONSOLE_TYPE_NAME (con)); write_c_string (buf, printcharfun); - if (CONSOLE_LIVE_P (con)) + if (CONSOLE_LIVE_P (con) && !NILP (CONSOLE_CONNECTION (con))) { write_c_string (" on ", printcharfun); print_internal (CONSOLE_CONNECTION (con), printcharfun, 1); @@ -137,14 +139,14 @@ } DEFINE_LRECORD_IMPLEMENTATION ("console", console, - mark_console, print_console, 0, 0, 0, + mark_console, print_console, 0, 0, 0, 0, struct console); static struct console * allocate_console (void) { Lisp_Object console; - struct console *con = alloc_lcrecord_type (struct console, lrecord_console); + struct console *con = alloc_lcrecord_type (struct console, &lrecord_console); struct gcpro gcpro1; copy_lcrecord (con, XCONSOLE (Vconsole_defaults)); @@ -353,16 +355,24 @@ semi_canonicalize_console_connection (struct console_methods *meths, Lisp_Object name, Error_behavior errb) { - return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_console_connection, - (name, errb), name); + if (HAS_CONTYPE_METH_P (meths, semi_canonicalize_console_connection)) + return CONTYPE_METH (meths, semi_canonicalize_console_connection, + (name, errb)); + else + return CONTYPE_METH_OR_GIVEN (meths, canonicalize_console_connection, + (name, errb), name); } static Lisp_Object canonicalize_console_connection (struct console_methods *meths, Lisp_Object name, Error_behavior errb) { - return CONTYPE_METH_OR_GIVEN (meths, canonicalize_console_connection, - (name, errb), name); + if (HAS_CONTYPE_METH_P (meths, canonicalize_console_connection)) + return CONTYPE_METH (meths, canonicalize_console_connection, + (name, errb)); + else + return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_console_connection, + (name, errb), name); } static Lisp_Object @@ -486,7 +496,7 @@ /* Do it this way so that the console list is in order of creation */ Vconsole_list = nconc2 (Vconsole_list, Fcons (console, Qnil)); - if (CONMETH (con, initially_selected_for_input, (con))) + if (CONMETH_OR_GIVEN (con, initially_selected_for_input, (con), 0)) event_stream_select_console (con); UNGCPRO; @@ -876,7 +886,9 @@ Extcount count; Extbyte *p; - GET_STRING_EXT_DATA_ALLOCA (stuffstring, FORMAT_KEYBOARD, p, count); + TO_EXTERNAL_FORMAT (LISP_STRING, stuffstring, + ALLOCA, (p, count), + Qkeyboard); while (count-- > 0) stuff_char (XCONSOLE (Vcontrolling_terminal), *p++); stuff_char (XCONSOLE (Vcontrolling_terminal), '\n'); @@ -1096,10 +1108,45 @@ defsymbol (&Qsuspend_resume_hook, "suspend-resume-hook"); } +static const struct lrecord_description cte_description_1[] = { + { XD_LISP_OBJECT, offsetof (console_type_entry, symbol) }, + { XD_STRUCT_PTR, offsetof (console_type_entry, meths), 1, &console_methods_description }, + { XD_END } +}; + +static const struct struct_description cte_description = { + sizeof (console_type_entry), + cte_description_1 +}; + +static const struct lrecord_description cted_description_1[] = { + XD_DYNARR_DESC (console_type_entry_dynarr, &cte_description), + { XD_END } +}; + +const struct struct_description cted_description = { + sizeof (console_type_entry_dynarr), + cted_description_1 +}; + +static const struct lrecord_description console_methods_description_1[] = { + { XD_LISP_OBJECT, offsetof (struct console_methods, symbol) }, + { XD_LISP_OBJECT, offsetof (struct console_methods, predicate_symbol) }, + { XD_LISP_OBJECT, offsetof (struct console_methods, image_conversion_list) }, + { XD_END } +}; + +const struct struct_description console_methods_description = { + sizeof (struct console_methods), + console_methods_description_1 +}; + + void console_type_create (void) { the_console_type_entry_dynarr = Dynarr_new (console_type_entry); + dumpstruct(&the_console_type_entry_dynarr, &cted_description); Vconsole_type_list = Qnil; staticpro (&Vconsole_type_list); @@ -1114,8 +1161,19 @@ } void +reinit_vars_of_console (void) +{ + staticpro_nodump (&Vconsole_list); + Vconsole_list = Qnil; + staticpro_nodump (&Vselected_console); + Vselected_console = Qnil; +} + +void vars_of_console (void) { + reinit_vars_of_console (); + DEFVAR_LISP ("create-console-hook", &Vcreate_console_hook /* Function or functions to call when a console is created. One argument, the newly-created console. @@ -1131,11 +1189,6 @@ */ ); Vdelete_console_hook = Qnil; - staticpro (&Vconsole_list); - Vconsole_list = Qnil; - staticpro (&Vselected_console); - Vselected_console = Qnil; - #ifdef HAVE_WINDOW_SYSTEM Fprovide (intern ("window-system")); #endif @@ -1147,10 +1200,26 @@ from SunPro C's fix-and-continue feature (a way neato feature that makes debugging unbelievably more bearable) */ #define DEFVAR_CONSOLE_LOCAL_1(lname, field_name, forward_type, magicfun) do { \ - static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { symbol_value_forward_lheader_initializer, \ - (struct lcrecord_header *) &(console_local_flags.field_name), 69 }, \ - forward_type }, magicfun }; \ + static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C = \ + { /* struct symbol_value_forward */ \ + { /* struct symbol_value_magic */ \ + { /* struct lcrecord_header */ \ + { /* struct lrecord_header */ \ + 1, /* type - index into lrecord_implementations_table */ \ + 0, /* mark bit */ \ + 0, /* c_readonly bit */ \ + 0 /* lisp_readonly bit */ \ + }, \ + 0, /* next */ \ + 0, /* uid */ \ + 0 /* free */ \ + }, \ + &(console_local_flags.field_name), \ + forward_type \ + }, \ + magicfun \ + }; \ + \ { \ int offset = ((char *)symbol_value_forward_forward (&I_hate_C) \ - (char *)&console_local_flags); \ @@ -1184,22 +1253,22 @@ { zero_lcrecord (con); -#define MARKED_SLOT(x) con->x = (zap); +#define MARKED_SLOT(x) con->x = zap #include "conslots.h" #undef MARKED_SLOT } -void -complex_vars_of_console (void) +static void +common_init_complex_vars_of_console (void) { /* Make sure all markable slots in console_defaults are initialized reasonably, so mark_console won't choke. */ - struct console *defs = alloc_lcrecord_type (struct console, lrecord_console); - struct console *syms = alloc_lcrecord_type (struct console, lrecord_console); + struct console *defs = alloc_lcrecord_type (struct console, &lrecord_console); + struct console *syms = alloc_lcrecord_type (struct console, &lrecord_console); - staticpro (&Vconsole_defaults); - staticpro (&Vconsole_local_symbols); + staticpro_nodump (&Vconsole_defaults); + staticpro_nodump (&Vconsole_local_symbols); XSETCONSOLE (Vconsole_defaults, defs); XSETCONSOLE (Vconsole_local_symbols, syms); @@ -1254,6 +1323,53 @@ currently allowable due to the XINT() handling of this value. With some rearrangement you can get 4 more bits. */ } +} + + +#define CONSOLE_SLOTS_SIZE (offsetof (struct console, CONSOLE_SLOTS_LAST_NAME) - offsetof (struct console, CONSOLE_SLOTS_FIRST_NAME) + sizeof (Lisp_Object)) +#define CONSOLE_SLOTS_COUNT (CONSOLE_SLOTS_SIZE / sizeof (Lisp_Object)) + +void +reinit_complex_vars_of_console (void) +{ + struct console *defs, *syms; + + common_init_complex_vars_of_console (); + + defs = XCONSOLE (Vconsole_defaults); + syms = XCONSOLE (Vconsole_local_symbols); + memcpy (&defs->CONSOLE_SLOTS_FIRST_NAME, + console_defaults_saved_slots, + CONSOLE_SLOTS_SIZE); + memcpy (&syms->CONSOLE_SLOTS_FIRST_NAME, + console_local_symbols_saved_slots, + CONSOLE_SLOTS_SIZE); +} + + +static const struct lrecord_description console_slots_description_1[] = { + { XD_LISP_OBJECT_ARRAY, 0, CONSOLE_SLOTS_COUNT }, + { XD_END } +}; + +static const struct struct_description console_slots_description = { + CONSOLE_SLOTS_SIZE, + console_slots_description_1 +}; + +void +complex_vars_of_console (void) +{ + struct console *defs, *syms; + + common_init_complex_vars_of_console (); + + defs = XCONSOLE (Vconsole_defaults); + syms = XCONSOLE (Vconsole_local_symbols); + console_defaults_saved_slots = &defs->CONSOLE_SLOTS_FIRST_NAME; + console_local_symbols_saved_slots = &syms->CONSOLE_SLOTS_FIRST_NAME; + dumpstruct (&console_defaults_saved_slots, &console_slots_description); + dumpstruct (&console_local_symbols_saved_slots, &console_slots_description); DEFVAR_CONSOLE_DEFAULTS ("default-function-key-map", function_key_map /* Default value of `function-key-map' for consoles that don't override it. @@ -1284,7 +1400,7 @@ */ ); #ifdef HAVE_TTY - /* ### Should this somehow go to TTY data? How do we make it + /* #### Should this somehow go to TTY data? How do we make it accessible from Lisp, then? */ DEFVAR_CONSOLE_LOCAL ("tty-erase-char", tty_erase_char /* The ERASE character as set by the user with stty. @@ -1293,7 +1409,7 @@ */ ); #endif - /* While this should be CONST it can't be because some things + /* While this should be const it can't be because some things (i.e. edebug) do manipulate it. */ DEFVAR_CONSOLE_LOCAL ("defining-kbd-macro", defining_kbd_macro /* Non-nil while a console macro is being defined. Don't set this! diff -r f4aeb21a5bad -r 74fd4e045ea6 src/console.h --- a/src/console.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/console.h Mon Aug 13 11:13:30 2007 +0200 @@ -22,8 +22,8 @@ /* Written by Ben Wing. */ -#ifndef _XEMACS_CONSOLE_H_ -#define _XEMACS_CONSOLE_H_ +#ifndef INCLUDED_console_h_ +#define INCLUDED_console_h_ /* Devices and consoles are similar entities. The idea is that a console represents a physical keyboard/mouse/other-input-source @@ -55,20 +55,23 @@ DM_font_menubar, DM_font_dialog, DM_size_cursor, DM_size_scrollbar, DM_size_menu, DM_size_toolbar, DM_size_toolbar_button, DM_size_toolbar_border, DM_size_icon, DM_size_icon_small, DM_size_device, - DM_size_workspace, DM_size_device_mm, DM_device_dpi, DM_num_bit_planes, - DM_num_color_cells, DM_mouse_buttons, DM_swap_buttons, DM_show_sounds, - DM_slow_device, DM_security + DM_size_workspace, DM_offset_workspace, DM_size_device_mm, DM_device_dpi, + DM_num_bit_planes, DM_num_color_cells, DM_mouse_buttons, DM_swap_buttons, + DM_show_sounds, DM_slow_device, DM_security }; +extern const struct struct_description cted_description; +extern const struct struct_description console_methods_description; + struct console_methods { - CONST char *name; /* Used by print_console, print_device, print_frame */ + const char *name; /* Used by print_console, print_device, print_frame */ Lisp_Object symbol; Lisp_Object predicate_symbol; /* console methods */ void (*init_console_method) (struct console *, Lisp_Object props); - void (*mark_console_method) (struct console *, void (*)(Lisp_Object)); + void (*mark_console_method) (struct console *); int (*initially_selected_for_input_method) (struct console *); void (*delete_console_method) (struct console *); Lisp_Object (*semi_canonicalize_console_connection_method) @@ -86,10 +89,15 @@ void (*init_device_method) (struct device *, Lisp_Object props); void (*finish_init_device_method) (struct device *, Lisp_Object props); void (*delete_device_method) (struct device *); - void (*mark_device_method) (struct device *, void (*)(Lisp_Object)); + void (*mark_device_method) (struct device *); void (*asynch_device_change_method) (void); Lisp_Object (*device_system_metrics_method) (struct device *, enum device_metrics); unsigned int (*device_implementation_flags_method) (void); + Lisp_Object (*own_selection_method)(Lisp_Object selection_name, Lisp_Object selection_value); + void (*disown_selection_method)(Lisp_Object selection_name, Lisp_Object timeval); + Lisp_Object (*get_foreign_selection_method) (Lisp_Object selection_symbol, + Lisp_Object target_type); + Lisp_Object (*selection_exists_p_method)(Lisp_Object selection_name); /* frame methods */ Lisp_Object *device_specific_frame_props; @@ -98,7 +106,7 @@ void (*init_frame_3_method) (struct frame *); void (*after_init_frame_method) (struct frame *, int first_on_device, int first_on_console); - void (*mark_frame_method) (struct frame *, void (*)(Lisp_Object)); + void (*mark_frame_method) (struct frame *); void (*delete_frame_method) (struct frame *); void (*focus_on_frame_method) (struct frame *); void (*raise_frame_method) (struct frame *); @@ -127,12 +135,13 @@ Lisp_Object (*get_frame_parent_method) (struct frame *f); void (*update_frame_external_traits_method) (struct frame *f, Lisp_Object name); int (*frame_size_fixed_p_method) (struct frame *f); + void (*eject_page_method) (struct frame *f); /* redisplay methods */ int (*left_margin_width_method) (struct window *); int (*right_margin_width_method) (struct window *); int (*text_width_method) (struct frame *f, struct face_cachel *cachel, - CONST Emchar *str, Charcount len); + const Emchar *str, Charcount len); void (*output_display_block_method) (struct window *, struct display_line *, int, int, int, int, int, int, int); int (*divider_height_method) (void); @@ -150,41 +159,48 @@ int duration); void (*frame_redraw_cursor_method) (struct frame *f); void (*set_final_cursor_coords_method) (struct frame *, int, int); - + void (*bevel_area_method) (struct window *, face_index, int, int, int, int, int, + int, enum edge_style); + void (*output_pixmap_method) (struct window *w, Lisp_Object image_instance, + struct display_box *db, struct display_glyph_area *dga, + face_index findex, int cursor_start, int cursor_width, + int cursor_height, int offset_bitmap); + void (*output_string_method) (struct window *w, struct display_line *dl, + Emchar_dynarr *buf, int xpos, int xoffset, + int start_pixpos, int width, face_index findex, + int cursor, int cursor_start, int cursor_width, + int cursor_height); /* color methods */ - int (*initialize_color_instance_method) (struct Lisp_Color_Instance *, + int (*initialize_color_instance_method) (Lisp_Color_Instance *, Lisp_Object name, Lisp_Object device, Error_behavior errb); - void (*mark_color_instance_method) (struct Lisp_Color_Instance *, - void (*)(Lisp_Object)); - void (*print_color_instance_method) (struct Lisp_Color_Instance *, + void (*mark_color_instance_method) (Lisp_Color_Instance *); + void (*print_color_instance_method) (Lisp_Color_Instance *, Lisp_Object printcharfun, int escapeflag); - void (*finalize_color_instance_method) (struct Lisp_Color_Instance *); - int (*color_instance_equal_method) (struct Lisp_Color_Instance *, - struct Lisp_Color_Instance *, + void (*finalize_color_instance_method) (Lisp_Color_Instance *); + int (*color_instance_equal_method) (Lisp_Color_Instance *, + Lisp_Color_Instance *, int depth); - unsigned long (*color_instance_hash_method) (struct Lisp_Color_Instance *, + unsigned long (*color_instance_hash_method) (Lisp_Color_Instance *, int depth); - Lisp_Object (*color_instance_rgb_components_method) - (struct Lisp_Color_Instance *); + Lisp_Object (*color_instance_rgb_components_method) (Lisp_Color_Instance *); int (*valid_color_name_p_method) (struct device *, Lisp_Object color); /* font methods */ - int (*initialize_font_instance_method) (struct Lisp_Font_Instance *, + int (*initialize_font_instance_method) (Lisp_Font_Instance *, Lisp_Object name, Lisp_Object device, Error_behavior errb); - void (*mark_font_instance_method) (struct Lisp_Font_Instance *, - void (*)(Lisp_Object)); - void (*print_font_instance_method) (struct Lisp_Font_Instance *, + void (*mark_font_instance_method) (Lisp_Font_Instance *); + void (*print_font_instance_method) (Lisp_Font_Instance *, Lisp_Object printcharfun, int escapeflag); - void (*finalize_font_instance_method) (struct Lisp_Font_Instance *); - Lisp_Object (*font_instance_truename_method) (struct Lisp_Font_Instance *, + void (*finalize_font_instance_method) (Lisp_Font_Instance *); + Lisp_Object (*font_instance_truename_method) (Lisp_Font_Instance *, Error_behavior errb); - Lisp_Object (*font_instance_properties_method) (struct Lisp_Font_Instance *); + Lisp_Object (*font_instance_properties_method) (Lisp_Font_Instance *); Lisp_Object (*list_fonts_method) (Lisp_Object pattern, Lisp_Object device); Lisp_Object (*find_charset_font_method) (Lisp_Object device, @@ -192,29 +208,31 @@ Lisp_Object charset); int (*font_spec_matches_charset_method) (struct device *d, Lisp_Object charset, - CONST Bufbyte *nonreloc, + const Bufbyte *nonreloc, Lisp_Object reloc, Bytecount offset, Bytecount length); /* image methods */ - void (*mark_image_instance_method) (struct Lisp_Image_Instance *, - void (*)(Lisp_Object)); - void (*print_image_instance_method) (struct Lisp_Image_Instance *, + void (*mark_image_instance_method) (Lisp_Image_Instance *); + void (*print_image_instance_method) (Lisp_Image_Instance *, Lisp_Object printcharfun, int escapeflag); - void (*finalize_image_instance_method) (struct Lisp_Image_Instance *); - void (*unmap_subwindow_method) (struct Lisp_Image_Instance *); - void (*map_subwindow_method) (struct Lisp_Image_Instance *, int x, int y); - void (*resize_subwindow_method) (struct Lisp_Image_Instance *, int w, int h); - void (*update_subwindow_method) (struct Lisp_Image_Instance *); - int (*image_instance_equal_method) (struct Lisp_Image_Instance *, - struct Lisp_Image_Instance *, + void (*finalize_image_instance_method) (Lisp_Image_Instance *); + void (*unmap_subwindow_method) (Lisp_Image_Instance *); + void (*map_subwindow_method) (Lisp_Image_Instance *, int x, int y, + struct display_glyph_area* dga); + void (*resize_subwindow_method) (Lisp_Image_Instance *, int w, int h); + void (*update_subwindow_method) (Lisp_Image_Instance *); + void (*update_widget_method) (Lisp_Image_Instance *); + int (*image_instance_equal_method) (Lisp_Image_Instance *, + Lisp_Image_Instance *, int depth); - unsigned long (*image_instance_hash_method) (struct Lisp_Image_Instance *, + unsigned long (*image_instance_hash_method) (Lisp_Image_Instance *, int depth); - void (*init_image_instance_from_eimage_method) (struct Lisp_Image_Instance *ii, + void (*init_image_instance_from_eimage_method) (Lisp_Image_Instance *ii, int width, int height, + int slices, unsigned char *eimage, int dest_mask, Lisp_Object instantiator, @@ -272,8 +290,18 @@ /* * Constants returned by device_implementation_flags_method */ + /* Set when device uses pixel-based geometry */ -#define XDEVIMPF_PIXEL_GEOMETRY 0x00000001L +#define XDEVIMPF_PIXEL_GEOMETRY 0x00000001L + +/* Indicates that the device is a printer */ +#define XDEVIMPF_IS_A_PRINTER 0x00000002L + +/* Do not automatically redisplay this device */ +#define XDEVIMPF_NO_AUTO_REDISPLAY 0x00000004L + +/* Do not delete the device when last frame's gone */ +#define XDEVIMPF_FRAMELESS_OK 0x00000008L #define CONSOLE_TYPE_NAME(c) ((c)->conmeths->name) @@ -340,17 +368,29 @@ type##_console_methods = xnew_and_zero (struct console_methods); \ type##_console_methods->name = obj_name; \ type##_console_methods->symbol = Q##type; \ - defsymbol (&type##_console_methods->predicate_symbol, pred_sym); \ + defsymbol_nodump (&type##_console_methods->predicate_symbol, pred_sym); \ add_entry_to_console_type_list (Q##type, type##_console_methods); \ type##_console_methods->image_conversion_list = Qnil; \ - staticpro (&type##_console_methods->image_conversion_list); \ + staticpro_nodump (&type##_console_methods->image_conversion_list); \ + dumpstruct (&type##_console_methods, &console_methods_description); \ } while (0) +#define REINITIALIZE_CONSOLE_TYPE(type) do { \ + staticpro_nodump (&type##_console_methods->predicate_symbol); \ + staticpro_nodump (&type##_console_methods->image_conversion_list); \ +} while (0) + + /* Declare that console-type TYPE has method M; used in initialization routines */ #define CONSOLE_HAS_METHOD(type, m) \ (type##_console_methods->m##_method = type##_##m) +/* Declare that console-type TYPE inherits method M + implementation from console-type FROMTYPE */ +#define CONSOLE_INHERITS_METHOD(type, fromtype, m) \ + (type##_console_methods->m##_method = fromtype##_##m) + struct console { struct lcrecord_header header; @@ -396,7 +436,6 @@ #define XCONSOLE(x) XRECORD (x, console, struct console) #define XSETCONSOLE(x, p) XSETRECORD (x, p, console) #define CONSOLEP(x) RECORDP (x, console) -#define GC_CONSOLEP(x) GC_RECORDP (x, console) #define CHECK_CONSOLE(x) CHECK_RECORD (x, console) #define CONCHECK_CONSOLE(x) CONCHECK_RECORD (x, console) @@ -553,4 +592,4 @@ void set_console_last_nonminibuf_frame (struct console *con, Lisp_Object frame); -#endif /* _XEMACS_CONSOLE_H_ */ +#endif /* INCLUDED_console_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/data.c --- a/src/data.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/data.c Mon Aug 13 11:13:30 2007 +0200 @@ -50,18 +50,16 @@ Lisp_Object Qarith_error, Qrange_error, Qdomain_error; Lisp_Object Qsingularity_error, Qoverflow_error, Qunderflow_error; Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only; -Lisp_Object Qintegerp, Qnatnump, Qsymbolp, Qkeywordp; +Lisp_Object Qintegerp, Qnatnump, Qsymbolp; Lisp_Object Qlistp, Qtrue_list_p, Qweak_listp; Lisp_Object Qconsp, Qsubrp; Lisp_Object Qcharacterp, Qstringp, Qarrayp, Qsequencep, Qvectorp; Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qbufferp; Lisp_Object Qinteger_or_char_p, Qinteger_char_or_marker_p; -Lisp_Object Qnumberp, Qnumber_or_marker_p, Qnumber_char_or_marker_p; -Lisp_Object Qbit_vectorp, Qbitp, Qcons, Qkeyword, Qcdr, Qignore; +Lisp_Object Qnumberp, Qnumber_char_or_marker_p; +Lisp_Object Qbit_vectorp, Qbitp, Qcdr; -#ifdef LISP_FLOAT_TYPE Lisp_Object Qfloatp; -#endif #ifdef DEBUG_XEMACS @@ -69,19 +67,14 @@ int debug_ebola_backtrace_length; -#if 0 -/*#ifndef LRECORD_SYMBOL*/ -#include "backtrace.h" -#endif - int eq_with_ebola_notice (Lisp_Object obj1, Lisp_Object obj2) { - if (debug_issue_ebola_notices != -42 /* abracadabra */ && - (((CHARP (obj1) && INTP (obj2)) || (CHARP (obj2) && INTP (obj1))) - && (debug_issue_ebola_notices >= 2 - || XCHAR_OR_INT (obj1) == XCHAR_OR_INT (obj2)))) + if (debug_issue_ebola_notices + && ((CHARP (obj1) && INTP (obj2)) || (CHARP (obj2) && INTP (obj1)))) { + /* #### It would be really nice if this were a proper warning + instead of brain-dead print ro Qexternal_debugging_output. */ write_c_string ("Comparison between integer and character is constant nil (", Qexternal_debugging_output); Fprinc (obj1, Qexternal_debugging_output); @@ -130,9 +123,15 @@ } DOESNT_RETURN -pure_write_error (Lisp_Object obj) +c_write_error (Lisp_Object obj) { - signal_simple_error ("Attempt to modify read-only object", obj); + signal_simple_error ("Attempt to modify read-only object (c)", obj); +} + +DOESNT_RETURN +lisp_write_error (Lisp_Object obj) +{ + signal_simple_error ("Attempt to modify read-only object (lisp)", obj); } DOESNT_RETURN @@ -148,7 +147,7 @@ } void -check_int_range (int val, int min, int max) +check_int_range (EMACS_INT val, EMACS_INT min, EMACS_INT max) { if (val < min || val > max) args_out_of_range_3 (make_int (val), make_int (min), make_int (max)); @@ -161,8 +160,8 @@ /* On a few machines, XINT can only be done by calling this. */ /* XEmacs: only used by m/convex.h */ -int sign_extend_lisp_int (EMACS_INT num); -int +EMACS_INT sign_extend_lisp_int (EMACS_INT num); +EMACS_INT sign_extend_lisp_int (EMACS_INT num) { if (num & (1L << (VALBITS - 1))) @@ -358,7 +357,7 @@ */ (subr)) { - CONST char *prompt; + const char *prompt; CHECK_SUBR (subr); prompt = XSUBR (subr)->prompt; return prompt ? list2 (Qinteractive, build_string (prompt)) : Qnil; @@ -546,22 +545,6 @@ { switch (XTYPE (object)) { -#ifndef LRECORD_CONS - case Lisp_Type_Cons: return Qcons; -#endif - -#ifndef LRECORD_SYMBOL - case Lisp_Type_Symbol: return Qsymbol; -#endif - -#ifndef LRECORD_STRING - case Lisp_Type_String: return Qstring; -#endif - -#ifndef LRECORD_VECTOR - case Lisp_Type_Vector: return Qvector; -#endif - case Lisp_Type_Record: return intern (XRECORD_LHEADER_IMPLEMENTATION (object)->name); @@ -632,7 +615,6 @@ if (!CONSP (conscell)) conscell = wrong_type_argument (Qconsp, conscell); - CHECK_IMPURE (conscell); XCAR (conscell) = newcar; return newcar; } @@ -645,7 +627,6 @@ if (!CONSP (conscell)) conscell = wrong_type_argument (Qconsp, conscell); - CHECK_IMPURE (conscell); XCDR (conscell) = newcdr; return newcdr; } @@ -679,7 +660,7 @@ } if (errorp && UNBOUNDP (hare)) - signal_void_function_error (object); + return signal_void_function_error (object); return hare; } @@ -706,7 +687,7 @@ */ (array, index_)) { - int idx; + EMACS_INT idx; retry: @@ -760,7 +741,7 @@ */ (array, index_, newval)) { - int idx; + EMACS_INT idx; retry: @@ -774,8 +755,6 @@ if (idx < 0) goto range_error; - CHECK_IMPURE (array); - if (VECTORP (array)) { if (idx >= XVECTOR_LENGTH (array)) goto range_error; @@ -816,7 +795,7 @@ int int_p; union { - int ival; + EMACS_INT ival; double dval; } c; } int_or_double; @@ -856,7 +835,7 @@ } } -static int +static EMACS_INT integer_char_or_marker_to_int (Lisp_Object obj) { retry: @@ -1433,8 +1412,8 @@ */ (num1, num2)) { - int ival1 = integer_char_or_marker_to_int (num1); - int ival2 = integer_char_or_marker_to_int (num2); + EMACS_INT ival1 = integer_char_or_marker_to_int (num1); + EMACS_INT ival2 = integer_char_or_marker_to_int (num2); if (ival2 == 0) Fsignal (Qarith_error, Qnil); @@ -1485,7 +1464,7 @@ } #endif /* LISP_FLOAT_TYPE */ { - int ival; + EMACS_INT ival; if (iod2.c.ival == 0) goto divide_by_zero; ival = iod1.c.ival % iod2.c.ival; @@ -1587,7 +1566,7 @@ static Lisp_Object encode_weak_list_type (enum weak_list_type type); static Lisp_Object -mark_weak_list (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_weak_list (Lisp_Object obj) { return Qnil; /* nichts ist gemarkt */ } @@ -1630,7 +1609,7 @@ { Lisp_Object result; struct weak_list *wl = - alloc_lcrecord_type (struct weak_list, lrecord_weak_list); + alloc_lcrecord_type (struct weak_list, &lrecord_weak_list); wl->list = Qnil; wl->type = type; @@ -1640,9 +1619,16 @@ return result; } +static const struct lrecord_description weak_list_description[] = { + { XD_LISP_OBJECT, offsetof (struct weak_list, list) }, + { XD_LO_LINK, offsetof (struct weak_list, next_weak) }, + { XD_END } +}; + DEFINE_LRECORD_IMPLEMENTATION ("weak-list", weak_list, mark_weak_list, print_weak_list, 0, weak_list_equal, weak_list_hash, + weak_list_description, struct weak_list); /* -- we do not mark the list elements (either the elements themselves @@ -1662,20 +1648,19 @@ */ int -finish_marking_weak_lists (int (*obj_marked_p) (Lisp_Object), - void (*markobj) (Lisp_Object)) +finish_marking_weak_lists (void) { Lisp_Object rest; int did_mark = 0; for (rest = Vall_weak_lists; - !GC_NILP (rest); + !NILP (rest); rest = XWEAK_LIST (rest)->next_weak) { Lisp_Object rest2; enum weak_list_type type = XWEAK_LIST (rest)->type; - if (! obj_marked_p (rest)) + if (! marked_p (rest)) /* The weak list is probably garbage. Ignore it. */ continue; @@ -1683,7 +1668,7 @@ /* We need to be trickier since we're inside of GC; use CONSP instead of !NILP in case of user-visible imperfect lists */ - GC_CONSP (rest2); + CONSP (rest2); rest2 = XCDR (rest2)) { Lisp_Object elem; @@ -1698,7 +1683,7 @@ (either because of an external pointer or because of a previous call to this function), and likewise for all the rest of the elements in the list, so we can stop now. */ - if (obj_marked_p (rest2)) + if (marked_p (rest2)) break; elem = XCAR (rest2); @@ -1706,19 +1691,19 @@ switch (type) { case WEAK_LIST_SIMPLE: - if (obj_marked_p (elem)) + if (marked_p (elem)) need_to_mark_cons = 1; break; case WEAK_LIST_ASSOC: - if (!GC_CONSP (elem)) + if (!CONSP (elem)) { /* just leave bogus elements there */ need_to_mark_cons = 1; need_to_mark_elem = 1; } - else if (obj_marked_p (XCAR (elem)) && - obj_marked_p (XCDR (elem))) + else if (marked_p (XCAR (elem)) && + marked_p (XCDR (elem))) { need_to_mark_cons = 1; /* We still need to mark elem, because it's @@ -1728,13 +1713,13 @@ break; case WEAK_LIST_KEY_ASSOC: - if (!GC_CONSP (elem)) + if (!CONSP (elem)) { /* just leave bogus elements there */ need_to_mark_cons = 1; need_to_mark_elem = 1; } - else if (obj_marked_p (XCAR (elem))) + else if (marked_p (XCAR (elem))) { need_to_mark_cons = 1; /* We still need to mark elem and XCDR (elem); @@ -1744,13 +1729,13 @@ break; case WEAK_LIST_VALUE_ASSOC: - if (!GC_CONSP (elem)) + if (!CONSP (elem)) { /* just leave bogus elements there */ need_to_mark_cons = 1; need_to_mark_elem = 1; } - else if (obj_marked_p (XCDR (elem))) + else if (marked_p (XCDR (elem))) { need_to_mark_cons = 1; /* We still need to mark elem and XCAR (elem); @@ -1763,23 +1748,23 @@ abort (); } - if (need_to_mark_elem && ! obj_marked_p (elem)) + if (need_to_mark_elem && ! marked_p (elem)) { - markobj (elem); + mark_object (elem); did_mark = 1; } /* We also need to mark the cons that holds the elem or - assoc-pair. We do *not* want to call (markobj) here + assoc-pair. We do *not* want to call (mark_object) here because that will mark the entire list; we just want to mark the cons itself. */ if (need_to_mark_cons) { - struct Lisp_Cons *ptr = XCONS (rest2); - if (!CONS_MARKED_P (ptr)) + Lisp_Cons *c = XCONS (rest2); + if (!CONS_MARKED_P (c)) { - MARK_CONS (ptr); + MARK_CONS (c); did_mark = 1; } } @@ -1787,9 +1772,9 @@ /* In case of imperfect list, need to mark the final cons because we're not removing it */ - if (!GC_NILP (rest2) && ! obj_marked_p (rest2)) + if (!NILP (rest2) && ! marked_p (rest2)) { - markobj (rest2); + mark_object (rest2); did_mark = 1; } } @@ -1798,18 +1783,18 @@ } void -prune_weak_lists (int (*obj_marked_p) (Lisp_Object)) +prune_weak_lists (void) { Lisp_Object rest, prev = Qnil; for (rest = Vall_weak_lists; - !GC_NILP (rest); + !NILP (rest); rest = XWEAK_LIST (rest)->next_weak) { - if (! (obj_marked_p (rest))) + if (! (marked_p (rest))) { /* This weak list itself is garbage. Remove it from the list. */ - if (GC_NILP (prev)) + if (NILP (prev)) Vall_weak_lists = XWEAK_LIST (rest)->next_weak; else XWEAK_LIST (prev)->next_weak = @@ -1825,7 +1810,7 @@ /* We need to be trickier since we're inside of GC; use CONSP instead of !NILP in case of user-visible imperfect lists */ - GC_CONSP (rest2);) + CONSP (rest2);) { /* It suffices to check the cons for marking, regardless of the type of weak list: @@ -1836,10 +1821,10 @@ have been marked in finish_marking_weak_lists(). -- otherwise, it's not marked and should disappear. */ - if (! obj_marked_p (rest2)) + if (! marked_p (rest2)) { /* bye bye :-( */ - if (GC_NILP (prev2)) + if (NILP (prev2)) XWEAK_LIST (rest)->list = XCDR (rest2); else XCDR (prev2) = XCDR (rest2); @@ -1880,7 +1865,7 @@ if (go_tortoise) tortoise = XCDR (tortoise); go_tortoise = !go_tortoise; - if (GC_EQ (rest2, tortoise)) + if (EQ (rest2, tortoise)) break; } } @@ -2091,17 +2076,13 @@ void syms_of_data (void) { - defsymbol (&Qcons, "cons"); - defsymbol (&Qkeyword, "keyword"); defsymbol (&Qquote, "quote"); defsymbol (&Qlambda, "lambda"); - defsymbol (&Qignore, "ignore"); defsymbol (&Qlistp, "listp"); defsymbol (&Qtrue_list_p, "true-list-p"); defsymbol (&Qconsp, "consp"); defsymbol (&Qsubrp, "subrp"); defsymbol (&Qsymbolp, "symbolp"); - defsymbol (&Qkeywordp, "keywordp"); defsymbol (&Qintegerp, "integerp"); defsymbol (&Qcharacterp, "characterp"); defsymbol (&Qnatnump, "natnump"); @@ -2118,7 +2099,6 @@ defsymbol (&Qinteger_or_char_p, "integer-or-char-p"); defsymbol (&Qinteger_char_or_marker_p, "integer-char-or-marker-p"); defsymbol (&Qnumberp, "numberp"); - defsymbol (&Qnumber_or_marker_p, "number-or-marker-p"); defsymbol (&Qnumber_char_or_marker_p, "number-char-or-marker-p"); defsymbol (&Qcdr, "cdr"); defsymbol (&Qweak_listp, "weak-list-p"); @@ -2217,9 +2197,10 @@ { /* This must not be staticpro'd */ Vall_weak_lists = Qnil; + pdump_wire_list (&Vall_weak_lists); #ifdef DEBUG_XEMACS - DEFVAR_INT ("debug-issue-ebola-notices", &debug_issue_ebola_notices /* + DEFVAR_BOOL ("debug-issue-ebola-notices", &debug_issue_ebola_notices /* If non-zero, note when your code may be suffering from char-int confoundance. That is to say, if XEmacs encounters a usage of `eq', `memq', `equal', etc. where an int and a char with the same value are being compared, @@ -2233,7 +2214,7 @@ impossible to accurately determine Ebola infection. */ ); - debug_issue_ebola_notices = 2; /* #### temporary hack */ + debug_issue_ebola_notices = 0; DEFVAR_INT ("debug-ebola-backtrace-length", &debug_ebola_backtrace_length /* diff -r f4aeb21a5bad -r 74fd4e045ea6 src/database.c --- a/src/database.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/database.c Mon Aug 13 11:13:30 2007 +0200 @@ -75,9 +75,6 @@ Lisp_Object Qdatabasep; -struct Lisp_Database; -typedef struct Lisp_Database Lisp_Database; - typedef struct { Lisp_Object (*get_subtype) (Lisp_Database *); @@ -113,7 +110,6 @@ #define XDATABASE(x) XRECORD (x, database, Lisp_Database) #define XSETDATABASE(x, p) XSETRECORD (x, p, database) #define DATABASEP(x) RECORDP (x, database) -#define GC_DATABASEP(x) GC_RECORDP (x, database) #define CHECK_DATABASE(x) CHECK_RECORD (x, database) #define CONCHECK_DATABASE(x) CONCHECK_RECORD (x, database) #define DATABASE_LIVE_P(x) (x->live_p) @@ -128,7 +124,7 @@ static Lisp_Database * allocate_database (void) { - Lisp_Database *db = alloc_lcrecord_type (Lisp_Database, lrecord_database); + Lisp_Database *db = alloc_lcrecord_type (Lisp_Database, &lrecord_database); db->fname = Qnil; db->live_p = 0; @@ -148,12 +144,10 @@ } static Lisp_Object -mark_database (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_database (Lisp_Object obj) { Lisp_Database *db = XDATABASE (obj); - - markobj (db->fname); - return Qnil; + return db->fname; } static void @@ -195,7 +189,7 @@ DEFINE_LRECORD_IMPLEMENTATION ("database", database, mark_database, print_database, - finalize_database, 0, 0, + finalize_database, 0, 0, 0, Lisp_Database); DEFUN ("close-database", Fclose_database, 1, 1, 0, /* @@ -492,7 +486,7 @@ status == 0; status = dbp->seq (dbp, &keydatum, &valdatum, R_NEXT)) { - /* ### Needs mule-izing */ + /* #### Needs mule-izing */ key = make_string ((Bufbyte *) keydatum.data, keydatum.size); val = make_string ((Bufbyte *) valdatum.data, valdatum.size); call2 (func, key, val); @@ -505,12 +499,12 @@ status = dbp->cursor (dbp, NULL, &dbcp, 0); #else status = dbp->cursor (dbp, NULL, &dbcp); -#endif +#endif for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST); status == 0; status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT)) { - /* ### Needs mule-izing */ + /* #### Needs mule-izing */ key = make_string ((Bufbyte *) keydatum.data, keydatum.size); val = make_string ((Bufbyte *) valdatum.data, valdatum.size); call2 (func, key, val); @@ -584,7 +578,9 @@ file = Fexpand_file_name (file, Qnil); UNGCPRO; - GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (XSTRING_DATA (file), filename); + TO_EXTERNAL_FORMAT (LISP_STRING, file, + C_STRING_ALLOCA, filename, + Qfile_name); if (NILP (access_)) { diff -r f4aeb21a5bad -r 74fd4e045ea6 src/database.h --- a/src/database.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/database.h Mon Aug 13 11:13:30 2007 +0200 @@ -21,9 +21,10 @@ /* This file is only necessary to get INLINE handling correct. See inline.c */ -#ifndef _XEMACS_DATABASE_H -#define _XEMACS_DATABASE_H +#ifndef INCLUDED_database_h_ +#define INCLUDED_database_h_ -DECLARE_LRECORD (database, struct Lisp_Database); +typedef struct Lisp_Database Lisp_Database; +DECLARE_LRECORD (database, Lisp_Database); -#endif +#endif /* INCLUDED_database_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/dbxrc --- a/src/dbxrc Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,383 +0,0 @@ -# -*- ksh -*- -# Copyright (C) 1998 Free Software Foundation, Inc. - -# This file is part of XEmacs. - -# XEmacs is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any -# later version. - -# XEmacs is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. - -# You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. - -# Author: Martin Buchholz - -# You can use this file to debug XEmacs using Sun WorkShop's dbx. -# Add the contents of this file to $HOME/.dbxrc or -# Source the contents of this file with something like: -# if test -r ./dbxrc; then . ./dbxrc; fi - -# Some functions defined here require a running process, but most -# don't. Considerable effort has been expended to this end. - -# See also the comments in gdbinit. - -# See also the question of the XEmacs FAQ, titled -# "How to Debug an XEmacs problem with a debugger". - -ignore POLL -ignore IO - -document lbt << 'end' -Usage: lbt -Print the current Lisp stack trace. -Requires a running xemacs process. -end - -function lbt { - call debug_backtrace() -} - -document ldp << 'end' -Usage: ldp lisp_object -Print a Lisp Object value using the Lisp printer. -Requires a running xemacs process. -end - -function ldp { - call debug_print ($1); -} - -# A bug in dbx prevents string variables from having values beginning with `-'!! -function XEmacsInit { - function ToInt { eval "$1=\$[(int) $1]"; } - ToInt dbg_USE_MINIMAL_TAGBITS - ToInt dbg_USE_UNION_TYPE - ToInt dbg_USE_INDEXED_LRECORD_IMPLEMENTATION - ToInt Lisp_Type_Int - ToInt Lisp_Type_Char - ToInt Lisp_Type_Cons - ToInt Lisp_Type_String - ToInt Lisp_Type_Vector - ToInt Lisp_Type_Symbol - ToInt Lisp_Type_Record - ToInt dbg_valbits - ToInt dbg_gctypebits - function ToLong { eval "$1=\$[(unsigned long) $1]"; } - ToLong dbg_valmask - ToLong dbg_typemask - xemacs_initted=yes -} - -function printvar { - for i in $*; do eval "echo $i=\$$i"; done -} - -document decode_object << 'end' -Usage: decode_object lisp_object -Extract implementation information from a Lisp Object. -Defines variables $val, $type and $imp. -end - -# Various dbx bugs cause ugliness in following code -function decode_object { - if test -z "$xemacs_initted"; then XEmacsInit; fi; - if test $dbg_USE_UNION_TYPE = 1; then - # Repeat after me... dbx sux, dbx sux, dbx sux... - # Allow both `pobj Qnil' and `pobj 0x82746834' to work - case $(whatis $1) in - *Lisp_Object*) obj="$[(unsigned long)(($1).i)]";; - *) obj="$[(unsigned long)($1)]";; - esac - else - obj="$[(unsigned long)($1)]"; - fi - if test $dbg_USE_MINIMAL_TAGBITS = 1; then - if test $[(int)($obj & 1)] = 1; then - # It's an int - val=$[(long)(((unsigned long long)$obj) >> 1)] - type=$Lisp_Type_Int - else - type=$[(int)(((void*)$obj) & $dbg_typemask)] - if test $type = $Lisp_Type_Char; then - val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)] - else - # It's a record pointer - val=$[(void*)$obj] - if test "$val" = "(nil)"; then type=null_pointer; fi - fi - fi - else - # not dbg_USE_MINIMAL_TAGBITS - type=$[(int)(((unsigned long long)($obj & $dbg_typemask)) >> ($dbg_valbits + 1))] - if test "$type" = $Lisp_Type_Int; then - val=$[(int)($obj & $dbg_valmask)] - elif test "$type" = $Lisp_Type_Char; then - val=$[(int)($obj & $dbg_valmask)] - else - val=$[(void*)($obj & $dbg_valmask)] - if test "$val" = "(nil)"; then type=null_pointer; fi - fi - #val=$[(void*)($obj & $dbg_valmask)] - #printvar val type obj - fi - - if test $type = $Lisp_Type_Record; then - typeset lheader="((struct lrecord_header *) $val)" - if test $dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 1; then - imp=$[(void*)(lrecord_implementations_table[$lheader->type])] - else - imp=$[(void*)($lheader->implementation)] - fi - else - imp="0xdeadbeef" - fi - # printvar obj val type imp -} - -function xint { - decode_object "$*" - print (long) ($val) -} - -function xtype { - decode_object "$*" - if test $type = $Lisp_Type_Int; then echo "int" - elif test $type = $Lisp_Type_Char; then echo "char" - elif test $type = $Lisp_Type_Symbol; then echo "symbol" - elif test $type = $Lisp_Type_String; then echo "string" - elif test $type = $Lisp_Type_Vector; then echo "vector" - elif test $type = $Lisp_Type_Cons; then echo "cons" - elif test $type = null_pointer; then echo "null_pointer" - else - echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]" - fi -} - -function lisp-shadows { - run -batch -vanilla -f list-load-path-shadows -} - -function environment-to-run-temacs { - unset EMACSLOADPATH - export EMACSBOOTSTRAPLOADPATH=../lisp/:.. - export EMACSBOOTSTRAPMODULEPATH=../modules/:.. -} - -document run-temacs << 'end' -Usage: run-temacs -Run temacs interactively, like xemacs. -Use this with debugging tools (like purify) that cannot deal with dumping, -or when temacs builds successfully, but xemacs does not. -end - -function run-temacs { - environment-to-run-temacs - run -batch -l ../lisp/loadup.el run-temacs -q -} - -document update-elc << 'end' -Usage: update-elc -Run the core lisp byte compilation part of the build procedure. -Use when debugging temacs, not xemacs! -Use this when temacs builds successfully, but xemacs does not. -end - -function update-elc { - environment-to-run-temacs - run -batch -l ../lisp/update-elc.el -} - - -function dump-temacs { - environment-to-run-temacs - run -batch -l ../lisp/loadup.el dump -} - -document dump-temacs << 'end' -Usage: dump-temacs -Run the dumping part of the build procedure. -Use when debugging temacs, not xemacs! -Use this when temacs builds successfully, but xemacs does not. -end - -function pstruct { - xstruct="((struct $1 *) $val)" - print $xstruct - print *$xstruct -} - -function lrecord_type_p { - if eval test -z \"\$lrecord_$1\" && test $imp = $[(void*)(&lrecord_$1)]; then return 0; else return 1; fi -} - -document pobj << 'end' -Usage: pobj lisp_object -Print the internal C structure of a underlying Lisp Object. -end - -function pobj { - decode_object $1 - if test $type = $Lisp_Type_Int; then - print -f"Integer: %d" $val - elif test $type = $Lisp_Type_Char; then - if test $[$val > 32 && $val < 128] = 1; then - print -f"Char: %c" $val - else - print -f"Char: %d" $val - fi - elif test $type = $Lisp_Type_String || lrecord_type_p string; then - pstruct Lisp_String - elif test $type = $Lisp_Type_Cons || lrecord_type_p cons; then - pstruct Lisp_Cons - elif test $type = $Lisp_Type_Symbol || lrecord_type_p symbol; then - pstruct Lisp_Symbol - echo "Symbol name: $[(char *)($xstruct->name->data)]" - elif test $type = $Lisp_Type_Vector || lrecord_type_p vector; then - pstruct Lisp_Vector - echo "Vector of length $[$xstruct->size]" - elif lrecord_type_p bit_vector; then - pstruct Lisp_Bit_Vector - elif lrecord_type_p buffer; then - pstruct buffer - elif lrecord_type_p char_table; then - pstruct Lisp_Char_Table - elif lrecord_type_p char_table_entry; then - pstruct Lisp_Char_Table_Entry - elif lrecord_type_p charset; then - pstruct Lisp_Charset - elif lrecord_type_p coding_system; then - pstruct Lisp_Coding_System - elif lrecord_type_p color_instance; then - pstruct Lisp_Color_Instance - elif lrecord_type_p command_builder; then - pstruct command_builder - elif lrecord_type_p compiled_function; then - pstruct Lisp_Compiled_Function - elif lrecord_type_p console; then - pstruct console - elif lrecord_type_p database; then - pstruct Lisp_Database - elif lrecord_type_p device; then - pstruct device - elif lrecord_type_p event; then - pstruct Lisp_Event - elif lrecord_type_p extent; then - pstruct extent - elif lrecord_type_p extent_auxiliary; then - pstruct extent_auxiliary - elif lrecord_type_p extent_info; then - pstruct extent_info - elif lrecord_type_p face; then - pstruct Lisp_Face - elif lrecord_type_p float; then - pstruct Lisp_Float - elif lrecord_type_p font_instance; then - pstruct Lisp_Font_Instance - elif lrecord_type_p frame; then - pstruct frame - elif lrecord_type_p glyph; then - pstruct Lisp_Glyph - elif lrecord_type_p hash_table; then - pstruct Lisp_Hash_Table - elif lrecord_type_p image_instance; then - pstruct Lisp_Image_Instance - elif lrecord_type_p keymap; then - pstruct Lisp_Keymap - elif lrecord_type_p lcrecord_list; then - pstruct lcrecord_list - elif lrecord_type_p lstream; then - pstruct lstream - elif lrecord_type_p marker; then - pstruct Lisp_Marker - elif lrecord_type_p opaque; then - pstruct Lisp_Opaque - elif lrecord_type_p opaque_list; then - pstruct Lisp_Opaque_List - elif lrecord_type_p popup_data; then - pstruct popup_data - elif lrecord_type_p process; then - pstruct Lisp_Process - elif lrecord_type_p range_table; then - pstruct Lisp_Range_Table - elif lrecord_type_p specifier; then - pstruct Lisp_Specifier - elif lrecord_type_p subr; then - pstruct Lisp_Subr - elif lrecord_type_p symbol_value_buffer_local; then - pstruct symbol_value_buffer_local - elif lrecord_type_p symbol_value_forward; then - pstruct symbol_value_forward - elif lrecord_type_p symbol_value_lisp_magic; then - pstruct symbol_value_lisp_magic - elif lrecord_type_p symbol_value_varalias; then - pstruct symbol_value_varalias - elif lrecord_type_p toolbar_button; then - pstruct toolbar_button - elif lrecord_type_p tooltalk_message; then - pstruct Lisp_Tooltalk_Message - elif lrecord_type_p tooltalk_pattern; then - pstruct Lisp_Tooltalk_Pattern - elif lrecord_type_p weak_list; then - pstruct weak_list - elif lrecord_type_p window; then - pstruct window - elif lrecord_type_p window_configuration; then - pstruct window_config - elif test "$type" = "null_pointer"; then - echo "Lisp Object is a null pointer!!" - else - echo "Unknown Lisp Object type" - print $1 - fi -} - -function pproc { - print *(`process.c`struct Lisp_Process*)$1 ; - ldp "(`process.c`struct Lisp_Process*)$1->name" ; - ldp "(`process.c`struct Lisp_Process*)$1->command" ; -} - -dbxenv suppress_startup_message 4.0 -dbxenv mt_watchpoints on - -function dp_core { - print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core -} - -# Barf! -function print_shell { - print *(`frame-x.c`TopLevelShellRec*) (((struct `frame-x.c`x_frame*) (((struct `frame-x.c`frame*) (Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget) -} - -# ------------------------------------------------------------- -# functions to test the debugging support itself. -# If you change this file, make sure the following still work... -# ------------------------------------------------------------- -function test_xtype { - function doit { echo -n "$1: "; xtype "$1"; } - test_various_objects -} - -function test_pobj { - function doit { echo '==============================='; echo -n "$1: "; pobj "$1"; } - test_various_objects -} - -function test_various_objects { - doit Vemacs_major_version - doit Vhelp_char - doit Qnil - doit Qunbound - doit Vobarray - doit Vall_weak_lists - doit Vxemacs_codename -} diff -r f4aeb21a5bad -r 74fd4e045ea6 src/debug.c --- a/src/debug.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/debug.c Mon Aug 13 11:13:30 2007 +0200 @@ -39,44 +39,43 @@ * 4. Add a FROB line for it in xemacs_debug_loop. */ -Lisp_Object Qredisplay, Qbuffers, Qfaces; -Lisp_Object Qwindows, Qframes, Qdevices; +static Lisp_Object Qredisplay, Qbuffers, Qfaces, Qwindows, Qframes, Qdevices; struct debug_classes active_debug_classes; enum debug_loop { - ADD, - DELETE, - LIST, - ACTIVE, - INIT, - VALIDATE, - TYPE, - SETTYPE + X_ADD, + X_DELETE, + X_LIST, + X_ACTIVE, + X_INIT, + X_VALIDATE, + X_TYPE, + X_SETTYPE }; static Lisp_Object xemacs_debug_loop (enum debug_loop op, Lisp_Object class, Lisp_Object type) { - int flag = (op == ADD) ? 1 : 0; + int flag = (op == X_ADD) ? 1 : 0; Lisp_Object retval = Qnil; #define FROB(item) \ - if (op == LIST || op == ACTIVE || op == INIT || EQ (class, Q##item)) \ + if (op == X_LIST || op == X_ACTIVE || op == X_INIT || EQ (class, Q##item)) \ { \ - if (op == ADD || op == DELETE || op == INIT) \ + if (op == X_ADD || op == X_DELETE || op == X_INIT) \ active_debug_classes.item = flag; \ - else if (op == LIST \ - || (op == ACTIVE && active_debug_classes.item)) \ + else if (op == X_LIST \ + || (op == X_ACTIVE && active_debug_classes.item)) \ retval = Fcons (Q##item, retval); \ - else if (op == VALIDATE) \ + else if (op == X_VALIDATE) \ return Qt; \ - else if (op == SETTYPE) \ + else if (op == X_SETTYPE) \ active_debug_classes.types_of_##item = XINT (type); \ - else if (op == TYPE) \ + else if (op == X_TYPE) \ retval = make_int (active_debug_classes.types_of_##item); \ - if (op == INIT) active_debug_classes.types_of_##item = VALBITS; \ + if (op == X_INIT) active_debug_classes.types_of_##item = VALBITS; \ } FROB (redisplay); @@ -97,12 +96,12 @@ */ (class)) { - if (NILP (xemacs_debug_loop (VALIDATE, class, Qnil))) + if (NILP (xemacs_debug_loop (X_VALIDATE, class, Qnil))) error ("No such debug class exists"); else - xemacs_debug_loop (ADD, class, Qnil); + xemacs_debug_loop (X_ADD, class, Qnil); - return (xemacs_debug_loop (ACTIVE, Qnil, Qnil)); + return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil)); } DEFUN ("delete-debug-class-to-check", Fdelete_debug_class_to_check, 1, 1, 0, /* @@ -110,12 +109,12 @@ */ (class)) { - if (NILP (xemacs_debug_loop (VALIDATE, class, Qnil))) + if (NILP (xemacs_debug_loop (X_VALIDATE, class, Qnil))) error ("No such debug class exists"); else - xemacs_debug_loop (DELETE, class, Qnil); + xemacs_debug_loop (X_DELETE, class, Qnil); - return (xemacs_debug_loop (ACTIVE, Qnil, Qnil)); + return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil)); } DEFUN ("debug-classes-being-checked", Fdebug_classes_being_checked, 0, 0, 0, /* @@ -123,7 +122,7 @@ */ ()) { - return (xemacs_debug_loop (ACTIVE, Qnil, Qnil)); + return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil)); } DEFUN ("debug-classes-list", Fdebug_classes_list, 0, 0, 0, /* @@ -131,7 +130,7 @@ */ ()) { - return (xemacs_debug_loop (LIST, Qnil, Qnil)); + return (xemacs_debug_loop (X_LIST, Qnil, Qnil)); } DEFUN ("set-debug-classes-to-check", Fset_debug_classes_to_check, 1, 1, 0, /* @@ -148,14 +147,14 @@ valid, reject the entire list without doing anything. */ LIST_LOOP (rest, classes ) { - if (NILP (xemacs_debug_loop (VALIDATE, XCAR (rest), Qnil))) + if (NILP (xemacs_debug_loop (X_VALIDATE, XCAR (rest), Qnil))) error ("Invalid object in class list"); } LIST_LOOP (rest, classes) Fadd_debug_class_to_check (XCAR (rest)); - return (xemacs_debug_loop (ACTIVE, Qnil, Qnil)); + return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil)); } DEFUN ("set-debug-class-types-to-check", Fset_debug_class_types_to_check, 2, 2, 0, /* @@ -166,12 +165,12 @@ (class, type)) { CHECK_INT (type); - if (NILP (xemacs_debug_loop (VALIDATE, class, Qnil))) + if (NILP (xemacs_debug_loop (X_VALIDATE, class, Qnil))) error ("Invalid debug class"); - xemacs_debug_loop (SETTYPE, class, type); + xemacs_debug_loop (X_SETTYPE, class, type); - return (xemacs_debug_loop (TYPE, class, Qnil)); + return (xemacs_debug_loop (X_TYPE, class, Qnil)); } DEFUN ("debug-types-being-checked", Fdebug_types_being_checked, 1, 1, 0, /* @@ -179,10 +178,10 @@ */ (class)) { - if (NILP (xemacs_debug_loop (VALIDATE, class, Qnil))) + if (NILP (xemacs_debug_loop (X_VALIDATE, class, Qnil))) error ("Invalid debug class"); - return (xemacs_debug_loop (TYPE, class, Qnil)); + return (xemacs_debug_loop (X_TYPE, class, Qnil)); } void @@ -194,7 +193,6 @@ defsymbol (&Qwindows, "windows"); defsymbol (&Qframes, "frames"); defsymbol (&Qdevices, "devices"); - /* defsymbol (&Qbyte_code, "byte-code"); in bytecode.c */ DEFSUBR (Fadd_debug_class_to_check); DEFSUBR (Fdelete_debug_class_to_check); @@ -206,11 +204,17 @@ } void -vars_of_debug (void) +reinit_vars_of_debug (void) { /* If you need to have any classes active early on in startup, then the flags should be set here. All functions called by this function are "allowed" according to emacs.c. */ - xemacs_debug_loop (INIT, Qnil, Qnil); + xemacs_debug_loop (X_INIT, Qnil, Qnil); } + +void +vars_of_debug (void) +{ + reinit_vars_of_debug (); +} diff -r f4aeb21a5bad -r 74fd4e045ea6 src/debug.h --- a/src/debug.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/debug.h Mon Aug 13 11:13:30 2007 +0200 @@ -22,8 +22,8 @@ /* Written by Chuck Thompson */ -#ifndef _XEMACS_DEBUG_H_ -#define _XEMACS_DEBUG_H_ +#ifndef INCLUDED_debug_h_ +#define INCLUDED_debug_h_ #define DEBUG_STDERR 1 #define DEBUG_ABORT 2 @@ -53,8 +53,6 @@ unsigned int types_of_byte_code; }; -extern Lisp_Object Qbuffers, Qdevices, Qfaces, Qframes, Qredisplay, Qwindows; - extern struct debug_classes active_debug_classes; #define DASSERT(class, desired_type, action, assertion) do \ @@ -78,4 +76,4 @@ #endif /* !DEBUG_XEMACS */ -#endif /* _XEMACS_DEBUG_H_ */ +#endif /* INCLUDED_debug_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/depend --- a/src/depend Mon Aug 13 11:12:06 2007 +0200 +++ b/src/depend Mon Aug 13 11:13:30 2007 +0200 @@ -8,18 +8,18 @@ LISP_H = lisp.h config.h $(LISP_UNION_H) #ifdef HAVE_MS_WINDOWS console-msw.o: $(LISP_H) conslots.h console-msw.h console.h events.h lisp-disunion.h lisp-union.h lrecord.h opaque.h symeval.h symsinit.h systime.h -device-msw.o: $(LISP_H) buffer.h bufslots.h conslots.h console-msw.h console-stream.h console.h device.h events.h faces.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h systime.h toolbar.h -dialog-msw.o: $(LISP_H) buffer.h bufslots.h conslots.h console-msw.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h +device-msw.o: $(LISP_H) buffer.h bufslots.h conslots.h console-msw.h console-stream.h console.h device.h events.h faces.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h systime.h toolbar.h +dialog-msw.o: $(LISP_H) buffer.h bufslots.h conslots.h console-msw.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h dired-msw.o: $(LISP_H) buffer.h bufslots.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h ndir.h nt.h regex.h symeval.h symsinit.h sysdir.h sysfile.h sysproc.h systime.h -event-msw.o: $(LISP_H) buffer.h bufslots.h conslots.h console-msw.h console-tty.h console.h device.h dragdrop.h events-mod.h events.h faces.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h lstream.h menubar-msw.h mule-charset.h objects-msw.h objects.h process.h redisplay.h scrollbar-msw.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h sysproc.h syssignal.h systime.h systty.h syswait.h toolbar.h +event-msw.o: $(LISP_H) buffer.h bufslots.h conslots.h console-msw.h console-tty.h console.h device.h dragdrop.h events-mod.h events.h faces.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h lstream.h menubar-msw.h mule-charset.h objects-msw.h objects.h process.h redisplay.h scrollbar-msw.h scrollbar.h select.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h sysproc.h syssignal.h systime.h systty.h syswait.h toolbar.h frame-msw.o: $(LISP_H) buffer.h bufslots.h conslots.h console-msw.h console.h device.h elhash.h events.h faces.h frame.h frameslots.h glyphs-msw.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h glyphs-msw.o: $(LISP_H) buffer.h bufslots.h conslots.h console-msw.h console.h device.h elhash.h faces.h file-coding.h frame.h frameslots.h glyphs-msw.h glyphs.h gui.h imgproc.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h objects-msw.h objects.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysfile.h toolbar.h window.h winslots.h gui-msw.o: $(LISP_H) conslots.h console-msw.h console.h device.h elhash.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h menubar-msw.o: $(LISP_H) buffer.h bufslots.h commands.h conslots.h console-msw.h console.h device.h elhash.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h menubar-msw.h menubar.h mule-charset.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h objects-msw.o: $(LISP_H) buffer.h bufslots.h conslots.h console-msw.h console.h device.h hash.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects-msw.h objects.h specifier.h symeval.h symsinit.h -redisplay-msw.o: $(LISP_H) buffer.h bufslots.h conslots.h console-msw.h console.h debug.h device.h events.h faces.h frame.h frameslots.h glyphs-msw.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-ccl.h mule-charset.h objects-msw.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h systime.h toolbar.h window.h winslots.h +redisplay-msw.o: $(LISP_H) buffer.h bufslots.h conslots.h console-msw.h console.h debug.h device.h events.h faces.h frame.h frameslots.h glyphs-msw.h glyphs.h gui.h gutter.h lisp-disunion.h lisp-union.h lrecord.h mule-ccl.h mule-charset.h objects-msw.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h systime.h toolbar.h window.h winslots.h scrollbar-msw.o: $(LISP_H) conslots.h console-msw.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h redisplay.h scrollbar-msw.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h -select-msw.o: $(LISP_H) conslots.h console-msw.h console.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h +select-msw.o: $(LISP_H) conslots.h console-msw.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h redisplay.h scrollbar.h select.h specifier.h symeval.h symsinit.h toolbar.h toolbar-msw.o: $(LISP_H) buffer.h bufslots.h conslots.h console-msw.h console.h device.h elhash.h faces.h frame.h frameslots.h glyphs-msw.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects-msw.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h #endif #ifdef HAVE_X_WINDOWS @@ -28,14 +28,15 @@ device-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h conslots.h console-x.h console.h device.h elhash.h events.h faces.h frame.h frameslots.h glyphs-x.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects-x.h objects.h offix-types.h offix.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h systime.h toolbar.h window.h winslots.h xgccache.h xintrinsic.h xintrinsicp.h xmu.h dialog-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h buffer.h bufslots.h commands.h conslots.h console-x.h console.h device.h events.h frame.h frameslots.h glyphs.h gui-x.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h xintrinsic.h frame-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h EmacsManager.h EmacsShell.h ExternalShell.h buffer.h bufslots.h conslots.h console-x.h console.h device.h dragdrop.h events-mod.h events.h extents.h faces.h frame.h frameslots.h glyphs-x.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects-x.h objects.h offix-types.h offix.h redisplay.h scrollbar-x.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h xintrinsic.h xintrinsicp.h xmprimitivep.h xmu.h -glyphs-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h bitmaps.h buffer.h bufslots.h conslots.h console-x.h console.h device.h file-coding.h frame.h frameslots.h glyphs-x.h glyphs.h gui.h imgproc.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h objects-x.h objects.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysfile.h toolbar.h window.h winslots.h xintrinsic.h xmu.h -gui-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h conslots.h console-x.h console.h device.h frame.h frameslots.h glyphs.h gui-x.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h xintrinsic.h +glyphs-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h bitmaps.h buffer.h bufslots.h conslots.h console-x.h console.h device.h faces.h file-coding.h frame.h frameslots.h glyphs-x.h glyphs.h gui-x.h gui.h imgproc.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h objects-x.h objects.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysfile.h toolbar.h window.h winslots.h xintrinsic.h xmu.h +gui-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h conslots.h console-x.h console.h device.h frame.h frameslots.h glyphs.h gui-x.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h xintrinsic.h input-method-xfs.o: $(LISP_H) EmacsFrame.h buffer.h bufslots.h conslots.h console-x.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h xintrinsic.h input-method-xlib.o: $(LISP_H) EmacsFrame.h buffer.h bufslots.h conslots.h console-x.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h xintrinsic.h menubar-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h buffer.h bufslots.h commands.h conslots.h console-x.h console.h device.h events.h frame.h frameslots.h glyphs.h gui-x.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h xintrinsic.h objects-x.o: $(LISP_H) buffer.h bufslots.h conslots.h console-x.h console.h device.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects-x.h objects.h specifier.h symeval.h symsinit.h xintrinsic.h -redisplay-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h buffer.h bufslots.h conslots.h console-x.h console.h debug.h device.h faces.h file-coding.h frame.h frameslots.h glyphs-x.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-ccl.h mule-charset.h objects-x.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysproc.h systime.h toolbar.h window.h winslots.h xgccache.h xintrinsic.h xintrinsicp.h xmprimitivep.h -scrollbar-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h conslots.h console-x.h console.h device.h frame.h frameslots.h glyphs-x.h glyphs.h gui-x.h gui.h lisp-disunion.h lisp-union.h lrecord.h redisplay.h scrollbar-x.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h xintrinsic.h +redisplay-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h buffer.h bufslots.h conslots.h console-x.h console.h debug.h device.h faces.h file-coding.h frame.h frameslots.h glyphs-x.h glyphs.h gui.h gutter.h lisp-disunion.h lisp-union.h lrecord.h mule-ccl.h mule-charset.h objects-x.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysproc.h systime.h toolbar.h window.h winslots.h xgccache.h xintrinsic.h xintrinsicp.h xmprimitivep.h +scrollbar-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h conslots.h console-x.h console.h device.h frame.h frameslots.h glyphs-x.h glyphs.h gui-x.h gui.h lisp-disunion.h lisp-union.h lrecord.h redisplay.h scrollbar-x.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h xintrinsic.h +select-x.o: $(LISP_H) buffer.h bufslots.h conslots.h console-x.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects-x.h objects.h opaque.h redisplay.h scrollbar.h select.h specifier.h symeval.h symsinit.h systime.h toolbar.h xintrinsic.h toolbar-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h buffer.h bufslots.h conslots.h console-x.h console.h device.h faces.h frame.h frameslots.h glyphs-x.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects-x.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h xintrinsic.h xintrinsicp.h xmprimitivep.h #endif #ifdef HAVE_DATABASE @@ -44,8 +45,7 @@ #ifdef MULE mule-canna.o: $(LISP_H) buffer.h bufslots.h file-coding.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h mule-ccl.o: $(LISP_H) buffer.h bufslots.h file-coding.h lisp-disunion.h lisp-union.h lrecord.h mule-ccl.h mule-charset.h symeval.h symsinit.h -mule-charset.o: $(LISP_H) buffer.h bufslots.h chartab.h conslots.h console.h device.h elhash.h faces.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h symeval.h symsinit.h -mule-coding.o: $(LISP_H) buffer.h bufslots.h elhash.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-ccl.h mule-charset.h mule-coding.h symeval.h symsinit.h +mule-charset.o: $(LISP_H) buffer.h bufslots.h chartab.h conslots.h console.h device.h elhash.h faces.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-ccl.h mule-charset.h symeval.h symsinit.h mule-mcpath.o: $(LISP_H) buffer.h bufslots.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h sysfile.h mule-wnnfns.o: $(LISP_H) buffer.h bufslots.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h symeval.h symsinit.h sysdep.h window.h winslots.h mule.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h regex.h symeval.h symsinit.h @@ -62,11 +62,11 @@ EmacsShell-sub.o: EmacsShell.h EmacsShellP.h config.h xintrinsic.h xintrinsicp.h EmacsShell.o: EmacsShell.h ExternalShell.h config.h xintrinsicp.h abbrev.o: $(LISP_H) buffer.h bufslots.h chartab.h commands.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h symeval.h symsinit.h syntax.h window.h winslots.h -alloc.o: $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h chartab.h conslots.h console.h device.h elhash.h events.h extents.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h puresize-adjust.h puresize.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysfile.h systime.h toolbar.h window.h winslots.h +alloc.o: $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h chartab.h conslots.h console-stream.h console.h device.h elhash.h events.h extents.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysfile.h systime.h toolbar.h window.h winslots.h alloca.o: config.h balloon_help.o: balloon_help.h config.h xintrinsic.h blocktype.o: $(LISP_H) blocktype.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -buffer.o: $(LISP_H) buffer.h bufslots.h chartab.h commands.h conslots.h console.h device.h elhash.h extents.h faces.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h syntax.h sysdep.h sysfile.h toolbar.h window.h winslots.h +buffer.o: $(LISP_H) buffer.h bufslots.h chartab.h commands.h conslots.h console.h device.h elhash.h extents.h faces.h file-coding.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h syntax.h sysdep.h sysfile.h toolbar.h window.h winslots.h bytecode.o: $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h chartab.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h symeval.h symsinit.h syntax.h callint.o: $(LISP_H) buffer.h bufslots.h bytecode.h commands.h events.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h symeval.h symsinit.h systime.h window.h winslots.h callproc.o: $(LISP_H) buffer.h bufslots.h commands.h file-coding.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h nt.h process.h redisplay.h scrollbar.h symeval.h symsinit.h sysdep.h sysfile.h sysproc.h syssignal.h systime.h systty.h window.h winslots.h @@ -77,65 +77,67 @@ cmdloop.o: $(LISP_H) buffer.h bufslots.h commands.h conslots.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h cmds.o: $(LISP_H) buffer.h bufslots.h chartab.h commands.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h syntax.h console-stream.o: $(LISP_H) conslots.h console-stream.h console-tty.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h syssignal.h systime.h systty.h toolbar.h window.h winslots.h -console-tty.o: $(LISP_H) buffer.h bufslots.h conslots.h console-stream.h console-tty.h console.h device.h faces.h file-coding.h frame.h frameslots.h glyphs.h gpmevent.h gui.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h syssignal.h systty.h toolbar.h +console-tty.o: $(LISP_H) buffer.h bufslots.h conslots.h console-stream.h console-tty.h console.h device.h faces.h file-coding.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h syssignal.h systty.h toolbar.h console.o: $(LISP_H) buffer.h bufslots.h conslots.h console-tty.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h syssignal.h systime.h systty.h toolbar.h window.h winslots.h -data.o: $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h sysfloat.h syssignal.h +data.o: $(LISP_H) buffer.h bufslots.h bytecode.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h sysfloat.h syssignal.h debug.o: $(LISP_H) bytecode.h debug.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h device-tty.o: $(LISP_H) buffer.h bufslots.h conslots.h console-stream.h console-tty.h console.h device.h events.h faces.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h syssignal.h systime.h systty.h toolbar.h device.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h elhash.h events.h faces.h frame.h frameslots.h glyphs.h gui.h keymap.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h syssignal.h systime.h toolbar.h window.h winslots.h dgif_lib.o: gifrlib.h -dialog.o: $(LISP_H) conslots.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h -dired.o: $(LISP_H) buffer.h bufslots.h commands.h elhash.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h ndir.h opaque.h regex.h symeval.h symsinit.h sysdir.h sysfile.h syspwd.h systime.h +dialog.o: $(LISP_H) conslots.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h +dired.o: $(LISP_H) buffer.h bufslots.h commands.h elhash.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h ndir.h opaque.h regex.h symeval.h symsinit.h sysdep.h sysdir.h sysfile.h syspwd.h systime.h doc.o: $(LISP_H) buffer.h bufslots.h bytecode.h insdel.h keymap.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h sysfile.h doprnt.o: $(LISP_H) buffer.h bufslots.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h symeval.h symsinit.h dragdrop.o: $(LISP_H) dragdrop.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h dynarr.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h ecrt0.o: config.h -editfns.o: $(LISP_H) buffer.h bufslots.h chartab.h commands.h conslots.h console.h device.h events.h extents.h frame.h frameslots.h glyphs.h gui.h insdel.h line-number.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h syspwd.h systime.h toolbar.h window.h winslots.h +editfns.o: $(LISP_H) buffer.h bufslots.h chartab.h commands.h conslots.h console.h device.h events.h extents.h frame.h frameslots.h glyphs.h gui.h insdel.h line-number.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h syspwd.h systime.h toolbar.h window.h winslots.h eldap.o: $(LISP_H) buffer.h bufslots.h eldap.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h symeval.h symsinit.h sysdep.h elhash.o: $(LISP_H) bytecode.h elhash.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -emacs.o: $(LISP_H) backtrace.h buffer.h bufslots.h commands.h conslots.h console.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h paths.h process.h redisplay.h symeval.h symsinit.h sysdep.h sysdll.h sysfile.h syssignal.h systime.h systty.h +emacs.o: $(LISP_H) backtrace.h buffer.h bufslots.h commands.h conslots.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h paths.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysdll.h sysfile.h syssignal.h systime.h systty.h toolbar.h emodules.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h emodules.h file-coding.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysdll.h toolbar.h window.h winslots.h +esd.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h miscplay.h symeval.h symsinit.h eval.o: $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h commands.h conslots.h console.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h symeval.h symsinit.h event-Xt.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h blocktype.h buffer.h bufslots.h conslots.h console-tty.h console-x.h console.h device.h dragdrop.h elhash.h events-mod.h events.h file-coding.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h objects-x.h objects.h offix-types.h offix.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysproc.h syssignal.h systime.h systty.h toolbar.h xintrinsic.h xintrinsicp.h -event-stream.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h blocktype.h buffer.h bufslots.h commands.h conslots.h console-x.h console.h device.h elhash.h events-mod.h events.h file-coding.h frame.h frameslots.h glyphs.h gui-x.h gui.h insdel.h keymap.h lisp-disunion.h lisp-union.h lrecord.h lstream.h macros.h mule-charset.h opaque.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h syssignal.h systime.h toolbar.h window.h winslots.h xintrinsic.h -event-tty.o: $(LISP_H) conslots.h console-tty.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h process.h scrollbar.h specifier.h symeval.h symsinit.h sysproc.h syssignal.h systime.h systty.h syswait.h toolbar.h -event-unixoid.o: $(LISP_H) conslots.h console-stream.h console-tty.h console.h device.h events.h gpmevent.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h process.h symeval.h symsinit.h sysdep.h sysfile.h sysproc.h syssignal.h systime.h systty.h +event-stream.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h blocktype.h buffer.h bufslots.h commands.h conslots.h console-x.h console.h device.h elhash.h events-mod.h events.h file-coding.h frame.h frameslots.h glyphs.h gui-x.h gui.h insdel.h keymap.h lisp-disunion.h lisp-union.h lrecord.h lstream.h macros.h mule-charset.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h syssignal.h systime.h toolbar.h window.h winslots.h xintrinsic.h +event-tty.o: $(LISP_H) conslots.h console-tty.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysproc.h syssignal.h systime.h systty.h syswait.h toolbar.h +event-unixoid.o: $(LISP_H) conslots.h console-stream.h console-tty.h console.h device.h events.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h process.h symeval.h symsinit.h sysdep.h sysfile.h sysproc.h syssignal.h systime.h systty.h events.o: $(LISP_H) buffer.h bufslots.h conslots.h console-tty.h console-x.h console.h device.h events-mod.h events.h extents.h frame.h frameslots.h glyphs.h gui.h keymap.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h syssignal.h systime.h systty.h toolbar.h window.h winslots.h xintrinsic.h extents.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h debug.h device.h elhash.h extents.h faces.h frame.h frameslots.h glyphs.h gui.h insdel.h keymap.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h faces.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h elhash.h extents.h faces.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h -file-coding.o: $(LISP_H) buffer.h bufslots.h elhash.h file-coding.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-ccl.h mule-charset.h symeval.h symsinit.h +file-coding.o: $(LISP_H) buffer.h bufslots.h chartab.h elhash.h file-coding.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-ccl.h mule-charset.h opaque.h symeval.h symsinit.h fileio.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h events.h file-coding.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h ndir.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysdir.h sysfile.h sysproc.h syspwd.h systime.h toolbar.h window.h winslots.h filelock.o: $(LISP_H) buffer.h bufslots.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h ndir.h paths.h symeval.h symsinit.h sysdir.h sysfile.h syspwd.h syssignal.h filemode.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h sysfile.h floatfns.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h sysfloat.h syssignal.h -fns.o: $(LISP_H) buffer.h bufslots.h bytecode.h conslots.h console.h device.h events.h extents.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h opaque.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h +fns.o: $(LISP_H) buffer.h bufslots.h bytecode.h conslots.h console.h device.h events.h extents.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h font-lock.o: $(LISP_H) buffer.h bufslots.h chartab.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h syntax.h -frame-tty.o: $(LISP_H) conslots.h console-tty.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h scrollbar.h specifier.h symeval.h symsinit.h syssignal.h systime.h systty.h toolbar.h -frame.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h events.h extents.h faces.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h menubar.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h +frame-tty.o: $(LISP_H) conslots.h console-tty.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h syssignal.h systime.h systty.h toolbar.h +frame.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h events.h extents.h faces.h frame.h frameslots.h glyphs.h gui.h gutter.h lisp-disunion.h lisp-union.h lrecord.h menubar.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h free-hook.o: $(LISP_H) hash.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h general.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h getloadavg.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h sysfile.h -gif_io.o: gifrlib.h -glyphs-eimage.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h faces.h file-coding.h frame.h frameslots.h gifrlib.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h objects.h opaque.h scrollbar.h specifier.h symeval.h symsinit.h sysfile.h toolbar.h +gif_io.o: gifrlib.h sysfile.h +glyphs-eimage.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h faces.h file-coding.h frame.h frameslots.h gifrlib.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h objects.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysfile.h toolbar.h glyphs-widget.o: $(LISP_H) buffer.h bufslots.h bytecode.h conslots.h console.h device.h faces.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h objects.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h -glyphs.o: $(LISP_H) buffer.h bufslots.h chartab.h conslots.h console.h device.h elhash.h faces.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects.h opaque.h rangetab.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h +glyphs.o: $(LISP_H) blocktype.h buffer.h bufslots.h chartab.h conslots.h console.h device.h elhash.h faces.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects.h opaque.h rangetab.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h gmalloc.o: config.h getpagesize.h -gpmevent.o: $(LISP_H) conslots.h console-tty.h console.h device.h events-mod.h events.h gpmevent.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h sysdep.h syssignal.h systime.h systty.h +gpmevent.o: $(LISP_H) commands.h conslots.h console-tty.h console.h device.h events-mod.h events.h gpmevent.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h process.h symeval.h symsinit.h sysdep.h sysproc.h syssignal.h systime.h systty.h gui.o: $(LISP_H) bytecode.h elhash.h gui.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h +gutter.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h faces.h frame.h frameslots.h glyphs.h gui.h gutter.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h hash.o: $(LISP_H) hash.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h hftctl.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h hpplay.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h imgproc.o: $(LISP_H) imgproc.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h indent.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h extents.h faces.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h inline.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h bytecode.h chartab.h conslots.h console.h database.h device.h eldap.h elhash.h events.h extents.h faces.h file-coding.h frame.h frameslots.h glyphs-x.h glyphs.h gui-x.h gui.h keymap.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h objects.h opaque.h process.h rangetab.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h syntax.h systime.h toolbar.h tooltalk.h window.h winslots.h xintrinsic.h -input-method-motif.o: $(LISP_H) EmacsFrame.h conslots.h console-x.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h xintrinsic.h +input-method-motif.o: $(LISP_H) EmacsFrame.h conslots.h console-x.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h xintrinsic.h insdel.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h extents.h frame.h frameslots.h glyphs.h gui.h insdel.h line-number.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h intl.o: $(LISP_H) bytecode.h conslots.h console.h device.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h keymap.o: $(LISP_H) buffer.h bufslots.h bytecode.h conslots.h console.h device.h elhash.h events-mod.h events.h frame.h frameslots.h glyphs.h gui.h insdel.h keymap.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h libsst.o: $(LISP_H) libsst.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h line-number.o: $(LISP_H) buffer.h bufslots.h line-number.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h -linuxplay.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h sysfile.h syssignal.h +linuxplay.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h miscplay.h symeval.h symsinit.h sysfile.h syssignal.h lread.o: $(LISP_H) buffer.h bufslots.h bytecode.h elhash.h file-coding.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h opaque.h symeval.h symsinit.h sysfile.h sysfloat.h lstream.o: $(LISP_H) buffer.h bufslots.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h symeval.h symsinit.h sysfile.h macros.o: $(LISP_H) buffer.h bufslots.h commands.h conslots.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h keymap.h lisp-disunion.h lisp-union.h lrecord.h macros.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h @@ -144,33 +146,34 @@ md5.o: $(LISP_H) buffer.h bufslots.h file-coding.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h symeval.h symsinit.h menubar.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h menubar.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h minibuf.o: $(LISP_H) buffer.h bufslots.h commands.h conslots.h console-stream.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h +miscplay.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h miscplay.h symeval.h symsinit.h sysfile.h syssignal.h nas.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h sysdep.h syssignal.h -nt.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h nt.h ntheap.h symeval.h symsinit.h sysproc.h syssignal.h systime.h +nt.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h nt.h ntheap.h symeval.h symsinit.h sysfile.h sysproc.h syssignal.h systime.h ntheap.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h ntheap.h symeval.h symsinit.h ntplay.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h sysfile.h -ntproc.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h nt.h ntheap.h process.h symeval.h symsinit.h sysproc.h syssignal.h systime.h syswait.h +ntproc.o: $(LISP_H) buffer.h bufslots.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h nt.h ntheap.h process.h symeval.h symsinit.h sysfile.h sysproc.h syssignal.h systime.h syswait.h objects-tty.o: $(LISP_H) conslots.h console-tty.h console.h device.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects-tty.h objects.h specifier.h symeval.h symsinit.h syssignal.h systty.h objects.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h elhash.h faces.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h offix.o: offix-cursors.h offix-types.h offix.h xintrinsic.h opaque.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h opaque.h symeval.h symsinit.h -print.o: $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h conslots.h console-stream.h console-tty.h console.h device.h extents.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h scrollbar.h specifier.h symeval.h symsinit.h sysfile.h syssignal.h systty.h toolbar.h +print.o: $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h conslots.h console-stream.h console-tty.h console.h device.h extents.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysfile.h syssignal.h systty.h toolbar.h process-nt.o: $(LISP_H) hash.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h process.h procimpl.h symeval.h symsinit.h sysdep.h process-unix.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h events.h file-coding.h frame.h frameslots.h glyphs.h gui.h hash.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h opaque.h process.h procimpl.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h sysproc.h syssignal.h systime.h systty.h syswait.h toolbar.h window.h winslots.h process.o: $(LISP_H) buffer.h bufslots.h commands.h conslots.h console.h device.h events.h file-coding.h frame.h frameslots.h glyphs.h gui.h hash.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h opaque.h process.h procimpl.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysfile.h sysproc.h syssignal.h systime.h systty.h syswait.h toolbar.h window.h winslots.h profile.o: $(LISP_H) backtrace.h bytecode.h elhash.h hash.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h syssignal.h systime.h -pure.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h puresize-adjust.h puresize.h symeval.h symsinit.h ralloc.o: $(LISP_H) getpagesize.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h rangetab.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h rangetab.h symeval.h symsinit.h realpath.o: config.h redisplay-output.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h faces.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h redisplay-tty.o: $(LISP_H) buffer.h bufslots.h conslots.h console-tty.h console.h device.h events.h faces.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h objects-tty.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h syssignal.h systime.h systty.h toolbar.h window.h winslots.h -redisplay.o: $(LISP_H) buffer.h bufslots.h commands.h conslots.h console-tty.h console.h debug.h device.h elhash.h extents.h faces.h file-coding.h frame.h frameslots.h glyphs.h gui.h insdel.h line-number.h lisp-disunion.h lisp-union.h lrecord.h menubar.h mule-charset.h objects.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h syssignal.h systty.h toolbar.h window.h winslots.h +redisplay.o: $(LISP_H) buffer.h bufslots.h commands.h conslots.h console-tty.h console.h debug.h device.h elhash.h extents.h faces.h file-coding.h frame.h frameslots.h glyphs.h gui.h gutter.h insdel.h line-number.h lisp-disunion.h lisp-union.h lrecord.h menubar.h mule-charset.h objects.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h syssignal.h systty.h toolbar.h window.h winslots.h regex.o: $(LISP_H) buffer.h bufslots.h chartab.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h regex.h symeval.h symsinit.h syntax.h -scrollbar.o: $(LISP_H) buffer.h bufslots.h commands.h conslots.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h +scrollbar.o: $(LISP_H) buffer.h bufslots.h commands.h conslots.h console.h device.h frame.h frameslots.h glyphs.h gui.h gutter.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h search.o: $(LISP_H) buffer.h bufslots.h chartab.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h regex.h symeval.h symsinit.h syntax.h +select.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects.h opaque.h redisplay.h scrollbar.h select.h specifier.h symeval.h symsinit.h toolbar.h sgiplay.o: $(LISP_H) libst.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h sheap.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h sheap-adjust.h symeval.h symsinit.h -signal.o: $(LISP_H) conslots.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h syssignal.h systime.h toolbar.h +signal.o: $(LISP_H) conslots.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h syssignal.h systime.h toolbar.h sound.o: $(LISP_H) buffer.h bufslots.h conslots.h console-x.h console.h device.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h symeval.h symsinit.h sysdep.h xintrinsic.h specifier.o: $(LISP_H) buffer.h bufslots.h chartab.h conslots.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h rangetab.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h strcat.o: config.h @@ -186,6 +189,7 @@ sysdll.o: config.h sysdll.h termcap.o: $(LISP_H) conslots.h console.h device.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h terminfo.o: config.h +tests.o: $(LISP_H) buffer.h bufslots.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h opaque.h symeval.h symsinit.h toolbar.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h tooltalk.o: $(LISP_H) buffer.h bufslots.h elhash.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h process.h symeval.h symsinit.h tooltalk.h tparam.o: config.h @@ -207,7 +211,6 @@ unexsunos4.o: config.h vm-limit.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h mem-limits.h symeval.h symsinit.h widget.o: $(LISP_H) buffer.h bufslots.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h -window.o: $(LISP_H) buffer.h bufslots.h commands.h conslots.h console.h device.h elhash.h faces.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h +window.o: $(LISP_H) buffer.h bufslots.h commands.h conslots.h console.h device.h elhash.h faces.h frame.h frameslots.h glyphs.h gui.h gutter.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h xgccache.o: $(LISP_H) hash.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h xgccache.h xmu.o: config.h -xselect.o: $(LISP_H) buffer.h bufslots.h conslots.h console-x.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects-x.h objects.h opaque.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h xintrinsic.h diff -r f4aeb21a5bad -r 74fd4e045ea6 src/device-msw.c --- a/src/device-msw.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/device-msw.c Mon Aug 13 11:13:30 2007 +0200 @@ -39,6 +39,8 @@ #include "frame.h" #include "sysdep.h" +#include <winspool.h> + /* win32 DDE management library globals */ #ifdef HAVE_DRAGNDROP DWORD mswindows_dde_mlid; @@ -64,15 +66,15 @@ /************************************************************************/ static Lisp_Object -build_syscolor_string (int index) +build_syscolor_string (int idx) { DWORD clr; char buf[16]; - if (index < 0) + if (idx < 0) return Qnil; - clr = GetSysColor (index); + clr = GetSysColor (idx); sprintf (buf, "#%02X%02X%02X", GetRValue (clr), GetGValue (clr), @@ -98,10 +100,17 @@ index2 < 0 ? Qnil : make_int (GetSystemMetrics (index2))); } +static Lisp_Object +build_devicecaps_cons (HDC hdc, int index1, int index2) +{ + return Fcons (index1 < 0 ? Qnil : make_int (GetDeviceCaps (hdc, index1)), + index2 < 0 ? Qnil : make_int (GetDeviceCaps (hdc, index2))); +} + /************************************************************************/ -/* methods */ +/* display methods */ /************************************************************************/ static void @@ -129,9 +138,9 @@ DEVICE_MSWINDOWS_HORZSIZE(d) = GetDeviceCaps(hdc, HORZSIZE); DEVICE_MSWINDOWS_VERTSIZE(d) = GetDeviceCaps(hdc, VERTSIZE); DEVICE_MSWINDOWS_BITSPIXEL(d) = GetDeviceCaps(hdc, BITSPIXEL); - DeleteDC (hdc); + DEVICE_MSWINDOWS_FONTLIST (d) = mswindows_enumerate_fonts (hdc); - mswindows_enumerate_fonts (d); + DeleteDC (hdc); /* Register the main window class */ wc.cbSize = sizeof (WNDCLASSEX); @@ -139,7 +148,9 @@ wc.lpfnWndProc = (WNDPROC) mswindows_wnd_proc; wc.cbClsExtra = 0; wc.cbWndExtra = MSWINDOWS_WINDOW_EXTRA_BYTES; - wc.hInstance = NULL; /* ? */ + /* This must match whatever is passed to CreateWIndowEx, NULL is ok + for this. */ + wc.hInstance = NULL; wc.hIcon = LoadIcon (GetModuleHandle(NULL), XEMACS_CLASS); wc.hCursor = LoadCursor (NULL, IDC_ARROW); /* Background brush is only used during sizing, when XEmacs cannot @@ -151,7 +162,18 @@ wc.hIconSm = LoadImage (GetModuleHandle (NULL), XEMACS_CLASS, IMAGE_ICON, 16, 16, 0); RegisterClassEx (&wc); -#ifdef HAVE_TOOLBARS + +#ifdef HAVE_WIDGETS + xzero (wc); + /* Register the main window class */ + wc.cbSize = sizeof (WNDCLASSEX); + wc.lpfnWndProc = (WNDPROC) mswindows_control_wnd_proc; + wc.lpszClassName = XEMACS_CONTROL_CLASS; + wc.hInstance = NULL; + RegisterClassEx (&wc); +#endif + +#if defined (HAVE_TOOLBARS) || defined (HAVE_WIDGETS) InitCommonControls (); #endif } @@ -178,16 +200,6 @@ static void mswindows_delete_device (struct device *d) { - struct mswindows_font_enum *fontlist, *next; - - fontlist = DEVICE_MSWINDOWS_FONTLIST (d); - while (fontlist) - { - next = fontlist->next; - free (fontlist); - fontlist = next; - } - #ifdef HAVE_DRAGNDROP DdeNameService (mswindows_dde_mlid, 0L, 0L, DNS_REGISTER); DdeUninitialize (mswindows_dde_mlid); @@ -196,6 +208,12 @@ free (d->device_data); } +static void +mswindows_mark_device (struct device *d) +{ + mark_object (DEVICE_MSWINDOWS_FONTLIST (d)); +} + static Lisp_Object mswindows_device_system_metrics (struct device *d, enum device_metrics m) @@ -206,6 +224,10 @@ return Fcons (make_int (DEVICE_MSWINDOWS_HORZRES(d)), make_int (DEVICE_MSWINDOWS_VERTRES(d))); break; + case DM_device_dpi: + return Fcons (make_int (DEVICE_MSWINDOWS_LOGPIXELSX(d)), + make_int (DEVICE_MSWINDOWS_LOGPIXELSY(d))); + break; case DM_size_device_mm: return Fcons (make_int (DEVICE_MSWINDOWS_HORZSIZE(d)), make_int (DEVICE_MSWINDOWS_VERTSIZE(d))); @@ -292,6 +314,184 @@ /************************************************************************/ +/* printer methods */ +/************************************************************************/ + +static void +signal_open_printer_error (struct device *d) +{ + signal_simple_error ("Failed to open printer", DEVICE_CONNECTION (d)); +} + +static void +msprinter_init_device (struct device *d, Lisp_Object props) +{ + char* printer_name; + + DEVICE_INFD (d) = DEVICE_OUTFD (d) = -1; + + CHECK_STRING (DEVICE_CONNECTION (d)); + + TO_EXTERNAL_FORMAT (LISP_STRING, DEVICE_CONNECTION (d), + C_STRING_ALLOCA, printer_name, + Qctext); + + d->device_data = xnew_and_zero (struct msprinter_device); + + DEVICE_MSPRINTER_NAME(d) = xstrdup (printer_name); + + if (!OpenPrinter (printer_name, &DEVICE_MSPRINTER_HPRINTER (d), NULL)) + { + DEVICE_MSPRINTER_HPRINTER (d) = NULL; + signal_open_printer_error (d); + } + + DEVICE_MSPRINTER_HDC (d) = CreateDC ("WINSPOOL", printer_name, + NULL, NULL); + if (DEVICE_MSPRINTER_HDC (d) == NULL) + signal_open_printer_error (d); + + /* Determinie DEVMODE size and store the default DEVMODE */ + DEVICE_MSPRINTER_DEVMODE_SIZE(d) = + DocumentProperties (NULL, DEVICE_MSPRINTER_HPRINTER(d), + printer_name, NULL, NULL, 0); + if (DEVICE_MSPRINTER_DEVMODE_SIZE(d) <= 0) + signal_open_printer_error (d); + + DEVICE_MSPRINTER_DEVMODE(d) = xmalloc (DEVICE_MSPRINTER_DEVMODE_SIZE(d)); + DocumentProperties (NULL, DEVICE_MSPRINTER_HPRINTER(d), + printer_name, DEVICE_MSPRINTER_DEVMODE(d), + NULL, DM_OUT_BUFFER); + + /* We do not use printer fon list as we do with the display + device. Rather, we allow GDI to pick the closest match to the + display font. */ + DEVICE_MSPRINTER_FONTLIST (d) = Qnil; + + DEVICE_CLASS (d) = (GetDeviceCaps (DEVICE_MSPRINTER_HDC (d), BITSPIXEL) + * GetDeviceCaps (DEVICE_MSPRINTER_HDC (d), PLANES) + > 1) ? Qcolor : Qmono; +} + +static Lisp_Object +msprinter_device_system_metrics (struct device *d, + enum device_metrics m) +{ + switch (m) + { + /* Device sizes - pixel and mm */ +#define FROB(met, index1, index2) \ + case DM_##met: \ + return build_devicecaps_cons \ + (DEVICE_MSPRINTER_HDC(d), index1, index2); + + FROB (size_device, PHYSICALWIDTH, PHYSICALHEIGHT); + FROB (size_device_mm, HORZSIZE, VERTSIZE); + FROB (size_workspace, HORZRES, VERTRES); + FROB (offset_workspace, PHYSICALOFFSETX, PHYSICALOFFSETY); + FROB (device_dpi, LOGPIXELSX, LOGPIXELSY); +#undef FROB + + case DM_num_bit_planes: + /* this is what X means by bitplanes therefore we ought to be + consistent. num planes is always 1 under mswindows and + therefore useless */ + return make_int (GetDeviceCaps (DEVICE_MSPRINTER_HDC(d), BITSPIXEL)); + + case DM_num_color_cells: /* Prnters are non-palette devices */ + case DM_slow_device: /* Animation would be a really bad idea */ + case DM_security: /* Not provided by windows */ + return Qzero; + } + + /* Do not know such property */ + return Qunbound; +} + +static void +msprinter_delete_device (struct device *d) +{ + if (d->device_data) + { + if (DEVICE_MSPRINTER_HPRINTER (d)) + ClosePrinter (DEVICE_MSPRINTER_HPRINTER (d)); + if (DEVICE_MSPRINTER_HDC (d)) + DeleteDC (DEVICE_MSPRINTER_HDC (d)); + if (DEVICE_MSPRINTER_NAME (d)) + free (DEVICE_MSPRINTER_NAME (d)); + if (DEVICE_MSPRINTER_DEVMODE (d)) + free (DEVICE_MSPRINTER_DEVMODE (d)); + if (DEVICE_MSPRINTER_DEVMODE_MIRROR (d)) + free (DEVICE_MSPRINTER_DEVMODE_MIRROR (d)); + + free (d->device_data); + } +} + +static void +msprinter_mark_device (struct device *d) +{ + mark_object (DEVICE_MSPRINTER_FONTLIST (d)); +} + +static unsigned int +msprinter_device_implementation_flags (void) +{ + return ( XDEVIMPF_PIXEL_GEOMETRY + | XDEVIMPF_IS_A_PRINTER + | XDEVIMPF_NO_AUTO_REDISPLAY + | XDEVIMPF_FRAMELESS_OK ); +} + + +/************************************************************************/ +/* printer external functions */ +/************************************************************************/ + +/* + * Return a copy of default DEVMODE. The copy returned is in + * a static buffer which will be overwritten by next call. + */ +DEVMODE* +msprinter_get_devmode_copy (struct device *d) +{ + assert (DEVICE_MSPRINTER_P (d)); + + if (DEVICE_MSPRINTER_DEVMODE_MIRROR(d) == NULL) + DEVICE_MSPRINTER_DEVMODE_MIRROR(d) = + xmalloc (DEVICE_MSPRINTER_DEVMODE_SIZE(d)); + + memcpy (DEVICE_MSPRINTER_DEVMODE_MIRROR(d), + DEVICE_MSPRINTER_DEVMODE(d), + DEVICE_MSPRINTER_DEVMODE_SIZE(d)); + + return DEVICE_MSPRINTER_DEVMODE_MIRROR(d); +} + +/* + * Apply settings from the DEVMODE. The settings are considered + * incremental to the default DEVMODE, so that changes in the + * passed structure supercede parameters of the printer. + * + * The passed structure is overwritten by the fuction call; + * complete printer settings are returned. + */ +void +msprinter_apply_devmode (struct device *d, DEVMODE *devmode) +{ + assert (DEVICE_MSPRINTER_P (d)); + + DocumentProperties (NULL, + DEVICE_MSPRINTER_HPRINTER(d), + DEVICE_MSPRINTER_NAME(d), + devmode, devmode, + DM_IN_BUFFER | DM_OUT_BUFFER); + + ResetDC (DEVICE_MSPRINTER_HDC (d), devmode); +} + + +/************************************************************************/ /* initialization */ /************************************************************************/ @@ -300,19 +500,6 @@ { defsymbol (&Qinit_pre_mswindows_win, "init-pre-mswindows-win"); defsymbol (&Qinit_post_mswindows_win, "init-post-mswindows-win"); - - DEFVAR_LISP ("mswindows-downcase-file-names", &Vmswindows_downcase_file_names /* -Non-nil means convert all-upper case file names to lower case. -This applies when performing completions and file name expansion.*/ ); - Vmswindows_downcase_file_names = Qnil; - - DEFVAR_LISP ("mswindows-get-true-file-attributes", &Vmswindows_get_true_file_attributes /* - "Non-nil means determine accurate link count in file-attributes. -This option slows down file-attributes noticeably, so is disabled by -default. Note that it is only useful for files on NTFS volumes, -where hard links are supported. -*/ ); - Vmswindows_get_true_file_attributes = Qnil; } void @@ -320,13 +507,33 @@ { CONSOLE_HAS_METHOD (mswindows, init_device); CONSOLE_HAS_METHOD (mswindows, finish_init_device); -/* CONSOLE_HAS_METHOD (mswindows, mark_device); */ + CONSOLE_HAS_METHOD (mswindows, mark_device); CONSOLE_HAS_METHOD (mswindows, delete_device); CONSOLE_HAS_METHOD (mswindows, device_system_metrics); CONSOLE_HAS_METHOD (mswindows, device_implementation_flags); + + CONSOLE_HAS_METHOD (msprinter, init_device); + CONSOLE_HAS_METHOD (msprinter, mark_device); + CONSOLE_HAS_METHOD (msprinter, delete_device); + CONSOLE_HAS_METHOD (msprinter, device_system_metrics); + CONSOLE_HAS_METHOD (msprinter, device_implementation_flags); } + void vars_of_device_mswindows (void) { + DEFVAR_LISP ("mswindows-downcase-file-names", &Vmswindows_downcase_file_names /* +Non-nil means convert all-upper case file names to lower case. +This applies when performing completions and file name expansion. +*/ ); + Vmswindows_downcase_file_names = Qnil; + + DEFVAR_LISP ("mswindows-get-true-file-attributes", &Vmswindows_get_true_file_attributes /* +Non-nil means determine accurate link count in file-attributes. +This option slows down file-attributes noticeably, so is disabled by +default. Note that it is only useful for files on NTFS volumes, +where hard links are supported. +*/ ); + Vmswindows_get_true_file_attributes = Qnil; } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/device-tty.c --- a/src/device-tty.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/device-tty.c Mon Aug 13 11:13:30 2007 +0200 @@ -38,10 +38,6 @@ #include "syssignal.h" /* for SIGWINCH */ -#ifdef HAVE_GPM -#include <gpm.h> -#endif - #include <errno.h> Lisp_Object Qinit_pre_tty_win, Qinit_post_tty_win; @@ -155,15 +151,6 @@ CONSOLE_TTY_DATA (con)->width = width; CONSOLE_TTY_DATA (con)->height = height; -#ifdef HAVE_GPM - /* We need to tell GPM how big our screen is now - ** I am pretty sure the GPM library will get incredibly confused - ** if you try to connect to more than one mouse-capable device, - ** so I don't think it will cause any more damage in that case. - */ - gpm_mx = width; - gpm_my = height; -#endif for (tail = DEVICE_FRAME_LIST (d); !NILP (tail); tail = XCDR (tail)) diff -r f4aeb21a5bad -r 74fd4e045ea6 src/device-x.c --- a/src/device-x.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/device-x.c Mon Aug 13 11:13:30 2007 +0200 @@ -50,6 +50,10 @@ #include "sysfile.h" #include "systime.h" +#if defined(HAVE_SHLIB) && defined(LWLIB_USES_ATHENA) && !defined(HAVE_ATHENA_3D) +#include "sysdll.h" +#endif /* HAVE_SHLIB and LWLIB_USES_ATHENA and not HAVE_ATHENA_3D */ + #ifdef HAVE_OFFIX_DND #include "offix.h" #endif @@ -387,8 +391,8 @@ vi_out [i].depth == 1 || vi_out [i].depth == 8) #endif - - /* SGI has 30-bit deep visuals. Ignore them. + + /* SGI has 30-bit deep visuals. Ignore them. (We only have 24-bit data anyway.) */ && (vi_out [i].depth <= 24) @@ -456,9 +460,9 @@ Widget app_shell; int argc; char **argv; - CONST char *app_class; - CONST char *app_name; - CONST char *disp_name; + const char *app_class; + const char *app_name; + const char *disp_name; Visual *visual = NULL; int depth = 8; /* shut up the compiler */ Colormap cmap; @@ -466,6 +470,78 @@ /* */ int best_visual_found = 0; +#if defined(HAVE_SHLIB) && defined(LWLIB_USES_ATHENA) && !defined(HAVE_ATHENA_3D) + /* + * In order to avoid the lossage with flat Athena widgets dynamically + * linking to one of the ThreeD variants, using the dynamic symbol helpers + * to look for symbols that shouldn't be there and refusing to run if they + * are seems a less toxic idea than having XEmacs crash when we try and + * use a subclass of a widget that has changed size. + * + * It's ugly, I know, and not going to work everywhere. It seems better to + * do our damnedest to try and tell the user what to expect rather than + * simply blow up though. + * + * All the ThreeD variants I have access to define the following function + * symbols in the shared library. The flat Xaw library does not define them: + * + * Xaw3dComputeBottomShadowRGB + * Xaw3dComputeTopShadowRGB + * + * So far only Linux has shown this problem. This seems to be portable to + * all the distributions (certainly all the ones I checked - Debian and + * Redhat) + * + * This will only work, sadly, with dlopen() -- the other dynamic linkers + * are simply not capable of doing what is needed. :/ + */ + + { + /* Get a dll handle to the main process. */ + dll_handle xaw_dll_handle = dll_open (NULL); + + /* Did that fail? If so, continue without error. + * We could die here but, well, that's unfriendly and all -- plus I feel + * better about some crashing somewhere rather than preventing a perfectly + * good configuration working just because dll_open failed. + */ + if (xaw_dll_handle != NULL) + { + /* Look for the Xaw3d function */ + dll_func xaw_function_handle = + dll_function (xaw_dll_handle, "Xaw3dComputeTopShadowRGB"); + + /* If we found it, warn the user in big, nasty, unfriendly letters */ + if (xaw_function_handle != NULL) + { + warn_when_safe (Qdevice, Qerror, "\n" +"It seems that XEmacs is built dynamically linked to the flat Athena widget\n" +"library but it finds a 3D Athena variant with the same name at runtime.\n" +"\n" +"This WILL cause your XEmacs process to dump core at some point.\n" +"You should not continue to use this binary without resolving this issue.\n" +"\n" +"This can be solved with the xaw-wrappers package under Debian\n" +"(register XEmacs as incompatible with all 3d widget sets, see\n" +"update-xaw-wrappers(8) and .../doc/xaw-wrappers/README.packagers). It\n" +"can be verified by checking the runtime path in /etc/ld.so.conf and by\n" +"using `ldd /path/to/xemacs' under other Linux distributions. One\n" +"solution is to use LD_PRELOAD or LD_LIBRARY_PATH to force ld.so to\n" +"load the flat Athena widget library instead of the aliased 3D widget\n" +"library (see ld.so(8) for use of these environment variables).\n\n" + ); + + } + + /* Otherwise release the handle to the library + * No error catch here; I can't think of a way to recover anyhow. + */ + dll_close (xaw_dll_handle); + } + } +#endif /* HAVE_SHLIB and LWLIB_USES_ATHENA and not HAVE_ATHENA_3D */ + + XSETDEVICE (device, d); display = DEVICE_CONNECTION (d); @@ -473,7 +549,9 @@ make_argc_argv (Vx_initial_argv_list, &argc, &argv); - GET_C_STRING_CTEXT_DATA_ALLOCA (display, disp_name); + TO_EXTERNAL_FORMAT (LISP_STRING, display, + C_STRING_ALLOCA, disp_name, + Qctext); /* * Break apart the old XtOpenDisplay call into XOpenDisplay and @@ -495,7 +573,9 @@ if (STRINGP (Vx_emacs_application_class) && XSTRING_LENGTH (Vx_emacs_application_class) > 0) - GET_C_STRING_CTEXT_DATA_ALLOCA (Vx_emacs_application_class, app_class); + TO_EXTERNAL_FORMAT (LISP_STRING, Vx_emacs_application_class, + C_STRING_ALLOCA, app_class, + Qctext); else { app_class = (NILP (Vx_emacs_application_class) && @@ -529,15 +609,17 @@ data-directory/app-defaults/$LANG/Emacs. This is in addition to the standard app-defaults files, and does not override resources defined elsewhere */ - CONST char *data_dir; + const char *data_dir; char *path; XrmDatabase db = XtDatabase (dpy); /* #### XtScreenDatabase(dpy) ? */ - CONST char *locale = XrmLocaleOfDatabase (db); + const char *locale = XrmLocaleOfDatabase (db); if (STRINGP (Vx_app_defaults_directory) && XSTRING_LENGTH (Vx_app_defaults_directory) > 0) { - GET_C_STRING_FILENAME_DATA_ALLOCA(Vx_app_defaults_directory, data_dir); + TO_EXTERNAL_FORMAT (LISP_STRING, Vx_app_defaults_directory, + C_STRING_ALLOCA, data_dir, + Qfile_name); path = (char *)alloca (strlen (data_dir) + strlen (locale) + 7); sprintf (path, "%s%s/Emacs", data_dir, locale); if (!access (path, R_OK)) @@ -545,7 +627,9 @@ } else if (STRINGP (Vdata_directory) && XSTRING_LENGTH (Vdata_directory) > 0) { - GET_C_STRING_FILENAME_DATA_ALLOCA (Vdata_directory, data_dir); + TO_EXTERNAL_FORMAT (LISP_STRING, Vdata_directory, + C_STRING_ALLOCA, data_dir, + Qfile_name); path = (char *)alloca (strlen (data_dir) + 13 + strlen (locale) + 7); sprintf (path, "%sapp-defaults/%s/Emacs", data_dir, locale); if (!access (path, R_OK)) @@ -566,8 +650,10 @@ XtGetApplicationNameAndClass (dpy, (char **) &app_name, (char **) &app_class); /* search for a matching visual if requested by the user, or setup the display default */ { - char *buf1 = (char *)alloca (strlen (app_name) + 17); - char *buf2 = (char *)alloca (strlen (app_class) + 17); + int resource_name_length = max (sizeof (".emacsVisual"), + sizeof (".privateColormap")); + char *buf1 = alloca_array (char, strlen (app_name) + resource_name_length); + char *buf2 = alloca_array (char, strlen (app_class) + resource_name_length); char *type; XrmValue value; @@ -575,13 +661,14 @@ sprintf (buf2, "%s.EmacsVisual", app_class); if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True) { - int cnt = 0, vis_class = PseudoColor; + int cnt = 0; + int vis_class = PseudoColor; XVisualInfo vinfo; - char *res, *str = (char*)value.addr; + char *str = (char*) value.addr; -#define CHECK_VIS_CLASS(class) \ - else if (strncmp (str, #class, sizeof (#class) - 1) == 0) \ - cnt = sizeof (#class) - 1, vis_class = class +#define CHECK_VIS_CLASS(visual_class) \ + else if (memcmp (str, #visual_class, sizeof (#visual_class) - 1) == 0) \ + cnt = sizeof (#visual_class) - 1, vis_class = visual_class if (1) ; @@ -594,8 +681,7 @@ if (cnt) { - res = str + cnt; - depth = atoi (res); + depth = atoi (str + cnt); if (depth == 0) { stderr_out ("Invalid Depth specification in %s... ignoring...\n", str); @@ -653,7 +739,7 @@ else { /* We have to create a matching colormap anyway... - ### think about using standard colormaps (need the Xmu libs?) */ + #### think about using standard colormaps (need the Xmu libs?) */ cmap = XCreateColormap(dpy, RootWindow(dpy, screen), visual, AllocNone); XInstallColormap(dpy, cmap); } @@ -696,7 +782,7 @@ XtRealizeWidget (app_shell); } -#ifdef HAVE_SESSION +#ifdef HAVE_WMCOMMAND { int new_argc; char **new_argv; @@ -704,7 +790,7 @@ XSetCommand (XtDisplay (app_shell), XtWindow (app_shell), new_argv, new_argc); free_argc_argv (new_argv); } -#endif /* HAVE_SESSION */ +#endif /* HAVE_WMCOMMAND */ #ifdef HAVE_OFFIX_DND @@ -728,7 +814,7 @@ DEVICE_X_GC_CACHE (d) = make_gc_cache (dpy, XtWindow(app_shell)); DEVICE_X_GRAY_PIXMAP (d) = None; Xatoms_of_device_x (d); - Xatoms_of_xselect (d); + Xatoms_of_select_x (d); Xatoms_of_objects_x (d); x_init_device_class (d); @@ -743,10 +829,10 @@ } static void -x_mark_device (struct device *d, void (*markobj) (Lisp_Object)) +x_mark_device (struct device *d) { - markobj (DEVICE_X_WM_COMMAND_FRAME (d)); - markobj (DEVICE_X_DATA (d)->x_keysym_map_hash_table); + mark_object (DEVICE_X_WM_COMMAND_FRAME (d)); + mark_object (DEVICE_X_DATA (d)->x_keysym_map_hash_table); } @@ -827,10 +913,10 @@ /* handle X errors */ /************************************************************************/ -CONST char * +const char * x_event_name (int event_type) { - static CONST char *events[] = + static const char *events[] = { "0: ERROR!", "1: REPLY", @@ -1335,7 +1421,7 @@ found. If the third arg is `string', a string is returned, and if it is `integer', an integer is returned. If the third arg is `boolean', then the returned value is the list (t) for true, (nil) for false, and is nil to -mean ``unspecified.'' +mean ``unspecified''. */ (name, class, type, locale, device, no_error)) { @@ -1598,17 +1684,19 @@ */ (keysym)) { - CONST char *keysym_ext; + const char *keysym_ext; CHECK_STRING (keysym); - GET_C_STRING_CTEXT_DATA_ALLOCA (keysym, keysym_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, keysym, + C_STRING_ALLOCA, keysym_ext, + Qctext); return XStringToKeysym (keysym_ext) ? Qt : Qnil; } DEFUN ("x-keysym-hash-table", Fx_keysym_hash_table, 0, 1, 0, /* -Return a hash table which contains a hash key for all keysyms which -name keys on the keyboard. See `x-keysym-on-keyboard-p'. +Return a hash table containing a key for all keysyms on DEVICE. +DEVICE must be an X11 display device. See `x-keysym-on-keyboard-p'. */ (device)) { @@ -1750,7 +1838,7 @@ So long as the keyboard is grabbed, all keyboard events will be delivered to emacs -- it is not possible for other X clients to eavesdrop on them. Ungrab the keyboard with `x-ungrab-keyboard' (use an unwind-protect). -Returns t if the grab was successful; nil otherwise. +Returns t if the grab is successful, nil otherwise. */ (device)) { @@ -1802,15 +1890,16 @@ { Display *dpy = get_x_display (device); int ndirs_return; - CONST char **directories = (CONST char **) XGetFontPath (dpy, &ndirs_return); + const char **directories = (const char **) XGetFontPath (dpy, &ndirs_return); Lisp_Object font_path = Qnil; if (!directories) signal_simple_error ("Can't get X font path", device); while (ndirs_return--) - font_path = Fcons (build_ext_string (directories[ndirs_return], - FORMAT_FILENAME), font_path); + font_path = Fcons (build_ext_string (directories[ndirs_return], + Qfile_name), + font_path); return font_path; } @@ -1833,7 +1922,7 @@ { Display *dpy = get_x_display (device); Lisp_Object path_entry; - CONST char **directories; + const char **directories; int i=0,ndirs=0; EXTERNAL_LIST_LOOP (path_entry, font_path) @@ -1842,11 +1931,13 @@ ndirs++; } - directories = alloca_array (CONST char *, ndirs); + directories = alloca_array (const char *, ndirs); EXTERNAL_LIST_LOOP (path_entry, font_path) { - GET_C_STRING_FILENAME_DATA_ALLOCA (XCAR (path_entry), directories[i++]); + TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (path_entry), + C_STRING_ALLOCA, directories[i++], + Qfile_name); } expect_x_error (dpy); @@ -1893,29 +1984,43 @@ } void +reinit_console_type_create_device_x (void) +{ + /* Initialize variables to speed up X resource interactions */ + const char *valid_resource_chars = + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"; + while (*valid_resource_chars) + valid_resource_char_p[(unsigned int) (*valid_resource_chars++)] = 1; + + name_char_dynarr = Dynarr_new (char); + class_char_dynarr = Dynarr_new (char); +} + +void console_type_create_device_x (void) { + reinit_console_type_create_device_x (); CONSOLE_HAS_METHOD (x, init_device); CONSOLE_HAS_METHOD (x, finish_init_device); CONSOLE_HAS_METHOD (x, mark_device); CONSOLE_HAS_METHOD (x, delete_device); CONSOLE_HAS_METHOD (x, device_system_metrics); +} - { - /* Initialize variables to speed up X resource interactions */ - CONST char *valid_resource_chars = - "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"; - while (*valid_resource_chars) - valid_resource_char_p[(unsigned int) (*valid_resource_chars++)] = 1; +void +reinit_vars_of_device_x (void) +{ + error_expected = 0; + error_occurred = 0; - name_char_dynarr = Dynarr_new (char); - class_char_dynarr = Dynarr_new (char); - } + in_resource_setting = 0; } void vars_of_device_x (void) { + reinit_vars_of_device_x (); + DEFVAR_LISP ("x-emacs-application-class", &Vx_emacs_application_class /* The X application class of the XEmacs process. This controls, among other things, the name of the `app-defaults' file @@ -1958,9 +2063,4 @@ staticpro (&Vdefault_x_device); Vdefault_x_device = Qnil; - - error_expected = 0; - error_occurred = 0; - - in_resource_setting = 0; } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/device.c --- a/src/device.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/device.c Mon Aug 13 11:13:30 2007 +0200 @@ -68,46 +68,45 @@ Qfont_menubar, Qfont_dialog, Qsize_cursor, Qsize_scrollbar, Qsize_menu, Qsize_toolbar, Qsize_toolbar_button, Qsize_toolbar_border, Qsize_icon, Qsize_icon_small, Qsize_device, - Qsize_workspace, Qsize_device_mm, Qdevice_dpi, Qnum_bit_planes, - Qnum_color_cells, Qmouse_buttons, Qswap_buttons, Qshow_sounds, - Qslow_device, Qsecurity; + Qsize_workspace, Qoffset_workspace, Qsize_device_mm, Qdevice_dpi, + Qnum_bit_planes, Qnum_color_cells, Qmouse_buttons, Qswap_buttons, + Qshow_sounds, Qslow_device, Qsecurity; Lisp_Object Qdevicep, Qdevice_live_p; -Lisp_Object Qdelete_device; Lisp_Object Qcreate_device_hook; Lisp_Object Qdelete_device_hook; Lisp_Object Vdevice_class_list; static Lisp_Object -mark_device (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_device (Lisp_Object obj) { struct device *d = XDEVICE (obj); - markobj (d->name); - markobj (d->connection); - markobj (d->canon_connection); - markobj (d->console); - markobj (d->selected_frame); - markobj (d->frame_with_focus_real); - markobj (d->frame_with_focus_for_hooks); - markobj (d->frame_that_ought_to_have_focus); - markobj (d->device_class); - markobj (d->user_defined_tags); - markobj (d->pixel_to_glyph_cache.obj1); - markobj (d->pixel_to_glyph_cache.obj2); + mark_object (d->name); + mark_object (d->connection); + mark_object (d->canon_connection); + mark_object (d->console); + mark_object (d->selected_frame); + mark_object (d->frame_with_focus_real); + mark_object (d->frame_with_focus_for_hooks); + mark_object (d->frame_that_ought_to_have_focus); + mark_object (d->device_class); + mark_object (d->user_defined_tags); + mark_object (d->pixel_to_glyph_cache.obj1); + mark_object (d->pixel_to_glyph_cache.obj2); - markobj (d->color_instance_cache); - markobj (d->font_instance_cache); + mark_object (d->color_instance_cache); + mark_object (d->font_instance_cache); #ifdef MULE - markobj (d->charset_font_cache); + mark_object (d->charset_font_cache); #endif - markobj (d->image_instance_cache); + mark_object (d->image_instance_cache); if (d->devmeths) { - markobj (d->devmeths->symbol); - MAYBE_DEVMETH (d, mark_device, (d, markobj)); + mark_object (d->devmeths->symbol); + MAYBE_DEVMETH (d, mark_device, (d)); } return (d->frame_list); @@ -126,7 +125,7 @@ sprintf (buf, "#<%s-device", !DEVICE_LIVE_P (d) ? "dead" : DEVICE_TYPE_NAME (d)); write_c_string (buf, printcharfun); - if (DEVICE_LIVE_P (d)) + if (DEVICE_LIVE_P (d) && !NILP (DEVICE_CONNECTION (d))) { write_c_string (" on ", printcharfun); print_internal (DEVICE_CONNECTION (d), printcharfun, 1); @@ -136,7 +135,7 @@ } DEFINE_LRECORD_IMPLEMENTATION ("device", device, - mark_device, print_device, 0, 0, 0, + mark_device, print_device, 0, 0, 0, 0, struct device); int @@ -166,7 +165,7 @@ allocate_device (Lisp_Object console) { Lisp_Object device; - struct device *d = alloc_lcrecord_type (struct device, lrecord_device); + struct device *d = alloc_lcrecord_type (struct device, &lrecord_device); struct gcpro gcpro1; zero_lcrecord (d); @@ -387,16 +386,24 @@ semi_canonicalize_device_connection (struct console_methods *meths, Lisp_Object name, Error_behavior errb) { - return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_device_connection, - (name, errb), name); + if (HAS_CONTYPE_METH_P (meths, semi_canonicalize_device_connection)) + return CONTYPE_METH (meths, semi_canonicalize_device_connection, + (name, errb)); + else + return CONTYPE_METH_OR_GIVEN (meths, canonicalize_device_connection, + (name, errb), name); } static Lisp_Object canonicalize_device_connection (struct console_methods *meths, Lisp_Object name, Error_behavior errb) { - return CONTYPE_METH_OR_GIVEN (meths, canonicalize_device_connection, - (name, errb), name); + if (HAS_CONTYPE_METH_P (meths, canonicalize_device_connection)) + return CONTYPE_METH (meths, canonicalize_device_connection, + (name, errb)); + else + return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_device_connection, + (name, errb), name); } static Lisp_Object @@ -912,6 +919,15 @@ return make_int (DEVICE_BAUD_RATE (decode_device (device))); } +DEFUN ("device-printer-p", Fdevice_printer_p, 0, 1, 0, /* +Return t if DEVICE is a printer, nil if it is a display. DEVICE defaults +to selected device if omitted, and must be live if specified. +*/ + (device)) +{ + return DEVICE_PRINTER_P (decode_device (device)) ? Qt : Qnil; +} + DEFUN ("device-system-metric", Fdevice_system_metric, 1, 3, 0, /* Get a metric for DEVICE as provided by the system. @@ -967,11 +983,14 @@ size-toolbar-border Toolbar border width and height. size-icon Icon dimensions. size-icon-small Small icon dimensions. -size-device Device screen size in pixels. -size-workspace Workspace size in pixels. This can be less than the - above if window manager has decorations which - effectively shrink the area remaining for application - windows. +size-device Device screen or paper size in pixels. +size-workspace Workspace size in pixels. This can be less than or + equal to the above. For diplays, this is the area + available to applications less window manager + decorations. For printers, this is the size of + printable area. +offset-workspace Offset of workspace area from the top left corner + of screen or paper. size-device-mm Device screen size in millimeters. device-dpi Device resolution, in dots per inch. num-bit-planes Integer, number of device bit planes. @@ -1028,6 +1047,7 @@ FROB (size_icon_small); FROB (size_device); FROB (size_workspace); + FROB (offset_workspace); FROB (size_device_mm); FROB (device_dpi); FROB (num_bit_planes); @@ -1090,6 +1110,7 @@ FROB (size_icon_small); FROB (size_device); FROB (size_workspace); + FROB (offset_workspace); FROB (size_device_mm); FROB (device_dpi); FROB (num_bit_planes); @@ -1247,10 +1268,10 @@ DEFSUBR (Fset_device_baud_rate); DEFSUBR (Fdevice_baud_rate); DEFSUBR (Fdomain_device_type); + DEFSUBR (Fdevice_printer_p); defsymbol (&Qdevicep, "devicep"); defsymbol (&Qdevice_live_p, "device-live-p"); - defsymbol (&Qdelete_device, "delete-device"); defsymbol (&Qcreate_device_hook, "create-device-hook"); defsymbol (&Qdelete_device_hook, "delete-device-hook"); @@ -1287,6 +1308,7 @@ defsymbol (&Qsize_icon_small, "size-icon-small"); defsymbol (&Qsize_device, "size-device"); defsymbol (&Qsize_workspace, "size-workspace"); + defsymbol (&Qoffset_workspace, "offset-workspace"); defsymbol (&Qsize_device_mm, "size-device-mm"); defsymbol (&Qnum_bit_planes, "num-bit-planes"); defsymbol (&Qnum_color_cells, "num-color-cells"); @@ -1299,8 +1321,18 @@ } void +reinit_vars_of_device (void) +{ + staticpro_nodump (&Vdefault_device); + Vdefault_device = Qnil; + asynch_device_change_pending = 0; +} + +void vars_of_device (void) { + reinit_vars_of_device (); + DEFVAR_LISP ("create-device-hook", &Vcreate_device_hook /* Function or functions to call when a device is created. One argument, the newly-created device. @@ -1316,11 +1348,6 @@ */ ); Vdelete_device_hook = Qnil; - staticpro (&Vdefault_device); - Vdefault_device = Qnil; - - asynch_device_change_pending = 0; - Vdevice_class_list = list3 (Qcolor, Qgrayscale, Qmono); staticpro (&Vdevice_class_list); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/device.h --- a/src/device.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/device.h Mon Aug 13 11:13:30 2007 +0200 @@ -24,8 +24,8 @@ /* Written by Chuck Thompson and Ben Wing. */ -#ifndef _XEMACS_DEVICE_H_ -#define _XEMACS_DEVICE_H_ +#ifndef INCLUDED_device_h_ +#define INCLUDED_device_h_ #include "console.h" @@ -168,11 +168,13 @@ unsigned int frame_changed :1; unsigned int glyphs_changed :1; unsigned int subwindows_changed :1; + unsigned int subwindows_state_changed :1; unsigned int icon_changed :1; unsigned int menubar_changed :1; unsigned int modeline_changed :1; unsigned int point_changed :1; unsigned int size_changed :1; + unsigned int gutter_changed :1; unsigned int toolbar_changed :1; unsigned int windows_changed :1; unsigned int windows_structure_changed :1; @@ -219,7 +221,6 @@ #define XDEVICE(x) XRECORD (x, device, struct device) #define XSETDEVICE(x, p) XSETRECORD (x, p, device) #define DEVICEP(x) RECORDP (x, device) -#define GC_DEVICEP(x) GC_RECORDP (x, device) #define CHECK_DEVICE(x) CHECK_RECORD (x, device) #define CONCHECK_DEVICE(x) CONCHECK_RECORD (x, device) @@ -246,7 +247,7 @@ return d; } # define DEVICE_TYPE_DATA(d, type) \ - ((struct type##_device *) (error_check_device_type (d, Q##type))->device_data) + ((struct type##_device *) error_check_device_type (d, Q##type)->device_data) #else # define DEVICE_TYPE_DATA(d, type) \ ((struct type##_device *) (d)->device_data) @@ -269,6 +270,47 @@ (type##_console_methods->predicate_symbol, x); \ } while (0) +#define DEVICE_DISPLAY_P(dev) \ + (DEVICE_LIVE_P (dev) && \ + (MAYBE_INT_DEVMETH (dev, \ + device_implementation_flags, ()) \ + & XDEVIMPF_IS_A_PRINTER) ? 0 : 1) + +#define CHECK_DISPLAY_DEVICE(dev) \ + do { \ + CHECK_DEVICE (dev); \ + if (!(DEVICEP (dev) \ + && DEVICE_DISPLAY_P (XDEVICE (dev)))) \ + dead_wrong_type_argument (Qdisplay, dev); \ + } while (0) + +#define CONCHECK_DISPLAY_DEVICE(dev) \ + do { \ + CONCHECK_DEVICE (dev); \ + if (!(DEVICEP (dev) \ + && DEVICE_DISPLAY_P (XDEVICE (dev)))) \ + wrong_type_argument (Qdisplay, dev); \ + } while (0) + +#define DEVICE_PRINTER_P(dev) \ + (DEVICE_LIVE_P (dev) && !DEVICE_DISPLAY_P (dev)) + +#define CHECK_PRINTER_DEVICE(dev) \ + do { \ + CHECK_DEVICE (dev); \ + if (!(DEVICEP (dev) \ + && DEVICE_PRINTER_P (XDEVICE (dev)))) \ + dead_wrong_type_argument (Qprinter, dev); \ + } while (0) + +#define CONCHECK_PRINTER_DEVICE(dev) \ + do { \ + CONCHECK_DEVICE (dev); \ + if (!(DEVICEP (dev) \ + && DEVICE_PRINTER_P (XDEVICE (dev)))) \ + wrong_type_argument (Qprinter, dev); \ + } while (0) + /* #### These should be in the device-*.h files but there are too many places where the abstraction is broken. Need to fix. */ @@ -347,9 +389,15 @@ #define MARK_DEVICE_SUBWINDOWS_CHANGED(d) \ ((void) (subwindows_changed = (d)->subwindows_changed = 1)) +#define MARK_DEVICE_SUBWINDOWS_STATE_CHANGED(d) \ + ((void) (subwindows_state_changed = (d)->subwindows_state_changed = 1)) + #define MARK_DEVICE_TOOLBARS_CHANGED(d) \ ((void) (toolbar_changed = (d)->toolbar_changed = 1)) +#define MARK_DEVICE_GUTTERS_CHANGED(d) \ + ((void) (gutter_changed = (d)->gutter_changed = 1)) + #define MARK_DEVICE_SIZE_CHANGED(d) \ ((void) (size_changed = (d)->size_changed = 1)) @@ -361,6 +409,14 @@ MARK_DEVICE_FACES_CHANGED (mdffc_d); \ } while (0) +#define MARK_DEVICE_FRAMES_GLYPHS_CHANGED(d) do { \ + struct device *mdffc_d = (d); \ + Lisp_Object frmcons; \ + DEVICE_FRAME_LOOP (frmcons, mdffc_d) \ + XFRAME (XCAR (frmcons))->glyphs_changed = 1; \ + MARK_DEVICE_GLYPHS_CHANGED (mdffc_d); \ +} while (0) + #define MARK_DEVICE_FRAME_CHANGED(d) \ ((void) (frame_changed = (d)->frame_changed = 1)) @@ -405,4 +461,4 @@ Lisp_Object domain_device_type (Lisp_Object domain); int window_system_pixelated_geometry (Lisp_Object domain); -#endif /* _XEMACS_DEVICE_H_ */ +#endif /* INCLUDED_device_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/dialog-msw.c --- a/src/dialog-msw.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/dialog-msw.c Mon Aug 13 11:13:30 2007 +0200 @@ -110,12 +110,6 @@ #define ID_ITEM_BIAS 32 -typedef struct gui_item struct_gui_item; -typedef struct -{ - Dynarr_declare (struct gui_item); -} struct_gui_item_dynarr; - /* Dialog procedure */ static BOOL CALLBACK dialog_proc (HWND hwnd, UINT msg, WPARAM w_param, LPARAM l_param) @@ -165,8 +159,9 @@ Charcount length = XSTRING_CHAR_LENGTH (string); LPWSTR uni_string; - GET_C_CHARPTR_EXT_DATA_ALLOCA (XSTRING_DATA (string), - FORMAT_OS, mbcs_string); + TO_EXTERNAL_FORMAT (LISP_STRING, string, + C_STRING_ALLOCA, mbcs_string, + Qnative); uni_string = alloca_array (WCHAR, length + 1); length = MultiByteToWideChar (CP_ACP, 0, mbcs_string, -1, uni_string, sizeof(WCHAR) * (length + 1)); @@ -200,7 +195,7 @@ static void mswindows_popup_dialog_box (struct frame* f, Lisp_Object desc) { - struct_gui_item_dynarr *dialog_items = Dynarr_new (struct_gui_item); + Lisp_Object_dynarr *dialog_items = Dynarr_new (Lisp_Object); unsigned_char_dynarr *template = Dynarr_new (unsigned_char); unsigned int button_row_width = 0; unsigned int text_width, text_height; @@ -223,11 +218,10 @@ { if (!NILP (XCAR (item_cons))) { - struct gui_item gitem; - gui_item_init (&gitem); - gui_parse_item_keywords (XCAR (item_cons), &gitem); + Lisp_Object gitem = gui_parse_item_keywords (XCAR (item_cons)); Dynarr_add (dialog_items, gitem); - button_row_width += button_width (gitem.name) + X_BUTTON_MARGIN; + button_row_width += button_width (XGUI_ITEM (gitem)->name) + + X_BUTTON_MARGIN; } } if (Dynarr_length (dialog_items) == 0) @@ -350,10 +344,11 @@ for (i = 0; i < Dynarr_length (dialog_items); ++i) { - struct gui_item *pgui_item = Dynarr_atp (dialog_items, i); + Lisp_Object* gui_item = Dynarr_atp (dialog_items, i); + Lisp_Gui_Item *pgui_item = XGUI_ITEM (*gui_item); item_tem.style = (WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON - | (gui_item_active_p (pgui_item) ? 0 : WS_DISABLED)); + | (gui_item_active_p (*gui_item) ? 0 : WS_DISABLED)); item_tem.cx = button_width (pgui_item->name); /* Item ids are indices into dialog_items plus offset, to avoid having items by reserved ids (IDOK, IDCANCEL) */ @@ -390,7 +385,7 @@ vector = make_vector (Dynarr_length (dialog_items), Qunbound); dialog_data = Fcons (frame, vector); for (i = 0; i < Dynarr_length (dialog_items); i++) - XVECTOR_DATA (vector) [i] = Dynarr_atp (dialog_items, i)->callback; + XVECTOR_DATA (vector) [i] = XGUI_ITEM (*Dynarr_atp (dialog_items, i))->callback; /* Woof! Everything is ready. Pop pop pop in now! */ if (!CreateDialogIndirectParam (NULL, diff -r f4aeb21a5bad -r 74fd4e045ea6 src/dialog-x.c --- a/src/dialog-x.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/dialog-x.c Mon Aug 13 11:13:30 2007 +0200 @@ -44,7 +44,7 @@ widget_value *wv; int got_some; wv = xmalloc_widget_value (); - wv->name = (char *) "value"; + wv->name = xstrdup ("value"); got_some = lw_get_some_values (id, wv); if (got_some) { @@ -56,10 +56,12 @@ void *tmp = LISP_TO_VOID (list2 (text_field_callback, build_string (text_field_value))); popup_selection_callback (0, id, (XtPointer) tmp); - xfree (text_field_value); } } - free_widget_value (wv); + /* This code tried to optimize, newing/freeing. This is generally + unsafe so we will alwats strdup and always use + free_widget_value_tree. */ + free_widget_value_tree (wv); } static void @@ -100,7 +102,7 @@ lw_set_keyboard_focus (FRAME_X_SHELL_WIDGET (f), FRAME_X_TEXT_WIDGET (f)); } -static CONST char * CONST button_names [] = { +static const char * const button_names [] = { "button1", "button2", "button3", "button4", "button5", "button6", "button7", "button8", "button9", "button10" }; @@ -120,7 +122,7 @@ widget_value *prev = 0, *kids = 0; int n = 0; int count = specpdl_depth (); - Lisp_Object wv_closure; + Lisp_Object wv_closure, gui_item; CHECK_CONS (desc); CHECK_STRING (XCAR (desc)); @@ -144,7 +146,7 @@ wv_closure = make_opaque_ptr (kids); record_unwind_protect (widget_value_unwind, wv_closure); - prev->name = (char *) "message"; + prev->name = xstrdup ("message"); prev->value = xstrdup (name); prev->enabled = 1; @@ -163,9 +165,10 @@ CHECK_VECTOR (button); wv = xmalloc_widget_value (); - if (!button_item_to_widget_value (button, wv, allow_text_p, 1)) + gui_item = gui_parse_item_keywords (button); + if (!button_item_to_widget_value (gui_item, wv, allow_text_p, 1)) { - free_widget_value (wv); + free_widget_value_tree (wv); continue; } @@ -177,8 +180,9 @@ else /* it's a button */ { allow_text_p = 0; /* only allow text field at the front */ - wv->value = xstrdup (wv->name); /* what a mess... */ - wv->name = (char *) button_names [n]; + if (wv->value) xfree (wv->value); + wv->value = wv->name; /* what a mess... */ + wv->name = xstrdup (button_names [n]); if (partition_seen) rbuttons++; @@ -201,7 +205,7 @@ widget_value *dbox; sprintf (tmp_dbox_name, "%c%dBR%d", type, lbuttons + rbuttons, rbuttons); dbox = xmalloc_widget_value (); - dbox->name = tmp_dbox_name; + dbox->name = xstrdup (tmp_dbox_name); dbox->contents = kids; /* No more need to free the half-filled-in structures. */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/dired-msw.c --- a/src/dired-msw.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/dired-msw.c Mon Aug 13 11:13:30 2007 +0200 @@ -75,11 +75,10 @@ #include "buffer.h" #include "regex.h" +#include "sysfile.h" #include "sysdir.h" -#include "sysfile.h" #include "sysproc.h" -#include <windows.h> #include <limits.h> #include <time.h> @@ -319,14 +318,14 @@ cptr[1] = cptr[4] = cptr[7] = 'w'; } if ((file->dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) || - len > 4 && - (_stricmp(&file->cFileName[len - 4], ".exe") == 0 - || _stricmp(&file->cFileName[len - 4], ".com") == 0 - || _stricmp(&file->cFileName[len - 4], ".bat") == 0 + (len > 4 && + (_stricmp(&file->cFileName[len - 4], ".exe") == 0 + || _stricmp(&file->cFileName[len - 4], ".com") == 0 + || _stricmp(&file->cFileName[len - 4], ".bat") == 0 #if 0 - || _stricmp(&file->cFileName[len - 4], ".pif") == 0 + || _stricmp(&file->cFileName[len - 4], ".pif") == 0 #endif - )) + ))) { cptr[2] = cptr[5] = cptr[8] = 'x'; } else { @@ -639,7 +638,7 @@ void vars_of_dired_mswindows (void) { - DEFVAR_BOOL ("mswindows-ls-sort-case-insensitive", &mswindows_ls_sort_case_insensitive, /* + DEFVAR_BOOL ("mswindows-ls-sort-case-insensitive", &mswindows_ls_sort_case_insensitive /* *Non-nil means filenames are sorted in a case-insensitive fashion. Nil means filenames are sorted in a case-sensitive fashion, just like Unix. */ ); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/dired.c --- a/src/dired.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/dired.c Mon Aug 13 11:13:30 2007 +0200 @@ -31,6 +31,7 @@ #include "sysfile.h" #include "sysdir.h" #include "systime.h" +#include "sysdep.h" #include "syspwd.h" Lisp_Object Vcompletion_ignored_extensions; @@ -139,38 +140,15 @@ { if (!NILP (files_only)) { - int dir_p; struct stat st; - char *cur_statbuf = statbuf; - char *cur_statbuf_tail = statbuf_tail; - - /* #### I don't think the code under `if' is necessary - anymore. The crashes in this function were reported - because MAXNAMLEN was used to remember the *whole* - statbuf, instead of using MAXPATHLEN. This should be - tested after 21.0 is released. */ + int dir_p = 0; - /* We normally use the buffer created by alloca. - However, if the file name we get too big, we'll use a - malloced buffer, and free it. It is undefined how - stat() will react to this, but we avoid a buffer - overrun. */ - if (len > MAXNAMLEN) - { - cur_statbuf = (char *)xmalloc (directorylen + len + 1); - memcpy (cur_statbuf, statbuf, directorylen); - cur_statbuf_tail = cur_statbuf + directorylen; - } - memcpy (cur_statbuf_tail, dp->d_name, len); - cur_statbuf_tail[len] = 0; + memcpy (statbuf_tail, dp->d_name, len); + statbuf_tail[len] = 0; - if (stat (cur_statbuf, &st) < 0) - dir_p = 0; - else - dir_p = ((st.st_mode & S_IFMT) == S_IFDIR); - - if (cur_statbuf != statbuf) - xfree (cur_statbuf); + if (stat (statbuf, &st) == 0 + && (st.st_mode & S_IFMT) == S_IFDIR) + dir_p = 1; if (EQ (files_only, Qt) && dir_p) continue; @@ -564,9 +542,7 @@ (user)) { int uniq; - Lisp_Object completed; - - completed = user_name_completion (user, 0, &uniq); + Lisp_Object completed = user_name_completion (user, 0, &uniq); return Fcons (completed, uniq ? Qt : Qnil); } @@ -579,54 +555,57 @@ return user_name_completion (user, 1, NULL); } -static Lisp_Object -user_name_completion_unwind (Lisp_Object locative) +struct user_name { - Lisp_Object obj1 = XCAR (locative); - Lisp_Object obj2 = XCDR (locative); - char **cache; - int clen, i; + Bufbyte *ptr; + size_t len; +}; +struct user_cache +{ + struct user_name *user_names; + int length; + int size; + EMACS_TIME last_rebuild_time; +}; +static struct user_cache user_cache; - if (!NILP (obj1) && !NILP (obj2)) - { - /* clean up if interrupted building cache */ - cache = *(char ***)get_opaque_ptr (obj1); - clen = *(int *)get_opaque_ptr (obj2); - free_opaque_ptr (obj1); - free_opaque_ptr (obj2); - for (i = 0; i < clen; i++) - free (cache[i]); - free (cache); - } +static void +free_user_cache (struct user_cache *cache) +{ + int i; + for (i = 0; i < cache->length; i++) + xfree (cache->user_names[i].ptr); + xfree (cache->user_names); + xzero (*cache); +} - free_cons (XCONS (locative)); +static Lisp_Object +user_name_completion_unwind (Lisp_Object cache_incomplete_p) +{ endpwent (); + speed_up_interrupts (); + + if (! NILP (XCAR (cache_incomplete_p))) + free_user_cache (&user_cache); + + free_cons (XCONS (cache_incomplete_p)); return Qnil; } -static char **user_cache; -static int user_cache_len; -static int user_cache_max; -static long user_cache_time; - -#define USER_CACHE_REBUILD (24*60*60) /* 1 day, in seconds */ +#define USER_CACHE_TTL (24*60*60) /* Time to live: 1 day, in seconds */ static Lisp_Object user_name_completion (Lisp_Object user, int all_flag, int *uniq) { /* This function can GC */ - struct passwd *pw; int matchcount = 0; Lisp_Object bestmatch = Qnil; Charcount bestmatchsize = 0; - int speccount = specpdl_depth (); - int i, cmax, clen; - char **cache; Charcount user_name_length; - Lisp_Object locative; EMACS_TIME t; + int i; struct gcpro gcpro1, gcpro2; GCPRO2 (user, bestmatch); @@ -638,67 +617,49 @@ /* Cache user name lookups because it tends to be quite slow. * Rebuild the cache occasionally to catch changes */ EMACS_GET_TIME (t); - if (user_cache && - EMACS_SECS (t) - user_cache_time > USER_CACHE_REBUILD) + if (user_cache.user_names && + (EMACS_SECS (t) - EMACS_SECS (user_cache.last_rebuild_time) + > USER_CACHE_TTL)) + free_user_cache (&user_cache); + + if (!user_cache.user_names) { - for (i = 0; i < user_cache_len; i++) - free (user_cache[i]); - free (user_cache); - user_cache = NULL; - user_cache_len = 0; - user_cache_max = 0; + struct passwd *pwd; + Lisp_Object cache_incomplete_p = noseeum_cons (Qt, Qnil); + int speccount = specpdl_depth (); + + slow_down_interrupts (); + setpwent (); + record_unwind_protect (user_name_completion_unwind, cache_incomplete_p); + while ((pwd = getpwent ())) + { + QUIT; + DO_REALLOC (user_cache.user_names, user_cache.size, + user_cache.length + 1, struct user_name); + TO_INTERNAL_FORMAT (C_STRING, pwd->pw_name, + MALLOC, + (user_cache.user_names[user_cache.length].ptr, + user_cache.user_names[user_cache.length].len), + Qnative); + user_cache.length++; + } + XCAR (cache_incomplete_p) = Qnil; + unbind_to (speccount, Qnil); + + EMACS_GET_TIME (user_cache.last_rebuild_time); } - if (user_cache == NULL || user_cache_max <= 0) + for (i = 0; i < user_cache.length; i++) { - cmax = 200; - clen = 0; - cache = (char **) malloc (cmax*sizeof (char *)); - - setpwent (); - locative = noseeum_cons (Qnil, Qnil); - XCAR (locative) = make_opaque_ptr ((void *) &cache); - XCDR (locative) = make_opaque_ptr ((void *) &clen); - record_unwind_protect (user_name_completion_unwind, locative); - /* #### may need to slow down interrupts around call to getpwent - * below. at least the call to getpwnam in Fuser_full_name - * is documented as needing it on irix. */ - while ((pw = getpwent ())) - { - if (clen >= cmax) - { - cmax *= 2; - cache = (char **) realloc (cache, cmax*sizeof (char *)); - } - - QUIT; - - cache[clen++] = strdup (pw->pw_name); - } - free_opaque_ptr (XCAR (locative)); - free_opaque_ptr (XCDR (locative)); - XCAR (locative) = Qnil; - XCDR (locative) = Qnil; - - unbind_to (speccount, Qnil); /* free locative cons, endpwent() */ - - user_cache_max = cmax; - user_cache_len = clen; - user_cache = cache; - user_cache_time = EMACS_SECS (t); - } - - for (i = 0; i < user_cache_len; i++) - { - Bufbyte *d_name = (Bufbyte *) user_cache[i]; - Bytecount len = strlen ((char *) d_name); + Bufbyte *u_name = user_cache.user_names[i].ptr; + Bytecount len = user_cache.user_names[i].len; /* scmp() works in chars, not bytes, so we have to compute this: */ - Charcount cclen = bytecount_to_charcount (d_name, len); + Charcount cclen = bytecount_to_charcount (u_name, len); QUIT; - if (cclen < user_name_length || - 0 <= scmp (d_name, XSTRING_DATA (user), user_name_length)) + if (cclen < user_name_length + || 0 <= scmp_1 (u_name, XSTRING_DATA (user), user_name_length, 0)) continue; matchcount++; /* count matching completions */ @@ -709,7 +670,7 @@ struct gcpro ngcpro1; NGCPRO1 (name); /* This is a possible completion */ - name = make_string (d_name, len); + name = make_string (u_name, len); if (all_flag) { bestmatch = Fcons (name, bestmatch); @@ -725,37 +686,11 @@ { Charcount compare = min (bestmatchsize, cclen); Bufbyte *p1 = XSTRING_DATA (bestmatch); - Bufbyte *p2 = d_name; - Charcount matchsize = scmp (p1, p2, compare); + Bufbyte *p2 = u_name; + Charcount matchsize = scmp_1 (p1, p2, compare, 0); if (matchsize < 0) matchsize = compare; - if (completion_ignore_case) - { - /* If this is an exact match except for case, - use it as the best match rather than one that is not - an exact match. This way, we get the case pattern - of the actual match. */ - if ((matchsize == cclen - && matchsize < XSTRING_CHAR_LENGTH (bestmatch)) - || - /* If there is no exact match ignoring case, - prefer a match that does not change the case - of the input. */ - (((matchsize == cclen) - == - (matchsize == XSTRING_CHAR_LENGTH (bestmatch))) - /* If there is more than one exact match aside from - case, and one of them is exact including case, - prefer that one. */ - && 0 > scmp_1 (p2, XSTRING_DATA (user), - user_name_length, 0) - && 0 <= scmp_1 (p1, XSTRING_DATA (user), - user_name_length, 0))) - { - bestmatch = make_string (d_name, len); - } - } bestmatchsize = matchsize; } @@ -776,14 +711,14 @@ Lisp_Object -make_directory_hash_table (CONST char *path) +make_directory_hash_table (const char *path) { DIR *d; - Lisp_Object hash = - make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); if ((d = opendir (path))) { DIRENTRY *dp; + Lisp_Object hash = + make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); while ((dp = readdir (d))) { @@ -793,8 +728,10 @@ Fputhash (make_string ((Bufbyte *) dp->d_name, len), Qt, hash); } closedir (d); + return hash; } - return hash; + else + return Qnil; } Lisp_Object @@ -955,10 +892,4 @@ `file-name-all-completions'. */ ); Vcompletion_ignored_extensions = Qnil; - -#ifndef WINDOWSNT - user_cache = NULL; - user_cache_len = 0; - user_cache_max = 0; -#endif } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/doc.c --- a/src/doc.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/doc.c Mon Aug 13 11:13:30 2007 +0200 @@ -138,7 +138,7 @@ } /* #### mrb: following STILL completely broken */ - return_me = make_ext_string ((Bufbyte *) buffer, to - buffer, FORMAT_BINARY); + return_me = make_ext_string ((Bufbyte *) buffer, to - buffer, Qbinary); done: if (buffer != buf) /* We must have allocated buffer above */ @@ -284,7 +284,7 @@ else if (COMPILED_FUNCTIONP (fun)) { Lisp_Object tem; - struct Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); + Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); if (! (f->flags.documentationp)) return Qnil; tem = compiled_function_documentation (f); @@ -392,7 +392,7 @@ } static void -weird_doc (Lisp_Object sym, CONST char *weirdness, CONST char *type, int pos) +weird_doc (Lisp_Object sym, const char *weirdness, const char *type, int pos) { if (!strcmp (weirdness, GETTEXT ("duplicate"))) return; message ("Note: Strange doc (%s) for %s %s @ %d", @@ -573,8 +573,7 @@ { /* Compiled-Function objects sometimes have slots for it. */ - struct Lisp_Compiled_Function *f = - XCOMPILED_FUNCTION (fun); + Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); /* This compiled-function object must have a slot for the docstring, since we've found a @@ -640,7 +639,7 @@ kludgily_ignore_lost_doc_p (Lisp_Object sym) { # define kludge_prefix "ad-Orig-" - struct Lisp_String *name = XSYMBOL (sym)->name; + Lisp_String *name = XSYMBOL (sym)->name; return (string_length (name) > (Bytecount) (sizeof (kludge_prefix)) && !strncmp ((char *) string_data (name), kludge_prefix, sizeof (kludge_prefix) - 1)); @@ -684,7 +683,7 @@ } else if (COMPILED_FUNCTIONP (fun)) { - struct Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); + Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); if (! (f->flags.documentationp)) doc = -1; else @@ -886,7 +885,7 @@ case '{': case '<': { - /* ### jump to label `subst_string|subst' crosses + /* #### jump to label `subst_string|subst' crosses initialization of `buffer|_buf' */ Lisp_Object buffer; struct buffer *buf_; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/doprnt.c --- a/src/doprnt.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/doprnt.c Mon Aug 13 11:13:30 2007 +0200 @@ -31,13 +31,13 @@ #include "buffer.h" #include "lstream.h" -static CONST char *valid_flags = "-+ #0"; +static const char *valid_flags = "-+ #0"; -static CONST char *valid_converters = "diouxXfeEgGcsS"; -static CONST char *int_converters = "dic"; -static CONST char *unsigned_int_converters = "ouxX"; -static CONST char *double_converters = "feEgG"; -static CONST char *string_converters = "sS"; +static const char *valid_converters = "diouxXfeEgGcsS"; +static const char *int_converters = "dic"; +static const char *unsigned_int_converters = "ouxX"; +static const char *double_converters = "feEgG"; +static const char *string_converters = "sS"; typedef struct printf_spec printf_spec; struct printf_spec @@ -99,7 +99,7 @@ Note that MINLEN and MAXLEN are Charcounts but LEN is a Bytecount. */ static void -doprnt_1 (Lisp_Object stream, CONST Bufbyte *string, Bytecount len, +doprnt_1 (Lisp_Object stream, const Bufbyte *string, Bytecount len, Charcount minlen, Charcount maxlen, int minus_flag, int zero_flag) { Charcount cclen; @@ -140,8 +140,8 @@ } } -static CONST Bufbyte * -parse_off_posnum (CONST Bufbyte *start, CONST Bufbyte *end, int *returned_num) +static const Bufbyte * +parse_off_posnum (const Bufbyte *start, const Bufbyte *end, int *returned_num) { Bufbyte arg_convert[100]; REGISTER Bufbyte *arg_ptr = arg_convert; @@ -178,17 +178,17 @@ } while (0) static printf_spec_dynarr * -parse_doprnt_spec (CONST Bufbyte *format, Bytecount format_length) +parse_doprnt_spec (const Bufbyte *format, Bytecount format_length) { - CONST Bufbyte *fmt = format; - CONST Bufbyte *fmt_end = format + format_length; + const Bufbyte *fmt = format; + const Bufbyte *fmt_end = format + format_length; printf_spec_dynarr *specs = Dynarr_new (printf_spec); int prev_argnum = 0; while (1) { struct printf_spec spec; - CONST Bufbyte *text_end; + const Bufbyte *text_end; Bufbyte ch; xzero (spec); @@ -216,7 +216,7 @@ /* Is there a field number specifier? */ { - CONST Bufbyte *ptr; + const Bufbyte *ptr; int fieldspec; ptr = parse_off_posnum (fmt, fmt_end, &fieldspec); @@ -386,7 +386,7 @@ if (strchr (int_converters, ch)) { if (spec->h_flag) - arg.i = va_arg (vargs, short); + arg.i = va_arg (vargs, int /* short */); else if (spec->l_flag) arg.l = va_arg (vargs, long); else @@ -395,7 +395,7 @@ else if (strchr (unsigned_int_converters, ch)) { if (spec->h_flag) - arg.ui = va_arg (vargs, unsigned short); + arg.ui = va_arg (vargs, unsigned int /* unsigned short */); else if (spec->l_flag) arg.ul = va_arg (vargs, unsigned long); else @@ -423,11 +423,11 @@ to the arguments. */ static Bytecount -emacs_doprnt_1 (Lisp_Object stream, CONST Bufbyte *format_nonreloc, +emacs_doprnt_1 (Lisp_Object stream, const Bufbyte *format_nonreloc, Lisp_Object format_reloc, Bytecount format_length, int nargs, /* #### Gag me, gag me, gag me */ - CONST Lisp_Object *largs, va_list vargs) + const Lisp_Object *largs, va_list vargs) { printf_spec_dynarr *specs = 0; printf_arg_dynarr *args = 0; @@ -440,7 +440,7 @@ format_length = XSTRING_LENGTH (format_reloc); } if (format_length < 0) - format_length = (Bytecount) strlen ((CONST char *) format_nonreloc); + format_length = (Bytecount) strlen ((const char *) format_nonreloc); specs = parse_doprnt_spec (format_nonreloc, format_length); if (largs) @@ -538,7 +538,7 @@ else { Lisp_Object obj = largs[spec->argnum - 1]; - struct Lisp_String *ls; + Lisp_String *ls; if (ch == 'S') { @@ -697,9 +697,9 @@ /* You really don't want to know why this is necessary... */ static Bytecount -emacs_doprnt_2 (Lisp_Object stream, CONST Bufbyte *format_nonreloc, +emacs_doprnt_2 (Lisp_Object stream, const Bufbyte *format_nonreloc, Lisp_Object format_reloc, Bytecount format_length, int nargs, - CONST Lisp_Object *largs, ...) + const Lisp_Object *largs, ...) { va_list vargs; Bytecount val; @@ -732,7 +732,7 @@ parameter, because this function can cause GC. */ Bytecount -emacs_doprnt_c (Lisp_Object stream, CONST Bufbyte *format_nonreloc, +emacs_doprnt_c (Lisp_Object stream, const Bufbyte *format_nonreloc, Lisp_Object format_reloc, Bytecount format_length, ...) { @@ -749,7 +749,7 @@ /* Like emacs_doprnt_c but the args come in va_list format. */ Bytecount -emacs_doprnt_va (Lisp_Object stream, CONST Bufbyte *format_nonreloc, +emacs_doprnt_va (Lisp_Object stream, const Bufbyte *format_nonreloc, Lisp_Object format_reloc, Bytecount format_length, va_list vargs) { @@ -763,9 +763,9 @@ See `format' for a description of this behavior. */ Bytecount -emacs_doprnt_lisp (Lisp_Object stream, CONST Bufbyte *format_nonreloc, +emacs_doprnt_lisp (Lisp_Object stream, const Bufbyte *format_nonreloc, Lisp_Object format_reloc, Bytecount format_length, - int nargs, CONST Lisp_Object *largs) + int nargs, const Lisp_Object *largs) { return emacs_doprnt_2 (stream, format_nonreloc, format_reloc, format_length, nargs, largs); @@ -774,7 +774,7 @@ /* Like the previous function but takes a variable number of arguments. */ Bytecount -emacs_doprnt_lisp_2 (Lisp_Object stream, CONST Bufbyte *format_nonreloc, +emacs_doprnt_lisp_2 (Lisp_Object stream, const Bufbyte *format_nonreloc, Lisp_Object format_reloc, Bytecount format_length, int nargs, ...) { @@ -796,7 +796,7 @@ to a stream. */ Lisp_Object -emacs_doprnt_string_c (CONST Bufbyte *format_nonreloc, +emacs_doprnt_string_c (const Bufbyte *format_nonreloc, Lisp_Object format_reloc, Bytecount format_length, ...) { @@ -819,7 +819,7 @@ } Lisp_Object -emacs_doprnt_string_va (CONST Bufbyte *format_nonreloc, +emacs_doprnt_string_va (const Bufbyte *format_nonreloc, Lisp_Object format_reloc, Bytecount format_length, va_list vargs) { @@ -842,9 +842,9 @@ } Lisp_Object -emacs_doprnt_string_lisp (CONST Bufbyte *format_nonreloc, +emacs_doprnt_string_lisp (const Bufbyte *format_nonreloc, Lisp_Object format_reloc, Bytecount format_length, - int nargs, CONST Lisp_Object *largs) + int nargs, const Lisp_Object *largs) { Lisp_Object obj; Lisp_Object stream = make_resizing_buffer_output_stream (); @@ -862,7 +862,7 @@ } Lisp_Object -emacs_doprnt_string_lisp_2 (CONST Bufbyte *format_nonreloc, +emacs_doprnt_string_lisp_2 (const Bufbyte *format_nonreloc, Lisp_Object format_reloc, Bytecount format_length, int nargs, ...) { diff -r f4aeb21a5bad -r 74fd4e045ea6 src/dragdrop.h --- a/src/dragdrop.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/dragdrop.h Mon Aug 13 11:13:30 2007 +0200 @@ -21,8 +21,8 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_DRAGDROP_H_ -#define _XEMACS_DRAGDROP_H_ +#ifndef INCLUDED_dragdrop_h_ +#define INCLUDED_dragdrop_h_ /* Drag'n'Drop data types known by XEmacs */ extern Lisp_Object Qdragdrop_MIME; @@ -37,4 +37,4 @@ /* emacs interface */ void syms_of_dragdrop (void); -#endif /* _XEMACS_DRAGDROP_H_ */ +#endif /* INCLUDED_dragdrop_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/dynarr.c --- a/src/dynarr.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/dynarr.c Mon Aug 13 11:13:30 2007 +0200 @@ -101,15 +101,27 @@ Use the following global variable: Dynarr_min_size - Minimum allowable size for a dynamic array when it is resized. The - default is 32 and does not normally need to be changed. + Minimum allowable size for a dynamic array when it is resized. */ #include <config.h> #include "lisp.h" -int Dynarr_min_size = 1; +static int Dynarr_min_size = 8; + +static void +Dynarr_realloc (Dynarr *dy, int new_size) +{ + if (DUMPEDP (dy->base)) + { + void *new_base = malloc (new_size); + memcpy (new_base, dy->base, dy->max > new_size ? new_size : dy->max); + dy->base = new_base; + } + else + dy->base = xrealloc (dy->base, new_size); +} void * Dynarr_newf (int elsize) @@ -138,14 +150,14 @@ /* Don't do anything if the array is already big enough. */ if (newsize > dy->max) { - dy->base = xrealloc (dy->base, newsize*dy->elsize); + Dynarr_realloc (dy, newsize*dy->elsize); dy->max = newsize; } } /* Add a number of contiguous elements to the array starting at START. */ void -Dynarr_insert_many (void *d, CONST void *el, int len, int start) +Dynarr_insert_many (void *d, const void *el, int len, int start) { Dynarr *dy = (Dynarr *) d; @@ -186,9 +198,10 @@ { Dynarr *dy = (Dynarr *) d; - if (dy->base) + if (dy->base && !DUMPEDP (dy->base)) xfree (dy->base); - xfree (dy); + if(!DUMPEDP (dy)) + xfree (dy); } #ifdef MEMORY_USAGE_STATS diff -r f4aeb21a5bad -r 74fd4e045ea6 src/editfns.c --- a/src/editfns.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/editfns.c Mon Aug 13 11:13:30 2007 +0200 @@ -45,6 +45,7 @@ #include "systime.h" #include "sysdep.h" #include "syspwd.h" +#include "sysfile.h" /* for getcwd */ /* Some static data, and a function to initialize it for each run */ @@ -65,8 +66,6 @@ Lisp_Object Vuser_full_name; EXFUN (Fuser_full_name, 1); -char *get_system_name (void); - Lisp_Object Qformat; Lisp_Object Qpoint, Qmark, Qregion_beginning, Qregion_end; @@ -97,7 +96,7 @@ if ((p = getenv ("NAME"))) /* I don't think it's the right thing to do the ampersand modification on NAME. Not that it matters anymore... -hniksic */ - Vuser_full_name = build_ext_string (p, FORMAT_OS); + Vuser_full_name = build_ext_string (p, Qnative); else Vuser_full_name = Fuser_full_name (Qnil); } @@ -132,7 +131,7 @@ */ (str)) { - struct Lisp_String *p; + Lisp_String *p; CHECK_STRING (str); p = XSTRING (str); @@ -441,7 +440,8 @@ DEFUN ("point-min", Fpoint_min, 0, 1, 0, /* Return the minimum permissible value of point in BUFFER. -This is 1, unless narrowing (a buffer restriction) is in effect. +This is 1, unless narrowing (a buffer restriction) +is in effect, in which case it may be greater. If BUFFER is nil, the current buffer is assumed. */ (buffer)) @@ -452,7 +452,8 @@ DEFUN ("point-min-marker", Fpoint_min_marker, 0, 1, 0, /* Return a marker to the minimum permissible value of point in BUFFER. -This is the beginning, unless narrowing (a buffer restriction) is in effect. +This is the beginning, unless narrowing (a buffer restriction) +is in effect, in which case it may be greater. If BUFFER is nil, the current buffer is assumed. */ (buffer)) @@ -464,7 +465,7 @@ DEFUN ("point-max", Fpoint_max, 0, 1, 0, /* Return the maximum permissible value of point in BUFFER. This is (1+ (buffer-size)), unless narrowing (a buffer restriction) -is in effect, in which case it is less. +is in effect, in which case it may be less. If BUFFER is nil, the current buffer is assumed. */ (buffer)) @@ -474,9 +475,9 @@ } DEFUN ("point-max-marker", Fpoint_max_marker, 0, 1, 0, /* -Return a marker to the maximum permissible value of point BUFFER. +Return a marker to the maximum permissible value of point in BUFFER. This is (1+ (buffer-size)), unless narrowing (a buffer restriction) -is in effect, in which case it is less. +is in effect, in which case it may be less. If BUFFER is nil, the current buffer is assumed. */ (buffer)) @@ -565,11 +566,11 @@ } DEFUN ("char-after", Fchar_after, 0, 2, 0, /* -Return character in BUFFER at position POS. -POS is an integer or a buffer pointer. +Return the character at position POS in BUFFER. +POS is an integer or a marker. If POS is out of range, the value is nil. +if POS is nil, the value of point is assumed. If BUFFER is nil, the current buffer is assumed. -if POS is nil, the value of point is assumed. */ (pos, buffer)) { @@ -583,17 +584,17 @@ } DEFUN ("char-before", Fchar_before, 0, 2, 0, /* -Return character in BUFFER before position POS. -POS is an integer or a buffer pointer. +Return the character preceding position POS in BUFFER. +POS is an integer or a marker. If POS is out of range, the value is nil. +if POS is nil, the value of point is assumed. If BUFFER is nil, the current buffer is assumed. -if POS is nil, the value of point is assumed. */ (pos, buffer)) { struct buffer *b = decode_buffer (buffer, 1); - Bufpos n = ((NILP (pos) ? BUF_PT (b) : - get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD))); + Bufpos n = (NILP (pos) ? BUF_PT (b) : + get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD)); n--; @@ -624,7 +625,7 @@ tmpdir = "/tmp"; #endif - return build_ext_string (tmpdir, FORMAT_FILENAME); + return build_ext_string (tmpdir, Qfile_name); } DEFUN ("user-login-name", Fuser_login_name, 0, 1, 0, /* @@ -638,17 +639,17 @@ (uid)) { char *returned_name; - int local_uid; + uid_t local_uid; if (!NILP (uid)) { CHECK_INT (uid); - local_uid = XINT(uid); - returned_name = user_login_name(&local_uid); + local_uid = XINT (uid); + returned_name = user_login_name (&local_uid); } else { - returned_name = user_login_name(NULL); + returned_name = user_login_name (NULL); } /* #### - I believe this should return nil instead of "unknown" when pw==0 pw=0 is indicated by a null return from user_login_name @@ -664,14 +665,12 @@ corresponds to a nil argument to Fuser_login_name. */ char* -user_login_name (int *uid) +user_login_name (uid_t *uid) { - struct passwd *pw = NULL; - /* uid == NULL to return name of this user */ if (uid != NULL) { - pw = getpwuid (*uid); + struct passwd *pw = getpwuid (*uid); return pw ? pw->pw_name : NULL; } else @@ -692,7 +691,7 @@ return (user_name); else { - pw = getpwuid (geteuid ()); + struct passwd *pw = getpwuid (geteuid ()); #ifdef __CYGWIN32__ /* Since the Cygwin environment may not have an /etc/passwd, return "unknown" instead of the null if the username @@ -765,11 +764,13 @@ user_name = (STRINGP (user) ? user : Fuser_login_name (user)); if (!NILP (user_name)) /* nil when nonexistent UID passed as arg */ { - CONST char *user_name_ext; + const char *user_name_ext; /* Fuck me. getpwnam() can call select() and (under IRIX at least) things get wedged if a SIGIO arrives during this time. */ - GET_C_STRING_OS_DATA_ALLOCA (user_name, user_name_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, user_name, + C_STRING_ALLOCA, user_name_ext, + Qnative); slow_down_interrupts (); pw = (struct passwd *) getpwnam (user_name_ext); speed_up_interrupts (); @@ -787,7 +788,7 @@ tem = ((!NILP (user) && !pw) ? Qnil : make_ext_string ((Extbyte *) p, (q ? q - p : strlen (p)), - FORMAT_OS)); + Qnative)); #ifdef AMPERSAND_FULL_NAME if (!NILP (tem)) @@ -812,7 +813,7 @@ return tem; } -static char *cached_home_directory; +static Extbyte *cached_home_directory; void uncache_home_directory (void) @@ -822,24 +823,27 @@ } /* Returns the home directory, in external format */ -char * +Extbyte * get_home_directory (void) { int output_home_warning = 0; if (cached_home_directory == NULL) { - if ((cached_home_directory = getenv("HOME")) == NULL) + if ((cached_home_directory = (Extbyte *) getenv("HOME")) == NULL) { #if defined(WINDOWSNT) && !defined(__CYGWIN32__) - char *homedrive, *homepath; + char *homedrive, *homepath; if ((homedrive = getenv("HOMEDRIVE")) != NULL && (homepath = getenv("HOMEPATH")) != NULL) { cached_home_directory = - (char *) xmalloc(strlen(homedrive) + strlen(homepath) + 1); - sprintf(cached_home_directory, "%s%s", homedrive, homepath); + (Extbyte *) xmalloc (strlen (homedrive) + + strlen (homepath) + 1); + sprintf((char *) cached_home_directory, "%s%s", + homedrive, + homepath); } else { @@ -862,7 +866,7 @@ /* * This is NT Emacs behavior */ - cached_home_directory = "C:\\"; + cached_home_directory = (Extbyte *) "C:\\"; output_home_warning = 1; # endif } @@ -873,7 +877,7 @@ * We probably should try to extract pw_dir from /etc/passwd, * before falling back to this. */ - cached_home_directory = "/"; + cached_home_directory = (Extbyte *) "/"; output_home_warning = 1; #endif /* !WINDOWSNT */ } @@ -896,11 +900,11 @@ */ ()) { - char *path = get_home_directory (); + Extbyte *path = get_home_directory (); return path == NULL ? Qnil : Fexpand_file_name (Fsubstitute_in_file_name - (build_ext_string (path, FORMAT_FILENAME)), + (build_ext_string ((char *) path, Qfile_name)), Qnil); } @@ -912,14 +916,6 @@ return Fcopy_sequence (Vsystem_name); } -/* For the benefit of callers who don't want to include lisp.h. - Caller must free! */ -char * -get_system_name (void) -{ - return xstrdup ((char *) XSTRING_DATA (Vsystem_name)); -} - DEFUN ("emacs-pid", Femacs_pid, 0, 0, 0, /* Return the process ID of Emacs, as an integer. */ @@ -1008,9 +1004,9 @@ return Fcons (make_int (item >> 16), make_int (item & 0xffff)); } -size_t emacs_strftime (char *string, size_t max, CONST char *format, - CONST struct tm *tm); -static long difftm (CONST struct tm *a, CONST struct tm *b); +size_t emacs_strftime (char *string, size_t max, const char *format, + const struct tm *tm); +static long difftm (const struct tm *a, const struct tm *b); DEFUN ("format-time-string", Fformat_time_string, 1, 2, 0, /* @@ -1040,6 +1036,8 @@ %p is replaced by AM or PM, as appropriate. %r is a synonym for "%I:%M:%S %p". %R is a synonym for "%H:%M". +%s is replaced by the time in seconds since 00:00:00, Jan 1, 1970 (a + nonstandard extension) %S is replaced by the second (00-60). %t is a synonym for "\\t". %T is a synonym for "%H:%M:%S". @@ -1075,10 +1073,10 @@ char *buf = (char *) alloca (size); *buf = 1; if (emacs_strftime (buf, size, - (CONST char *) XSTRING_DATA (format_string), + (const char *) XSTRING_DATA (format_string), localtime (&value)) || !*buf) - return build_ext_string (buf, FORMAT_BINARY); + return build_ext_string (buf, Qbinary); /* If buffer was too small, make it bigger. */ size *= 2; } @@ -1232,14 +1230,14 @@ strncpy (buf, tem, 24); buf[24] = 0; - return build_ext_string (buf, FORMAT_BINARY); + return build_ext_string (buf, Qbinary); } #define TM_YEAR_ORIGIN 1900 /* Yield A - B, measured in seconds. */ static long -difftm (CONST struct tm *a, CONST struct tm *b) +difftm (const struct tm *a, const struct tm *b) { int ay = a->tm_year + (TM_YEAR_ORIGIN - 1); int by = b->tm_year + (TM_YEAR_ORIGIN - 1); @@ -1826,7 +1824,7 @@ mc_count = begin_multiple_change (buf, pos, stop); if (STRINGP (table)) { - struct Lisp_String *stable = XSTRING (table); + Lisp_String *stable = XSTRING (table); Charcount size = string_char_length (stable); #ifdef MULE /* Under Mule, string_char(n) is O(n), so for large tables or @@ -1906,7 +1904,7 @@ && (XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC || XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR)) { - struct Lisp_Char_Table *ctable = XCHAR_TABLE (table); + Lisp_Char_Table *ctable = XCHAR_TABLE (table); for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++) { @@ -2240,17 +2238,16 @@ ? Qt : Qnil; } -DEFUN ("char=", Fchar_Equal, 2, 3, 0, /* +DEFUN ("char=", Fchar_Equal, 2, 2, 0, /* Return t if two characters match, case is significant. Both arguments must be characters (i.e. NOT integers). -The optional buffer argument is for symmetry and is ignored. */ - (c1, c2, buffer)) + (c1, c2)) { CHECK_CHAR_COERCE_INT (c1); CHECK_CHAR_COERCE_INT (c2); - return XCHAR(c1) == XCHAR(c2) ? Qt : Qnil; + return EQ (c1, c2) ? Qt : Qnil; } #if 0 /* Undebugged FSFmacs code */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/eldap.c --- a/src/eldap.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/eldap.c Mon Aug 13 11:13:30 2007 +0200 @@ -26,8 +26,8 @@ conforming to the API defined in RFC 1823. It has been tested with: - UMich LDAP 3.3 (http://www.umich.edu/~dirsvcs/ldap/) - - OpenLDAP 1.0.3 (http://www.openldap.org/) - - Netscape's LDAP SDK 1.0 (http://developer.netscape.com/) */ + - OpenLDAP 1.2 (http://www.openldap.org/) + - Netscape's LDAP SDK (http://developer.netscape.com/) */ #include <config.h> @@ -40,14 +40,6 @@ #include "eldap.h" -#ifdef HAVE_NS_LDAP -# define HAVE_LDAP_SET_OPTION 1 -# define HAVE_LDAP_GET_ERRNO 1 -#else -# undef HAVE_LDAP_SET_OPTION -# undef HAVE_LDAP_GET_ERRNO -#endif - static int ldap_default_port; static Lisp_Object Vldap_default_base; @@ -55,30 +47,40 @@ Lisp_Object Qldapp; /* ldap-open plist keywords */ -extern Lisp_Object Qport, Qauth, Qbinddn, Qpasswd, Qderef, Qtimelimit, - Qsizelimit; +static Lisp_Object Qport, Qauth, Qbinddn, Qpasswd, Qderef, Qtimelimit, Qsizelimit; /* Search scope limits */ -extern Lisp_Object Qbase, Qonelevel, Qsubtree; +static Lisp_Object Qbase, Qonelevel, Qsubtree; /* Authentication methods */ -extern Lisp_Object Qkrbv41, Qkrbv42; +static Lisp_Object Qkrbv41, Qkrbv42; /* Deref policy */ -extern Lisp_Object Qnever, Qalways, Qfind; +static Lisp_Object Qnever, Qalways, Qfind; /************************************************************************/ /* Utility Functions */ /************************************************************************/ static void -signal_ldap_error (LDAP *ld) +signal_ldap_error (LDAP *ld, LDAPMessage *res, int ldap_err) { -#ifdef HAVE_LDAP_GET_ERRNO - signal_simple_error - ("LDAP error", - build_string (ldap_err2string (ldap_get_lderrno (ld, NULL, NULL)))); + if (ldap_err <= 0) + { +#if defined HAVE_LDAP_PARSE_RESULT + int err; + ldap_err = ldap_parse_result (ld, res, + &err, + NULL, NULL, NULL, NULL, 0); + if (ldap_err == LDAP_SUCCESS) + ldap_err = err; +#elif defined HAVE_LDAP_GET_LDERRNO + ldap_err = ldap_get_lderrno (ld, NULL, NULL); +#elif defined HAVE_LDAP_RESULT2ERROR + ldap_err = ldap_result2error (ld, res, 0); #else + ldap_err = ld->ld_errno; +#endif + } signal_simple_error ("LDAP error", - build_string (ldap_err2string (ld->ld_errno))); -#endif + build_string (ldap_err2string (ldap_err))); } @@ -87,7 +89,7 @@ /************************************************************************/ static Lisp_Object -make_ldap (struct Lisp_LDAP *ldap) +make_ldap (Lisp_LDAP *ldap) { Lisp_Object lisp_ldap; XSETLDAP (lisp_ldap, ldap); @@ -95,7 +97,7 @@ } static Lisp_Object -mark_ldap (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_ldap (Lisp_Object obj) { return XLDAP (obj)->host; } @@ -105,7 +107,7 @@ { char buf[32]; - struct Lisp_LDAP *ldap = XLDAP (obj); + Lisp_LDAP *ldap = XLDAP (obj); if (print_readably) error ("printing unreadable object #<ldap %s>", @@ -113,40 +115,39 @@ write_c_string ("#<ldap ", printcharfun); print_internal (ldap->host, printcharfun, 1); - if (!ldap->livep) + if (!ldap->ld) write_c_string ("(dead) ",printcharfun); sprintf (buf, " 0x%x>", (unsigned int)ldap); write_c_string (buf, printcharfun); } -static struct Lisp_LDAP * +static Lisp_LDAP * allocate_ldap (void) { - struct Lisp_LDAP *ldap = - alloc_lcrecord_type (struct Lisp_LDAP, lrecord_ldap); + Lisp_LDAP *ldap = alloc_lcrecord_type (Lisp_LDAP, &lrecord_ldap); ldap->ld = NULL; ldap->host = Qnil; - ldap->livep = 0; return ldap; } static void finalize_ldap (void *header, int for_disksave) { - struct Lisp_LDAP *ldap = (struct Lisp_LDAP *) header; + Lisp_LDAP *ldap = (Lisp_LDAP *) header; if (for_disksave) signal_simple_error ("Can't dump an emacs containing LDAP objects", make_ldap (ldap)); - if (ldap->livep) + if (ldap->ld) ldap_unbind (ldap->ld); + ldap->ld = NULL; } DEFINE_LRECORD_IMPLEMENTATION ("ldap", ldap, mark_ldap, print_ldap, finalize_ldap, - NULL, NULL, struct Lisp_LDAP); + NULL, NULL, 0, Lisp_LDAP); @@ -178,7 +179,7 @@ (ldap)) { CHECK_LDAP (ldap); - return (XLDAP (ldap))->livep ? Qt : Qnil; + return (XLDAP (ldap))->ld ? Qt : Qnil; } /************************************************************************/ @@ -203,7 +204,7 @@ (host, plist)) { /* This function can GC */ - struct Lisp_LDAP *ldap; + Lisp_LDAP *ldap; LDAP *ld; int ldap_port = 0; int ldap_auth = LDAP_AUTH_SIMPLE; @@ -246,13 +247,17 @@ else if (EQ (keyword, Qbinddn)) { CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, ldap_binddn); + TO_EXTERNAL_FORMAT (LISP_STRING, value, + C_STRING_ALLOCA, ldap_binddn, + Qnative); } /* Password */ else if (EQ (keyword, Qpasswd)) { CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, ldap_passwd); + TO_EXTERNAL_FORMAT (LISP_STRING, value, + C_STRING_ALLOCA, ldap_passwd, + Qnative); } /* Deref */ else if (EQ (keyword, Qderef)) @@ -299,16 +304,18 @@ #ifdef HAVE_LDAP_SET_OPTION - if (ldap_set_option (ld, LDAP_OPT_DEREF, (void *)&ldap_deref) != LDAP_SUCCESS) - signal_ldap_error (ld); - if (ldap_set_option (ld, LDAP_OPT_TIMELIMIT, - (void *)&ldap_timelimit) != LDAP_SUCCESS) - signal_ldap_error (ld); - if (ldap_set_option (ld, LDAP_OPT_SIZELIMIT, - (void *)&ldap_sizelimit) != LDAP_SUCCESS) - signal_ldap_error (ld); - if (ldap_set_option (ld, LDAP_OPT_REFERRALS, LDAP_OPT_ON) != LDAP_SUCCESS) - signal_ldap_error (ld); + if ((err = ldap_set_option (ld, LDAP_OPT_DEREF, + (void *)&ldap_deref)) != LDAP_SUCCESS) + signal_ldap_error (ld, NULL, err); + if ((err = ldap_set_option (ld, LDAP_OPT_TIMELIMIT, + (void *)&ldap_timelimit)) != LDAP_SUCCESS) + signal_ldap_error (ld, NULL, err); + if ((err = ldap_set_option (ld, LDAP_OPT_SIZELIMIT, + (void *)&ldap_sizelimit)) != LDAP_SUCCESS) + signal_ldap_error (ld, NULL, err); + if ((err = ldap_set_option (ld, LDAP_OPT_REFERRALS, + LDAP_OPT_ON)) != LDAP_SUCCESS) + signal_ldap_error (ld, NULL, err); #else /* not HAVE_LDAP_SET_OPTION */ ld->ld_deref = ldap_deref; ld->ld_timelimit = ldap_timelimit; @@ -331,7 +338,6 @@ ldap = allocate_ldap (); ldap->ld = ld; ldap->host = host; - ldap->livep = 1; return make_ldap (ldap); } @@ -343,11 +349,11 @@ */ (ldap)) { - struct Lisp_LDAP *lldap; + Lisp_LDAP *lldap; CHECK_LIVE_LDAP (ldap); lldap = XLDAP (ldap); ldap_unbind (lldap->ld); - lldap->livep = 0; + lldap->ld = NULL; return Qnil; } @@ -359,7 +365,7 @@ struct ldap_unwind_struct { LDAPMessage *res; - char **vals; + struct berval **vals; }; @@ -371,11 +377,11 @@ if (unwind->res) ldap_msgfree (unwind->res); if (unwind->vals) - ldap_value_free (unwind->vals); + ldap_value_free_len (unwind->vals); return Qnil; } -DEFUN ("ldap-search-internal", Fldap_search_internal, 2, 6, 0, /* +DEFUN ("ldap-search-internal", Fldap_search_internal, 2, 7, 0, /* Perform a search on an open LDAP connection. LDAP is an LDAP connection object created with `ldap-open'. FILTER is a filter string for the search as described in RFC 1558. @@ -386,10 +392,13 @@ for each matching entry. If nil return all available attributes. If ATTRSONLY is non-nil then only the attributes are retrieved, not the associated values. +If WITHDN is non-nil each entry in the result will be prepennded with +its distinguished name DN. The function returns a list of matching entries. Each entry is itself -an alist of attribute/values. +an alist of attribute/value pairs optionally preceded by the DN of the +entry according to the value of WITHDN. */ - (ldap, filter, base, scope, attrs, attrsonly)) + (ldap, filter, base, scope, attrs, attrsonly, withdn)) { /* This function can GC */ @@ -397,8 +406,8 @@ LDAP *ld; LDAPMessage *e; BerElement *ptr; - char *a; - int i, rc; + char *a, *dn; + int i, rc, rc2; int matches; struct ldap_unwind_struct unwind; @@ -457,7 +466,9 @@ { Lisp_Object current = XCAR (attrs); CHECK_STRING (current); - GET_C_STRING_OS_DATA_ALLOCA (current, ldap_attributes[i]); + TO_EXTERNAL_FORMAT (LISP_STRING, current, + C_STRING_ALLOCA, ldap_attributes[i], + Qnative); ++i; } ldap_attributes[i] = NULL; @@ -473,9 +484,9 @@ NILP (filter) ? "" : (char *) XSTRING_DATA (filter), ldap_attributes, NILP (attrsonly) ? 0 : 1) - == -1) + == -1) { - signal_ldap_error (ld); + signal_ldap_error (ld, NULL, 0); } /* Ensure we don't exit without cleaning up */ @@ -500,23 +511,33 @@ restore the old echo area contents later. */ message ("Parsing ldap results... %d", matches); entry = Qnil; + /* Get the DN if required */ + if (! NILP (withdn)) + { + dn = ldap_get_dn (ld, e); + if (dn == NULL) + signal_ldap_error (ld, e, 0); + entry = Fcons (build_ext_string (dn, Qnative), Qnil); + } for (a= ldap_first_attribute (ld, e, &ptr); a != NULL; - a= ldap_next_attribute (ld, e, ptr) ) + a = ldap_next_attribute (ld, e, ptr) ) { - list = Fcons (build_ext_string (a, FORMAT_OS), Qnil); - unwind.vals = ldap_get_values (ld, e, a); + list = Fcons (build_ext_string (a, Qnative), Qnil); + unwind.vals = ldap_get_values_len (ld, e, a); if (unwind.vals != NULL) { for (i = 0; unwind.vals[i] != NULL; i++) { - list = Fcons (build_ext_string (unwind.vals[i], FORMAT_OS), + list = Fcons (make_ext_string (unwind.vals[i]->bv_val, + unwind.vals[i]->bv_len, + Qnative), list); } } entry = Fcons (Fnreverse (list), entry); - ldap_value_free (unwind.vals); + ldap_value_free_len (unwind.vals); unwind.vals = NULL; } result = Fcons (Fnreverse (entry), @@ -530,15 +551,22 @@ } if (rc == -1) - { - signal_ldap_error (ld); - } + signal_ldap_error (ld, unwind.res, 0); + + if (rc == 0) + signal_ldap_error (ld, NULL, LDAP_TIMELIMIT_EXCEEDED); + +#if defined HAVE_LDAP_PARSE_RESULT + rc2 = ldap_parse_result (ld, unwind.res, + &rc, + NULL, NULL, NULL, NULL, 0); + if (rc2 != LDAP_SUCCESS) + rc = rc2; +#elif defined HAVE_LDAP_RESULT2ERROR rc = ldap_result2error (ld, unwind.res, 0); - if ((rc != LDAP_SUCCESS) && - (rc != LDAP_SIZELIMIT_EXCEEDED)) - { - signal_ldap_error (ld); - } +#endif + if ((rc != LDAP_SUCCESS) && (rc != LDAP_SIZELIMIT_EXCEEDED)) + signal_ldap_error (ld, NULL, rc); ldap_msgfree (unwind.res); unwind.res = (LDAPMessage *)NULL; @@ -555,6 +583,22 @@ syms_of_eldap (void) { defsymbol (&Qldapp, "ldapp"); + defsymbol (&Qport, "port"); + defsymbol (&Qauth, "auth"); + defsymbol (&Qbinddn, "binddn"); + defsymbol (&Qpasswd, "passwd"); + defsymbol (&Qderef, "deref"); + defsymbol (&Qtimelimit, "timelimit"); + defsymbol (&Qsizelimit, "sizelimit"); + defsymbol (&Qbase, "base"); + defsymbol (&Qonelevel, "onelevel"); + defsymbol (&Qsubtree, "subtree"); + defsymbol (&Qkrbv41, "krbv41"); + defsymbol (&Qkrbv42, "krbv42"); + defsymbol (&Qnever, "never"); + defsymbol (&Qalways, "always"); + defsymbol (&Qfind, "find"); + DEFSUBR (Fldapp); DEFSUBR (Fldap_host); DEFSUBR (Fldap_status); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/eldap.h --- a/src/eldap.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/eldap.h Mon Aug 13 11:13:30 2007 +0200 @@ -18,8 +18,8 @@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -#ifndef _XEMACS_ELDAP_H_ -#define _XEMACS_ELDAP_H_ +#ifndef INCLUDED_eldap_h_ +#define INCLUDED_eldap_h_ #include <lber.h> #include <ldap.h> @@ -37,22 +37,20 @@ LDAP *ld; /* Name of the host we connected to */ Lisp_Object host; - /* Status of the LDAP connection. */ - int livep; }; +typedef struct Lisp_LDAP Lisp_LDAP; -DECLARE_LRECORD (ldap, struct Lisp_LDAP); -#define XLDAP(x) XRECORD (x, ldap, struct Lisp_LDAP) +DECLARE_LRECORD (ldap, Lisp_LDAP); +#define XLDAP(x) XRECORD (x, ldap, Lisp_LDAP) #define XSETLDAP(x, p) XSETRECORD (x, p, ldap) #define LDAPP(x) RECORDP (x, ldap) -#define GC_LDAPP(x) GC_RECORDP (x, ldap) #define CHECK_LDAP(x) CHECK_RECORD (x, ldap) #define CONCHECK_LDAP(x) CONCHECK_RECORD (x, ldap) #define CHECK_LIVE_LDAP(ldap) do { \ CHECK_LDAP (ldap); \ - if (!XLDAP (ldap)->livep) \ + if (!XLDAP (ldap)->ld) \ signal_simple_error ("Attempting to access closed LDAP connection", \ ldap); \ } while (0) @@ -69,6 +67,7 @@ Lisp_Object base, Lisp_Object scope, Lisp_Object attrs, - Lisp_Object attrsonly); + Lisp_Object attrsonly, + Lisp_Object withdn); -#endif /* _XEMACS_ELDAP_H_ */ +#endif /* INCLUDED_eldap_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/elhash.c --- a/src/elhash.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/elhash.c Mon Aug 13 11:13:30 2007 +0200 @@ -27,11 +27,15 @@ #include "bytecode.h" #include "elhash.h" -Lisp_Object Qhash_tablep, Qhashtable, Qhash_table; -Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qnon_weak; +Lisp_Object Qhash_tablep; +static Lisp_Object Qhashtable, Qhash_table; +static Lisp_Object Qweakness, Qvalue; static Lisp_Object Vall_weak_hash_tables; static Lisp_Object Qrehash_size, Qrehash_threshold; -static Lisp_Object Q_size, Q_test, Q_type, Q_rehash_size, Q_rehash_threshold; +static Lisp_Object Q_size, Q_test, Q_weakness, Q_rehash_size, Q_rehash_threshold; + +/* obsolete as of 19990901 in xemacs-21.2 */ +static Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qnon_weak, Q_type; typedef struct hentry { @@ -51,26 +55,27 @@ hash_table_hash_function_t hash_function; hash_table_test_function_t test_function; hentry *hentries; - enum hash_table_type type; /* whether and how this hash table is weak */ + enum hash_table_weakness weakness; Lisp_Object next_weak; /* Used to chain together all of the weak hash tables. Don't mark through this. */ }; -typedef struct Lisp_Hash_Table Lisp_Hash_Table; #define HENTRY_CLEAR_P(hentry) ((*(EMACS_UINT*)(&((hentry)->key))) == 0) -#define CLEAR_HENTRY(hentry) ((*(EMACS_UINT*)(&((hentry)->key))) = 0) +#define CLEAR_HENTRY(hentry) \ + ((*(EMACS_UINT*)(&((hentry)->key))) = 0, \ + (*(EMACS_UINT*)(&((hentry)->value))) = 0) #define HASH_TABLE_DEFAULT_SIZE 16 #define HASH_TABLE_DEFAULT_REHASH_SIZE 1.3 #define HASH_TABLE_MIN_SIZE 10 -#define HASH_CODE(key, ht) \ - (((((ht)->hash_function ? (ht)->hash_function (key) : LISP_HASH (key)) \ - * (ht)->golden_ratio) \ - % (ht)->size)) +#define HASH_CODE(key, ht) \ +((((ht)->hash_function ? (ht)->hash_function (key) : LISP_HASH (key)) \ + * (ht)->golden_ratio) \ + % (ht)->size) #define KEYS_EQUAL_P(key1, key2, testfun) \ - (EQ ((key1), (key2)) || ((testfun) && (testfun) ((key1), (key2)))) + (EQ (key1, key2) || ((testfun) && (testfun) (key1, key2))) #define LINEAR_PROBING_LOOP(probe, entries, size) \ for (; \ @@ -117,7 +122,7 @@ /* Return some prime near, but greater than or equal to, SIZE. Decades from the time of writing, someone will have a system large enough that the list below will be too short... */ - static CONST size_t primes [] = + static const size_t primes [] = { 19, 29, 41, 59, 79, 107, 149, 197, 263, 347, 457, 599, 787, 1031, 1361, 1777, 2333, 3037, 3967, 5167, 6719, 8737, 11369, 14783, @@ -190,29 +195,29 @@ static Lisp_Object -mark_hash_table (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_hash_table (Lisp_Object obj) { Lisp_Hash_Table *ht = XHASH_TABLE (obj); /* If the hash table is weak, we don't want to mark the keys and values (we scan over them after everything else has been marked, and mark or remove them as necessary). */ - if (ht->type == HASH_TABLE_NON_WEAK) + if (ht->weakness == HASH_TABLE_NON_WEAK) { hentry *e, *sentinel; for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) if (!HENTRY_CLEAR_P (e)) { - markobj (e->key); - markobj (e->value); + mark_object (e->key); + mark_object (e->value); } } return Qnil; } /* Equality of hash tables. Two hash tables are equal when they are of - the same type and test function, they have the same number of + the same weakness and test function, they have the same number of elements, and for each key in the hash table, the values are `equal'. This is similar to Common Lisp `equalp' of hash tables, with the @@ -229,7 +234,7 @@ hentry *e, *sentinel; if ((ht1->test_function != ht2->test_function) || - (ht1->type != ht2->type) || + (ht1->weakness != ht2->weakness) || (ht1->count != ht2->count)) return 0; @@ -247,6 +252,16 @@ return 1; } + +/* This is not a great hash function, but it _is_ correct and fast. + Examining all entries is too expensive, and examining a random + subset does not yield a correct hash function. */ +static hashcode_t +hash_table_hash (Lisp_Object hash_table, int depth) +{ + return XHASH_TABLE (hash_table)->count; +} + /* Printing hash tables. @@ -256,12 +271,15 @@ #s(hash-table size 2 data (key1 value1 key2 value2)) - The supported keywords are `type' (non-weak (or nil), weak, - key-weak and value-weak), `test' (eql (or nil), eq or equal), - `size' (a natnum or nil) and `data' (a list). + The supported hash table structure keywords and their values are: + `test' (eql (or nil), eq or equal) + `size' (a natnum or nil) + `rehash-size' (a float) + `rehash-threshold' (a float) + `weakness' (nil, t, key or value) + `data' (a list) - If `print-readably' is non-nil, then a simpler syntax is used; for - instance: + If `print-readably' is nil, then a simpler syntax is used, for example #<hash-table size 2/13 data (key1 value1 key2 value2) 0x874d> @@ -307,16 +325,6 @@ write_c_string (print_readably ? "#s(hash-table" : "#<hash-table", printcharfun); - if (ht->type != HASH_TABLE_NON_WEAK) - { - sprintf (buf, " type %s", - (ht->type == HASH_TABLE_WEAK ? "weak" : - ht->type == HASH_TABLE_KEY_WEAK ? "key-weak" : - ht->type == HASH_TABLE_VALUE_WEAK ? "value-weak" : - "you-d-better-not-see-this")); - write_c_string (buf, printcharfun); - } - /* These checks have a kludgy look to them, but they are safe. Due to nature of hashing, you cannot use arbitrary test functions anyway. */ @@ -340,6 +348,16 @@ write_c_string (buf, printcharfun); } + if (ht->weakness != HASH_TABLE_NON_WEAK) + { + sprintf (buf, " weakness %s", + (ht->weakness == HASH_TABLE_WEAK ? "t" : + ht->weakness == HASH_TABLE_KEY_WEAK ? "key" : + ht->weakness == HASH_TABLE_VALUE_WEAK ? "value" : + "you-d-better-not-see-this")); + write_c_string (buf, printcharfun); + } + if (ht->count) print_hash_table_data (ht, printcharfun); @@ -364,11 +382,29 @@ } } +static const struct lrecord_description hentry_description_1[] = { + { XD_LISP_OBJECT, offsetof (hentry, key) }, + { XD_LISP_OBJECT, offsetof (hentry, value) }, + { XD_END } +}; + +static const struct struct_description hentry_description = { + sizeof (hentry), + hentry_description_1 +}; + +const struct lrecord_description hash_table_description[] = { + { XD_SIZE_T, offsetof (Lisp_Hash_Table, size) }, + { XD_STRUCT_PTR, offsetof (Lisp_Hash_Table, hentries), XD_INDIRECT(0, 1), &hentry_description }, + { XD_LO_LINK, offsetof (Lisp_Hash_Table, next_weak) }, + { XD_END } +}; + DEFINE_LRECORD_IMPLEMENTATION ("hash-table", hash_table, mark_hash_table, print_hash_table, finalize_hash_table, - /* #### Implement hash_table_hash()! */ - hash_table_equal, 0, + hash_table_equal, hash_table_hash, + hash_table_description, Lisp_Hash_Table); static Lisp_Hash_Table * @@ -386,36 +422,24 @@ /************************************************************************/ /* Creation of hash tables, without error-checking. */ -static double -hash_table_rehash_threshold (Lisp_Hash_Table *ht) -{ - return - ht->rehash_threshold > 0.0 ? ht->rehash_threshold : - ht->size > 4096 && !ht->test_function ? 0.7 : 0.6; -} - static void compute_hash_table_derived_values (Lisp_Hash_Table *ht) { ht->rehash_count = (size_t) - ((double) ht->size * hash_table_rehash_threshold (ht)); + ((double) ht->size * ht->rehash_threshold); ht->golden_ratio = (size_t) ((double) ht->size * (.6180339887 / (double) sizeof (Lisp_Object))); } Lisp_Object -make_general_lisp_hash_table (size_t size, - enum hash_table_type type, - enum hash_table_test test, - double rehash_size, - double rehash_threshold) +make_general_lisp_hash_table (enum hash_table_test test, + size_t size, + double rehash_size, + double rehash_threshold, + enum hash_table_weakness weakness) { Lisp_Object hash_table; - Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, lrecord_hash_table); - - ht->type = type; - ht->rehash_size = rehash_size; - ht->rehash_threshold = rehash_threshold; + Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, &lrecord_hash_table); switch (test) { @@ -438,15 +462,21 @@ abort (); } - if (ht->rehash_size <= 0.0) - ht->rehash_size = HASH_TABLE_DEFAULT_REHASH_SIZE; + ht->weakness = weakness; + + ht->rehash_size = + rehash_size > 1.0 ? rehash_size : HASH_TABLE_DEFAULT_REHASH_SIZE; + + ht->rehash_threshold = + rehash_threshold > 0.0 ? rehash_threshold : + size > 4096 && !ht->test_function ? 0.7 : 0.6; + if (size < HASH_TABLE_MIN_SIZE) size = HASH_TABLE_MIN_SIZE; - if (rehash_threshold < 0.0) - rehash_threshold = 0.75; - ht->size = - hash_table_size ((size_t) ((double) size / hash_table_rehash_threshold (ht)) + 1); + ht->size = hash_table_size ((size_t) (((double) size / ht->rehash_threshold) + + 1.0)); ht->count = 0; + compute_hash_table_derived_values (ht); /* We leave room for one never-occupied sentinel hentry at the end. */ @@ -460,7 +490,7 @@ XSETHASH_TABLE (hash_table, ht); - if (type == HASH_TABLE_NON_WEAK) + if (weakness == HASH_TABLE_NON_WEAK) ht->next_weak = Qunbound; else ht->next_weak = Vall_weak_hash_tables, Vall_weak_hash_tables = hash_table; @@ -470,11 +500,10 @@ Lisp_Object make_lisp_hash_table (size_t size, - enum hash_table_type type, + enum hash_table_weakness weakness, enum hash_table_test test) { - return make_general_lisp_hash_table (size, type, test, - HASH_TABLE_DEFAULT_REHASH_SIZE, -1.0); + return make_general_lisp_hash_table (test, size, -1.0, -1.0, weakness); } /* Pretty reading of hash tables. @@ -507,30 +536,40 @@ } static int -hash_table_type_validate (Lisp_Object keyword, Lisp_Object value, - Error_behavior errb) +hash_table_weakness_validate (Lisp_Object keyword, Lisp_Object value, + Error_behavior errb) { if (EQ (value, Qnil)) return 1; + if (EQ (value, Qt)) return 1; + if (EQ (value, Qkey)) return 1; + if (EQ (value, Qvalue)) return 1; + + /* Following values are obsolete as of 19990901 in xemacs-21.2 */ if (EQ (value, Qnon_weak)) return 1; if (EQ (value, Qweak)) return 1; if (EQ (value, Qkey_weak)) return 1; if (EQ (value, Qvalue_weak)) return 1; - maybe_signal_simple_error ("Invalid hash table type", + maybe_signal_simple_error ("Invalid hash table weakness", value, Qhash_table, errb); return 0; } -static enum hash_table_type -decode_hash_table_type (Lisp_Object obj) +static enum hash_table_weakness +decode_hash_table_weakness (Lisp_Object obj) { if (EQ (obj, Qnil)) return HASH_TABLE_NON_WEAK; + if (EQ (obj, Qt)) return HASH_TABLE_WEAK; + if (EQ (obj, Qkey)) return HASH_TABLE_KEY_WEAK; + if (EQ (obj, Qvalue)) return HASH_TABLE_VALUE_WEAK; + + /* Following values are obsolete as of 19990901 in xemacs-21.2 */ if (EQ (obj, Qnon_weak)) return HASH_TABLE_NON_WEAK; if (EQ (obj, Qweak)) return HASH_TABLE_WEAK; if (EQ (obj, Qkey_weak)) return HASH_TABLE_KEY_WEAK; if (EQ (obj, Qvalue_weak)) return HASH_TABLE_VALUE_WEAK; - signal_simple_error ("Invalid hash table type", obj); + signal_simple_error ("Invalid hash table weakness", obj); return HASH_TABLE_NON_WEAK; /* not reached */ } @@ -562,7 +601,7 @@ static int hash_table_rehash_size_validate (Lisp_Object keyword, Lisp_Object value, - Error_behavior errb) + Error_behavior errb) { if (!FLOATP (value)) { @@ -651,11 +690,11 @@ { Lisp_Object hash_table; Lisp_Object test = Qnil; - Lisp_Object type = Qnil; Lisp_Object size = Qnil; - Lisp_Object data = Qnil; Lisp_Object rehash_size = Qnil; Lisp_Object rehash_threshold = Qnil; + Lisp_Object weakness = Qnil; + Lisp_Object data = Qnil; while (!NILP (plist)) { @@ -664,22 +703,23 @@ value = XCAR (plist); plist = XCDR (plist); if (EQ (key, Qtest)) test = value; - else if (EQ (key, Qtype)) type = value; else if (EQ (key, Qsize)) size = value; - else if (EQ (key, Qdata)) data = value; else if (EQ (key, Qrehash_size)) rehash_size = value; else if (EQ (key, Qrehash_threshold)) rehash_threshold = value; + else if (EQ (key, Qweakness)) weakness = value; + else if (EQ (key, Qdata)) data = value; + else if (EQ (key, Qtype))/*obsolete*/ weakness = value; else abort (); } /* Create the hash table. */ hash_table = make_general_lisp_hash_table - (decode_hash_table_size (size), - decode_hash_table_type (type), - decode_hash_table_test (test), + (decode_hash_table_test (test), + decode_hash_table_size (size), decode_hash_table_rehash_size (rehash_size), - decode_hash_table_rehash_threshold (rehash_threshold)); + decode_hash_table_rehash_threshold (rehash_threshold), + decode_hash_table_weakness (weakness)); /* I'm not sure whether this can GC, but better safe than sorry. */ { @@ -706,17 +746,20 @@ struct structure_type *st; st = define_structure_type (structure_name, 0, hash_table_instantiate); + define_structure_type_keyword (st, Qtest, hash_table_test_validate); define_structure_type_keyword (st, Qsize, hash_table_size_validate); - define_structure_type_keyword (st, Qtest, hash_table_test_validate); - define_structure_type_keyword (st, Qtype, hash_table_type_validate); - define_structure_type_keyword (st, Qdata, hash_table_data_validate); define_structure_type_keyword (st, Qrehash_size, hash_table_rehash_size_validate); define_structure_type_keyword (st, Qrehash_threshold, hash_table_rehash_threshold_validate); + define_structure_type_keyword (st, Qweakness, hash_table_weakness_validate); + define_structure_type_keyword (st, Qdata, hash_table_data_validate); + + /* obsolete as of 19990901 in xemacs-21.2 */ + define_structure_type_keyword (st, Qtype, hash_table_weakness_validate); } /* Create a built-in Lisp structure type named `hash-table'. We make #s(hashtable ...) equivalent to #s(hash-table ...), - for backward comptabibility. + for backward compatibility. This is called from emacs.c. */ void structure_type_create_hash_table (void) @@ -741,17 +784,23 @@ DEFUN ("make-hash-table", Fmake_hash_table, 0, MANY, 0, /* Return a new empty hash table object. Use Common Lisp style keywords to specify hash table properties. - (make-hash-table &key :size :test :type :rehash-size :rehash-threshold) - -Keyword :size specifies the number of keys likely to be inserted. -This number of entries can be inserted without enlarging the hash table. + (make-hash-table &key test size rehash-size rehash-threshold weakness) Keyword :test can be `eq', `eql' (default) or `equal'. Comparison between keys is done using this function. If speed is important, consider using `eq'. When storing strings in the hash table, you will likely need to use `equal'. -Keyword :type can be `non-weak' (default), `weak', `key-weak' or `value-weak'. +Keyword :size specifies the number of keys likely to be inserted. +This number of entries can be inserted without enlarging the hash table. + +Keyword :rehash-size must be a float greater than 1.0, and specifies +the factor by which to increase the size of the hash table when enlarging. + +Keyword :rehash-threshold must be a float between 0.0 and 1.0, +and specifies the load factor of the hash table which triggers enlarging. + +Non-standard keyword :weakness can be `nil' (default), `t', `key' or `value'. A weak hash table is one whose pointers do not count as GC referents: for any key-value pair in the hash table, if the only remaining pointer @@ -771,58 +820,48 @@ unmarked outside of weak hash tables. The pair will remain in the hash table if the value is pointed to by something other than a weak hash table, even if the key is not. - -Keyword :rehash-size must be a float greater than 1.0, and specifies -the factor by which to increase the size of the hash table when enlarging. - -Keyword :rehash-threshold must be a float between 0.0 and 1.0, -and specifies the load factor of the hash table which triggers enlarging. - */ (int nargs, Lisp_Object *args)) { - int j = 0; + int i = 0; + Lisp_Object test = Qnil; Lisp_Object size = Qnil; - Lisp_Object type = Qnil; - Lisp_Object test = Qnil; Lisp_Object rehash_size = Qnil; Lisp_Object rehash_threshold = Qnil; - - while (j < nargs) - { - Lisp_Object keyword, value; + Lisp_Object weakness = Qnil; - keyword = args[j++]; - if (!KEYWORDP (keyword)) - signal_simple_error ("Invalid hash table property keyword", keyword); - if (j == nargs) - signal_simple_error ("Hash table property requires a value", keyword); + while (i + 1 < nargs) + { + Lisp_Object keyword = args[i++]; + Lisp_Object value = args[i++]; - value = args[j++]; - - if (EQ (keyword, Q_size)) size = value; - else if (EQ (keyword, Q_type)) type = value; - else if (EQ (keyword, Q_test)) test = value; + if (EQ (keyword, Q_test)) test = value; + else if (EQ (keyword, Q_size)) size = value; else if (EQ (keyword, Q_rehash_size)) rehash_size = value; else if (EQ (keyword, Q_rehash_threshold)) rehash_threshold = value; + else if (EQ (keyword, Q_weakness)) weakness = value; + else if (EQ (keyword, Q_type))/*obsolete*/ weakness = value; else signal_simple_error ("Invalid hash table property keyword", keyword); } + if (i < nargs) + signal_simple_error ("Hash table property requires a value", args[i]); + #define VALIDATE_VAR(var) \ if (!NILP (var)) hash_table_##var##_validate (Q##var, var, ERROR_ME); + VALIDATE_VAR (test); VALIDATE_VAR (size); - VALIDATE_VAR (type); - VALIDATE_VAR (test); VALIDATE_VAR (rehash_size); VALIDATE_VAR (rehash_threshold); + VALIDATE_VAR (weakness); return make_general_lisp_hash_table - (decode_hash_table_size (size), - decode_hash_table_type (type), - decode_hash_table_test (test), + (decode_hash_table_test (test), + decode_hash_table_size (size), decode_hash_table_rehash_size (rehash_size), - decode_hash_table_rehash_threshold (rehash_threshold)); + decode_hash_table_rehash_threshold (rehash_threshold), + decode_hash_table_weakness (weakness)); } DEFUN ("copy-hash-table", Fcopy_hash_table, 1, 1, 0, /* @@ -831,8 +870,8 @@ */ (hash_table)) { - CONST Lisp_Hash_Table *ht_old = xhash_table (hash_table); - Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, lrecord_hash_table); + const Lisp_Hash_Table *ht_old = xhash_table (hash_table); + Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, &lrecord_hash_table); copy_lcrecord (ht, ht_old); @@ -851,29 +890,22 @@ } static void -enlarge_hash_table (Lisp_Hash_Table *ht) +resize_hash_table (Lisp_Hash_Table *ht, size_t new_size) { - hentry *old_entries, *new_entries, *old_sentinel, *new_sentinel, *e; - size_t old_size, new_size; + hentry *old_entries, *new_entries, *sentinel, *e; + size_t old_size; old_size = ht->size; - new_size = ht->size = - hash_table_size ((size_t) ((double) old_size * ht->rehash_size)); + ht->size = new_size; old_entries = ht->hentries; - ht->hentries = xnew_array (hentry, new_size + 1); + ht->hentries = xnew_array_and_zero (hentry, new_size + 1); new_entries = ht->hentries; - old_sentinel = old_entries + old_size; - new_sentinel = new_entries + new_size; - - for (e = new_entries; e <= new_sentinel; e++) - CLEAR_HENTRY (e); - compute_hash_table_derived_values (ht); - for (e = old_entries; e < old_sentinel; e++) + for (e = old_entries, sentinel = e + old_size; e < sentinel; e++) if (!HENTRY_CLEAR_P (e)) { hentry *probe = new_entries + HASH_CODE (e->key, ht); @@ -882,11 +914,44 @@ *probe = *e; } - xfree (old_entries); + if (!DUMPEDP (old_entries)) + xfree (old_entries); +} + +/* After a hash table has been saved to disk and later restored by the + portable dumper, it contains the same objects, but their addresses + and thus their HASH_CODEs have changed. */ +void +pdump_reorganize_hash_table (Lisp_Object hash_table) +{ + const Lisp_Hash_Table *ht = xhash_table (hash_table); + hentry *new_entries = xnew_array_and_zero (hentry, ht->size + 1); + hentry *e, *sentinel; + + for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) + if (!HENTRY_CLEAR_P (e)) + { + hentry *probe = new_entries + HASH_CODE (e->key, ht); + LINEAR_PROBING_LOOP (probe, new_entries, ht->size) + ; + *probe = *e; + } + + memcpy (ht->hentries, new_entries, ht->size * sizeof (hentry)); + + xfree (new_entries); +} + +static void +enlarge_hash_table (Lisp_Hash_Table *ht) +{ + size_t new_size = + hash_table_size ((size_t) ((double) ht->size * ht->rehash_size)); + resize_hash_table (ht, new_size); } static hentry * -find_hentry (Lisp_Object key, CONST Lisp_Hash_Table *ht) +find_hentry (Lisp_Object key, const Lisp_Hash_Table *ht) { hash_table_test_function_t test_function = ht->test_function; hentry *entries = ht->hentries; @@ -905,7 +970,7 @@ */ (key, hash_table, default_)) { - CONST Lisp_Hash_Table *ht = xhash_table (hash_table); + const Lisp_Hash_Table *ht = xhash_table (hash_table); hentry *e = find_hentry (key, ht); return HENTRY_CLEAR_P (e) ? default_ : e->value; @@ -938,7 +1003,8 @@ remhash_1 (Lisp_Hash_Table *ht, hentry *entries, hentry *probe) { size_t size = ht->size; - CLEAR_HENTRY (probe++); + CLEAR_HENTRY (probe); + probe++; ht->count--; LINEAR_PROBING_LOOP (probe, entries, size) @@ -999,30 +1065,6 @@ return make_int (xhash_table (hash_table)->count); } -DEFUN ("hash-table-size", Fhash_table_size, 1, 1, 0, /* -Return the size of HASH-TABLE. -This is the current number of slots in HASH-TABLE, whether occupied or not. -*/ - (hash_table)) -{ - return make_int (xhash_table (hash_table)->size); -} - -DEFUN ("hash-table-type", Fhash_table_type, 1, 1, 0, /* -Return the type of HASH-TABLE. -This can be one of `non-weak', `weak', `key-weak' or `value-weak'. -*/ - (hash_table)) -{ - switch (xhash_table (hash_table)->type) - { - case HASH_TABLE_WEAK: return Qweak; - case HASH_TABLE_KEY_WEAK: return Qkey_weak; - case HASH_TABLE_VALUE_WEAK: return Qvalue_weak; - default: return Qnon_weak; - } -} - DEFUN ("hash-table-test", Fhash_table_test, 1, 1, 0, /* Return the test function of HASH-TABLE. This can be one of `eq', `eql' or `equal'. @@ -1036,6 +1078,15 @@ Qeq); } +DEFUN ("hash-table-size", Fhash_table_size, 1, 1, 0, /* +Return the size of HASH-TABLE. +This is the current number of slots in HASH-TABLE, whether occupied or not. +*/ + (hash_table)) +{ + return make_int (xhash_table (hash_table)->size); +} + DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, 1, 1, 0, /* Return the current rehash size of HASH-TABLE. This is a float greater than 1.0; the factor by which HASH-TABLE @@ -1053,7 +1104,38 @@ */ (hash_table)) { - return make_float (hash_table_rehash_threshold (xhash_table (hash_table))); + return make_float (xhash_table (hash_table)->rehash_threshold); +} + +DEFUN ("hash-table-weakness", Fhash_table_weakness, 1, 1, 0, /* +Return the weakness of HASH-TABLE. +This can be one of `nil', `t', `key' or `value'. +*/ + (hash_table)) +{ + switch (xhash_table (hash_table)->weakness) + { + case HASH_TABLE_WEAK: return Qt; + case HASH_TABLE_KEY_WEAK: return Qkey; + case HASH_TABLE_VALUE_WEAK: return Qvalue; + default: return Qnil; + } +} + +/* obsolete as of 19990901 in xemacs-21.2 */ +DEFUN ("hash-table-type", Fhash_table_type, 1, 1, 0, /* +Return the type of HASH-TABLE. +This can be one of `non-weak', `weak', `key-weak' or `value-weak'. +*/ + (hash_table)) +{ + switch (xhash_table (hash_table)->weakness) + { + case HASH_TABLE_WEAK: return Qweak; + case HASH_TABLE_KEY_WEAK: return Qkey_weak; + case HASH_TABLE_VALUE_WEAK: return Qvalue_weak; + default: return Qnon_weak; + } } /************************************************************************/ @@ -1068,8 +1150,8 @@ */ (function, hash_table)) { - CONST Lisp_Hash_Table *ht = xhash_table (hash_table); - CONST hentry *e, *sentinel; + const Lisp_Hash_Table *ht = xhash_table (hash_table); + const hentry *e, *sentinel; for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) if (!HENTRY_CLEAR_P (e)) @@ -1094,8 +1176,8 @@ elisp_maphash (maphash_function_t function, Lisp_Object hash_table, void *extra_arg) { - CONST Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); - CONST hentry *e, *sentinel; + const Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); + const hentry *e, *sentinel; for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) if (!HENTRY_CLEAR_P (e)) @@ -1139,21 +1221,20 @@ /* Complete the marking for semi-weak hash tables. */ int -finish_marking_weak_hash_tables (int (*obj_marked_p) (Lisp_Object), - void (*markobj) (Lisp_Object)) +finish_marking_weak_hash_tables (void) { Lisp_Object hash_table; int did_mark = 0; for (hash_table = Vall_weak_hash_tables; - !GC_NILP (hash_table); + !NILP (hash_table); hash_table = XHASH_TABLE (hash_table)->next_weak) { - CONST Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); - CONST hentry *e = ht->hentries; - CONST hentry *sentinel = e + ht->size; + const Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); + const hentry *e = ht->hentries; + const hentry *sentinel = e + ht->size; - if (! obj_marked_p (hash_table)) + if (! marked_p (hash_table)) /* The hash table is probably garbage. Ignore it. */ continue; @@ -1161,28 +1242,28 @@ half-marked, we may need to mark the other half if we're keeping this pair. */ #define MARK_OBJ(obj) \ -do { if (!obj_marked_p (obj)) markobj (obj), did_mark = 1; } while (0) +do { if (!marked_p (obj)) mark_object (obj), did_mark = 1; } while (0) - switch (ht->type) + switch (ht->weakness) { case HASH_TABLE_KEY_WEAK: for (; e < sentinel; e++) if (!HENTRY_CLEAR_P (e)) - if (obj_marked_p (e->key)) + if (marked_p (e->key)) MARK_OBJ (e->value); break; case HASH_TABLE_VALUE_WEAK: for (; e < sentinel; e++) if (!HENTRY_CLEAR_P (e)) - if (obj_marked_p (e->value)) + if (marked_p (e->value)) MARK_OBJ (e->key); break; case HASH_TABLE_KEY_CAR_WEAK: for (; e < sentinel; e++) if (!HENTRY_CLEAR_P (e)) - if (!CONSP (e->key) || obj_marked_p (XCAR (e->key))) + if (!CONSP (e->key) || marked_p (XCAR (e->key))) { MARK_OBJ (e->key); MARK_OBJ (e->value); @@ -1192,7 +1273,7 @@ case HASH_TABLE_VALUE_CAR_WEAK: for (; e < sentinel; e++) if (!HENTRY_CLEAR_P (e)) - if (!CONSP (e->value) || obj_marked_p (XCAR (e->value))) + if (!CONSP (e->value) || marked_p (XCAR (e->value))) { MARK_OBJ (e->key); MARK_OBJ (e->value); @@ -1208,17 +1289,17 @@ } void -prune_weak_hash_tables (int (*obj_marked_p) (Lisp_Object)) +prune_weak_hash_tables (void) { Lisp_Object hash_table, prev = Qnil; for (hash_table = Vall_weak_hash_tables; - !GC_NILP (hash_table); + !NILP (hash_table); hash_table = XHASH_TABLE (hash_table)->next_weak) { - if (! obj_marked_p (hash_table)) + if (! marked_p (hash_table)) { /* This hash table itself is garbage. Remove it from the list. */ - if (GC_NILP (prev)) + if (NILP (prev)) Vall_weak_hash_tables = XHASH_TABLE (hash_table)->next_weak; else XHASH_TABLE (prev)->next_weak = XHASH_TABLE (hash_table)->next_weak; @@ -1227,7 +1308,7 @@ { /* Now, scan over all the pairs. Remove all of the pairs in which the key or value, or both, is unmarked - (depending on the type of weak hash table). */ + (depending on the weakness of the hash table). */ Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); hentry *entries = ht->hentries; hentry *sentinel = entries + ht->size; @@ -1237,7 +1318,7 @@ if (!HENTRY_CLEAR_P (e)) { again: - if (!obj_marked_p (e->key) || !obj_marked_p (e->value)) + if (!marked_p (e->key) || !marked_p (e->value)) { remhash_1 (ht, entries, e); if (!HENTRY_CLEAR_P (e)) @@ -1256,12 +1337,13 @@ internal_array_hash (Lisp_Object *arr, int size, int depth) { int i; - unsigned long hash = 0; + hashcode_t hash = 0; + depth++; if (size <= 5) { for (i = 0; i < size; i++) - hash = HASH2 (hash, internal_hash (arr[i], depth + 1)); + hash = HASH2 (hash, internal_hash (arr[i], depth)); return hash; } @@ -1269,7 +1351,7 @@ A slightly better approach would be to offset by some noise factor from the points chosen below. */ for (i = 0; i < 5; i++) - hash = HASH2 (hash, internal_hash (arr[i*size/5], depth + 1)); + hash = HASH2 (hash, internal_hash (arr[i*size/5], depth)); return hash; } @@ -1302,16 +1384,9 @@ { return hash_string (XSTRING_DATA (obj), XSTRING_LENGTH (obj)); } - if (VECTORP (obj)) - { - return HASH2 (XVECTOR_LENGTH (obj), - internal_array_hash (XVECTOR_DATA (obj), - XVECTOR_LENGTH (obj), - depth + 1)); - } if (LRECORDP (obj)) { - CONST struct lrecord_implementation + const struct lrecord_implementation *imp = XRECORD_LHEADER_IMPLEMENTATION (obj); if (imp->hash) return imp->hash (obj, depth); @@ -1320,6 +1395,15 @@ return LISP_HASH (obj); } +DEFUN ("sxhash", Fsxhash, 1, 1, 0, /* +Return a hash value for OBJECT. +(equal obj1 obj2) implies (= (sxhash obj1) (sxhash obj2)). +*/ + (object)) +{ + return make_int (internal_hash (object, 0)); +} + #if 0 xxDEFUN ("internal-hash-value", Finternal_hash_value, 1, 1, 0, /* Hash value of OBJECT. For debugging. @@ -1328,7 +1412,7 @@ (object)) { /* This function is pretty 32bit-centric. */ - unsigned long hash = internal_hash (object, 0); + hashcode_t hash = internal_hash (object, 0); return Fcons (hash >> 16, hash & 0xffff); } #endif @@ -1350,11 +1434,13 @@ DEFSUBR (Fclrhash); DEFSUBR (Fmaphash); DEFSUBR (Fhash_table_count); + DEFSUBR (Fhash_table_test); DEFSUBR (Fhash_table_size); DEFSUBR (Fhash_table_rehash_size); DEFSUBR (Fhash_table_rehash_threshold); - DEFSUBR (Fhash_table_type); - DEFSUBR (Fhash_table_test); + DEFSUBR (Fhash_table_weakness); + DEFSUBR (Fhash_table_type); /* obsolete */ + DEFSUBR (Fsxhash); #if 0 DEFSUBR (Finternal_hash_value); #endif @@ -1362,18 +1448,22 @@ defsymbol (&Qhash_tablep, "hash-table-p"); defsymbol (&Qhash_table, "hash-table"); defsymbol (&Qhashtable, "hashtable"); - defsymbol (&Qweak, "weak"); - defsymbol (&Qkey_weak, "key-weak"); - defsymbol (&Qvalue_weak, "value-weak"); - defsymbol (&Qnon_weak, "non-weak"); + defsymbol (&Qweakness, "weakness"); + defsymbol (&Qvalue, "value"); defsymbol (&Qrehash_size, "rehash-size"); defsymbol (&Qrehash_threshold, "rehash-threshold"); - defkeyword (&Q_size, ":size"); + defsymbol (&Qweak, "weak"); /* obsolete */ + defsymbol (&Qkey_weak, "key-weak"); /* obsolete */ + defsymbol (&Qvalue_weak, "value-weak"); /* obsolete */ + defsymbol (&Qnon_weak, "non-weak"); /* obsolete */ + defkeyword (&Q_test, ":test"); - defkeyword (&Q_type, ":type"); + defkeyword (&Q_size, ":size"); defkeyword (&Q_rehash_size, ":rehash-size"); defkeyword (&Q_rehash_threshold, ":rehash-threshold"); + defkeyword (&Q_weakness, ":weakness"); + defkeyword (&Q_type, ":type"); /* obsolete */ } void @@ -1381,4 +1471,5 @@ { /* This must NOT be staticpro'd */ Vall_weak_hash_tables = Qnil; + pdump_wire_list (&Vall_weak_hash_tables); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/elhash.h --- a/src/elhash.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/elhash.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,19 +20,20 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_ELHASH_H_ -#define _XEMACS_ELHASH_H_ +#ifndef INCLUDED_elhash_h_ +#define INCLUDED_elhash_h_ -DECLARE_LRECORD (hash_table, struct Lisp_Hash_Table); +typedef struct Lisp_Hash_Table Lisp_Hash_Table; -#define XHASH_TABLE(x) XRECORD (x, hash_table, struct Lisp_Hash_Table) +DECLARE_LRECORD (hash_table, Lisp_Hash_Table); + +#define XHASH_TABLE(x) XRECORD (x, hash_table, Lisp_Hash_Table) #define XSETHASH_TABLE(x, p) XSETRECORD (x, p, hash_table) #define HASH_TABLEP(x) RECORDP (x, hash_table) -#define GC_HASH_TABLEP(x) GC_RECORDP (x, hash_table) #define CHECK_HASH_TABLE(x) CHECK_RECORD (x, hash_table) #define CONCHECK_HASH_TABLE(x) CONCHECK_RECORD (x, hash_table) -enum hash_table_type +enum hash_table_weakness { HASH_TABLE_NON_WEAK, HASH_TABLE_KEY_WEAK, @@ -49,6 +50,8 @@ HASH_TABLE_EQUAL }; +extern const struct lrecord_description hash_table_description[]; + EXFUN (Fcopy_hash_table, 1); EXFUN (Fhash_table_count, 1); EXFUN (Fgethash, 3); @@ -62,15 +65,14 @@ typedef int (*maphash_function_t) (Lisp_Object key, Lisp_Object value, void* extra_arg); - -Lisp_Object make_general_lisp_hash_table (size_t size, - enum hash_table_type type, - enum hash_table_test test, +Lisp_Object make_general_lisp_hash_table (enum hash_table_test test, + size_t size, + double rehash_size, double rehash_threshold, - double rehash_size); + enum hash_table_weakness weakness); Lisp_Object make_lisp_hash_table (size_t size, - enum hash_table_type type, + enum hash_table_weakness weakness, enum hash_table_test test); void elisp_maphash (maphash_function_t function, @@ -79,8 +81,9 @@ void elisp_map_remhash (maphash_function_t predicate, Lisp_Object hash_table, void *extra_arg); -int finish_marking_weak_hash_tables (int (*obj_marked_p) (Lisp_Object), - void (*markobj) (Lisp_Object)); -void prune_weak_hash_tables (int (*obj_marked_p) (Lisp_Object)); +int finish_marking_weak_hash_tables (void); +void prune_weak_hash_tables (void); -#endif /* _XEMACS_ELHASH_H_ */ +void pdump_reorganize_hash_table (Lisp_Object); + +#endif /* INCLUDED_elhash_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/emacs.c --- a/src/emacs.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/emacs.c Mon Aug 13 11:13:30 2007 +0200 @@ -36,6 +36,7 @@ #include "console.h" #include "process.h" #include "redisplay.h" +#include "frame.h" #include "sysdep.h" #include "syssignal.h" /* Always include before systty.h */ @@ -60,12 +61,6 @@ #include TT_C_H_PATH #endif -#ifdef APOLLO -#ifndef APOLLO_SR10 -#include <default_acl.h> -#endif -#endif - #if defined (WINDOWSNT) #include <windows.h> #endif @@ -73,7 +68,11 @@ /* For PATH_EXEC */ #include <paths.h> -#if !defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC +#ifdef HEAP_IN_DATA +void report_sheap_usage (int die_if_pure_storage_exceeded); +#endif + +#if !defined (SYSTEM_MALLOC) && !defined (DOUG_LEA_MALLOC) extern void *(*__malloc_hook)(size_t); extern void *(*__realloc_hook)(void *, size_t); extern void (*__free_hook)(void *); @@ -111,6 +110,7 @@ /* Version numbers and strings */ Lisp_Object Vemacs_major_version; Lisp_Object Vemacs_minor_version; +Lisp_Object Vemacs_patch_level; Lisp_Object Vemacs_beta_version; Lisp_Object Vxemacs_codename; #ifdef INFODOCK @@ -146,10 +146,11 @@ Lisp_Object Vdoc_directory, Vconfigure_doc_directory; Lisp_Object Vconfigure_lock_directory; Lisp_Object Vdata_directory_list; -Lisp_Object Vinfo_directory, Vconfigure_info_directory; +Lisp_Object Vconfigure_info_directory; Lisp_Object Vsite_directory, Vconfigure_site_directory; Lisp_Object Vconfigure_info_path; Lisp_Object Vinternal_error_checking; +Lisp_Object Vmail_lock_methods, Vconfigure_mail_lock_method; Lisp_Object Vpath_separator; /* The default base directory XEmacs is installed under. */ @@ -170,7 +171,7 @@ /* Type of display specified. We cannot use a Lisp symbol here because Lisp symbols may not initialized at the time that we set this variable. */ -CONST char *display_use; +const char *display_use; /* If non-zero, then the early error handler will only print the error message and exit. */ @@ -216,14 +217,16 @@ int debug_paths; /* Save argv and argc. */ -char **initial_argv; -int initial_argc; +static char **initial_argv; +static int initial_argc; static void sort_args (int argc, char **argv); Lisp_Object Qkill_emacs_hook; Lisp_Object Qsave_buffers_kill_emacs; +extern Lisp_Object Vlisp_EXEC_SUFFIXES; + /* Signal code for the fatal signal that was received */ static int fatal_error_code; @@ -253,7 +256,7 @@ # if 0 /* This is evil, rarely useful, and causes grief in some cases. */ /* Check for Sun-style stack printing via /proc */ { - CONST char *pstack = "/usr/proc/bin/pstack"; + const char *pstack = "/usr/proc/bin/pstack"; if (access (pstack, X_OK) == 0) { char buf[100]; @@ -272,7 +275,7 @@ DOESNT_RETURN -fatal (CONST char *fmt, ...) +fatal (const char *fmt, ...) { va_list args; va_start (args, fmt); @@ -297,7 +300,7 @@ GETTEXT on the format string. */ int -stderr_out (CONST char *fmt, ...) +stderr_out (const char *fmt, ...) { int retval; va_list args; @@ -314,7 +317,7 @@ GETTEXT on the format string. */ int -stdout_out (CONST char *fmt, ...) +stdout_out (const char *fmt, ...) { int retval; va_list args; @@ -362,7 +365,7 @@ /* Do not trust to what crt0 has stuffed into argv[0] */ char full_exe_path [MAX_PATH]; GetModuleFileName (NULL, full_exe_path, MAX_PATH); - result = Fcons (build_ext_string (full_exe_path, FORMAT_FILENAME), + result = Fcons (build_ext_string (full_exe_path, Qfile_name), result); #if defined(HAVE_SHLIB) (void)dll_init(full_exe_path); @@ -370,7 +373,8 @@ } else #endif - result = Fcons (build_ext_string (argv [i], FORMAT_FILENAME), result); + result = Fcons (build_ext_string (argv [i], Qfile_name), + result); } } return result; @@ -394,10 +398,12 @@ for (i = 0, next = argv_list; i < n; i++, next = XCDR (next)) { - CONST char *temp; + const char *temp; CHECK_STRING (XCAR (next)); - GET_C_STRING_EXT_DATA_ALLOCA (XCAR (next), FORMAT_OS, temp); + TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (next), + C_STRING_ALLOCA, temp, + Qnative); (*argv) [i] = xstrdup (temp); } (*argv) [n] = 0; @@ -540,7 +546,8 @@ extern int malloc_cookie; #endif -#if !defined(SYSTEM_MALLOC) && !defined(HAVE_LIBMCHECK) +#if (!defined (SYSTEM_MALLOC) && !defined (HAVE_LIBMCHECK) \ + && !defined (DOUG_LEA_MALLOC)) /* Make sure that any libraries we link against haven't installed a hook for a gmalloc of a potentially incompatible version. */ /* If we're using libmcheck, the hooks have already been initialized, */ @@ -548,7 +555,7 @@ __malloc_hook = NULL; __realloc_hook = NULL; __free_hook = NULL; -#endif /* not SYSTEM_MALLOC */ +#endif /* not SYSTEM_MALLOC or HAVE_LIBMCHECK or DOUG_LEA_MALLOC */ noninteractive = 0; @@ -610,15 +617,6 @@ clearerr (stdin); -#ifdef APOLLO -#ifndef APOLLO_SR10 - /* If USE_DOMAIN_ACLS environment variable exists, - use ACLs rather than UNIX modes. */ - if (egetenv ("USE_DOMAIN_ACLS")) - default_acl (USE_DEFACL); -#endif -#endif /* APOLLO */ - #if defined (HAVE_MMAP) && defined (REL_ALLOC) /* ralloc can only be used if using the GNU memory allocator. */ init_ralloc (); @@ -848,6 +846,22 @@ We try to do things in an order that minimizes the non-obvious dependencies between functions. */ + /* purify_flag 1 is correct even if CANNOT_DUMP. + * loadup.el will set to nil at end. */ + + purify_flag = 0; +#ifdef PDUMP + if (restart) + initialized = 1; + else { + initialized = pdump_load (); + purify_flag = !initialized; + } +#else + if (!initialized) + purify_flag = 1; +#endif + if (!initialized) { /* Initialize things so that new Lisp objects @@ -884,9 +898,6 @@ syms_of_abbrev (); syms_of_alloc (); -#ifdef HAVE_X_WINDOWS - syms_of_balloon_x (); -#endif syms_of_buffer (); syms_of_bytecode (); syms_of_callint (); @@ -900,6 +911,7 @@ syms_of_data (); #ifdef DEBUG_XEMACS syms_of_debug (); + syms_of_tests (); #endif /* DEBUG_XEMACS */ syms_of_device (); #ifdef HAVE_DIALOGS @@ -936,6 +948,7 @@ #if defined (HAVE_MENUBARS) || defined (HAVE_SCROLLBARS) || defined (HAVE_DIALOGS) || defined (HAVE_TOOLBARS) syms_of_gui (); #endif + syms_of_gutter (); syms_of_indent (); syms_of_intl (); syms_of_keymap (); @@ -968,6 +981,7 @@ syms_of_rangetab (); syms_of_redisplay (); syms_of_search (); + syms_of_select (); syms_of_signal (); syms_of_sound (); syms_of_specifier (); @@ -990,6 +1004,7 @@ #endif #ifdef HAVE_X_WINDOWS + syms_of_balloon_x (); syms_of_device_x (); #ifdef HAVE_DIALOGS syms_of_dialog_x (); @@ -1000,10 +1015,15 @@ #ifdef HAVE_MENUBARS syms_of_menubar_x (); #endif - syms_of_xselect (); + syms_of_select_x (); #if defined (HAVE_MENUBARS) || defined (HAVE_SCROLLBARS) || defined (HAVE_DIALOGS) || defined (HAVE_TOOLBARS) syms_of_gui_x (); #endif +#ifdef HAVE_XIM +#ifdef XIM_XLIB + syms_of_input_method_xlib (); +#endif +#endif /* HAVE_XIM */ #endif /* HAVE_X_WINDOWS */ #ifdef HAVE_MS_WINDOWS @@ -1013,6 +1033,7 @@ syms_of_objects_mswindows (); syms_of_select_mswindows (); syms_of_glyphs_mswindows (); + syms_of_gui_mswindows (); #ifdef HAVE_MENUBARS syms_of_menubar_mswindows (); #endif @@ -1022,6 +1043,9 @@ #ifdef HAVE_MSW_C_DIRED syms_of_dired_mswindows (); #endif +#ifdef WINDOWSNT + syms_of_ntproc (); +#endif #endif /* HAVE_MS_WINDOWS */ #ifdef MULE @@ -1030,7 +1054,7 @@ syms_of_mule_charset (); #endif #ifdef FILE_CODING - syms_of_mule_coding (); + syms_of_file_coding (); #endif #ifdef MULE #ifdef HAVE_WNN @@ -1071,6 +1095,10 @@ syms_of_eldap (); #endif +#ifdef HAVE_GPM + syms_of_gpmevent (); +#endif + /* Now create the subtypes for the types that have them. We do this before the vars_*() because more symbols may get initialized here. */ @@ -1102,6 +1130,7 @@ console_type_create_device_x (); console_type_create_frame_x (); console_type_create_glyphs_x (); + console_type_create_select_x (); #ifdef HAVE_MENUBARS console_type_create_menubar_x (); #endif @@ -1125,6 +1154,7 @@ console_type_create_objects_mswindows (); console_type_create_redisplay_mswindows (); console_type_create_glyphs_mswindows (); + console_type_create_select_mswindows (); # ifdef HAVE_SCROLLBARS console_type_create_scrollbar_mswindows (); # endif @@ -1152,6 +1182,7 @@ specifier_type_create (); specifier_type_create_image (); + specifier_type_create_gutter (); specifier_type_create_objects (); #ifdef HAVE_TOOLBARS specifier_type_create_toolbar (); @@ -1187,6 +1218,9 @@ image_instantiator_format_create (); image_instantiator_format_create_glyphs_eimage (); image_instantiator_format_create_glyphs_widget (); +#ifdef HAVE_TTY + image_instantiator_format_create_glyphs_tty (); +#endif #ifdef HAVE_X_WINDOWS image_instantiator_format_create_glyphs_x (); #endif /* HAVE_X_WINDOWS */ @@ -1204,7 +1238,7 @@ lstream_type_create (); #ifdef FILE_CODING - lstream_type_create_mule_coding (); + lstream_type_create_file_coding (); #endif #if defined (HAVE_MS_WINDOWS) && !defined(HAVE_MSG_SELECT) lstream_type_create_mswindows_selectable (); @@ -1235,7 +1269,7 @@ staticpro() Fprovide(symbol) intern() - pure_put() + Fput() xmalloc() defsymbol(), if it's absolutely necessary and you're sure that the symbol isn't referenced anywhere else in the initialization @@ -1248,7 +1282,6 @@ Any of the object-creating functions on alloc.c: e.g. make_pure_*() - Fpurecopy() make_string() build_string() make_vector() @@ -1258,7 +1291,6 @@ Fcons() listN() make_opaque_ptr() - make_opaque_long() perhaps a few others. */ @@ -1266,21 +1298,23 @@ /* Now allow Fprovide() statements to be made. */ init_provide_once (); + /* Do that before any specifier creation (esp. vars_of_glyphs()) */ + vars_of_specifier (); + vars_of_abbrev (); vars_of_alloc (); -#ifdef HAVE_X_WINDOWS - vars_of_balloon_x (); -#endif vars_of_buffer (); vars_of_bytecode (); vars_of_callint (); vars_of_callproc (); + vars_of_chartab (); vars_of_cmdloop (); vars_of_cmds (); vars_of_console (); vars_of_data (); #ifdef DEBUG_XEMACS vars_of_debug (); + vars_of_tests (); #endif vars_of_console_stream (); vars_of_device (); @@ -1321,6 +1355,7 @@ #if defined (HAVE_MENUBARS) || defined (HAVE_SCROLLBARS) || defined (HAVE_DIALOGS) || defined (HAVE_TOOLBARS) vars_of_gui (); #endif + vars_of_gutter (); vars_of_indent (); vars_of_insdel (); vars_of_intl (); @@ -1346,6 +1381,10 @@ #ifdef HAVE_SHLIB vars_of_module (); #endif +#ifdef WINDOWSNT + vars_of_nt (); + vars_of_ntproc (); +#endif vars_of_objects (); vars_of_print (); @@ -1368,8 +1407,8 @@ vars_of_scrollbar (); #endif vars_of_search (); + vars_of_select (); vars_of_sound (); - vars_of_specifier (); vars_of_symbols (); vars_of_syntax (); #ifdef HAVE_TOOLBARS @@ -1385,6 +1424,7 @@ #endif #ifdef HAVE_X_WINDOWS + vars_of_balloon_x (); vars_of_device_x (); #ifdef HAVE_DIALOGS vars_of_dialog_x (); @@ -1395,14 +1435,14 @@ vars_of_menubar_x (); #endif vars_of_objects_x (); - vars_of_xselect (); + vars_of_select_x (); #ifdef HAVE_SCROLLBARS vars_of_scrollbar_x (); #endif #if defined (HAVE_MENUBARS) || defined (HAVE_SCROLLBARS) || defined (HAVE_DIALOGS) || defined (HAVE_TOOLBARS) vars_of_gui_x (); #endif -#endif +#endif /* HAVE_X_WINDOWS */ #ifdef HAVE_MS_WINDOWS vars_of_device_mswindows (); @@ -1427,10 +1467,11 @@ #ifdef MULE vars_of_mule (); + vars_of_mule_ccl (); vars_of_mule_charset (); #endif #ifdef FILE_CODING - vars_of_mule_coding (); + vars_of_file_coding (); #endif #ifdef MULE #ifdef HAVE_WNN @@ -1453,6 +1494,10 @@ vars_of_eldap (); #endif +#ifdef HAVE_GPM + vars_of_gpmevent (); +#endif + /* Now initialize any specifier variables. We do this later because it has some dependence on the vars initialized above. @@ -1468,6 +1513,7 @@ */ specifier_vars_of_glyphs (); + specifier_vars_of_gutter (); #ifdef HAVE_MENUBARS specifier_vars_of_menubar (); #endif @@ -1501,8 +1547,8 @@ earlier. The second may also depend on the first. */ complex_vars_of_mule_charset (); #endif -#if defined(FILE_CODING) - complex_vars_of_mule_coding (); +#ifdef FILE_CODING + complex_vars_of_file_coding (); #endif /* This calls allocate_glyph(), which creates specifiers @@ -1583,8 +1629,118 @@ garbage_collect_1 (); } #endif +#ifdef PDUMP + } else if (!restart) { + reinit_alloc_once_early (); + reinit_symbols_once_early (); + reinit_opaque_once_early (); + + reinit_console_type_create_stream (); +#ifdef HAVE_TTY + reinit_console_type_create_tty (); +#endif +#ifdef HAVE_X_WINDOWS + reinit_console_type_create_x (); + reinit_console_type_create_device_x (); +#endif +#ifdef HAVE_MS_WINDOWS + reinit_console_type_create_mswindows (); +#endif + + reinit_specifier_type_create (); + reinit_specifier_type_create_image (); + reinit_specifier_type_create_gutter (); + reinit_specifier_type_create_objects (); +#ifdef HAVE_TOOLBARS + reinit_specifier_type_create_toolbar (); +#endif + + structure_type_create (); + + structure_type_create_chartab (); + structure_type_create_faces (); + structure_type_create_rangetab (); + structure_type_create_hash_table (); + + lstream_type_create (); +#ifdef FILE_CODING + lstream_type_create_file_coding (); +#endif +#if defined (HAVE_MS_WINDOWS) && !defined(HAVE_MSG_SELECT) + lstream_type_create_mswindows_selectable (); +#endif +#ifdef HAVE_UNIX_PROCESSES + process_type_create_unix (); +#endif +#ifdef HAVE_WIN32_PROCESSES + process_type_create_nt (); +#endif + + reinit_vars_of_buffer (); + reinit_vars_of_console (); +#ifdef DEBUG_XEMACS + reinit_vars_of_debug (); +#endif + reinit_vars_of_device (); + reinit_vars_of_eval (); +#ifdef HAVE_X_WINDOWS + reinit_vars_of_event_Xt (); +#endif +#if defined(HAVE_TTY) && (defined (DEBUG_TTY_EVENT_STREAM) || !defined (HAVE_X_WINDOWS)) + reinit_vars_of_event_tty (); +#endif +#ifdef HAVE_MS_WINDOWS + reinit_vars_of_event_mswindows (); +#endif + reinit_vars_of_event_stream (); + reinit_vars_of_events (); + reinit_vars_of_extents (); + reinit_vars_of_font_lock (); + reinit_vars_of_glyphs (); + reinit_vars_of_glyphs_widget (); + reinit_vars_of_insdel (); + reinit_vars_of_lread (); + reinit_vars_of_lstream (); + reinit_vars_of_minibuf (); +#ifdef HAVE_SHLIB + reinit_vars_of_module (); +#endif + reinit_vars_of_objects (); + reinit_vars_of_print (); + reinit_vars_of_redisplay (); + reinit_vars_of_search (); + reinit_vars_of_undo (); + reinit_vars_of_window (); + +#ifdef HAVE_MS_WINDOWS + reinit_vars_of_frame_mswindows (); +#endif + +#ifdef HAVE_X_WINDOWS + reinit_vars_of_device_x (); +#ifdef HAVE_SCROLLBARS + reinit_vars_of_scrollbar_x (); +#endif +#ifdef HAVE_MENUBARS + reinit_vars_of_menubar_x (); +#endif + reinit_vars_of_select_x (); +#if defined (HAVE_MENUBARS) || defined (HAVE_SCROLLBARS) || defined (HAVE_DIALOGS) || defined (HAVE_TOOLBARS) + reinit_vars_of_gui_x (); +#endif +#endif /* HAVE_X_WINDOWS */ + +#if defined(MULE) && defined(HAVE_WNN) + reinit_vars_of_mule_wnn (); +#endif + + reinit_complex_vars_of_buffer (); + reinit_complex_vars_of_console (); + reinit_complex_vars_of_minibuf (); +#endif /* PDUMP */ } + /* CONGRATULATIONS!!! We have successfully initialized the Lisp engine. */ @@ -1639,6 +1795,7 @@ init_redisplay (); /* Determine terminal type. init_sys_modes uses results */ + init_frame (); init_event_stream (); /* Set up so we can get user input. */ init_macros (); /* set up so we can run macros. */ init_editfns (); /* Determine the name of the user we're running as */ @@ -1676,7 +1833,8 @@ else { Vinvocation_path = decode_env_path ("PATH", NULL); - locate_file (Vinvocation_path, Vinvocation_name, EXEC_SUFFIXES, + locate_file (Vinvocation_path, Vinvocation_name, + Vlisp_EXEC_SUFFIXES, &Vinvocation_directory, X_OK); } @@ -1745,8 +1903,8 @@ struct standard_args { - CONST char * CONST name; - CONST char * CONST longname; + const char * const name; + const char * const longname; int priority; int nargs; }; @@ -1985,11 +2143,11 @@ (int nargs, Lisp_Object *args)) { int ac; - CONST Extbyte *wampum; + const Extbyte *wampum; int namesize; int total_len; Lisp_Object orig_invoc_name = Fcar (Vcommand_line_args); - CONST Extbyte **wampum_all = alloca_array (CONST Extbyte *, nargs); + const Extbyte **wampum_all = alloca_array (const Extbyte *, nargs); int *wampum_all_len = alloca_array (int, nargs); assert (!gc_in_progress); @@ -2000,21 +2158,22 @@ /* Need to convert the orig_invoc_name and all of the arguments to external format. */ - GET_STRING_EXT_DATA_ALLOCA (orig_invoc_name, FORMAT_OS, wampum, - namesize); + TO_EXTERNAL_FORMAT (LISP_STRING, orig_invoc_name, + ALLOCA, (wampum, namesize), + Qnative); namesize++; for (ac = 0, total_len = namesize; ac < nargs; ac++) { CHECK_STRING (args[ac]); - GET_STRING_EXT_DATA_ALLOCA (args[ac], FORMAT_OS, - wampum_all[ac], - wampum_all_len[ac]); + TO_EXTERNAL_FORMAT (LISP_STRING, args[ac], + ALLOCA, (wampum_all[ac], wampum_all_len[ac]), + Qnative); wampum_all_len[ac]++; total_len += wampum_all_len[ac]; } DO_REALLOC (run_temacs_args, run_temacs_args_size, total_len, char); - DO_REALLOC (run_temacs_argv, run_temacs_argv_size, nargs+1, char *); + DO_REALLOC (run_temacs_argv, run_temacs_argv_size, nargs+2, char *); memcpy (run_temacs_args, wampum, namesize); run_temacs_argv [0] = run_temacs_args; @@ -2031,13 +2190,9 @@ unbind_to (0, Qnil); /* this closes loadup.el */ purify_flag = 0; run_temacs_argc = nargs + 1; -#if 0 -#ifdef REPORT_PURE_USAGE - report_pure_usage (1, 0); -#else - report_pure_usage (0, 0); +#ifdef HEAP_IN_DATA + report_sheap_usage (0); #endif -#endif /* 0 */ LONGJMP (run_temacs_catch, 1); return Qnil; /* not reached; warning suppression */ } @@ -2177,9 +2332,13 @@ { /* Disable all calls to free() when XEmacs is exiting and it doesn't */ /* matter. */ - __free_hook = voodoo_free_hook; + __free_hook = +#ifdef __GNUC__ /* prototype of __free_hook varies with glibc version */ + (__typeof__ (__free_hook)) +#endif + voodoo_free_hook; } -#endif +#endif /* GNU_MALLOC */ DEFUN ("kill-emacs", Fkill_emacs, 0, 1, "P", /* Exit the XEmacs job and kill it. Ask for confirmation, without argument. @@ -2233,13 +2392,17 @@ UNGCPRO; - shut_down_emacs (0, ((STRINGP (arg)) ? arg : Qnil)); + shut_down_emacs (0, STRINGP (arg) ? arg : Qnil); #if defined(GNU_MALLOC) - __free_hook = voodoo_free_hook; + __free_hook = +#ifdef __GNUC__ /* prototype of __free_hook varies with glibc version */ + (__typeof__ (__free_hook)) #endif - - exit ((INTP (arg)) ? XINT (arg) : 0); + voodoo_free_hook; +#endif + + exit (INTP (arg) ? XINT (arg) : 0); /* NOTREACHED */ return Qnil; /* I'm sick of the compiler warning */ } @@ -2295,12 +2458,16 @@ ("Your files have been auto-saved.\n" "Use `M-x recover-session' to recover them.\n" "\n" + "If you have access to the PROBLEMS file that came with your\n" + "version of XEmacs, please check to see if your crash is described\n" + "there, as there may be a workaround available.\n" #ifdef INFODOCK - "Please report this bug by selecting `Report-Bug' in the InfoDock\n" - "menu.\n" + "Otherwise, please report this bug by selecting `Report-Bug'\n" + "in the InfoDock menu.\n" #else - "Please report this bug by running the send-pr script included\n" - "with XEmacs, or selecting `Send Bug Report' from the help menu.\n" + "Otherwise, please report this bug by running the send-pr\n" + "script included with XEmacs, or selecting `Send Bug Report'\n" + "from the help menu.\n" "As a last resort send ordinary email to `crashes@xemacs.org'.\n" #endif "*MAKE SURE* to include the information in the command\n" @@ -2315,17 +2482,17 @@ "\n" " gdb "); { - CONST char *name; + const char *name; char *dir = 0; /* Now try to determine the actual path to the executable, to try to make the backtrace-determination process as foolproof as possible. */ - if (GC_STRINGP (Vinvocation_name)) + if (STRINGP (Vinvocation_name)) name = (char *) XSTRING_DATA (Vinvocation_name); else name = "xemacs"; - if (GC_STRINGP (Vinvocation_directory)) + if (STRINGP (Vinvocation_directory)) dir = (char *) XSTRING_DATA (Vinvocation_directory); if (!dir || dir[0] != '/') stderr_out ("`which %s`", name); @@ -2362,10 +2529,10 @@ #ifndef CANNOT_DUMP -/* Nothing like this can be implemented on an Apollo. - What a loss! */ - + +#if !defined(PDUMP) || !defined(SYSTEM_MALLOC) extern char my_edata[]; +#endif #ifdef HAVE_SHM @@ -2446,12 +2613,12 @@ opurify = purify_flag; purify_flag = 0; -#ifdef DEBUG_XEMACS - report_pure_usage (1, 1); -#else - report_pure_usage (0, 1); +#ifdef HEAP_IN_DATA + report_sheap_usage (1); #endif + clear_message (); + fflush (stderr); fflush (stdout); @@ -2482,13 +2649,23 @@ char *intoname_ext; char *symname_ext; - GET_C_STRING_FILENAME_DATA_ALLOCA (intoname, intoname_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, intoname, + C_STRING_ALLOCA, intoname_ext, + Qfile_name); + if (STRINGP (symname)) - GET_C_STRING_FILENAME_DATA_ALLOCA (symname, symname_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, symname, + C_STRING_ALLOCA, symname_ext, + Qfile_name); else symname_ext = 0; garbage_collect_1 (); + +#ifdef PDUMP + pdump (); +#else + #ifdef DOUG_LEA_MALLOC malloc_state_ptr = malloc_get_state (); #endif @@ -2502,6 +2679,7 @@ #ifdef DOUG_LEA_MALLOC free (malloc_state_ptr); #endif +#endif /* not PDUMP */ } #endif /* not MSDOS and EMX */ @@ -2521,15 +2699,15 @@ /* Split STRING into a list of substrings. The substrings are the parts of original STRING separated by SEPCHAR. */ static Lisp_Object -split_string_by_emchar_1 (CONST Bufbyte *string, Bytecount size, +split_string_by_emchar_1 (const Bufbyte *string, Bytecount size, Emchar sepchar) { Lisp_Object result = Qnil; - CONST Bufbyte *end = string + size; + const Bufbyte *end = string + size; while (1) { - CONST Bufbyte *p = string; + const Bufbyte *p = string; while (p < end) { if (charptr_emchar (p) == sepchar) @@ -2549,33 +2727,32 @@ } /* The same as the above, except PATH is an external C string (it is - converted as FORMAT_FILENAME), and sepchar is hardcoded to SEPCHAR + converted using Qfile_name), and sepchar is hardcoded to SEPCHAR (':' or whatever). */ Lisp_Object -decode_path (CONST char *path) +decode_path (const char *path) { - int len; + Bytecount newlen; Bufbyte *newpath; if (!path) return Qnil; - GET_C_CHARPTR_INT_FILENAME_DATA_ALLOCA (path, newpath); - - len = strlen ((const char *) newpath); + TO_INTERNAL_FORMAT (C_STRING, path, ALLOCA, (newpath, newlen), Qfile_name); + /* #### Does this make sense? It certainly does for decode_env_path(), but it looks dubious here. Does any code depend on decode_path("") returning nil instead of an empty string? */ - if (!len) + if (!newlen) return Qnil; - return split_string_by_emchar_1 (newpath, (Bytecount)len, SEPCHAR); + return split_string_by_emchar_1 (newpath, newlen, SEPCHAR); } Lisp_Object -decode_env_path (CONST char *evarname, CONST char *default_) +decode_env_path (const char *evarname, const char *default_) { - CONST char *path = 0; + const char *path = 0; if (evarname) path = egetenv (evarname); if (!path) @@ -2638,7 +2815,7 @@ /* This highly dubious kludge ... shut up Jamie, I'm tired of your slagging. */ DOESNT_RETURN -assert_failed (CONST char *file, int line, CONST char *expr) +assert_failed (const char *file, int line, const char *expr) { stderr_out ("Fatal error: assertion failed, file %s, line %d, %s\n", file, line, expr); @@ -2761,7 +2938,7 @@ DEFVAR_LISP ("system-configuration", &Vsystem_configuration /* String naming the configuration XEmacs was built for. */ ); - Vsystem_configuration = Fpurecopy (build_string (EMACS_CONFIGURATION)); + Vsystem_configuration = build_string (EMACS_CONFIGURATION); #ifndef EMACS_CONFIG_OPTIONS # define EMACS_CONFIG_OPTIONS "UNKNOWN" @@ -2769,8 +2946,7 @@ DEFVAR_LISP ("system-configuration-options", &Vsystem_configuration_options /* String containing the configuration options XEmacs was built with. */ ); - Vsystem_configuration_options = Fpurecopy (build_string - (EMACS_CONFIG_OPTIONS)); + Vsystem_configuration_options = build_string (EMACS_CONFIG_OPTIONS); DEFVAR_LISP ("emacs-major-version", &Vemacs_major_version /* Major version number of this version of Emacs, as an integer. @@ -2788,7 +2964,20 @@ */ ); Vemacs_minor_version = make_int (EMACS_MINOR_VERSION); - DEFVAR_LISP ("emacs-beta-version", &Vemacs_beta_version /* + DEFVAR_LISP ("emacs-patch-level", &Vemacs_patch_level /* +The patch level of this version of Emacs, as an integer. +The value is non-nil if this version of XEmacs is part of a series of +stable XEmacsen, but has bug fixes applied. +Warning: this variable does not exist in FSF Emacs or in XEmacs versions +earlier than 21.1.1 +*/ ); +#ifdef EMACS_PATCH_LEVEL + Vemacs_patch_level = make_int (EMACS_PATCH_LEVEL); +#else + Vemacs_patch_level = Qnil; +#endif + + DEFVAR_LISP ("emacs-beta-version", &Vemacs_beta_version /* Beta number of this version of Emacs, as an integer. The value is nil if this is an officially released version of XEmacs. Warning: this variable does not exist in FSF Emacs or in XEmacs versions @@ -2823,7 +3012,7 @@ #ifndef XEMACS_CODENAME #define XEMACS_CODENAME "Noname" #endif - Vxemacs_codename = Fpurecopy (build_string (XEMACS_CODENAME)); + Vxemacs_codename = build_string (XEMACS_CODENAME); DEFVAR_BOOL ("noninteractive", &noninteractive1 /* Non-nil means XEmacs is running without interactive terminal. @@ -2897,7 +3086,46 @@ Vinternal_error_checking = Fcons (intern ("bufpos"), Vinternal_error_checking); #endif - Vinternal_error_checking = Fpurecopy (Vinternal_error_checking); + + DEFVAR_CONST_LISP ("mail-lock-methods", &Vmail_lock_methods /* +Mail spool locking methods supported by this instance of XEmacs. +This is a list of symbols. Each of the symbols is one of the +following: dot, lockf, flock, locking, mmdf. +*/ ); + { + Vmail_lock_methods = Qnil; + Vmail_lock_methods = Fcons (intern ("dot"), Vmail_lock_methods); +#ifdef HAVE_LOCKF + Vmail_lock_methods = Fcons (intern ("lockf"), Vmail_lock_methods); +#endif +#ifdef HAVE_FLOCK + Vmail_lock_methods = Fcons (intern ("flock"), Vmail_lock_methods); +#endif +#ifdef HAVE_MMDF + Vmail_lock_methods = Fcons (intern ("mmdf"), Vmail_lock_methods); +#endif +#ifdef HAVE_LOCKING + Vmail_lock_methods = Fcons (intern ("locking"), Vmail_lock_methods); +#endif + } + + DEFVAR_CONST_LISP ("configure-mail-lock-method", &Vconfigure_mail_lock_method /* +Mail spool locking method suggested by configure. This is one +of the symbols in MAIL-LOCK-METHODS. +*/ ); + { +#if defined(MAIL_LOCK_FLOCK) && defined(HAVE_FLOCK) + Vconfigure_mail_lock_method = intern("flock"); +#elif defined(MAIL_LOCK_LOCKF) && defined(HAVE_LOCKF) + Vconfigure_mail_lock_method = intern("lockf"); +#elif defined(MAIL_LOCK_MMDF) && defined(HAVE_MMDF) + Vconfigure_mail_lock_method = intern("mmdf"); +#elif defined(MAIL_LOCK_LOCKING) && defined(HAVE_LOCKING) + Vconfigure_mail_lock_method = intern("locking"); +#else + Vconfigure_mail_lock_method = intern("dot"); +#endif + } DEFVAR_LISP ("path-separator", &Vpath_separator /* The directory separator in search paths, as a string. @@ -3124,7 +3352,7 @@ #endif } -#ifdef __sgi +#if defined(__sgi) && !defined(PDUMP) /* This is so tremendously ugly I'd puke. But then, it works. * The target is to override the static constructor from the * libiflPNG.so library which is maskerading as libz, and diff -r f4aeb21a5bad -r 74fd4e045ea6 src/emodules.c --- a/src/emodules.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/emodules.c Mon Aug 13 11:13:30 2007 +0200 @@ -42,12 +42,14 @@ dll_handle dlhandle; /* Dynamic lib handle */ } emodules_list; +static Lisp_Object Vmodule_extensions; + static int emodules_depth; static dll_handle dlhandle; static emodules_list *modules; static int modnum; -static int find_make_module (CONST char *mod, CONST char *name, CONST char *ver, int make_or_find); +static int find_make_module (const char *mod, const char *name, const char *ver, int make_or_find); static Lisp_Object module_load_unwind (Lisp_Object); static void attempt_module_delete (int mod); @@ -182,7 +184,7 @@ } static int -find_make_module (CONST char *mod, CONST char *name, CONST char *ver, int mof) +find_make_module (const char *mod, const char *name, const char *ver, int mof) { int i, fs = -1; @@ -211,9 +213,9 @@ * not previously loaded. */ if (modules == (emodules_list *)0) - modules = (emodules_list *)xmalloc (sizeof(emodules_list)); + modules = (emodules_list *) xmalloc (sizeof (emodules_list)); modnum++; - modules = xrealloc (modules, modnum * sizeof(emodules_list)); + modules = (emodules_list *) xrealloc (modules, modnum * sizeof (emodules_list)); fs = modnum - 1; memset (&modules[fs], 0, sizeof(emodules_list)); @@ -302,14 +304,14 @@ * the cleaning up. */ void -emodules_load(CONST char *module, CONST char *modname, CONST char *modver) +emodules_load(const char *module, const char *modname, const char *modver) { Lisp_Object filename; Lisp_Object foundname; int fd, x, mpx; char *soname, *tmod; - CONST char **f; - CONST long *ellcc_rev; + const char **f; + const long *ellcc_rev; char *mver, *mname, *mtitle, *symname; void (*modload)(void) = 0; void (*modsyms)(void) = 0; @@ -324,7 +326,7 @@ emodules_depth++; dlhandle = 0; - if ((module == (CONST char *)0) || (module[0] == '\0')) + if ((module == (const char *)0) || (module[0] == '\0')) error ("Empty module name"); /* This is to get around the fact that build_string() is not declared @@ -334,7 +336,8 @@ GCPRO2(filename, foundname); filename = build_string (tmod); - fd = locate_file(Vmodule_load_path, filename, ":.ell:.so:.dll", &foundname, -1); + fd = locate_file(Vmodule_load_path, filename, Vmodule_extensions, + &foundname, -1); UNGCPRO; if (fd < 0) @@ -347,15 +350,15 @@ if (dlhandle == (dll_handle)0) error ("Opening dynamic module: %s", dll_error (dlhandle)); - ellcc_rev = (CONST long *)dll_variable (dlhandle, "emodule_compiler"); - if ((ellcc_rev == (CONST long *)0) || (*ellcc_rev <= 0)) + ellcc_rev = (const long *)dll_variable (dlhandle, "emodule_compiler"); + if ((ellcc_rev == (const long *)0) || (*ellcc_rev <= 0)) error ("Missing symbol `emodule_compiler': Invalid dynamic module"); if (*ellcc_rev > EMODULES_REVISION) error ("Unsupported version `%ld(%ld)': Invalid dynamic module", *ellcc_rev, EMODULES_REVISION); - f = (CONST char **)dll_variable (dlhandle, "emodule_name"); - if ((f == (CONST char **)0) || (*f == (CONST char *)0)) + f = (const char **)dll_variable (dlhandle, "emodule_name"); + if ((f == (const char **)0) || (*f == (const char *)0)) error ("Missing symbol `emodule_name': Invalid dynamic module"); mname = (char *)alloca (strlen (*f) + 1); @@ -363,15 +366,15 @@ if (mname[0] == '\0') error ("Empty value for `emodule_name': Invalid dynamic module"); - f = (CONST char **)dll_variable (dlhandle, "emodule_version"); - if ((f == (CONST char **)0) || (*f == (CONST char *)0)) + f = (const char **)dll_variable (dlhandle, "emodule_version"); + if ((f == (const char **)0) || (*f == (const char *)0)) error ("Missing symbol `emodule_version': Invalid dynamic module"); mver = (char *)alloca (strlen (*f) + 1); strcpy (mver, *f); - f = (CONST char **)dll_variable (dlhandle, "emodule_title"); - if ((f == (CONST char **)0) || (*f == (CONST char *)0)) + f = (const char **)dll_variable (dlhandle, "emodule_title"); + if ((f == (const char **)0) || (*f == (const char *)0)) error ("Missing symbol `emodule_title': Invalid dynamic module"); mtitle = (char *)alloca (strlen (*f) + 1); @@ -475,11 +478,11 @@ } void -emodules_doc_subr(CONST char *symname, CONST char *doc) +emodules_doc_subr(const char *symname, const char *doc) { Bytecount len = strlen (symname); - Lisp_Object sym = oblookup (Vobarray, (CONST Bufbyte *)symname, len); - struct Lisp_Subr *subr; + Lisp_Object sym = oblookup (Vobarray, (const Bufbyte *)symname, len); + Lisp_Subr *subr; if (SYMBOLP(sym)) { @@ -495,10 +498,10 @@ } void -emodules_doc_sym (CONST char *symname, CONST char *doc) +emodules_doc_sym (const char *symname, const char *doc) { Bytecount len = strlen (symname); - Lisp_Object sym = oblookup (Vobarray, (CONST Bufbyte *)symname, len); + Lisp_Object sym = oblookup (Vobarray, (const Bufbyte *)symname, len); Lisp_Object docstr; struct gcpro gcpro1; @@ -523,8 +526,18 @@ } void +reinit_vars_of_module (void) +{ + emodules_depth = 0; + modules = (emodules_list *)0; + modnum = 0; +} + +void vars_of_module (void) { + reinit_vars_of_module (); + DEFVAR_LISP ("module-version", &Vmodule_version /* Emacs dynamic loading mechanism version, as a string. @@ -534,7 +547,7 @@ the dynamic loading technology used in Emacs, if required. It is not a given that this value will be the same as the Emacs version number. */ ); - Vmodule_version = Fpurecopy (build_string (EMODULES_VERSION)); + Vmodule_version = build_string (EMODULES_VERSION); DEFVAR_BOOL ("load-modules-quietly", &load_modules_quietly /* *Set to t if module loading is to be silent. @@ -567,10 +580,11 @@ when a dynamic module is loaded. */); + /* #### Export this to Lisp */ + Vmodule_extensions = build_string (":.ell:.so:.dll"); + staticpro (&Vmodule_extensions); + load_modules_quietly = 0; - emodules_depth = 0; - modules = (emodules_list *)0; - modnum = 0; Vmodule_load_path = Qnil; Fprovide (intern ("modules")); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/emodules.h --- a/src/emodules.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/emodules.h Mon Aug 13 11:13:30 2007 +0200 @@ -64,7 +64,7 @@ * specified version before. We also use these as checks when we open the * module to make sure we have the right module. */ -extern void emodules_load (CONST char *module, CONST char *name, CONST char *version); +extern void emodules_load (const char *module, const char *name, const char *version); /* * Because subrs and symbols added by a dynamic module are not part of @@ -75,12 +75,11 @@ * into the right place. These functions will be called by the module * init code, generated by ellcc during initialization mode. */ -extern void emodules_doc_subr (CONST char *objname, CONST char *docstr); -extern void emodules_doc_sym (CONST char *objname, CONST char *docstr); +extern void emodules_doc_subr (const char *objname, const char *docstr); +extern void emodules_doc_sym (const char *objname, const char *docstr); #define CDOCSUBR(Fname, DOC) emodules_doc_subr (Fname, DOC) #define CDOCSYM(Sname, DOC) emodules_doc_sym (Sname, DOC) #endif /* EMODULES_GATHER_VERSION */ #endif /* EMODULES_HDR */ - diff -r f4aeb21a5bad -r 74fd4e045ea6 src/esd.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/esd.c Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,130 @@ +/* esd.c - play a sound over ESD + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include "lisp.h" +#include "miscplay.h" + +#include <esd.h> + +#include <unistd.h> +#include <fcntl.h> +#include <stdio.h> +#include <errno.h> +#include <string.h> + +/* the name given to ESD - I think this should identify ourselves */ +#define ESD_NAME "xemacs" + +int esd_play_sound_file(char *file, int vol); +int esd_play_sound_file(char *file, int vol) +{ /* #### FIXME: vol is ignored */ + return esd_play_file(ESD_NAME, file, 0); +} + +int esd_play_sound_data(unsigned char *data, size_t length, int vol); +int esd_play_sound_data(unsigned char *data, size_t length, int vol) +{ /* #### FIXME: vol is ignored */ + size_t (*parsesndfile)(void **dayta,size_t *sz,void **outbuf); + size_t (*sndcnv)(void **dayta,size_t *sz,void **); + fmtType ffmt; + int fmt,speed,tracks; + unsigned char *pptr,*optr,*cptr,*sptr; + ssize_t wrtn; + size_t crtn; + size_t prtn; + int flags, sock; + + /* analyze_format needs at least this many bytes to work with */ + if (length < HEADERSZ) + return 0; + + ffmt = analyze_format(data,&fmt,&speed,&tracks,&parsesndfile); + + if (ffmt != fmtRaw && ffmt != fmtSunAudio && ffmt != fmtWave) { + message(GETTEXT("audio: Unsupported file format (neither RAW, nor Sun/DECAudio, nor WAVE)")); + return 0; + } + + /* convert header information into ESD flags */ + flags = ESD_STREAM|ESD_PLAY; + sndcnv = sndcnvnop; + switch (fmt) + { + case AFMT_MU_LAW: + sndcnv = sndcnvULaw_2linear; + flags |= ESD_BITS8; + break; + case AFMT_S8: + sndcnv = sndcnv2unsigned; /* ESD needs unsigned bytes */ + case AFMT_U8: + flags |= ESD_BITS8; + break; + case AFMT_S16_BE: + sndcnv = sndcnv16swap; /* ESD wants little endian */ + case AFMT_S16_LE: + flags |= ESD_BITS16; + break; + default: + message(GETTEXT("audio: byte format %d unimplemented"), fmt); + return 0; + } + switch (tracks) + { + case 1: flags |= ESD_MONO; break; + case 2: flags |= ESD_STEREO; break; + default: + message(GETTEXT("audio: %d channels - only 1 or 2 supported"), tracks); + return 0; + } + + sock = esd_play_stream(flags, speed, NULL, "xemacs"); + if (sock < 0) + return 0; + + reset_parsestate(); + + for (pptr = data; (prtn = parsesndfile((void **)&pptr,&length, + (void **)&optr)) > 0; ) + for (cptr = optr; (crtn = sndcnv((void **)&cptr,&prtn, + (void **)&sptr)) > 0; ) { + if ((wrtn = write(sock,sptr,crtn)) < 0) { + message(GETTEXT("audio: write error (%s)"), strerror(errno)); + goto END_OF_PLAY; + } + if (wrtn != crtn) { + message(GETTEXT("audio: only wrote %d of %d bytes"), wrtn, crtn); + goto END_OF_PLAY; + } + } + + if (ffmt == fmtWave) + parse_wave_complete(); + +END_OF_PLAY: + /* Now cleanup all used resources */ + + close(sock); + return 1; +} diff -r f4aeb21a5bad -r 74fd4e045ea6 src/eval.c --- a/src/eval.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/eval.c Mon Aug 13 11:13:30 2007 +0200 @@ -73,12 +73,11 @@ a SUBR with more than 8 arguments, use max_args == MANY. See the DEFUN macro in lisp.h) */ #define PRIMITIVE_FUNCALL(rv, fn, av, ac) do { \ - void (*PF_fn)() = (void (*)()) (fn); \ + void (*PF_fn)(void) = (void (*)(void)) fn; \ Lisp_Object *PF_av = (av); \ switch (ac) \ { \ - default: abort(); \ - case 0: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 0); break; \ + default:rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 0); break; \ case 1: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 1); break; \ case 2: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 2); break; \ case 3: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 3); break; \ @@ -170,7 +169,7 @@ int max_specpdl_size; /* Depth in Lisp evaluations and function calls. */ -int lisp_eval_depth; +static int lisp_eval_depth; /* Maximum allowed depth in Lisp evaluations and function calls. */ int max_lisp_eval_depth; @@ -282,10 +281,10 @@ print_subr (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { Lisp_Subr *subr = XSUBR (obj); - CONST char *header = + const char *header = (subr->max_args == UNEVALLED) ? "#<special-form " : "#<subr "; - CONST char *name = subr_name (subr); - CONST char *trailer = subr->prompt ? " (interactive)>" : ">"; + const char *name = subr_name (subr); + const char *trailer = subr->prompt ? " (interactive)>" : ">"; if (print_readably) error ("printing unreadable object %s%s%s", header, name, trailer); @@ -295,9 +294,15 @@ write_c_string (trailer, printcharfun); } -DEFINE_LRECORD_IMPLEMENTATION ("subr", subr, - this_one_is_unmarkable, print_subr, 0, 0, 0, - Lisp_Subr); +static const struct lrecord_description subr_description[] = { + { XD_DOC_STRING, offsetof (Lisp_Subr, doc) }, + { XD_END } +}; + +DEFINE_BASIC_LRECORD_IMPLEMENTATION ("subr", subr, + this_one_is_unmarkable, print_subr, 0, 0, 0, + subr_description, + Lisp_Subr); /************************************************************************/ /* Entering the debugger */ @@ -1004,8 +1009,6 @@ static Lisp_Object define_function (Lisp_Object name, Lisp_Object defn) { - if (purify_flag) - defn = Fpurecopy (defn); Ffset (name, defn); LOADHIST_ATTACH (name); return name; @@ -1078,14 +1081,7 @@ if (!NILP (args = XCDR (args))) { Lisp_Object doc = XCAR (args); -#if 0 /* FSFmacs */ - /* #### We should probably do this but it might be dangerous */ - if (purify_flag) - doc = Fpurecopy (doc); Fput (sym, Qvariable_documentation, doc); -#else - pure_put (sym, Qvariable_documentation, doc); -#endif if (!NILP (args = XCDR (args))) error ("too many arguments"); } @@ -1093,7 +1089,7 @@ #ifdef I18N3 if (!NILP (Vfile_domain)) - pure_put (sym, Qvariable_domain, Vfile_domain); + Fput (sym, Qvariable_domain, Vfile_domain); #endif LOADHIST_ATTACH (sym); @@ -1133,21 +1129,14 @@ if (!NILP (args = XCDR (args))) { Lisp_Object doc = XCAR (args); -#if 0 /* FSFmacs */ - /* #### We should probably do this but it might be dangerous */ - if (purify_flag) - doc = Fpurecopy (doc); Fput (sym, Qvariable_documentation, doc); -#else - pure_put (sym, Qvariable_documentation, doc); -#endif if (!NILP (args = XCDR (args))) error ("too many arguments"); } #ifdef I18N3 if (!NILP (Vfile_domain)) - pure_put (sym, Qvariable_domain, Vfile_domain); + Fput (sym, Qvariable_domain, Vfile_domain); #endif LOADHIST_ATTACH (sym); @@ -1167,7 +1156,7 @@ return ((INTP (documentation) && XINT (documentation) < 0) || - ((STRINGP (documentation)) && + (STRINGP (documentation) && (string_byte (XSTRING (documentation), 0) == '*')) || /* If (STRING . INTEGER), a negative integer means a user variable. */ @@ -1493,7 +1482,7 @@ static Lisp_Object condition_bind_unwind (Lisp_Object loser) { - struct Lisp_Cons *victim; + Lisp_Cons *victim; /* ((handler-fun . handler-args) ... other handlers) */ Lisp_Object tem = XCAR (loser); @@ -1515,7 +1504,7 @@ static Lisp_Object condition_case_unwind (Lisp_Object loser) { - struct Lisp_Cons *victim; + Lisp_Cons *victim; /* ((<unbound> . clauses) ... other handlers */ victim = XCONS (XCAR (loser)); @@ -2225,13 +2214,13 @@ /* dump an error message; called like printf */ DOESNT_RETURN -error (CONST char *fmt, ...) +error (const char *fmt, ...) { Lisp_Object obj; va_list args; va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, + obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1, args); va_end (args); @@ -2240,7 +2229,7 @@ } void -maybe_error (Lisp_Object class, Error_behavior errb, CONST char *fmt, ...) +maybe_error (Lisp_Object class, Error_behavior errb, const char *fmt, ...) { Lisp_Object obj; va_list args; @@ -2250,7 +2239,7 @@ return; va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, + obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1, args); va_end (args); @@ -2259,13 +2248,13 @@ } Lisp_Object -continuable_error (CONST char *fmt, ...) +continuable_error (const char *fmt, ...) { Lisp_Object obj; va_list args; va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, + obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1, args); va_end (args); @@ -2275,7 +2264,7 @@ Lisp_Object maybe_continuable_error (Lisp_Object class, Error_behavior errb, - CONST char *fmt, ...) + const char *fmt, ...) { Lisp_Object obj; va_list args; @@ -2285,7 +2274,7 @@ return Qnil; va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, + obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1, args); va_end (args); @@ -2302,13 +2291,13 @@ where the error is occurring). */ DOESNT_RETURN -signal_simple_error (CONST char *reason, Lisp_Object frob) +signal_simple_error (const char *reason, Lisp_Object frob) { signal_error (Qerror, list2 (build_translated_string (reason), frob)); } void -maybe_signal_simple_error (CONST char *reason, Lisp_Object frob, +maybe_signal_simple_error (const char *reason, Lisp_Object frob, Lisp_Object class, Error_behavior errb) { /* Optimization: */ @@ -2319,13 +2308,13 @@ } Lisp_Object -signal_simple_continuable_error (CONST char *reason, Lisp_Object frob) +signal_simple_continuable_error (const char *reason, Lisp_Object frob) { return Fsignal (Qerror, list2 (build_translated_string (reason), frob)); } Lisp_Object -maybe_signal_simple_continuable_error (CONST char *reason, Lisp_Object frob, +maybe_signal_simple_continuable_error (const char *reason, Lisp_Object frob, Lisp_Object class, Error_behavior errb) { /* Optimization: */ @@ -2346,13 +2335,13 @@ */ DOESNT_RETURN -error_with_frob (Lisp_Object frob, CONST char *fmt, ...) +error_with_frob (Lisp_Object frob, const char *fmt, ...) { Lisp_Object obj; va_list args; va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, + obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1, args); va_end (args); @@ -2362,7 +2351,7 @@ void maybe_error_with_frob (Lisp_Object frob, Lisp_Object class, - Error_behavior errb, CONST char *fmt, ...) + Error_behavior errb, const char *fmt, ...) { Lisp_Object obj; va_list args; @@ -2372,7 +2361,7 @@ return; va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, + obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1, args); va_end (args); @@ -2381,13 +2370,13 @@ } Lisp_Object -continuable_error_with_frob (Lisp_Object frob, CONST char *fmt, ...) +continuable_error_with_frob (Lisp_Object frob, const char *fmt, ...) { Lisp_Object obj; va_list args; va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, + obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1, args); va_end (args); @@ -2397,7 +2386,7 @@ Lisp_Object maybe_continuable_error_with_frob (Lisp_Object frob, Lisp_Object class, - Error_behavior errb, CONST char *fmt, ...) + Error_behavior errb, const char *fmt, ...) { Lisp_Object obj; va_list args; @@ -2407,7 +2396,7 @@ return Qnil; va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, + obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1, args); va_end (args); @@ -2424,7 +2413,7 @@ is three objects, a string and two related Lisp objects. */ DOESNT_RETURN -signal_simple_error_2 (CONST char *reason, +signal_simple_error_2 (const char *reason, Lisp_Object frob0, Lisp_Object frob1) { signal_error (Qerror, list3 (build_translated_string (reason), frob0, @@ -2432,7 +2421,7 @@ } void -maybe_signal_simple_error_2 (CONST char *reason, Lisp_Object frob0, +maybe_signal_simple_error_2 (const char *reason, Lisp_Object frob0, Lisp_Object frob1, Lisp_Object class, Error_behavior errb) { @@ -2445,7 +2434,7 @@ Lisp_Object -signal_simple_continuable_error_2 (CONST char *reason, Lisp_Object frob0, +signal_simple_continuable_error_2 (const char *reason, Lisp_Object frob0, Lisp_Object frob1) { return Fsignal (Qerror, list3 (build_translated_string (reason), frob0, @@ -2453,7 +2442,7 @@ } Lisp_Object -maybe_signal_simple_continuable_error_2 (CONST char *reason, Lisp_Object frob0, +maybe_signal_simple_continuable_error_2 (const char *reason, Lisp_Object frob0, Lisp_Object frob1, Lisp_Object class, Error_behavior errb) { @@ -2481,47 +2470,48 @@ /* Used in core lisp functions for efficiency */ -void +Lisp_Object signal_void_function_error (Lisp_Object function) { - Fsignal (Qvoid_function, list1 (function)); + return Fsignal (Qvoid_function, list1 (function)); } -static void +Lisp_Object signal_invalid_function_error (Lisp_Object function) { - Fsignal (Qinvalid_function, list1 (function)); + return Fsignal (Qinvalid_function, list1 (function)); } -static void +Lisp_Object signal_wrong_number_of_arguments_error (Lisp_Object function, int nargs) { - Fsignal (Qwrong_number_of_arguments, list2 (function, make_int (nargs))); + return Fsignal (Qwrong_number_of_arguments, + list2 (function, make_int (nargs))); } /* Used in list traversal macros for efficiency. */ -void +DOESNT_RETURN signal_malformed_list_error (Lisp_Object list) { - Fsignal (Qmalformed_list, list1 (list)); + signal_error (Qmalformed_list, list1 (list)); } -void +DOESNT_RETURN signal_malformed_property_list_error (Lisp_Object list) { - Fsignal (Qmalformed_property_list, list1 (list)); + signal_error (Qmalformed_property_list, list1 (list)); } -void +DOESNT_RETURN signal_circular_list_error (Lisp_Object list) { - Fsignal (Qcircular_list, list1 (list)); + signal_error (Qcircular_list, list1 (list)); } -void +DOESNT_RETURN signal_circular_property_list_error (Lisp_Object list) { - Fsignal (Qcircular_property_list, list1 (list)); + signal_error (Qcircular_property_list, list1 (list)); } /************************************************************************/ @@ -2633,7 +2623,7 @@ { Fsignal (Qwrong_type_argument, Fcons (Qcommandp, - ((EQ (cmd, final)) + (EQ (cmd, final) ? list1 (cmd) : list2 (cmd, final)))); return Qnil; @@ -2751,11 +2741,10 @@ file = Fsymbol_name (Fintern (file, Qnil)); } - return Ffset (function, - Fpurecopy (Fcons (Qautoload, list4 (file, - docstring, - interactive, - type)))); + return Ffset (function, Fcons (Qautoload, list4 (file, + docstring, + interactive, + type))); } Lisp_Object @@ -2842,7 +2831,7 @@ /************************************************************************/ static Lisp_Object funcall_lambda (Lisp_Object fun, - int nargs, Lisp_Object args[]); + int nargs, Lisp_Object args[]); static int in_warnings; static Lisp_Object @@ -2955,7 +2944,7 @@ if (max_args == UNEVALLED) /* Optimize for the common case */ { backtrace.evalargs = 0; - val = (((Lisp_Object (*) (Lisp_Object)) (subr_function (subr))) + val = (((Lisp_Object (*) (Lisp_Object)) subr_function (subr)) (original_args)); } else if (nargs <= max_args) @@ -3009,7 +2998,7 @@ backtrace.args = args; backtrace.nargs = nargs; - val = (((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr))) + val = (((Lisp_Object (*) (int, Lisp_Object *)) subr_function (subr)) (nargs, args)); UNGCPRO; @@ -3017,7 +3006,7 @@ else { wrong_number_of_arguments: - signal_wrong_number_of_arguments_error (fun, nargs); + val = signal_wrong_number_of_arguments_error (original_fun, nargs); } } else if (COMPILED_FUNCTIONP (fun)) @@ -3105,7 +3094,7 @@ else /* ! (SUBRP (fun) || COMPILED_FUNCTIONP (fun) || CONSP (fun)) */ { invalid_function: - signal_invalid_function_error (fun); + val = signal_invalid_function_error (fun); } lisp_eval_depth--; @@ -3180,14 +3169,15 @@ int max_args = subr->max_args; Lisp_Object spacious_args[SUBR_MAX_ARGS]; - if (fun_nargs < subr->min_args) - goto wrong_number_of_arguments; - if (fun_nargs == max_args) /* Optimize for the common case */ { funcall_subr: FUNCALL_SUBR (val, subr, fun_args, max_args); } + else if (fun_nargs < subr->min_args) + { + goto wrong_number_of_arguments; + } else if (fun_nargs < max_args) { Lisp_Object *p = spacious_args; @@ -3203,8 +3193,7 @@ } else if (max_args == MANY) { - val = ((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr))) - (fun_nargs, fun_args); + val = SUBR_FUNCTION (subr, MANY) (fun_nargs, fun_args); } else if (max_args == UNEVALLED) /* Can't funcall a special form */ { @@ -3213,7 +3202,7 @@ else { wrong_number_of_arguments: - signal_wrong_number_of_arguments_error (fun, fun_nargs); + val = signal_wrong_number_of_arguments_error (fun, fun_nargs); } } else if (COMPILED_FUNCTIONP (fun)) @@ -3240,12 +3229,12 @@ } else if (UNBOUNDP (fun)) { - signal_void_function_error (args[0]); + val = signal_void_function_error (args[0]); } else { invalid_function: - signal_invalid_function_error (fun); + val = signal_invalid_function_error (fun); } lisp_eval_depth--; @@ -3321,7 +3310,7 @@ else { invalid_function: - return Fsignal (Qinvalid_function, list1 (function)); + return signal_invalid_function_error (function); } { @@ -3508,10 +3497,10 @@ return unbind_to (speccount, Fprogn (body)); wrong_number_of_arguments: - return Fsignal (Qwrong_number_of_arguments, list2 (fun, make_int (nargs))); + return signal_wrong_number_of_arguments_error (fun, nargs); invalid_function: - return Fsignal (Qinvalid_function, list1 (fun)); + return signal_invalid_function_error (fun); } @@ -3627,8 +3616,9 @@ } else { - struct gcpro gcpro1, gcpro2; - GCPRO2 (sym, val); + struct gcpro gcpro1, gcpro2, gcpro3; + Lisp_Object globals = Qnil; + GCPRO3 (sym, val, globals); for (; CONSP (val) && ((cond == RUN_HOOKS_TO_COMPLETION) @@ -3640,7 +3630,7 @@ { /* t indicates this hook has a local binding; it means to run the global binding too. */ - Lisp_Object globals = Fdefault_value (sym); + globals = Fdefault_value (sym); if ((! CONSP (globals) || EQ (XCAR (globals), Qlambda)) && ! NILP (globals)) @@ -4148,7 +4138,7 @@ args[1] = errordata; warn_when_safe_lispobj (Qerror, Qwarning, - emacs_doprnt_string_lisp ((CONST Bufbyte *) "%s: %s", + emacs_doprnt_string_lisp ((const Bufbyte *) "%s: %s", Qnil, -1, 2, args)); } return Qunbound; @@ -4191,7 +4181,7 @@ } Lisp_Object -eval_in_buffer_trapping_errors (CONST char *warning_string, +eval_in_buffer_trapping_errors (const char *warning_string, struct buffer *buf, Lisp_Object form) { int speccount = specpdl_depth(); @@ -4207,14 +4197,14 @@ /* gc_currently_forbidden = 1; Currently no reason to do this; */ cons = noseeum_cons (buffer, form); - opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil); + opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil); GCPRO2 (cons, opaque); /* Qerror not Qt, so you can get a backtrace */ tem = condition_case_1 (Qerror, catch_them_squirmers_eval_in_buffer, cons, caught_a_squirmer, opaque); free_cons (XCONS (cons)); - if (OPAQUEP (opaque)) + if (OPAQUE_PTRP (opaque)) free_opaque_ptr (opaque); UNGCPRO; @@ -4231,7 +4221,7 @@ } Lisp_Object -run_hook_trapping_errors (CONST char *warning_string, Lisp_Object hook_symbol) +run_hook_trapping_errors (const char *warning_string, Lisp_Object hook_symbol) { int speccount; Lisp_Object tem; @@ -4247,13 +4237,13 @@ speccount = specpdl_depth(); specbind (Qinhibit_quit, Qt); - opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil); + opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil); GCPRO1 (opaque); /* Qerror not Qt, so you can get a backtrace */ tem = condition_case_1 (Qerror, catch_them_squirmers_run_hook, hook_symbol, caught_a_squirmer, opaque); - if (OPAQUEP (opaque)) + if (OPAQUE_PTRP (opaque)) free_opaque_ptr (opaque); UNGCPRO; @@ -4264,7 +4254,7 @@ if an error occurs. */ Lisp_Object -safe_run_hook_trapping_errors (CONST char *warning_string, +safe_run_hook_trapping_errors (const char *warning_string, Lisp_Object hook_symbol, int allow_quit) { @@ -4283,7 +4273,7 @@ specbind (Qinhibit_quit, Qt); cons = noseeum_cons (hook_symbol, - warning_string ? make_opaque_ptr (warning_string) + warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil); GCPRO1 (cons); /* Qerror not Qt, so you can get a backtrace */ @@ -4294,7 +4284,7 @@ allow_quit_safe_run_hook_caught_a_squirmer : safe_run_hook_caught_a_squirmer, cons); - if (OPAQUEP (XCDR (cons))) + if (OPAQUE_PTRP (XCDR (cons))) free_opaque_ptr (XCDR (cons)); free_cons (XCONS (cons)); UNGCPRO; @@ -4310,7 +4300,7 @@ } Lisp_Object -call0_trapping_errors (CONST char *warning_string, Lisp_Object function) +call0_trapping_errors (const char *warning_string, Lisp_Object function) { int speccount; Lisp_Object tem; @@ -4329,12 +4319,12 @@ specbind (Qinhibit_quit, Qt); /* gc_currently_forbidden = 1; Currently no reason to do this; */ - opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil); + opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil); /* Qerror not Qt, so you can get a backtrace */ tem = condition_case_1 (Qerror, catch_them_squirmers_call0, function, caught_a_squirmer, opaque); - if (OPAQUEP (opaque)) + if (OPAQUE_PTRP (opaque)) free_opaque_ptr (opaque); UNGCPRO; @@ -4357,7 +4347,7 @@ } Lisp_Object -call1_trapping_errors (CONST char *warning_string, Lisp_Object function, +call1_trapping_errors (const char *warning_string, Lisp_Object function, Lisp_Object object) { int speccount = specpdl_depth(); @@ -4379,12 +4369,12 @@ /* gc_currently_forbidden = 1; Currently no reason to do this; */ cons = noseeum_cons (function, object); - opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil); + opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil); /* Qerror not Qt, so you can get a backtrace */ tem = condition_case_1 (Qerror, catch_them_squirmers_call1, cons, caught_a_squirmer, opaque); - if (OPAQUEP (opaque)) + if (OPAQUE_PTRP (opaque)) free_opaque_ptr (opaque); free_cons (XCONS (cons)); UNGCPRO; @@ -4394,7 +4384,7 @@ } Lisp_Object -call2_trapping_errors (CONST char *warning_string, Lisp_Object function, +call2_trapping_errors (const char *warning_string, Lisp_Object function, Lisp_Object object1, Lisp_Object object2) { int speccount = specpdl_depth(); @@ -4415,12 +4405,12 @@ /* gc_currently_forbidden = 1; Currently no reason to do this; */ cons = list3 (function, object1, object2); - opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil); + opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil); /* Qerror not Qt, so you can get a backtrace */ tem = condition_case_1 (Qerror, catch_them_squirmers_call2, cons, caught_a_squirmer, opaque); - if (OPAQUEP (opaque)) + if (OPAQUE_PTRP (opaque)) free_opaque_ptr (opaque); free_list (cons); UNGCPRO; @@ -4473,7 +4463,7 @@ { Lisp_Object current = Fcurrent_buffer (); Lisp_Object symbol = specpdl_ptr->symbol; - struct Lisp_Cons *victim = XCONS (ovalue); + Lisp_Cons *victim = XCONS (ovalue); Lisp_Object buf = get_buffer (victim->car, 0); ovalue = victim->cdr; @@ -4627,7 +4617,7 @@ { /* We checked symbol for validity when we specbound it, so only need to call Fset if symbol has magic value. */ - struct Lisp_Symbol *sym = XSYMBOL (specpdl_ptr->symbol); + Lisp_Symbol *sym = XSYMBOL (specpdl_ptr->symbol); if (!SYMBOL_VALUE_MAGIC_P (sym->value)) sym->value = specpdl_ptr->old_value; else @@ -4753,7 +4743,7 @@ DEFUN ("backtrace", Fbacktrace, 0, 2, "", /* Print a trace of Lisp function calls currently active. -Option arg STREAM specifies the output stream to send the backtrace to, +Optional arg STREAM specifies the output stream to send the backtrace to, and defaults to the value of `standard-output'. Optional second arg DETAILED means show places where currently active variable bindings, catches, condition-cases, and unwind-protects were made as well as @@ -4796,8 +4786,8 @@ if (!NILP (detailed) && catches && catches->backlist == backlist) { int catchpdl = catches->pdlcount; - if (specpdl[catchpdl].func == condition_case_unwind - && speccount > catchpdl) + if (speccount > catchpdl + && specpdl[catchpdl].func == condition_case_unwind) /* This is a condition-case catchpoint */ catchpdl = catchpdl + 1; @@ -4947,13 +4937,13 @@ automatically be called when it is safe to do so. */ void -warn_when_safe (Lisp_Object class, Lisp_Object level, CONST char *fmt, ...) +warn_when_safe (Lisp_Object class, Lisp_Object level, const char *fmt, ...) { Lisp_Object obj; va_list args; va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), + obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1, args); va_end (args); @@ -5053,8 +5043,28 @@ } void +reinit_vars_of_eval (void) +{ + preparing_for_armageddon = 0; + in_warnings = 0; + Qunbound_suspended_errors_tag = make_opaque_ptr (&Qunbound_suspended_errors_tag); + staticpro_nodump (&Qunbound_suspended_errors_tag); + + specpdl_size = 50; + specpdl = xnew_array (struct specbinding, specpdl_size); + /* XEmacs change: increase these values. */ + max_specpdl_size = 3000; + max_lisp_eval_depth = 500; +#if 0 /* no longer used */ + throw_level = 0; +#endif +} + +void vars_of_eval (void) { + reinit_vars_of_eval (); + DEFVAR_INT ("max-specpdl-size", &max_specpdl_size /* Limit on number of Lisp variable bindings & unwind-protects before error. */ ); @@ -5156,13 +5166,10 @@ */ ); Vdebugger = Qnil; - preparing_for_armageddon = 0; - staticpro (&Vpending_warnings); Vpending_warnings = Qnil; - Vpending_warnings_tail = Qnil; /* no need to protect this */ - - in_warnings = 0; + pdump_wire (&Vpending_warnings_tail); + Vpending_warnings_tail = Qnil; staticpro (&Vautoload_queue); Vautoload_queue = Qnil; @@ -5175,18 +5182,5 @@ staticpro (&Vcurrent_error_state); Vcurrent_error_state = Qnil; /* errors as normal */ - Qunbound_suspended_errors_tag = make_opaque_long (0); - staticpro (&Qunbound_suspended_errors_tag); - - specpdl_size = 50; - specpdl_depth_counter = 0; - specpdl = xnew_array (struct specbinding, specpdl_size); - /* XEmacs change: increase these values. */ - max_specpdl_size = 3000; - max_lisp_eval_depth = 500; -#if 0 /* no longer used */ - throw_level = 0; -#endif - reinit_eval (); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/event-Xt.c --- a/src/event-Xt.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/event-Xt.c Mon Aug 13 11:13:30 2007 +0200 @@ -78,6 +78,7 @@ #include "events-mod.h" static void enqueue_Xt_dispatch_event (Lisp_Object event); +static void handle_focus_event_1 (struct frame *f, int in_p); static struct event_stream *Xt_event_stream; @@ -108,7 +109,7 @@ /* Mask of bits indicating the descriptors that we wait for input on */ extern SELECT_TYPE input_wait_mask, process_only_mask, tty_only_mask; -static CONST String x_fallback_resources[] = +static const String x_fallback_resources[] = { /* This file is automatically generated from the app-defaults file in ../etc/Emacs.ad. These resources are consulted only if no @@ -120,7 +121,7 @@ static Lisp_Object x_keysym_to_emacs_keysym (KeySym keysym, int simple_p); void emacs_Xt_mapping_action (Widget w, XEvent *event); -void debug_process_finalization (struct Lisp_Process *p); +void debug_process_finalization (Lisp_Process *p); void emacs_Xt_event_handler (Widget wid, XtPointer closure, XEvent *event, Boolean *continue_to_dispatch); @@ -174,6 +175,204 @@ use a pop-up-window instead.) */ +/* For every key on the keyboard that has a known character correspondence, + we define the ascii-character property of the keysym, and make the + default binding for the key be self-insert-command. + + The following magic is basically intimate knowledge of X11/keysymdef.h. + The keysym mappings defined by X11 are based on the iso8859 standards, + except for Cyrillic and Greek. + + In a non-Mule world, a user can still have a multi-lingual editor, by doing + (set-face-font "...-iso8859-2" (current-buffer)) + for all their Latin-2 buffers, etc. */ + +static Lisp_Object +x_keysym_to_character (KeySym keysym) +{ +#ifdef MULE + Lisp_Object charset = Qzero; +#define USE_CHARSET(var,cs) \ + ((var) = CHARSET_BY_LEADING_BYTE (LEADING_BYTE_##cs)) +#else +#define USE_CHARSET(var,lb) +#endif /* MULE */ + int code = 0; + + if ((keysym & 0xff) < 0xa0) + return Qnil; + + switch (keysym >> 8) + { + case 0: /* ASCII + Latin1 */ + USE_CHARSET (charset, LATIN_ISO8859_1); + code = keysym & 0x7f; + break; + case 1: /* Latin2 */ + USE_CHARSET (charset, LATIN_ISO8859_2); + code = keysym & 0x7f; + break; + case 2: /* Latin3 */ + USE_CHARSET (charset, LATIN_ISO8859_3); + code = keysym & 0x7f; + break; + case 3: /* Latin4 */ + USE_CHARSET (charset, LATIN_ISO8859_4); + code = keysym & 0x7f; + break; + case 4: /* Katakana */ + USE_CHARSET (charset, KATAKANA_JISX0201); + if ((keysym & 0xff) > 0xa0) + code = keysym & 0x7f; + break; + case 5: /* Arabic */ + USE_CHARSET (charset, ARABIC_ISO8859_6); + code = keysym & 0x7f; + break; + case 6: /* Cyrillic */ + { + static unsigned char const cyrillic[] = /* 0x20 - 0x7f */ + {0x00, 0x72, 0x73, 0x71, 0x74, 0x75, 0x76, 0x77, + 0x78, 0x79, 0x7a, 0x7b, 0x7c, 0x00, 0x7e, 0x7f, + 0x70, 0x22, 0x23, 0x21, 0x24, 0x25, 0x26, 0x27, + 0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x00, 0x2e, 0x2f, + 0x6e, 0x50, 0x51, 0x66, 0x54, 0x55, 0x64, 0x53, + 0x65, 0x58, 0x59, 0x5a, 0x5b, 0x5c, 0x5d, 0x5e, + 0x5f, 0x6f, 0x60, 0x61, 0x62, 0x63, 0x56, 0x52, + 0x6c, 0x6b, 0x57, 0x68, 0x6d, 0x69, 0x67, 0x6a, + 0x4e, 0x30, 0x31, 0x46, 0x34, 0x35, 0x44, 0x33, + 0x45, 0x38, 0x39, 0x3a, 0x3b, 0x3c, 0x3d, 0x3e, + 0x3f, 0x4f, 0x40, 0x41, 0x42, 0x43, 0x36, 0x32, + 0x4c, 0x4b, 0x37, 0x48, 0x4d, 0x49, 0x47, 0x4a}; + USE_CHARSET (charset, CYRILLIC_ISO8859_5); + code = cyrillic[(keysym & 0x7f) - 0x20]; + break; + } + case 7: /* Greek */ + { + static unsigned char const greek[] = /* 0x20 - 0x7f */ + {0x00, 0x36, 0x38, 0x39, 0x3a, 0x5a, 0x00, 0x3c, + 0x3e, 0x5b, 0x00, 0x3f, 0x00, 0x00, 0x35, 0x2f, + 0x00, 0x5c, 0x5d, 0x5e, 0x5f, 0x7a, 0x40, 0x7c, + 0x7d, 0x7b, 0x60, 0x7e, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, + 0x48, 0x49, 0x4a, 0x4b, 0x4c, 0x4d, 0x4e, 0x4f, + 0x50, 0x51, 0x53, 0x00, 0x54, 0x55, 0x56, 0x57, + 0x58, 0x59, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, + 0x68, 0x69, 0x6a, 0x6b, 0x6c, 0x6d, 0x6e, 0x6f, + 0x70, 0x71, 0x73, 0x72, 0x74, 0x75, 0x76, 0x77, + 0x78, 0x79, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; + USE_CHARSET (charset, GREEK_ISO8859_7); + code = greek[(keysym & 0x7f) - 0x20]; + break; + } + case 8: /* Technical */ + break; + case 9: /* Special */ + break; + case 10: /* Publishing */ + break; + case 11: /* APL */ + break; + case 12: /* Hebrew */ + USE_CHARSET (charset, HEBREW_ISO8859_8); + code = keysym & 0x7f; + break; + case 13: /* Thai */ + /* #### This needs to deal with character composition. */ + USE_CHARSET (charset, THAI_TIS620); + code = keysym & 0x7f; + break; + case 14: /* Korean Hangul */ + break; + case 19: /* Latin 9 - ISO8859-15 - unsupported charset. */ + break; + case 32: /* Currency */ + break; + default: + break; + } + + if (code == 0) + return Qnil; + +#ifdef MULE + return make_char (MAKE_CHAR (charset, code, 0)); +#else + return make_char (code + 0x80); +#endif +} + +/* #### The way that keysym correspondence to characters should work: + - a Lisp_Event should contain a keysym AND a character slot. + - keybindings are tried with the keysym. If no binding can be found, + and there is a corresponding character, call self-insert-command. + + #### Nuke x-iso8859-1.el. + #### Nuke the Qascii_character property. + #### Nuke Vcharacter_set_property. +*/ +static void +maybe_define_x_key_as_self_inserting_character (KeySym keysym, Lisp_Object symbol) +{ + Lisp_Object character = x_keysym_to_character (keysym); + + if (CHARP (character)) + { + extern Lisp_Object Vcurrent_global_map; + extern Lisp_Object Qascii_character; + Fput (symbol, Qascii_character, character); + if (NILP (Flookup_key (Vcurrent_global_map, symbol, Qnil))) + Fdefine_key (Vcurrent_global_map, symbol, Qself_insert_command); + } +} + +static void +x_has_keysym (KeySym keysym, Lisp_Object hash_table, int with_modifiers) +{ + KeySym upper_lower[2]; + int j; + + if (keysym < 0x80) /* Optimize for ASCII keysyms */ + return; + + /* If you execute: + xmodmap -e 'keysym NN = scaron' + and then press (Shift scaron), X11 will return the different + keysym `Scaron', but `xmodmap -pke' might not even mention `Scaron'. + So we "register" both `scaron' and `Scaron'. */ +#ifdef HAVE_XCONVERTCASE + XConvertCase (keysym, &upper_lower[0], &upper_lower[1]); +#else + upper_lower[0] = upper_lower[1] = keysym; +#endif + + for (j = 0; j < (upper_lower[0] == upper_lower[1] ? 1 : 2); j++) + { + char *name; + keysym = upper_lower[j]; + + name = XKeysymToString (keysym); + if (name) + { + /* X guarantees NAME to be in the Host Portable Character Encoding */ + Lisp_Object sym = x_keysym_to_emacs_keysym (keysym, 0); + Lisp_Object new_value = with_modifiers ? Qt : Qsans_modifiers; + Lisp_Object old_value = Fgethash (sym, hash_table, Qnil); + + if (! EQ (old_value, new_value) + && ! (EQ (old_value, Qsans_modifiers) && + EQ (new_value, Qt))) + { + maybe_define_x_key_as_self_inserting_character (keysym, sym); + Fputhash (build_ext_string (name, Qbinary), new_value, hash_table); + Fputhash (sym, new_value, hash_table); + } + } + } +} + static void x_reset_key_mapping (struct device *d) { @@ -211,34 +410,18 @@ if (keysym[0] == NoSymbol) continue; - { - char *name = XKeysymToString (keysym[0]); - Lisp_Object sym = x_keysym_to_emacs_keysym (keysym[0], 0); - if (name) - { - Fputhash (build_string (name), Qsans_modifiers, hash_table); - Fputhash (sym, Qsans_modifiers, hash_table); - } - } + x_has_keysym (keysym[0], hash_table, 0); for (j = 1; j < keysyms_per_code; j++) { if (keysym[j] != keysym[0] && keysym[j] != NoSymbol) - { - char *name = XKeysymToString (keysym[j]); - Lisp_Object sym = x_keysym_to_emacs_keysym (keysym[j], 0); - if (name && NILP (Fgethash (sym, hash_table, Qnil))) - { - Fputhash (build_string (name), Qt, hash_table); - Fputhash (sym, Qt, hash_table); - } - } + x_has_keysym (keysym[j], hash_table, 1); } } } -static CONST char * +static const char * index_to_name (int indice) { switch (indice) @@ -393,7 +576,7 @@ be totally wrong. */ if (mode_bit) { - CONST char *warn = 0; + const char *warn = 0; if (mode_bit == meta_bit) warn = "Meta", meta_bit = 0; else if (mode_bit == hyper_bit) warn = "Hyper", hyper_bit = 0; else if (mode_bit == super_bit) warn = "Super", super_bit = 0; @@ -807,7 +990,8 @@ len = XmImMbLookupString (XtWindowToWidget (event->display, event->window), event, bufptr, bufsiz, &keysym, &status); #else /* XIM_XLIB */ - len = XmbLookupString (xic, event, bufptr, bufsiz, &keysym, &status); + if (xic) + len = XmbLookupString (xic, event, bufptr, bufsiz, &keysym, &status); #endif /* HAVE_XIM */ #ifdef DEBUG_XEMACS @@ -858,10 +1042,9 @@ Lstream *istr; struct gcpro gcpro1, gcpro2; - fb_instream = - make_fixed_buffer_input_stream ((unsigned char *) bufptr, len); - - /* ### Use Fget_coding_system (Vcomposed_input_coding_system) */ + fb_instream = make_fixed_buffer_input_stream (bufptr, len); + + /* #### Use Fget_coding_system (Vcomposed_input_coding_system) */ instream = make_decoding_input_stream (XLSTREAM (fb_instream), Fget_coding_system (Qundecided)); @@ -872,7 +1055,7 @@ while ((ch = Lstream_get_emchar (istr)) != EOF) { Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); - struct Lisp_Event *ev = XEVENT (emacs_event); + Lisp_Event *ev = XEVENT (emacs_event); ev->channel = DEVICE_CONSOLE (d); ev->event_type = key_press_event; ev->timestamp = event->time; @@ -919,7 +1102,7 @@ } static int -x_event_to_emacs_event (XEvent *x_event, struct Lisp_Event *emacs_event) +x_event_to_emacs_event (XEvent *x_event, Lisp_Event *emacs_event) { Display *display = x_event->xany.display; struct device *d = get_device_from_display (display); @@ -1046,6 +1229,7 @@ { XButtonEvent *ev = &x_event->xbutton; struct frame *frame = x_window_to_frame (d, ev->window); + if (! frame) return 0; /* not for us */ XSETFRAME (emacs_event->channel, frame); @@ -1058,7 +1242,11 @@ emacs_event->event.button.button = ev->button; emacs_event->event.button.x = ev->x; emacs_event->event.button.y = ev->y; - + /* because we don't seem to get a FocusIn event for button clicks + when a widget-glyph is selected we will assume that we want the + focus if a button gets pressed. */ + if (x_event->type == ButtonPress) + handle_focus_event_1 (frame, 1); } } break; @@ -1184,7 +1372,7 @@ make_string ((Bufbyte *)"8bit", 4), make_ext_string ((Extbyte *)data, strlen((char *)data), - FORMAT_CTEXT) ) ); + Qctext) ) ); break; case DndMIME: /* we have to parse this in some way to extract @@ -1197,7 +1385,7 @@ l_type = Qdragdrop_MIME; l_dndlist = list1 ( make_ext_string ((Extbyte *)data, strlen((char *)data), - FORMAT_BINARY) ); + Qbinary) ); break; case DndFile: case DndDir: @@ -1218,7 +1406,7 @@ and escaping again will break them (cause % is unsave) */ l_dndlist = list1 ( make_ext_string ((Extbyte *)data, strlen ((char *)data), - FORMAT_FILENAME) ); + Qfile_name) ); l_type = Qdragdrop_URL; break; default: /* Unknown, RawData and any other type */ @@ -1226,7 +1414,7 @@ make_string ((Bufbyte *)"8bit", 4), make_ext_string ((Extbyte *)data, size, - FORMAT_BINARY) ) ); + Qbinary) ) ); l_type = Qdragdrop_MIME; break; } @@ -1304,6 +1492,9 @@ static void handle_focus_event_1 (struct frame *f, int in_p) { +#if XtSpecificationRelease > 5 + Widget focus_widget = XtGetKeyboardFocusWidget (FRAME_X_TEXT_WIDGET (f)); +#endif #ifdef HAVE_XIM XIM_focus_event (f, in_p); #endif /* HAVE_XIM */ @@ -1319,7 +1510,26 @@ Actually, we half handle it: we handle it as far as changing the box cursor for redisplay, but we don't call any hooks or do any select-frame stuff until after the sit-for. - */ + + Unfortunately native widgets break the model because they grab + the keyboard focus and nothing sets it back again. I cannot find + any reasonable way to do this elsewhere so we assert here that + the keyboard focus is on the emacs text widget. Menus and dialogs + do this in their selection callback, but we don't want that since + a button having focus is legitimate. An edit field having focus + is mandatory. Weirdly you get a FocusOut event when you click in + a widget-glyph but you don't get a correspondng FocusIn when you + click in the frame. Why is this? */ + if (in_p +#if XtSpecificationRelease > 5 + && FRAME_X_TEXT_WIDGET (f) != focus_widget +#endif + ) + { + lw_set_keyboard_focus (FRAME_X_SHELL_WIDGET (f), + FRAME_X_TEXT_WIDGET (f)); + } + /* do the generic event-stream stuff. */ { Lisp_Object frm; Lisp_Object conser; @@ -1404,7 +1614,7 @@ /* Bleagh!!!!!! Apparently some window managers (e.g. MWM) send synthetic MapNotify events when a window is first - created, EVENT IF IT'S CREATED ICONIFIED OR INVISIBLE. + created, EVEN IF IT'S CREATED ICONIFIED OR INVISIBLE. Or something like that. We initially tried a different solution below, but that ran into a different window- manager bug. @@ -1512,7 +1722,7 @@ } static void -emacs_Xt_handle_magic_event (struct Lisp_Event *emacs_event) +emacs_Xt_handle_magic_event (Lisp_Event *emacs_event) { /* This function can GC */ XEvent *event = &emacs_event->event.magic.underlying_x_event; @@ -1540,8 +1750,13 @@ break; case Expose: - x_redraw_exposed_area (f, event->xexpose.x, event->xexpose.y, - event->xexpose.width, event->xexpose.height); + if (!check_for_ignored_expose (f, event->xexpose.x, event->xexpose.y, + event->xexpose.width, event->xexpose.height) + && + !find_matching_subwindow (f, event->xexpose.x, event->xexpose.y, + event->xexpose.width, event->xexpose.height)) + x_redraw_exposed_area (f, event->xexpose.x, event->xexpose.y, + event->xexpose.width, event->xexpose.height); break; case GraphicsExpose: /* This occurs when an XCopyArea's source area was @@ -1579,6 +1794,7 @@ case FocusIn: case FocusOut: + #ifdef EXTERNAL_WIDGET /* External widget lossage: Ben said: YUCK. The only way to make focus changes work properly is to @@ -1633,14 +1849,14 @@ /* Xt interval id's might not fit into an int (they're pointers, as it happens), so we need to provide a conversion list. */ -struct Xt_timeout +static struct Xt_timeout { int id; XtIntervalId interval_id; struct Xt_timeout *next; } *pending_timeouts, *completed_timeouts; -struct Xt_timeout_blocktype +static struct Xt_timeout_blocktype { Blocktype_declare (struct Xt_timeout); } *the_Xt_timeout_blocktype; @@ -1747,7 +1963,7 @@ } static void -Xt_timeout_to_emacs_event (struct Lisp_Event *emacs_event) +Xt_timeout_to_emacs_event (Lisp_Event *emacs_event) { struct Xt_timeout *timeout = completed_timeouts; assert (timeout); @@ -1914,7 +2130,7 @@ } static void -emacs_Xt_select_process (struct Lisp_Process *p) +emacs_Xt_select_process (Lisp_Process *p) { Lisp_Object process; int infd = event_stream_unixoid_select_process (p); @@ -1924,7 +2140,7 @@ } static void -emacs_Xt_unselect_process (struct Lisp_Process *p) +emacs_Xt_unselect_process (Lisp_Process *p) { int infd = event_stream_unixoid_unselect_process (p); @@ -1953,7 +2169,7 @@ If we've still got pointers to it in this file, we're gonna lose hard. */ void -debug_process_finalization (struct Lisp_Process *p) +debug_process_finalization (Lisp_Process *p) { #if 0 /* #### */ int i; @@ -1973,25 +2189,27 @@ } static void -Xt_process_to_emacs_event (struct Lisp_Event *emacs_event) +Xt_process_to_emacs_event (Lisp_Event *emacs_event) { int i; - Lisp_Object process; assert (process_events_occurred > 0); + for (i = 0; i < MAXDESC; i++) { - process = filedesc_with_input[i]; + Lisp_Object process = filedesc_with_input[i]; if (PROCESSP (process)) - break; + { + filedesc_with_input[i] = Qnil; + process_events_occurred--; + /* process events have nil as channel */ + emacs_event->event_type = process_event; + emacs_event->timestamp = 0; /* #### */ + emacs_event->event.process.process = process; + return; + } } - assert (i < MAXDESC); - filedesc_with_input[i] = Qnil; - process_events_occurred--; - /* process events have nil as channel */ - emacs_event->event_type = process_event; - emacs_event->timestamp = 0; /* #### */ - emacs_event->event.process.process = process; + abort (); } static void @@ -1999,9 +2217,6 @@ { Lisp_Object console; int infd; -#ifdef HAVE_GPM - int mousefd; -#endif if (CONSOLE_X_P (con)) return; /* X consoles are automatically selected for when we @@ -2009,22 +2224,6 @@ infd = event_stream_unixoid_select_console (con); XSETCONSOLE (console, con); select_filedesc (infd, console); -#ifdef HAVE_GPM - /* On a stream device (ie: noninteractive), bad things can happen. */ - if (EQ (CONSOLE_TYPE (con), Qtty)) { - mousefd = CONSOLE_TTY_MOUSE_FD (con); - /* We check filedesc_to_what_closure[fd] here because if you run - ** XEmacs from a TTY, it will fire up GPM, select the mouse fd, then - ** if you run gnuattach to connect to another TTY, it will fire up - ** GPM again, and try to reselect the mouse fd. GPM uses the same - ** fd for every connection apparently, and select_filedesc will - ** fail its assertion if we try to select it twice. - */ - if ((mousefd >= 0) && !filedesc_to_what_closure[mousefd]) { - select_filedesc (mousefd, console); - } - } -#endif } static void @@ -2032,9 +2231,6 @@ { Lisp_Object console; int infd; -#ifdef HAVE_GPM - int mousefd; -#endif if (CONSOLE_X_P (con)) return; /* X consoles are automatically selected for when we @@ -2042,15 +2238,6 @@ infd = event_stream_unixoid_unselect_console (con); XSETCONSOLE (console, con); unselect_filedesc (infd); -#ifdef HAVE_GPM - /* On a stream device (ie: noninteractive), bad things can happen. */ - if (EQ (CONSOLE_TYPE (con), Qtty)) { - mousefd = CONSOLE_TTY_MOUSE_FD (con); - if (mousefd >= 0) { - unselect_filedesc (mousefd); - } - } -#endif } /* read an event from a tty, if one is available. Returns non-zero @@ -2062,7 +2249,7 @@ to be deleted.) */ static int -Xt_tty_to_emacs_event (struct Lisp_Event *emacs_event) +Xt_tty_to_emacs_event (Lisp_Event *emacs_event) { int i; @@ -2108,12 +2295,12 @@ char *buf = alloca_array (char, XSTRING_LENGTH (f->name) + 4); sprintf (buf, " \"%s\"", XSTRING_DATA (f->name)); write_string_to_stdio_stream (stderr, 0, (Bufbyte *) buf, 0, - strlen (buf), FORMAT_TERMINAL); + strlen (buf), Qterminal); } stderr_out ("\n"); } -static CONST char * +static const char * XEvent_mode_to_string (int mode) { switch (mode) @@ -2126,7 +2313,7 @@ } } -static CONST char * +static const char * XEvent_detail_to_string (int detail) { switch (detail) @@ -2142,7 +2329,7 @@ } } -static CONST char * +static const char * XEvent_visibility_to_string (int state) { switch (state) @@ -2347,7 +2534,7 @@ } static void -emacs_Xt_next_event (struct Lisp_Event *emacs_event) +emacs_Xt_next_event (Lisp_Event *emacs_event) { we_didnt_get_an_event: @@ -2732,10 +2919,10 @@ the '#if 0'. Note, however, that I got "unknown structure" errors when I tried this. */ XtConvertArgRec Const colorConvertArgs[] = { - {XtWidgetBaseOffset, (XtPointer)XtOffsetOf(WidgetRec, core.screen), - sizeof(Screen *)}, - {XtWidgetBaseOffset, (XtPointer)XtOffsetOf(WidgetRec, core.colormap), - sizeof(Colormap)} + { XtWidgetBaseOffset, (XtPointer)XtOffsetOf(WidgetRec, core.screen), + sizeof (Screen *) }, + { XtWidgetBaseOffset, (XtPointer)XtOffsetOf(WidgetRec, core.colormap), + sizeof (Colormap) } }; #endif @@ -2885,18 +3072,12 @@ { defsymbol (&Qkey_mapping, "key-mapping"); defsymbol (&Qsans_modifiers, "sans-modifiers"); + defsymbol (&Qself_insert_command, "self-insert-command"); } void -vars_of_event_Xt (void) +reinit_vars_of_event_Xt (void) { - dispatch_event_queue = Qnil; - staticpro (&dispatch_event_queue); - dispatch_event_queue_tail = Qnil; - - /* this function only makes safe calls */ - init_what_input_once (); - Xt_event_stream = xnew (struct event_stream); Xt_event_stream->event_pending_p = emacs_Xt_event_pending_p; Xt_event_stream->next_event_cb = emacs_Xt_next_event; @@ -2911,6 +3092,24 @@ Xt_event_stream->create_stream_pair_cb = emacs_Xt_create_stream_pair; Xt_event_stream->delete_stream_pair_cb = emacs_Xt_delete_stream_pair; + the_Xt_timeout_blocktype = Blocktype_new (struct Xt_timeout_blocktype); + + last_quit_check_signal_tick_count = 0; + + /* this function only makes safe calls */ + init_what_input_once (); +} + +void +vars_of_event_Xt (void) +{ + reinit_vars_of_event_Xt (); + + dispatch_event_queue = Qnil; + staticpro (&dispatch_event_queue); + dispatch_event_queue_tail = Qnil; + pdump_wire (&dispatch_event_queue_tail); + DEFVAR_BOOL ("modifier-keys-are-sticky", &modifier_keys_are_sticky /* *Non-nil makes modifier keys sticky. This means that you can release the modifier key before pressing down @@ -2936,10 +3135,6 @@ */ ); x_debug_events = 0; #endif - - the_Xt_timeout_blocktype = Blocktype_new (struct Xt_timeout_blocktype); - - last_quit_check_signal_tick_count = 0; } /* This mess is a hack that patches the shell widget to treat visual inheritance diff -r f4aeb21a5bad -r 74fd4e045ea6 src/event-msw.c --- a/src/event-msw.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/event-msw.c Mon Aug 13 11:13:30 2007 +0200 @@ -56,6 +56,7 @@ #include "lstream.h" #include "process.h" #include "redisplay.h" +#include "select.h" #include "sysproc.h" #include "syswait.h" #include "systime.h" @@ -72,6 +73,10 @@ #include <io.h> #include <errno.h> +#if defined (__CYGWIN32__) && (CYGWIN_VERSION_DLL_MAJOR < 20) +typedef NMHDR *LPNMHDR; +#endif + #ifdef HAVE_MENUBARS #define ADJR_MENUFLAG TRUE #else @@ -85,16 +90,10 @@ /* Timer ID used for button2 emulation */ #define BUTTON_2_TIMER_ID 1 -extern Lisp_Object -mswindows_get_toolbar_button_text (struct frame* f, int command_id); -extern Lisp_Object -mswindows_handle_toolbar_wm_command (struct frame* f, HWND ctrl, WORD id); -extern Lisp_Object -mswindows_handle_gui_wm_command (struct frame* f, HWND ctrl, WORD id); - static Lisp_Object mswindows_find_frame (HWND hwnd); static Lisp_Object mswindows_find_console (HWND hwnd); -static Lisp_Object mswindows_key_to_emacs_keysym(int mswindows_key, int mods); +static Lisp_Object mswindows_key_to_emacs_keysym (int mswindows_key, int mods, + int extendedp); static int mswindows_modifier_state (BYTE* keymap, int has_AltGr); static void mswindows_set_chord_timer (HWND hwnd); static int mswindows_button2_near_enough (POINTS p1, POINTS p2); @@ -119,6 +118,9 @@ static Lisp_Object mswindows_u_dispatch_event_queue, mswindows_u_dispatch_event_queue_tail; static Lisp_Object mswindows_s_dispatch_event_queue, mswindows_s_dispatch_event_queue_tail; +/* For speed: whether there is a WM_PAINT magic message in the system queue */ +static int mswindows_paint_pending = 0; + /* The number of things we can wait on */ #define MAX_WAITABLE (MAXIMUM_WAIT_OBJECTS - 1) @@ -129,6 +131,7 @@ /* Number of wait handles */ static int mswindows_waitable_count=0; #endif /* HAVE_MSG_SELECT */ + /* Brush for painting widgets */ static HBRUSH widget_brush = 0; static LONG last_widget_brushed = 0; @@ -140,6 +143,7 @@ /* These are Lisp integers; see DEFVARS in this file for description. */ int mswindows_dynamic_frame_resize; +int mswindows_meta_activates_menu; int mswindows_num_mouse_buttons; int mswindows_mouse_button_max_skew_x; int mswindows_mouse_button_max_skew_y; @@ -193,7 +197,7 @@ }; #define MAX_SLURP_STREAMS 32 -struct ntpipe_slurp_stream_shared_data +struct ntpipe_slurp_stream_shared_data shared_data_block[MAX_SLURP_STREAMS]={{0}}; struct ntpipe_slurp_stream @@ -265,7 +269,7 @@ /* Now we got something to notify caller, either a byte or an error/eof indication. Before we do, allow internal pipe - buffer to accumulate little bit more data. + buffer to accumulate little bit more data. Reader function pulses this event before waiting for a character, to avoid pipe delay, and to get the byte immediately. */ @@ -354,11 +358,11 @@ return s->thread_data->hev_caller; } -static int +static ssize_t ntpipe_slurp_reader (Lstream *stream, unsigned char *data, size_t size) { /* This function must be called from the main thread only */ - struct ntpipe_slurp_stream_shared_data* s = + struct ntpipe_slurp_stream_shared_data* s = NTPIPE_SLURP_STREAM_DATA(stream)->thread_data; if (!s->die_p) @@ -367,7 +371,7 @@ /* Disallow pipe read delay for the thread: we need a character ASAP */ SetEvent (s->hev_unsleep); - + /* Check if we have a character ready. Give it a short delay, for the thread to awake from pipe delay, just ion case*/ wait_result = WaitForSingleObject (s->hev_caller, 2); @@ -418,7 +422,7 @@ ReadFile (s->hpipe, data, min (bytes_available, size), &bytes_read, NULL); } - + /* Now we can unblock thread, so it attempts to read more */ SetEvent (s->hev_thread); return bytes_read + 1; @@ -427,11 +431,11 @@ return 0; } -static int +static int ntpipe_slurp_closer (Lstream *stream) { /* This function must be called from the main thread only */ - struct ntpipe_slurp_stream_shared_data* s = + struct ntpipe_slurp_stream_shared_data* s = NTPIPE_SLURP_STREAM_DATA(stream)->thread_data; /* Force thread to stop */ @@ -463,7 +467,7 @@ LSTREAM_TYPE_DATA (stream, ntpipe_shove) #define MAX_SHOVE_BUFFER_SIZE 128 - + struct ntpipe_shove_stream { LPARAM user_data; /* Any user data stored in the stream object */ @@ -490,7 +494,7 @@ for (;;) { - DWORD bytes_written; + DWORD bytes_written; /* Block on event and wait for a job */ InterlockedIncrement (&s->idle_p); @@ -527,7 +531,7 @@ s->hpipe = hpipe; s->user_data = param; - /* Create reader thread. This could fail, so do not + /* Create reader thread. This could fail, so do not create the event until thread is created */ s->hthread = CreateThread (NULL, 0, shove_thread, (LPVOID)s, CREATE_SUSPENDED, &thread_id_unused); @@ -556,7 +560,7 @@ } #endif -static int +static ssize_t ntpipe_shove_writer (Lstream *stream, const unsigned char *data, size_t size) { struct ntpipe_shove_stream* s = NTPIPE_SHOVE_STREAM_DATA(stream); @@ -665,7 +669,7 @@ str->eof_p = 1; } -static int +static ssize_t winsock_reader (Lstream *stream, unsigned char *data, size_t size) { struct winsock_stream *str = WINSOCK_STREAM_DATA (stream); @@ -698,7 +702,7 @@ return 0; if (str->error_p) return -1; - + /* Return as much of buffer as we have */ size = min (size, (size_t) (str->bufsize - str->bufpos)); memcpy (data, (void*)((BYTE*)str->buffer + str->bufpos), size); @@ -711,8 +715,8 @@ return size; } -static int -winsock_writer (Lstream *stream, CONST unsigned char *data, size_t size) +static ssize_t +winsock_writer (Lstream *stream, const unsigned char *data, size_t size) { struct winsock_stream *str = WINSOCK_STREAM_DATA (stream); @@ -739,7 +743,7 @@ if (size == 0) return 0; - + { ResetEvent (str->ov.hEvent); @@ -785,7 +789,7 @@ } static Lisp_Object -make_winsock_stream_1 (SOCKET s, LPARAM param, CONST char *mode) +make_winsock_stream_1 (SOCKET s, LPARAM param, const char *mode) { Lisp_Object obj; Lstream *lstr = Lstream_new (lstream_winsock, mode); @@ -853,7 +857,7 @@ /************************************************************************/ static int -mswindows_user_event_p (struct Lisp_Event* sevt) +mswindows_user_event_p (Lisp_Event* sevt) { return (sevt->event_type == key_press_event || sevt->event_type == button_press_event @@ -861,7 +865,7 @@ || sevt->event_type == misc_user_event); } -/* +/* * Add an emacs event to the proper dispatch queue */ static void @@ -869,7 +873,7 @@ { int user_p = mswindows_user_event_p (XEVENT(event)); enqueue_event (event, - user_p ? &mswindows_u_dispatch_event_queue : + user_p ? &mswindows_u_dispatch_event_queue : &mswindows_s_dispatch_event_queue, user_p ? &mswindows_u_dispatch_event_queue_tail : &mswindows_s_dispatch_event_queue_tail); @@ -889,10 +893,11 @@ Lisp_Object object) { Lisp_Object event = Fmake_event (Qnil, Qnil); - struct Lisp_Event* e = XEVENT (event); + Lisp_Event* e = XEVENT (event); e->event_type = misc_user_event; e->channel = channel; + e->timestamp = GetTickCount (); e->event.misc.function = function; e->event.misc.object = object; @@ -900,24 +905,24 @@ } void -mswindows_enqueue_magic_event (HWND hwnd, UINT message) +mswindows_enqueue_magic_event (HWND hwnd, UINT msg) { Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); - struct Lisp_Event* event = XEVENT (emacs_event); + Lisp_Event* event = XEVENT (emacs_event); event->channel = hwnd ? mswindows_find_frame (hwnd) : Qnil; event->timestamp = GetMessageTime(); event->event_type = magic_event; - EVENT_MSWINDOWS_MAGIC_TYPE (event) = message; + EVENT_MSWINDOWS_MAGIC_TYPE (event) = msg; mswindows_enqueue_dispatch_event (emacs_event); } static void -mswindows_enqueue_process_event (struct Lisp_Process* p) +mswindows_enqueue_process_event (Lisp_Process* p) { Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); - struct Lisp_Event* event = XEVENT (emacs_event); + Lisp_Event* event = XEVENT (emacs_event); Lisp_Object process; XSETPROCESS (process, p); @@ -929,7 +934,7 @@ } static void -mswindows_enqueue_mouse_button_event (HWND hwnd, UINT message, POINTS where, DWORD when) +mswindows_enqueue_mouse_button_event (HWND hwnd, UINT msg, POINTS where, DWORD when) { /* We always use last message time, because mouse button @@ -937,19 +942,19 @@ recognition will fail */ Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); - struct Lisp_Event* event = XEVENT(emacs_event); + Lisp_Event* event = XEVENT(emacs_event); event->channel = mswindows_find_frame(hwnd); event->timestamp = when; event->event.button.button = - (message==WM_LBUTTONDOWN || message==WM_LBUTTONUP) ? 1 : - ((message==WM_RBUTTONDOWN || message==WM_RBUTTONUP) ? 3 : 2); + (msg==WM_LBUTTONDOWN || msg==WM_LBUTTONUP) ? 1 : + ((msg==WM_RBUTTONDOWN || msg==WM_RBUTTONUP) ? 3 : 2); event->event.button.x = where.x; event->event.button.y = where.y; event->event.button.modifiers = mswindows_modifier_state (NULL, 0); - - if (message==WM_LBUTTONDOWN || message==WM_MBUTTONDOWN || - message==WM_RBUTTONDOWN) + + if (msg==WM_LBUTTONDOWN || msg==WM_MBUTTONDOWN || + msg==WM_RBUTTONDOWN) { event->event_type = button_press_event; SetCapture (hwnd); @@ -966,7 +971,7 @@ event->event_type = button_release_event; ReleaseCapture (); } - + mswindows_enqueue_dispatch_event (emacs_event); } @@ -974,7 +979,7 @@ mswindows_enqueue_keypress_event (HWND hwnd, Lisp_Object keysym, int mods) { Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); - struct Lisp_Event* event = XEVENT(emacs_event); + Lisp_Event* event = XEVENT(emacs_event); event->channel = mswindows_find_console(hwnd); event->timestamp = GetMessageTime(); @@ -992,16 +997,16 @@ mswindows_dequeue_dispatch_event () { Lisp_Object event; - struct Lisp_Event* sevt; + Lisp_Event* sevt; assert (!NILP(mswindows_u_dispatch_event_queue) || !NILP(mswindows_s_dispatch_event_queue)); event = dequeue_event ( - NILP(mswindows_u_dispatch_event_queue) ? - &mswindows_s_dispatch_event_queue : + NILP(mswindows_u_dispatch_event_queue) ? + &mswindows_s_dispatch_event_queue : &mswindows_u_dispatch_event_queue, - NILP(mswindows_u_dispatch_event_queue) ? + NILP(mswindows_u_dispatch_event_queue) ? &mswindows_s_dispatch_event_queue_tail : &mswindows_u_dispatch_event_queue_tail); @@ -1026,14 +1031,14 @@ */ Lisp_Object -mswindows_cancel_dispatch_event (struct Lisp_Event *match) +mswindows_cancel_dispatch_event (Lisp_Event *match) { Lisp_Object event; Lisp_Object previous_event = Qnil; int user_p = mswindows_user_event_p (match); - Lisp_Object* head = user_p ? &mswindows_u_dispatch_event_queue : + Lisp_Object* head = user_p ? &mswindows_u_dispatch_event_queue : &mswindows_s_dispatch_event_queue; - Lisp_Object* tail = user_p ? &mswindows_u_dispatch_event_queue_tail : + Lisp_Object* tail = user_p ? &mswindows_u_dispatch_event_queue_tail : &mswindows_s_dispatch_event_queue_tail; assert (match->event_type == timeout_event @@ -1041,7 +1046,7 @@ EVENT_CHAIN_LOOP (event, *head) { - struct Lisp_Event *e = XEVENT (event); + Lisp_Event *e = XEVENT (event); if ((e->event_type == match->event_type) && ((e->event_type == timeout_event) ? (e->event.timeout.interval_id == match->event.timeout.interval_id) : @@ -1056,7 +1061,7 @@ if (EQ (*tail, event)) *tail = previous_event; } - + return event; } previous_event = event; @@ -1097,7 +1102,7 @@ if (ix < 0) return; - mswindows_waitable_handles [ix] = + mswindows_waitable_handles [ix] = mswindows_waitable_handles [--mswindows_waitable_count]; } #endif /* HAVE_MSG_SELECT */ @@ -1121,7 +1126,7 @@ { Lisp_Object tmp; - ++mswindows_in_modal_loop; + ++mswindows_in_modal_loop; tmp = condition_case_1 (Qt, bfun, barg, mswindows_modal_loop_error_handler, Qnil); @@ -1145,7 +1150,7 @@ } /* - * This is an unsafe part of event pump, guarded by + * This is an unsafe part of event pump, guarded by * condition_case. See mswindows_pump_outstanding_events */ static Lisp_Object @@ -1169,7 +1174,7 @@ Fdeallocate_event (event); UNGCPRO; - + /* Qt becomes return value of mswindows_pump_outstanding_events once we get here */ return Qt; @@ -1217,33 +1222,58 @@ Lisp_Object result = Qt; struct gcpro gcpro1; GCPRO1 (result); - + if (NILP(mswindows_error_caught_in_modal_loop)) result = mswindows_protect_modal_loop (mswindows_unsafe_pump_events, Qnil); UNGCPRO; return result; } -static void +/* + * KEYBOARD_ONLY_P is set to non-zero when we are called from + * QUITP, and are interesting in keyboard messages only. + */ +static void mswindows_drain_windows_queue () { MSG msg; + + /* should call mswindows_need_event_in_modal_loop() if in modal loop */ + assert (!mswindows_in_modal_loop); + while (PeekMessage (&msg, NULL, 0, 0, PM_REMOVE)) { - /* we have to translate messages that are not sent to the main - window. this is so that key presses work ok in things like - edit fields. however, we *musn't* translate message for the + /* We have to translate messages that are not sent to the main + window. This is so that key presses work ok in things like + edit fields. However, we *musn't* translate message for the main window as this is handled in the wnd proc. */ - if ( GetWindowLong (msg.hwnd, GWL_STYLE) & WS_CHILD ) + if (GetWindowLong (msg.hwnd, GWL_STYLE) & WS_CHILD) { TranslateMessage (&msg); } + else if (msg.message == WM_PAINT) + { + /* hdc will be NULL unless this is a subwindow - in which case we + shouldn't have received a paint message for it here. */ + assert (msg.wParam == 0); + + if (!mswindows_paint_pending) + { + /* Queue a magic event for handling when safe */ + mswindows_enqueue_magic_event (msg.hwnd, WM_PAINT); + mswindows_paint_pending = 1; + } + + /* Don't dispatch. WM_PAINT is always the last message in the + queue so it's OK to just return. */ + return; + } DispatchMessage (&msg); mswindows_unmodalize_signal_maybe (); } } -/* +/* * This is a special flavor of the mswindows_need_event function, * used while in event pump. Actually, there is only kind of events * allowed while in event pump: a timer. An attempt to fetch any @@ -1276,7 +1306,7 @@ /* We'll deadlock if go waiting */ if (mswindows_pending_timers_count == 0) error ("Deadlock due to an attempt to call next-event in a wrong context"); - + /* Fetch and dispatch any pending timers */ GetMessage (&msg, NULL, WM_TIMER, WM_TIMER); DispatchMessage (&msg); @@ -1301,10 +1331,6 @@ return; } - /* Have to drain Windows message queue first, otherwise, we may miss - quit char when called from quit_p */ - mswindows_drain_windows_queue (); - while (NILP (mswindows_u_dispatch_event_queue) && NILP (mswindows_s_dispatch_event_queue)) { @@ -1313,7 +1339,7 @@ SELECT_TYPE temp_mask = input_wait_mask; EMACS_TIME sometime; EMACS_SELECT_TIME select_time_to_block, *pointer_to_this; - + if (badly_p) pointer_to_this = 0; else @@ -1324,9 +1350,10 @@ } active = select (MAXDESC, &temp_mask, 0, 0, pointer_to_this); - + if (active == 0) { + assert (!badly_p); return; /* timeout */ } else if (active > 0) @@ -1335,7 +1362,7 @@ { mswindows_drain_windows_queue (); } -#ifdef HAVE_TTY +#ifdef HAVE_TTY /* Look for a TTY event */ for (i = 0; i < MAXDESC-1; i++) { @@ -1346,8 +1373,8 @@ { struct console *c = tty_find_console_from_fd (i); Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); - struct Lisp_Event* event = XEVENT (emacs_event); - + Lisp_Event* event = XEVENT (emacs_event); + assert (c); if (read_event_from_tty_or_stream_desc (event, c, i)) { @@ -1364,9 +1391,9 @@ { if (FD_ISSET (i, &process_only_mask)) { - struct Lisp_Process *p = + Lisp_Process *p = get_process_from_usid (FD_TO_USID(i)); - + mswindows_enqueue_process_event (p); } else @@ -1405,7 +1432,7 @@ assert ((!badly_p && active == WAIT_TIMEOUT) || (active >= WAIT_OBJECT_0 && active <= WAIT_OBJECT_0 + mswindows_waitable_count)); - + if (active == WAIT_TIMEOUT) { /* No luck trying - just return what we've already got */ @@ -1420,7 +1447,7 @@ { int ix = active - WAIT_OBJECT_0; /* First, try to find which process' output has signaled */ - struct Lisp_Process *p = + Lisp_Process *p = get_process_from_usid (HANDLE_TO_USID (mswindows_waitable_handles[ix])); if (p != NULL) { @@ -1448,14 +1475,14 @@ /* Event generators */ /************************************************************************/ -/* +/* * Callback procedure for synchronous timer messages */ static void CALLBACK mswindows_wm_timer_callback (HWND hwnd, UINT umsg, UINT id_timer, DWORD dwtime) { Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); - struct Lisp_Event *event = XEVENT (emacs_event); + Lisp_Event *event = XEVENT (emacs_event); if (KillTimer (NULL, id_timer)) --mswindows_pending_timers_count; @@ -1470,7 +1497,7 @@ mswindows_enqueue_dispatch_event (emacs_event); } -/* +/* * Callback procedure for dde messages * * We execute a dde Open("file") by simulating a file drop, so dde support @@ -1481,9 +1508,9 @@ mswindows_dde_callback (UINT uType, UINT uFmt, HCONV hconv, HSZ hszTopic, HSZ hszItem, HDDEDATA hdata, DWORD dwData1, DWORD dwData2) -{ +{ switch (uType) - { + { case XTYP_CONNECT: if (!DdeCmpStringHandles (hszTopic, mswindows_dde_topic_system)) return (HDDEDATA)TRUE; @@ -1500,7 +1527,7 @@ return (DdeCreateDataHandle (mswindows_dde_mlid, (LPBYTE)pairs, sizeof (pairs), 0L, 0, uFmt, 0)); } - return (HDDEDATA)NULL; + return (HDDEDATA)NULL; case XTYP_EXECUTE: if (!DdeCmpStringHandles (hszTopic, mswindows_dde_topic_system)) @@ -1513,7 +1540,7 @@ Lisp_Object l_dndlist = Qnil; Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); Lisp_Object frmcons, devcons, concons; - struct Lisp_Event *event = XEVENT (emacs_event); + Lisp_Event *event = XEVENT (emacs_event); DdeGetData (hdata, cmd, len, 0); cmd[len] = '\0'; @@ -1581,16 +1608,64 @@ UNGCPRO; return (HDDEDATA) DDE_FACK; } - DdeFreeDataHandle (hdata); + DdeFreeDataHandle (hdata); return (HDDEDATA) DDE_FNOTPROCESSED; - default: - return (HDDEDATA) NULL; - } + default: + return (HDDEDATA) NULL; + } } #endif /* + * Helper to do repainting - repaints can happen both from the windows + * procedure and from magic events + */ +void +mswindows_handle_paint (struct frame *frame) + { + HWND hwnd = FRAME_MSWINDOWS_HANDLE (frame); + + /* According to the docs we need to check GetUpdateRect() before + actually doing a WM_PAINT */ + if (GetUpdateRect (hwnd, NULL, FALSE)) + { + PAINTSTRUCT paintStruct; + int x, y, width, height; + + BeginPaint (hwnd, &paintStruct); + x = paintStruct.rcPaint.left; + y = paintStruct.rcPaint.top; + width = paintStruct.rcPaint.right - paintStruct.rcPaint.left; + height = paintStruct.rcPaint.bottom - paintStruct.rcPaint.top; + /* Normally we want to ignore expose events when child + windows are unmapped, however once we are in the guts of + WM_PAINT we need to make sure that we don't register + unmaps then because they will not actually occur. */ + if (!check_for_ignored_expose (frame, x, y, width, height)) + { + hold_ignored_expose_registration = 1; + mswindows_redraw_exposed_area (frame, x, y, width, height); + hold_ignored_expose_registration = 0; + } + EndPaint (hwnd, &paintStruct); + } + } + +/* + * Returns 1 if a key is a real modifier or special key, which + * is better handled by DefWindowProc + */ +static int +key_needs_default_processing_p (UINT vkey) +{ + if (mswindows_meta_activates_menu && vkey == VK_MENU) + return 1; + + return 0; +} + +/* * The windows procedure for the window class XEMACS_CLASS */ LRESULT WINAPI @@ -1601,12 +1676,19 @@ Lisp_Object emacs_event = Qnil; Lisp_Object fobj = Qnil; - struct Lisp_Event *event; + Lisp_Event *event; struct frame *frame; struct mswindows_frame* msframe; switch (message) { + case WM_DESTROYCLIPBOARD: + /* We own the clipboard and someone else wants it. Delete our + cached copy of the clipboard contents so we'll ask for it from + Windows again when someone does a paste. */ + handle_selection_clear(QCLIPBOARD); + break; + case WM_ERASEBKGND: /* Erase background only during non-dynamic sizing */ msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); @@ -1638,7 +1720,10 @@ SetKeyboardState (keymap); } }; - goto defproc; + if (key_needs_default_processing_p (wParam)) + goto defproc; + else + break; case WM_KEYDOWN: case WM_SYSKEYDOWN: @@ -1654,21 +1739,23 @@ BYTE keymap[256]; int has_AltGr = mswindows_current_layout_has_AltGr (); int mods; + int extendedp = lParam & 0x1000000; Lisp_Object keysym; GetKeyboardState (keymap); mods = mswindows_modifier_state (keymap, has_AltGr); - /* Handle those keys for which TranslateMessage won't generate a WM_CHAR */ - if (!NILP (keysym = mswindows_key_to_emacs_keysym(wParam, mods))) + /* Handle non-printables */ + if (!NILP (keysym = mswindows_key_to_emacs_keysym (wParam, mods, + extendedp))) mswindows_enqueue_keypress_event (hwnd, keysym, mods); - else + else /* Normal keys & modifiers */ { int quit_ch = CONSOLE_QUIT_CHAR (XCONSOLE (mswindows_find_console (hwnd))); BYTE keymap_orig[256]; POINT pnt = { LOWORD (GetMessagePos()), HIWORD (GetMessagePos()) }; MSG msg; - + msg.hwnd = hwnd; msg.message = message; msg.wParam = wParam; @@ -1680,9 +1767,9 @@ * to loosely track Left and Right modifiers on behalf of the OS, * without screwing up Windows NT which tracks them properly. */ if (wParam == VK_CONTROL) - keymap [(lParam & 0x1000000) ? VK_RCONTROL : VK_LCONTROL] |= 0x80; + keymap [extendedp ? VK_RCONTROL : VK_LCONTROL] |= 0x80; else if (wParam == VK_MENU) - keymap [(lParam & 0x1000000) ? VK_RMENU : VK_LMENU] |= 0x80; + keymap [extendedp ? VK_RMENU : VK_LMENU] |= 0x80; memcpy (keymap_orig, keymap, 256); @@ -1692,7 +1779,8 @@ /* Clear control and alt modifiers unless AltGr is pressed */ keymap [VK_RCONTROL] = 0; keymap [VK_LMENU] = 0; - if (!has_AltGr || !(keymap [VK_LCONTROL] & 0x80) || !(keymap [VK_RMENU] & 0x80)) + if (!has_AltGr || !(keymap [VK_LCONTROL] & 0x80) + || !(keymap [VK_RMENU] & 0x80)) { keymap [VK_LCONTROL] = 0; keymap [VK_CONTROL] = 0; @@ -1728,10 +1816,10 @@ SetKeyboardState (keymap_orig); } /* else */ } - /* F10 causes menu activation by default. We do not want this */ - if (wParam != VK_F10) + if (key_needs_default_processing_p (wParam)) goto defproc; - break; + else + break; case WM_MBUTTONDOWN: case WM_MBUTTONUP: @@ -1741,7 +1829,7 @@ mswindows_enqueue_mouse_button_event (hwnd, message, MAKEPOINTS (lParam), GetMessageTime()); break; - + case WM_LBUTTONUP: msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); msframe->last_click_time = GetMessageTime(); @@ -1863,7 +1951,7 @@ } msframe->last_click_time = GetMessageTime(); break; - + case WM_TIMER: if (wParam == BUTTON_2_TIMER_ID) { @@ -1912,7 +2000,7 @@ event->event.motion.x = MAKEPOINTS(lParam).x; event->event.motion.y = MAKEPOINTS(lParam).y; event->event.motion.modifiers = mswindows_modifier_state (NULL, 0); - + mswindows_enqueue_dispatch_event (emacs_event); } break; @@ -1925,18 +2013,21 @@ Qcancel_mode_internal, Qnil); break; -#ifdef HAVE_TOOLBARS case WM_NOTIFY: { - LPTOOLTIPTEXT tttext = (LPTOOLTIPTEXT)lParam; - Lisp_Object btext; - if (tttext->hdr.code == TTN_NEEDTEXT) + LPNMHDR nmhdr = (LPNMHDR)lParam; + + if (nmhdr->code == TTN_NEEDTEXT) { +#ifdef HAVE_TOOLBARS + LPTOOLTIPTEXT tttext = (LPTOOLTIPTEXT)lParam; + Lisp_Object btext; + /* find out which toolbar */ frame = XFRAME (mswindows_find_frame (hwnd)); - btext = mswindows_get_toolbar_button_text ( frame, - tttext->hdr.idFrom ); - + btext = mswindows_get_toolbar_button_text ( frame, + nmhdr->idFrom ); + tttext->lpszText = NULL; tttext->hinst = NULL; @@ -1944,29 +2035,44 @@ { /* I think this is safe since the text will only go away when the toolbar does...*/ - GET_C_STRING_EXT_DATA_ALLOCA (btext, FORMAT_OS, - tttext->lpszText); + TO_EXTERNAL_FORMAT (LISP_STRING, btext, + C_STRING_ALLOCA, tttext->lpszText, + Qnative); } -#if 0 - tttext->uFlags |= TTF_DI_SETITEM; #endif - } + } + /* handle tree view callbacks */ + else if (nmhdr->code == TVN_SELCHANGED) + { + NM_TREEVIEW* ptree = (NM_TREEVIEW*)lParam; + frame = XFRAME (mswindows_find_frame (hwnd)); + mswindows_handle_gui_wm_command (frame, 0, ptree->itemNew.lParam); + } + /* handle tab control callbacks */ + else if (nmhdr->code == TCN_SELCHANGE) + { + TC_ITEM item; + int idx = SendMessage (nmhdr->hwndFrom, TCM_GETCURSEL, 0, 0); + frame = XFRAME (mswindows_find_frame (hwnd)); + + item.mask = TCIF_PARAM; + SendMessage (nmhdr->hwndFrom, TCM_GETITEM, (WPARAM)idx, + (LPARAM)&item); + + mswindows_handle_gui_wm_command (frame, 0, item.lParam); + } } break; -#endif - + case WM_PAINT: - { - PAINTSTRUCT paintStruct; - - frame = XFRAME (mswindows_find_frame (hwnd)); - - BeginPaint (hwnd, &paintStruct); - mswindows_redraw_exposed_area (frame, - paintStruct.rcPaint.left, paintStruct.rcPaint.top, - paintStruct.rcPaint.right, paintStruct.rcPaint.bottom); - EndPaint (hwnd, &paintStruct); - } + /* hdc will be NULL unless this is a subwindow - in which case we + shouldn't have received a paint message for it here. */ + assert (wParam == 0); + + /* Can't queue a magic event because windows goes modal and sends paint + messages directly to the windows procedure when doing solid drags + and the message queue doesn't get processed. */ + mswindows_handle_paint (XFRAME (mswindows_find_frame (hwnd))); break; case WM_SIZE: @@ -2008,8 +2114,8 @@ if (FRAME_MSWINDOWS_TARGET_RECT (frame)) { /* Yes, we have to size again */ - mswindows_size_frame_internal ( frame, - FRAME_MSWINDOWS_TARGET_RECT + mswindows_size_frame_internal ( frame, + FRAME_MSWINDOWS_TARGET_RECT (frame)); /* Reset so we do not get here again. The SetWindowPos call in * mswindows_size_frame_internal can cause recursion here. */ @@ -2024,7 +2130,7 @@ if (!msframe->sizing && !FRAME_VISIBLE_P (frame)) mswindows_enqueue_magic_event (hwnd, XM_MAPFRAME); FRAME_VISIBLE_P (frame) = 1; - + if (!msframe->sizing || mswindows_dynamic_frame_resize) redisplay (); } @@ -2115,7 +2221,24 @@ SendMessage (hwndScrollBar, WM_CANCELMODE, 0, 0); } UNGCPRO; - break; + break; + } + + case WM_MOUSEWHEEL: + { + int keys = LOWORD (wParam); /* Modifier key flags */ + int delta = (short) HIWORD (wParam); /* Wheel rotation amount */ + struct gcpro gcpro1, gcpro2; + + if (mswindows_handle_mousewheel_event (mswindows_find_frame (hwnd), keys, delta)) + { + GCPRO2 (emacs_event, fobj); + mswindows_pump_outstanding_events (); /* Can GC */ + UNGCPRO; + } + else + goto defproc; + break; } #endif @@ -2189,10 +2312,8 @@ Lisp_Object image_instance; VOID_TO_LISP (image_instance, ii); if (IMAGE_INSTANCEP (image_instance) - && - IMAGE_INSTANCE_TYPE_P (image_instance, IMAGE_WIDGET) && - !NILP (XIMAGE_INSTANCE_WIDGET_FACE (image_instance))) + IMAGE_INSTANCE_TYPE_P (image_instance, IMAGE_WIDGET)) { /* set colors for the buttons */ HDC hdc = (HDC)wParam; @@ -2200,27 +2321,27 @@ { if (widget_brush) DeleteObject (widget_brush); - widget_brush = CreateSolidBrush - (COLOR_INSTANCE_MSWINDOWS_COLOR - (XCOLOR_INSTANCE - (FACE_BACKGROUND + widget_brush = CreateSolidBrush + (COLOR_INSTANCE_MSWINDOWS_COLOR + (XCOLOR_INSTANCE + (FACE_BACKGROUND (XIMAGE_INSTANCE_WIDGET_FACE (image_instance), XIMAGE_INSTANCE_SUBWINDOW_FRAME (image_instance))))); } last_widget_brushed = ii; SetTextColor (hdc, - COLOR_INSTANCE_MSWINDOWS_COLOR - (XCOLOR_INSTANCE - (FACE_FOREGROUND + COLOR_INSTANCE_MSWINDOWS_COLOR + (XCOLOR_INSTANCE + (FACE_FOREGROUND (XIMAGE_INSTANCE_WIDGET_FACE (image_instance), XIMAGE_INSTANCE_SUBWINDOW_FRAME (image_instance))))); SetBkMode (hdc, OPAQUE); SetBkColor (hdc, - COLOR_INSTANCE_MSWINDOWS_COLOR - (XCOLOR_INSTANCE - (FACE_BACKGROUND + COLOR_INSTANCE_MSWINDOWS_COLOR + (XCOLOR_INSTANCE + (FACE_BACKGROUND (XIMAGE_INSTANCE_WIDGET_FACE (image_instance), XIMAGE_INSTANCE_SUBWINDOW_FRAME (image_instance))))); return (LRESULT)widget_brush; @@ -2392,67 +2513,100 @@ * Only returns non-Qnil for keys that don't generate WM_CHAR messages * or whose ASCII codes (like space) xemacs doesn't like. * Virtual key values are defined in winresrc.h - * XXX I'm not sure that KEYSYM("name") is the best thing to use here. */ -Lisp_Object mswindows_key_to_emacs_keysym(int mswindows_key, int mods) +Lisp_Object mswindows_key_to_emacs_keysym (int mswindows_key, int mods, + int extendedp) { - switch (mswindows_key) - { - /* First the predefined ones */ - case VK_BACK: return QKbackspace; - case VK_TAB: return QKtab; - case '\n': return QKlinefeed; /* No VK_LINEFEED in winresrc.h */ - case VK_RETURN: return QKreturn; - case VK_ESCAPE: return QKescape; - case VK_SPACE: return QKspace; - case VK_DELETE: return QKdelete; - - /* The rest */ - case VK_CLEAR: return KEYSYM ("clear"); /* Should do ^L ? */ - case VK_PRIOR: return KEYSYM ("prior"); - case VK_NEXT: return KEYSYM ("next"); - case VK_END: return KEYSYM ("end"); - case VK_HOME: return KEYSYM ("home"); - case VK_LEFT: return KEYSYM ("left"); - case VK_UP: return KEYSYM ("up"); - case VK_RIGHT: return KEYSYM ("right"); - case VK_DOWN: return KEYSYM ("down"); - case VK_SELECT: return KEYSYM ("select"); - case VK_PRINT: return KEYSYM ("print"); - case VK_EXECUTE: return KEYSYM ("execute"); - case VK_SNAPSHOT: return KEYSYM ("print"); - case VK_INSERT: return KEYSYM ("insert"); - case VK_HELP: return KEYSYM ("help"); -#if 0 /* XXX What are these supposed to do? */ - case VK_LWIN return KEYSYM (""); - case VK_RWIN return KEYSYM (""); + if (extendedp) /* Keys not present on a 82 key keyboard */ + { + switch (mswindows_key) + { + case VK_RETURN: return KEYSYM ("kp-enter"); + case VK_PRIOR: return KEYSYM ("prior"); + case VK_NEXT: return KEYSYM ("next"); + case VK_END: return KEYSYM ("end"); + case VK_HOME: return KEYSYM ("home"); + case VK_LEFT: return KEYSYM ("left"); + case VK_UP: return KEYSYM ("up"); + case VK_RIGHT: return KEYSYM ("right"); + case VK_DOWN: return KEYSYM ("down"); + case VK_INSERT: return KEYSYM ("insert"); + case VK_DELETE: return QKdelete; + } + } + else + { + switch (mswindows_key) + { + case VK_BACK: return QKbackspace; + case VK_TAB: return QKtab; + case '\n': return QKlinefeed; + case VK_CLEAR: return KEYSYM ("clear"); + case VK_RETURN: return QKreturn; + case VK_ESCAPE: return QKescape; + case VK_SPACE: return QKspace; + case VK_PRIOR: return KEYSYM ("kp-prior"); + case VK_NEXT: return KEYSYM ("kp-next"); + case VK_END: return KEYSYM ("kp-end"); + case VK_HOME: return KEYSYM ("kp-home"); + case VK_LEFT: return KEYSYM ("kp-left"); + case VK_UP: return KEYSYM ("kp-up"); + case VK_RIGHT: return KEYSYM ("kp-right"); + case VK_DOWN: return KEYSYM ("kp-down"); + case VK_SELECT: return KEYSYM ("select"); + case VK_PRINT: return KEYSYM ("print"); + case VK_EXECUTE: return KEYSYM ("execute"); + case VK_SNAPSHOT: return KEYSYM ("print"); + case VK_INSERT: return KEYSYM ("kp-insert"); + case VK_DELETE: return KEYSYM ("kp-delete"); + case VK_HELP: return KEYSYM ("help"); +#if 0 /* FSF Emacs allows these to return configurable syms/mods */ + case VK_LWIN return KEYSYM (""); + case VK_RWIN return KEYSYM (""); #endif - case VK_APPS: return KEYSYM ("menu"); - case VK_F1: return KEYSYM ("f1"); - case VK_F2: return KEYSYM ("f2"); - case VK_F3: return KEYSYM ("f3"); - case VK_F4: return KEYSYM ("f4"); - case VK_F5: return KEYSYM ("f5"); - case VK_F6: return KEYSYM ("f6"); - case VK_F7: return KEYSYM ("f7"); - case VK_F8: return KEYSYM ("f8"); - case VK_F9: return KEYSYM ("f9"); - case VK_F10: return KEYSYM ("f10"); - case VK_F11: return KEYSYM ("f11"); - case VK_F12: return KEYSYM ("f12"); - case VK_F13: return KEYSYM ("f13"); - case VK_F14: return KEYSYM ("f14"); - case VK_F15: return KEYSYM ("f15"); - case VK_F16: return KEYSYM ("f16"); - case VK_F17: return KEYSYM ("f17"); - case VK_F18: return KEYSYM ("f18"); - case VK_F19: return KEYSYM ("f19"); - case VK_F20: return KEYSYM ("f20"); - case VK_F21: return KEYSYM ("f21"); - case VK_F22: return KEYSYM ("f22"); - case VK_F23: return KEYSYM ("f23"); - case VK_F24: return KEYSYM ("f24"); - } + case VK_APPS: return KEYSYM ("menu"); + case VK_NUMPAD0: return KEYSYM ("kp-0"); + case VK_NUMPAD1: return KEYSYM ("kp-1"); + case VK_NUMPAD2: return KEYSYM ("kp-2"); + case VK_NUMPAD3: return KEYSYM ("kp-3"); + case VK_NUMPAD4: return KEYSYM ("kp-4"); + case VK_NUMPAD5: return KEYSYM ("kp-5"); + case VK_NUMPAD6: return KEYSYM ("kp-6"); + case VK_NUMPAD7: return KEYSYM ("kp-7"); + case VK_NUMPAD8: return KEYSYM ("kp-8"); + case VK_NUMPAD9: return KEYSYM ("kp-9"); + case VK_MULTIPLY: return KEYSYM ("kp-multiply"); + case VK_ADD: return KEYSYM ("kp-add"); + case VK_SEPARATOR: return KEYSYM ("kp-separator"); + case VK_SUBTRACT: return KEYSYM ("kp-subtract"); + case VK_DECIMAL: return KEYSYM ("kp-decimal"); + case VK_DIVIDE: return KEYSYM ("kp-divide"); + case VK_F1: return KEYSYM ("f1"); + case VK_F2: return KEYSYM ("f2"); + case VK_F3: return KEYSYM ("f3"); + case VK_F4: return KEYSYM ("f4"); + case VK_F5: return KEYSYM ("f5"); + case VK_F6: return KEYSYM ("f6"); + case VK_F7: return KEYSYM ("f7"); + case VK_F8: return KEYSYM ("f8"); + case VK_F9: return KEYSYM ("f9"); + case VK_F10: return KEYSYM ("f10"); + case VK_F11: return KEYSYM ("f11"); + case VK_F12: return KEYSYM ("f12"); + case VK_F13: return KEYSYM ("f13"); + case VK_F14: return KEYSYM ("f14"); + case VK_F15: return KEYSYM ("f15"); + case VK_F16: return KEYSYM ("f16"); + case VK_F17: return KEYSYM ("f17"); + case VK_F18: return KEYSYM ("f18"); + case VK_F19: return KEYSYM ("f19"); + case VK_F20: return KEYSYM ("f20"); + case VK_F21: return KEYSYM ("f21"); + case VK_F22: return KEYSYM ("f22"); + case VK_F23: return KEYSYM ("f23"); + case VK_F24: return KEYSYM ("f24"); + } + } return Qnil; } @@ -2510,7 +2664,7 @@ static void emacs_mswindows_remove_timeout (int id) { - struct Lisp_Event match_against; + Lisp_Event match_against; Lisp_Object emacs_event; if (KillTimer (NULL, id)) @@ -2546,13 +2700,13 @@ * Return the next event */ static void -emacs_mswindows_next_event (struct Lisp_Event *emacs_event) +emacs_mswindows_next_event (Lisp_Event *emacs_event) { Lisp_Object event, event2; mswindows_need_event (1); - event = mswindows_dequeue_dispatch_event (!NILP(mswindows_u_dispatch_event_queue)); + event = mswindows_dequeue_dispatch_event (); XSETEVENT (event2, emacs_event); Fcopy_event (event, event2); Fdeallocate_event (event); @@ -2562,13 +2716,18 @@ * Handle a magic event off the dispatch queue. */ static void -emacs_mswindows_handle_magic_event (struct Lisp_Event *emacs_event) +emacs_mswindows_handle_magic_event (Lisp_Event *emacs_event) { switch (EVENT_MSWINDOWS_MAGIC_TYPE(emacs_event)) { case XM_BUMPQUEUE: break; - + + case WM_PAINT: + mswindows_handle_paint (XFRAME (EVENT_CHANNEL (emacs_event))); + mswindows_paint_pending = 0; + break; + case WM_SETFOCUS: case WM_KILLFOCUS: { @@ -2596,13 +2755,13 @@ case XM_UNMAPFRAME: { Lisp_Object frame = EVENT_CHANNEL (emacs_event); - va_run_hook_with_args (EVENT_MSWINDOWS_MAGIC_TYPE(emacs_event) + va_run_hook_with_args (EVENT_MSWINDOWS_MAGIC_TYPE(emacs_event) == XM_MAPFRAME ? - Qmap_frame_hook : Qunmap_frame_hook, + Qmap_frame_hook : Qunmap_frame_hook, 1, frame); } break; - + /* #### What about Enter & Leave */ #if 0 va_run_hook_with_args (in_p ? Qmouse_enter_frame_hook : @@ -2616,7 +2775,7 @@ #ifndef HAVE_MSG_SELECT static HANDLE -get_process_input_waitable (struct Lisp_Process *process) +get_process_input_waitable (Lisp_Process *process) { Lisp_Object instr, outstr, p; XSETPROCESS (p, process); @@ -2632,7 +2791,7 @@ } static void -emacs_mswindows_select_process (struct Lisp_Process *process) +emacs_mswindows_select_process (Lisp_Process *process) { HANDLE hev = get_process_input_waitable (process); @@ -2657,7 +2816,7 @@ } static void -emacs_mswindows_unselect_process (struct Lisp_Process *process) +emacs_mswindows_unselect_process (Lisp_Process *process) { /* Process handle is removed in the event loop as soon as it is signaled, so don't bother here about it */ @@ -2691,38 +2850,37 @@ static void emacs_mswindows_quit_p (void) { - MSG msg; - /* Quit cannot happen in modal loop: all program input is dedicated to Windows. */ if (mswindows_in_modal_loop) return; - /* Drain windows queue. This sets up number of quit characters in the queue - * (and also processes wm focus change, move, resize, etc messages). - * We don't want to process WM_PAINT messages because this function can be - * called from almost anywhere and the windows' states may be changing. */ - while (PeekMessage (&msg, NULL, 0, WM_PAINT-1, PM_REMOVE) || - PeekMessage (&msg, NULL, WM_PAINT+1, WM_USER-1, PM_REMOVE)) - DispatchMessage (&msg); + /* Drain windows queue. This sets up number of quit characters in + the queue */ + mswindows_drain_windows_queue (); if (mswindows_quit_chars_count > 0) { /* Yes there's a hidden one... Throw it away */ - struct Lisp_Event match_against; + Lisp_Event match_against; Lisp_Object emacs_event; + int critical_p = 0; match_against.event_type = key_press_event; match_against.event.key.modifiers = FAKE_MOD_QUIT; - emacs_event = mswindows_cancel_dispatch_event (&match_against); - assert (!NILP (emacs_event)); - - Vquit_flag = (XEVENT(emacs_event)->event.key.modifiers & MOD_SHIFT - ? Qcritical : Qt); - - Fdeallocate_event(emacs_event); - --mswindows_quit_chars_count; + while (mswindows_quit_chars_count-- > 0) + { + emacs_event = mswindows_cancel_dispatch_event (&match_against); + assert (!NILP (emacs_event)); + + if (XEVENT(emacs_event)->event.key.modifiers & MOD_SHIFT) + critical_p = 1; + + Fdeallocate_event(emacs_event); + } + + Vquit_flag = critical_p ? Qcritical : Qt; } } @@ -2834,7 +2992,7 @@ If we've still got pointers to it in this file, we're gonna lose hard. */ void -debug_process_finalization (struct Lisp_Process *p) +debug_process_finalization (Lisp_Process *p) { #if 0 /* #### */ Lisp_Object instr, outstr; @@ -2852,20 +3010,10 @@ /************************************************************************/ /* initialization */ /************************************************************************/ - + void -vars_of_event_mswindows (void) +reinit_vars_of_event_mswindows (void) { - mswindows_u_dispatch_event_queue = Qnil; - staticpro (&mswindows_u_dispatch_event_queue); - mswindows_u_dispatch_event_queue_tail = Qnil; - - mswindows_s_dispatch_event_queue = Qnil; - staticpro (&mswindows_s_dispatch_event_queue); - mswindows_s_dispatch_event_queue_tail = Qnil; - - mswindows_error_caught_in_modal_loop = Qnil; - staticpro (&mswindows_error_caught_in_modal_loop); mswindows_in_modal_loop = 0; mswindows_pending_timers_count = 0; @@ -2880,10 +3028,10 @@ mswindows_event_stream->select_console_cb = emacs_mswindows_select_console; mswindows_event_stream->unselect_console_cb = emacs_mswindows_unselect_console; #ifdef HAVE_MSG_SELECT - mswindows_event_stream->select_process_cb = - (void (*)(struct Lisp_Process*))event_stream_unixoid_select_process; - mswindows_event_stream->unselect_process_cb = - (void (*)(struct Lisp_Process*))event_stream_unixoid_unselect_process; + mswindows_event_stream->select_process_cb = + (void (*)(Lisp_Process*))event_stream_unixoid_select_process; + mswindows_event_stream->unselect_process_cb = + (void (*)(Lisp_Process*))event_stream_unixoid_unselect_process; mswindows_event_stream->create_stream_pair_cb = event_stream_unixoid_create_stream_pair; mswindows_event_stream->delete_stream_pair_cb = event_stream_unixoid_delete_stream_pair; #else @@ -2892,6 +3040,31 @@ mswindows_event_stream->create_stream_pair_cb = emacs_mswindows_create_stream_pair; mswindows_event_stream->delete_stream_pair_cb = emacs_mswindows_delete_stream_pair; #endif +} + +void +vars_of_event_mswindows (void) +{ + reinit_vars_of_event_mswindows (); + + mswindows_u_dispatch_event_queue = Qnil; + staticpro (&mswindows_u_dispatch_event_queue); + mswindows_u_dispatch_event_queue_tail = Qnil; + pdump_wire (&mswindows_u_dispatch_event_queue_tail); + + mswindows_s_dispatch_event_queue = Qnil; + staticpro (&mswindows_s_dispatch_event_queue); + mswindows_s_dispatch_event_queue_tail = Qnil; + pdump_wire (&mswindows_s_dispatch_event_queue_tail); + + mswindows_error_caught_in_modal_loop = Qnil; + staticpro (&mswindows_error_caught_in_modal_loop); + + DEFVAR_BOOL ("mswindows-meta-activates-menu", &mswindows_meta_activates_menu /* +*Controls whether pressing and releasing the Meta (Alt) key should +activate the menubar. +Default is t. +*/ ); DEFVAR_BOOL ("mswindows-dynamic-frame-resize", &mswindows_dynamic_frame_resize /* *Controls redrawing frame contents during mouse-drag or keyboard resize @@ -2937,6 +3110,7 @@ mswindows_mouse_button_max_skew_x = 0; mswindows_mouse_button_max_skew_y = 0; mswindows_mouse_button_tolerance = 0; + mswindows_meta_activates_menu = 1; } void diff -r f4aeb21a5bad -r 74fd4e045ea6 src/event-stream.c --- a/src/event-stream.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/event-stream.c Mon Aug 13 11:13:30 2007 +0200 @@ -81,7 +81,6 @@ #include "keymap.h" #include "lstream.h" #include "macros.h" /* for defining_keyboard_macro */ -#include "opaque.h" #include "process.h" #include "window.h" @@ -102,8 +101,6 @@ Lisp_Object Qundefined_keystroke_sequence; -Lisp_Object Qcommand_execute; - Lisp_Object Qcommand_event_p; /* Hooks to run before and after each command. */ @@ -262,6 +259,8 @@ Lisp_Object Qmenu_select; Lisp_Object Qmenu_escape; +Lisp_Object Qself_insert_defer_undo; + /* this is in keymap.c */ extern Lisp_Object Fmake_keymap (Lisp_Object name); @@ -385,19 +384,18 @@ XRECORD (x, command_builder, struct command_builder) #define XSETCOMMAND_BUILDER(x, p) XSETRECORD (x, p, command_builder) #define COMMAND_BUILDERP(x) RECORDP (x, command_builder) -#define GC_COMMAND_BUILDERP(x) GC_RECORDP (x, command_builder) #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder) static Lisp_Object -mark_command_builder (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_command_builder (Lisp_Object obj) { struct command_builder *builder = XCOMMAND_BUILDER (obj); - markobj (builder->prefix_events); - markobj (builder->current_events); - markobj (builder->most_current_event); - markobj (builder->last_non_munged_event); - markobj (builder->munge_me[0].first_mungeable_event); - markobj (builder->munge_me[1].first_mungeable_event); + mark_object (builder->prefix_events); + mark_object (builder->current_events); + mark_object (builder->most_current_event); + mark_object (builder->last_non_munged_event); + mark_object (builder->munge_me[0].first_mungeable_event); + mark_object (builder->munge_me[1].first_mungeable_event); return builder->console; } @@ -413,7 +411,7 @@ DEFINE_LRECORD_IMPLEMENTATION ("command-builder", command_builder, mark_command_builder, internal_object_printer, - finalize_command_builder, 0, 0, + finalize_command_builder, 0, 0, 0, struct command_builder); static void @@ -432,7 +430,7 @@ { Lisp_Object builder_obj; struct command_builder *builder = - alloc_lcrecord_type (struct command_builder, lrecord_command_builder); + alloc_lcrecord_type (struct command_builder, &lrecord_command_builder); builder->console = console; reset_command_builder_event_chain (builder); @@ -510,7 +508,7 @@ } static int -maybe_read_quit_event (struct Lisp_Event *event) +maybe_read_quit_event (Lisp_Event *event) { /* A C-g that came from `sigint_happened' will always come from the controlling terminal. If that doesn't exist, however, then the @@ -537,7 +535,7 @@ } void -event_stream_next_event (struct Lisp_Event *event) +event_stream_next_event (Lisp_Event *event) { Lisp_Object event_obj; @@ -581,7 +579,7 @@ } void -event_stream_handle_magic_event (struct Lisp_Event *event) +event_stream_handle_magic_event (Lisp_Event *event) { check_event_stream_ok (EVENT_STREAM_READ); event_stream->handle_magic_event_cb (event); @@ -624,7 +622,7 @@ } void -event_stream_select_process (struct Lisp_Process *proc) +event_stream_select_process (Lisp_Process *proc) { check_event_stream_ok (EVENT_STREAM_PROCESS); if (!get_process_selected_p (proc)) @@ -635,7 +633,7 @@ } void -event_stream_unselect_process (struct Lisp_Process *proc) +event_stream_unselect_process (Lisp_Process *proc) { check_event_stream_ok (EVENT_STREAM_PROCESS); if (get_process_selected_p (proc)) @@ -799,7 +797,7 @@ } else if (CHARP (traduit)) { - struct Lisp_Event ev2; + Lisp_Event ev2; /* This used to call Fcharacter_to_event() directly into EVENT, but that can eradicate timestamps and other such stuff. @@ -985,7 +983,7 @@ used to indicate an absence of a timer. */ static int low_level_timeout_id_tick; -struct low_level_timeout_blocktype +static struct low_level_timeout_blocktype { Blocktype_declare (struct low_level_timeout); } *the_low_level_timeout_blocktype; @@ -1101,38 +1099,40 @@ static int timeout_id_tick; -/* Since timeout structures contain Lisp_Objects, they need to be GC'd - properly. The opaque data type provides a convenient way of doing - this without having to create a new Lisp object, since we can - provide our own mark function. */ - -struct timeout -{ - int id; /* Id we use to identify the timeout over its lifetime */ - int interval_id; /* Id for this particular interval; this may - be different each time the timeout is - signalled.*/ - Lisp_Object function, object; /* Function and object associated - with timeout. */ - EMACS_TIME next_signal_time; /* Absolute time when the timeout - is next going to be signalled. */ - unsigned int resignal_msecs; /* How far after the next timeout - should the one after that - occur? */ -}; - static Lisp_Object pending_timeout_list, pending_async_timeout_list; static Lisp_Object Vtimeout_free_list; static Lisp_Object -mark_timeout (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_timeout (Lisp_Object obj) { - struct timeout *tm = (struct timeout *) XOPAQUE_DATA (obj); - markobj (tm->function); + Lisp_Timeout *tm = XTIMEOUT (obj); + mark_object (tm->function); return tm->object; } +/* Should never, ever be called. (except by an external debugger) */ +static void +print_timeout (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) +{ + const Lisp_Timeout *t = XTIMEOUT (obj); + char buf[64]; + + sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (timeout) 0x%lx>", + (unsigned long) t); + write_c_string (buf, printcharfun); +} + +static const struct lrecord_description timeout_description[] = { + { XD_LISP_OBJECT, offsetof (Lisp_Timeout, function) }, + { XD_LISP_OBJECT, offsetof (Lisp_Timeout, object) }, + { XD_END } +}; + +DEFINE_LRECORD_IMPLEMENTATION ("timeout", timeout, + mark_timeout, print_timeout, + 0, 0, 0, timeout_description, Lisp_Timeout); + /* Generate a timeout and return its ID. */ int @@ -1141,8 +1141,8 @@ Lisp_Object function, Lisp_Object object, int async_p) { - Lisp_Object op = allocate_managed_opaque (Vtimeout_free_list, 0); - struct timeout *timeout = (struct timeout *) XOPAQUE_DATA (op); + Lisp_Object op = allocate_managed_lcrecord (Vtimeout_free_list); + Lisp_Timeout *timeout = XTIMEOUT (op); EMACS_TIME current_time; EMACS_TIME interval; @@ -1191,7 +1191,7 @@ Lisp_Object *function, Lisp_Object *object) { Lisp_Object op = Qnil, rest; - struct timeout *timeout; + Lisp_Timeout *timeout; Lisp_Object *timeout_list; struct gcpro gcpro1; int id; @@ -1204,16 +1204,16 @@ /* Find the timeout on the list of pending ones. */ LIST_LOOP (rest, *timeout_list) { - timeout = (struct timeout *) XOPAQUE_DATA (XCAR (rest)); + timeout = XTIMEOUT (XCAR (rest)); if (timeout->interval_id == interval_id) break; } assert (!NILP (rest)); op = XCAR (rest); - timeout = (struct timeout *) XOPAQUE_DATA (op); + timeout = XTIMEOUT (op); /* We make sure to snarf the data out of the timeout object before - we free it with free_managed_opaque(). */ + we free it with free_managed_lcrecord(). */ id = timeout->id; *function = timeout->function; *object = timeout->object; @@ -1255,7 +1255,7 @@ *timeout_list = noseeum_cons (op, *timeout_list); } else - free_managed_opaque (Vtimeout_free_list, op); + free_managed_lcrecord (Vtimeout_free_list, op); UNGCPRO; return id; @@ -1264,7 +1264,7 @@ void event_stream_disable_wakeup (int id, int async_p) { - struct timeout *timeout = 0; + Lisp_Timeout *timeout = 0; Lisp_Object rest; Lisp_Object *timeout_list; @@ -1276,7 +1276,7 @@ /* Find the timeout on the list of pending ones, if it's still there. */ LIST_LOOP (rest, *timeout_list) { - timeout = (struct timeout *) XOPAQUE_DATA (XCAR (rest)); + timeout = XTIMEOUT (XCAR (rest)); if (timeout->id == id) break; } @@ -1292,14 +1292,14 @@ event_stream_remove_async_timeout (timeout->interval_id); else event_stream_remove_timeout (timeout->interval_id); - free_managed_opaque (Vtimeout_free_list, op); + free_managed_lcrecord (Vtimeout_free_list, op); } } static int event_stream_wakeup_pending_p (int id, int async_p) { - struct timeout *timeout; + Lisp_Timeout *timeout; Lisp_Object rest; Lisp_Object timeout_list; int found = 0; @@ -1313,7 +1313,7 @@ /* Find the element on the list of pending ones, if it's still there. */ LIST_LOOP (rest, timeout_list) { - timeout = (struct timeout *) XOPAQUE_DATA (XCAR (rest)); + timeout = XTIMEOUT (XCAR (rest)); if (timeout->id == id) { found = 1; @@ -2016,7 +2016,7 @@ } else { - struct Lisp_Event *e = XEVENT (target_event); + Lisp_Event *e = XEVENT (target_event); /* The command_event_queue was empty. Wait for an event. */ event_stream_next_event (e); @@ -3038,7 +3038,7 @@ case timeout_event: { - struct Lisp_Event *e = XEVENT (event); + Lisp_Event *e = XEVENT (event); if (!NILP (e->event.timeout.function)) call1 (e->event.timeout.function, e->event.timeout.object); @@ -3100,20 +3100,15 @@ static void menu_move_up (void) { - widget_value *current, *prev; - widget_value *entries; - - current = lw_get_entries (False); - entries = lw_get_entries (True); - prev = NULL; - if (current != entries) + widget_value *current = lw_get_entries (False); + widget_value *entries = lw_get_entries (True); + widget_value *prev = NULL; + + while (entries != current) { - while (entries != current) - { - if (entries->name /*&& entries->enabled*/) prev = entries; - entries = entries->next; - assert (entries); - } + if (entries->name /*&& entries->enabled*/) prev = entries; + entries = entries->next; + assert (entries); } if (!prev) @@ -3142,11 +3137,8 @@ static void menu_move_down (void) { - widget_value *current; - widget_value *new; - - current = lw_get_entries (False); - new = current; + widget_value *current = lw_get_entries (False); + widget_value *new = current; while (new->next) { @@ -3179,11 +3171,9 @@ int l = level; widget_value *current; - while (level >= 3) - { - --level; - lw_pop_menu (); - } + while (level-- >= 3) + lw_pop_menu (); + menu_move_up (); current = lw_get_entries (False); if (l > 2 && current->contents) @@ -3197,11 +3187,9 @@ int l = level; widget_value *current; - while (level >= 3) - { - --level; - lw_pop_menu (); - } + while (level-- >= 3) + lw_pop_menu (); + menu_move_down (); current = lw_get_entries (False); if (l > 2 && current->contents) @@ -3424,7 +3412,7 @@ args[1] = errordata; warn_when_safe_lispobj (Qerror, Qwarning, - emacs_doprnt_string_lisp ((CONST Bufbyte *) "%s: %s", + emacs_doprnt_string_lisp ((const Bufbyte *) "%s: %s", Qnil, -1, 2, args)); } @@ -3782,7 +3770,7 @@ || (CHAR_OR_CHAR_INTP (key->keysym) && ((c = XCHAR_OR_CHAR_INT (key->keysym)), c >= 'A' && c <= 'Z'))) { - struct Lisp_Event terminal_copy = *XEVENT (terminal); + Lisp_Event terminal_copy = *XEVENT (terminal); if (key->modifiers & MOD_SHIFT) key->modifiers &= (~ MOD_SHIFT); @@ -4175,7 +4163,7 @@ if (EVENTP (recent) && event_matches_key_specifier_p (XEVENT (recent), Vmeta_prefix_char)) { - struct Lisp_Event *e; + Lisp_Event *e; /* When we see a sequence like "ESC x", pretend we really saw "M-x". DoubleThink the recent-keys and this-command-keys as well. */ @@ -4242,7 +4230,7 @@ } else if (!NILP (Vquit_flag)) { Lisp_Object quit_event = Fmake_event(Qnil, Qnil); - struct Lisp_Event *e = XEVENT (quit_event); + Lisp_Event *e = XEVENT (quit_event); /* if quit happened during menu acceleration, pretend we read it */ struct console *con = XCONSOLE (Fselected_console ()); int ch = CONSOLE_QUIT_CHAR (con); @@ -4413,7 +4401,7 @@ #if 0 /* If the last command deleted the frame, `win' might be nil. It seems safest to do nothing in this case. */ - /* ### This doesn't really fix the problem, + /* #### This doesn't really fix the problem, if delete-frame is called by some hook */ if (NILP (win)) return; @@ -4492,7 +4480,7 @@ { /* This function can GC */ struct command_builder *command_builder; - struct Lisp_Event *ev; + Lisp_Event *ev; Lisp_Object console; Lisp_Object channel; @@ -4606,15 +4594,35 @@ } else /* key sequence is bound to a command */ { + int magic_undo = 0; + int magic_undo_count = 20; + Vthis_command = leaf; + /* Don't push an undo boundary if the command set the prefix arg, or if we are executing a keyboard macro, or if in the minibuffer. If the command we are about to execute is self-insert, it's tricky: up to 20 consecutive self-inserts may be done without an undo boundary. This counter is reset as soon as a command other than self-insert-command is executed. - */ - if (! EQ (leaf, Qself_insert_command)) + + Programmers can also use the `self-insert-undo-magic' + property to install that behaviour on functions other + than `self-insert-command', or to change the magic + number 20 to something else. */ + + if (SYMBOLP (leaf)) + { + Lisp_Object prop = Fget (leaf, Qself_insert_defer_undo, Qnil); + if (NATNUMP (prop)) + magic_undo = 1, magic_undo_count = XINT (prop); + else if (!NILP (prop)) + magic_undo = 1; + else if (EQ (leaf, Qself_insert_command)) + magic_undo = 1; + } + + if (!magic_undo) command_builder->self_insert_countdown = 0; if (NILP (XCONSOLE (console)->prefix_arg) && NILP (Vexecuting_macro) @@ -4628,10 +4636,10 @@ && command_builder->self_insert_countdown == 0) Fundo_boundary (); - if (EQ (leaf, Qself_insert_command)) + if (magic_undo) { if (--command_builder->self_insert_countdown < 0) - command_builder->self_insert_countdown = 20; + command_builder->self_insert_countdown = magic_undo_count; } execute_command_event (command_builder, @@ -4817,7 +4825,7 @@ Calling this function directs the translated event to replace the original event, so that only one version of the event actually -appears in the echo area and in the value of `this-command-keys.'. +appears in the echo area and in the value of `this-command-keys'. */ ()) { @@ -4841,9 +4849,7 @@ { Emchar ch = XCHAR (keysym); Bufbyte str[MAX_EMCHAR_LEN]; - Bytecount len; - - len = set_charptr_emchar (str, ch); + Bytecount len = set_charptr_emchar (str, ch); Lstream_write (XLSTREAM (Vdribble_file), str, len); } else if (string_char_length (XSYMBOL (keysym)->name) == 1) @@ -4909,7 +4915,6 @@ deferror (&Qundefined_keystroke_sequence, "undefined-keystroke-sequence", "Undefined keystroke sequence", Qerror); - defsymbol (&Qcommand_execute, "command-execute"); DEFSUBR (Frecent_keys); DEFSUBR (Frecent_keys_ring_size); @@ -4962,26 +4967,41 @@ defsymbol (&Qmenu_select, "menu-select"); defsymbol (&Qmenu_escape, "menu-escape"); + defsymbol (&Qself_insert_defer_undo, "self-insert-defer-undo"); defsymbol (&Qcancel_mode_internal, "cancel-mode-internal"); } void +reinit_vars_of_event_stream (void) +{ + recent_keys_ring_index = 0; + recent_keys_ring_size = 100; + num_input_chars = 0; + Vtimeout_free_list = make_lcrecord_list (sizeof (Lisp_Timeout), + &lrecord_timeout); + staticpro_nodump (&Vtimeout_free_list); + the_low_level_timeout_blocktype = + Blocktype_new (struct low_level_timeout_blocktype); + something_happened = 0; + recursive_sit_for = Qnil; +} + +void vars_of_event_stream (void) { - recent_keys_ring_index = 0; - recent_keys_ring_size = 100; + reinit_vars_of_event_stream (); Vrecent_keys_ring = Qnil; staticpro (&Vrecent_keys_ring); Vthis_command_keys = Qnil; staticpro (&Vthis_command_keys); Vthis_command_keys_tail = Qnil; - - num_input_chars = 0; + pdump_wire (&Vthis_command_keys_tail); command_event_queue = Qnil; staticpro (&command_event_queue); command_event_queue_tail = Qnil; + pdump_wire (&command_event_queue_tail); Vlast_selected_frame = Qnil; staticpro (&Vlast_selected_frame); @@ -4992,20 +5012,9 @@ pending_async_timeout_list = Qnil; staticpro (&pending_async_timeout_list); - Vtimeout_free_list = make_opaque_list (sizeof (struct timeout), - mark_timeout); - staticpro (&Vtimeout_free_list); - - the_low_level_timeout_blocktype = - Blocktype_new (struct low_level_timeout_blocktype); - - something_happened = 0; - last_point_position_buffer = Qnil; staticpro (&last_point_position_buffer); - recursive_sit_for = Qnil; - DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes /* *Nonzero means echo unfinished commands after this many seconds of pause. */ ); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/event-tty.c --- a/src/event-tty.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/event-tty.c Mon Aug 13 11:13:30 2007 +0200 @@ -64,7 +64,7 @@ } static void -tty_timeout_to_emacs_event (struct Lisp_Event *emacs_event) +tty_timeout_to_emacs_event (Lisp_Event *emacs_event) { emacs_event->event_type = timeout_event; /* timeout events have nil as channel */ @@ -112,7 +112,7 @@ } static void -emacs_tty_next_event (struct Lisp_Event *emacs_event) +emacs_tty_next_event (Lisp_Event *emacs_event) { while (1) { @@ -156,8 +156,7 @@ if (FD_ISSET (i, &temp_mask) && FD_ISSET (i, &process_only_mask)) { Lisp_Object process; - struct Lisp_Process *p = - get_process_from_usid (FD_TO_USID(i)); + Lisp_Process *p = get_process_from_usid (FD_TO_USID(i)); assert (p); XSETPROCESS (process, p); @@ -188,20 +187,20 @@ } static void -emacs_tty_handle_magic_event (struct Lisp_Event *emacs_event) +emacs_tty_handle_magic_event (Lisp_Event *emacs_event) { /* Nothing to do currently */ } static void -emacs_tty_select_process (struct Lisp_Process *process) +emacs_tty_select_process (Lisp_Process *process) { event_stream_unixoid_select_process (process); } static void -emacs_tty_unselect_process (struct Lisp_Process *process) +emacs_tty_unselect_process (Lisp_Process *process) { event_stream_unixoid_unselect_process (process); } @@ -245,7 +244,7 @@ /************************************************************************/ void -vars_of_event_tty (void) +reinit_vars_of_event_tty (void) { tty_event_stream = xnew (struct event_stream); @@ -264,6 +263,12 @@ } void +vars_of_event_tty (void) +{ + reinit_vars_of_event_tty (); +} + +void init_event_tty_late (void) { event_stream = tty_event_stream; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/event-unixoid.c --- a/src/event-unixoid.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/event-unixoid.c Mon Aug 13 11:13:30 2007 +0200 @@ -41,10 +41,6 @@ #include "sysproc.h" /* select stuff */ #include "systime.h" -#ifdef HAVE_GPM -#include "gpmevent.h" -#endif - /* Mask of bits indicating the descriptors that we wait for input on. These work as follows: @@ -75,7 +71,7 @@ int fake_event_occurred; int -read_event_from_tty_or_stream_desc (struct Lisp_Event *event, +read_event_from_tty_or_stream_desc (Lisp_Event *event, struct console *con, int fd) { unsigned char ch; @@ -84,12 +80,6 @@ XSETCONSOLE (console, con); -#ifdef HAVE_GPM - if (fd == CONSOLE_TTY_MOUSE_FD (con)) { - return handle_gpm_read (event,con,fd); - } -#endif - nread = read (fd, &ch, 1); if (nread <= 0) { @@ -184,7 +174,7 @@ } static int -get_process_infd (struct Lisp_Process *p) +get_process_infd (Lisp_Process *p) { Lisp_Object instr, outstr; get_process_streams (p, &instr, &outstr); @@ -193,7 +183,7 @@ } int -event_stream_unixoid_select_process (struct Lisp_Process *proc) +event_stream_unixoid_select_process (Lisp_Process *proc) { int infd = get_process_infd (proc); @@ -204,7 +194,7 @@ } int -event_stream_unixoid_unselect_process (struct Lisp_Process *proc) +event_stream_unixoid_unselect_process (Lisp_Process *proc) { int infd = get_process_infd (proc); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/events.c --- a/src/events.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/events.c Mon Aug 13 11:13:30 2007 +0200 @@ -81,51 +81,51 @@ deinitialize_event (Lisp_Object ev) { int i; - struct Lisp_Event *event = XEVENT (ev); + Lisp_Event *event = XEVENT (ev); - for (i = 0; i < (int) (sizeof (struct Lisp_Event) / sizeof (int)); i++) + for (i = 0; i < (int) (sizeof (Lisp_Event) / sizeof (int)); i++) ((int *) event) [i] = 0xdeadbeef; event->event_type = dead_event; event->channel = Qnil; - set_lheader_implementation (&(event->lheader), lrecord_event); + set_lheader_implementation (&(event->lheader), &lrecord_event); XSET_EVENT_NEXT (ev, Qnil); } /* Set everything to zero or nil so that it's predictable. */ void -zero_event (struct Lisp_Event *e) +zero_event (Lisp_Event *e) { xzero (*e); - set_lheader_implementation (&(e->lheader), lrecord_event); + set_lheader_implementation (&(e->lheader), &lrecord_event); e->event_type = empty_event; e->next = Qnil; e->channel = Qnil; } static Lisp_Object -mark_event (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_event (Lisp_Object obj) { - struct Lisp_Event *event = XEVENT (obj); + Lisp_Event *event = XEVENT (obj); switch (event->event_type) { case key_press_event: - markobj (event->event.key.keysym); + mark_object (event->event.key.keysym); break; case process_event: - markobj (event->event.process.process); + mark_object (event->event.process.process); break; case timeout_event: - markobj (event->event.timeout.function); - markobj (event->event.timeout.object); + mark_object (event->event.timeout.function); + mark_object (event->event.timeout.object); break; case eval_event: case misc_user_event: - markobj (event->event.eval.function); - markobj (event->event.eval.object); + mark_object (event->event.eval.function); + mark_object (event->event.eval.object); break; case magic_eval_event: - markobj (event->event.magic_eval.object); + mark_object (event->event.magic_eval.object); break; case button_press_event: case button_release_event: @@ -137,12 +137,12 @@ default: abort (); } - markobj (event->channel); + mark_object (event->channel); return event->next; } static void -print_event_1 (CONST char *str, Lisp_Object obj, Lisp_Object printcharfun) +print_event_1 (const char *str, Lisp_Object obj, Lisp_Object printcharfun) { char buf[255]; write_c_string (str, printcharfun); @@ -221,8 +221,8 @@ static int event_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { - struct Lisp_Event *e1 = XEVENT (obj1); - struct Lisp_Event *e2 = XEVENT (obj2); + Lisp_Event *e1 = XEVENT (obj1); + Lisp_Event *e2 = XEVENT (obj2); if (e1->event_type != e2->event_type) return 0; if (!EQ (e1->channel, e2->channel)) return 0; @@ -293,8 +293,9 @@ if (CONSOLE_MSWINDOWS_P (con)) return (!memcmp(&e1->event.magic.underlying_mswindows_event, &e2->event.magic.underlying_mswindows_event, - sizeof(union magic_data))); + sizeof (union magic_data))); #endif + abort (); return 1; /* not reached */ } @@ -307,7 +308,7 @@ static unsigned long event_hash (Lisp_Object obj, int depth) { - struct Lisp_Event *e = XEVENT (obj); + Lisp_Event *e = XEVENT (obj); unsigned long hash; hash = HASH2 (e->event_type, LISP_HASH (e->channel)); @@ -360,6 +361,8 @@ if (CONSOLE_MSWINDOWS_P (con)) return HASH2 (hash, e->event.magic.underlying_mswindows_event); #endif + abort (); + return 0; } case empty_event: @@ -375,7 +378,7 @@ DEFINE_BASIC_LRECORD_IMPLEMENTATION ("event", event, mark_event, print_event, 0, event_equal, - event_hash, struct Lisp_Event); + event_hash, 0, Lisp_Event); DEFUN ("make-event", Fmake_event, 0, 2, 0, /* @@ -428,7 +431,7 @@ { Lisp_Object tail, keyword, value; Lisp_Object event = Qnil; - struct Lisp_Event *e; + Lisp_Event *e; EMACS_INT coord_x = 0, coord_y = 0; struct gcpro gcpro1; @@ -763,7 +766,7 @@ Make a copy of the given event object. If a second argument is given, the first event is copied into the second and the second is returned. If the second argument is not supplied (or -is nil) then a new event will be made as with `allocate-event.' See also +is nil) then a new event will be made as with `make-event'. See also the function `deallocate-event'. */ (event1, event2)) @@ -771,19 +774,26 @@ CHECK_LIVE_EVENT (event1); if (NILP (event2)) event2 = Fmake_event (Qnil, Qnil); - else CHECK_LIVE_EVENT (event2); - if (EQ (event1, event2)) - return signal_simple_continuable_error_2 - ("copy-event called with `eq' events", event1, event2); + else + { + CHECK_LIVE_EVENT (event2); + if (EQ (event1, event2)) + return signal_simple_continuable_error_2 + ("copy-event called with `eq' events", event1, event2); + } assert (XEVENT_TYPE (event1) <= last_event_type); assert (XEVENT_TYPE (event2) <= last_event_type); { - Lisp_Object save_next = XEVENT_NEXT (event2); + Lisp_Event *ev2 = XEVENT (event2); + Lisp_Event *ev1 = XEVENT (event1); - *XEVENT (event2) = *XEVENT (event1); - XSET_EVENT_NEXT (event2, save_next); + ev2->event_type = ev1->event_type; + ev2->channel = ev1->channel; + ev2->timestamp = ev1->timestamp; + ev2->event = ev1->event; + return event2; } } @@ -963,7 +973,7 @@ void -character_to_event (Emchar c, struct Lisp_Event *event, struct console *con, +character_to_event (Emchar c, Lisp_Event *event, struct console *con, int use_console_meta_flag, int do_backspace_mapping) { Lisp_Object k = Qnil; @@ -1032,17 +1042,18 @@ event->event.key.modifiers = m; } - /* This variable controls what character name -> character code mapping we are using. Window-system-specific code sets this to some symbol, and we use that symbol as the plist key to convert keysyms into 8-bit codes. In this way one can have several character sets predefined and switch them by changing this. + + #### This is utterly bogus and should be removed. */ Lisp_Object Vcharacter_set_property; Emchar -event_to_character (struct Lisp_Event *event, +event_to_character (Lisp_Event *event, int allow_extra_modifiers, int allow_meta, int allow_non_ascii) @@ -1052,7 +1063,7 @@ if (event->event_type != key_press_event) { - if (event->event_type == dead_event) abort (); + assert (event->event_type != dead_event); return -1; } if (!allow_extra_modifiers && @@ -1219,7 +1230,7 @@ } void -format_event_object (char *buf, struct Lisp_Event *event, int brief) +format_event_object (char *buf, Lisp_Event *event, int brief) { int mouse_p = 0; int mod = 0; @@ -1255,7 +1266,7 @@ } case magic_event: { - CONST char *name = NULL; + const char *name = NULL; #ifdef HAVE_X_WINDOWS { @@ -1303,7 +1314,7 @@ } else if (SYMBOLP (key)) { - CONST char *str = 0; + const char *str = 0; if (brief) { if (EQ (key, QKlinefeed)) str = "LFD"; @@ -1322,7 +1333,7 @@ } else { - struct Lisp_String *name = XSYMBOL (key)->name; + Lisp_String *name = XSYMBOL (key)->name; memcpy (buf, string_data (name), string_length (name) + 1); str += string_length (name); } @@ -1358,7 +1369,7 @@ */ (event)) { - struct Lisp_Event *e; + Lisp_Event *e; CHECK_LIVE_EVENT (event); return XEVENT_NEXT (event); @@ -2098,7 +2109,7 @@ (event)) { Lisp_Object props = Qnil; - struct Lisp_Event *e; + Lisp_Event *e; struct gcpro gcpro1; CHECK_LIVE_EVENT (event); @@ -2229,11 +2240,28 @@ defsymbol (&Qbutton_release, "button-release"); defsymbol (&Qmisc_user, "misc-user"); defsymbol (&Qascii_character, "ascii-character"); + + defsymbol (&QKbackspace, "backspace"); + defsymbol (&QKtab, "tab"); + defsymbol (&QKlinefeed, "linefeed"); + defsymbol (&QKreturn, "return"); + defsymbol (&QKescape, "escape"); + defsymbol (&QKspace, "space"); + defsymbol (&QKdelete, "delete"); +} + + +void +reinit_vars_of_events (void) +{ + Vevent_resource = Qnil; } void vars_of_events (void) { + reinit_vars_of_events (); + DEFVAR_LISP ("character-set-property", &Vcharacter_set_property /* A symbol used to look up the 8-bit character of a keysym. To convert a keysym symbol to an 8-bit code, as when that key is @@ -2243,22 +2271,4 @@ variable. */ ); Vcharacter_set_property = Qnil; - - Vevent_resource = Qnil; - - QKbackspace = KEYSYM ("backspace"); - QKtab = KEYSYM ("tab"); - QKlinefeed = KEYSYM ("linefeed"); - QKreturn = KEYSYM ("return"); - QKescape = KEYSYM ("escape"); - QKspace = KEYSYM ("space"); - QKdelete = KEYSYM ("delete"); - - staticpro (&QKbackspace); - staticpro (&QKtab); - staticpro (&QKlinefeed); - staticpro (&QKreturn); - staticpro (&QKescape); - staticpro (&QKspace); - staticpro (&QKdelete); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/events.h --- a/src/events.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/events.h Mon Aug 13 11:13:30 2007 +0200 @@ -22,8 +22,8 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_EVENTS_H_ -#define _XEMACS_EVENTS_H_ +#ifndef INCLUDED_events_h_ +#define INCLUDED_events_h_ #include "systime.h" @@ -40,7 +40,8 @@ multiple heterogeneous machines, X11 and SunView, or X11 and NeXT, for example, then it will be necessary to construct an event_stream structure that can cope with the given types. Currently, the only implemented - event_streams are for dumb-ttys, and for X11 plus dumb-ttys. + event_streams are for dumb-ttys, and for X11 plus dumb-ttys, + and for mswindows. To implement this for one window system is relatively simple. To implement this for multiple window systems is trickier and may @@ -275,9 +276,9 @@ The Create stream pair function is passed two void* values, which identify process-dependent 'handles'. The process implementation uses these handles to communicate with child processes. The function must be prepared to receive - handle types of any process implementation. Since there only one process + handle types of any process implementation. Since only one process implementation exists in a particular XEmacs configuration, preprocessing - is a mean of compiling in the support for the code which deals with particular + is a means of compiling in the support for the code which deals with particular handle types. For example, a unixoid type loop, which relies on file descriptors, may be @@ -316,20 +317,17 @@ #define USID_DONTHASH ((USID)0) -struct Lisp_Event; -struct Lisp_Process; - struct event_stream { int (*event_pending_p) (int); - void (*next_event_cb) (struct Lisp_Event *); - void (*handle_magic_event_cb) (struct Lisp_Event *); + void (*next_event_cb) (Lisp_Event *); + void (*handle_magic_event_cb) (Lisp_Event *); int (*add_timeout_cb) (EMACS_TIME); void (*remove_timeout_cb) (int); void (*select_console_cb) (struct console *); void (*unselect_console_cb) (struct console *); - void (*select_process_cb) (struct Lisp_Process *); - void (*unselect_process_cb) (struct Lisp_Process *); + void (*select_process_cb) (Lisp_Process *); + void (*unselect_process_cb) (Lisp_Process *); void (*quit_p_cb) (void); USID (*create_stream_pair_cb) (void* /* inhandle*/, void* /*outhandle*/ , Lisp_Object* /* instream */, @@ -435,6 +433,30 @@ #endif }; +struct Lisp_Timeout +{ + struct lcrecord_header header; + int id; /* Id we use to identify the timeout over its lifetime */ + int interval_id; /* Id for this particular interval; this may + be different each time the timeout is + signalled.*/ + Lisp_Object function, object; /* Function and object associated + with timeout. */ + EMACS_TIME next_signal_time; /* Absolute time when the timeout + is next going to be signalled. */ + unsigned int resignal_msecs; /* How far after the next timeout + should the one after that + occur? */ +}; +typedef struct Lisp_Timeout Lisp_Timeout; + +DECLARE_LRECORD (timeout, Lisp_Timeout); +#define XTIMEOUT(x) XRECORD (x, timeout, Lisp_Timeout) +#define XSETTIMEOUT(x, p) XSETRECORD (x, p, timeout) +#define TIMEOUTP(x) RECORDP (x, timeout) +#define CHECK_TIMEOUT(x) CHECK_RECORD (x, timeout) +#define CONCHECK_TIMEOUT(x) CONCHECK_RECORD (x, timeout) + struct Lisp_Event { /* header->next (aka XEVENT_NEXT ()) is used as follows: @@ -462,11 +484,10 @@ } event; }; -DECLARE_LRECORD (event, struct Lisp_Event); -#define XEVENT(x) XRECORD (x, event, struct Lisp_Event) +DECLARE_LRECORD (event, Lisp_Event); +#define XEVENT(x) XRECORD (x, event, Lisp_Event) #define XSETEVENT(x, p) XSETRECORD (x, p, event) #define EVENTP(x) RECORDP (x, event) -#define GC_EVENTP(x) GC_RECORDP (x, event) #define CHECK_EVENT(x) CHECK_RECORD (x, event) #define CONCHECK_EVENT(x) CONCHECK_RECORD (x, event) @@ -521,12 +542,12 @@ #define KEYSYM(x) (intern (x)) /* from events.c */ -void format_event_object (char *buf, struct Lisp_Event *e, int brief); -void character_to_event (Emchar c, struct Lisp_Event *event, +void format_event_object (char *buf, Lisp_Event *e, int brief); +void character_to_event (Emchar c, Lisp_Event *event, struct console *con, int use_console_meta_flag, int do_backspace_mapping); -void zero_event (struct Lisp_Event *e); +void zero_event (Lisp_Event *e); void deallocate_event_chain (Lisp_Object event); Lisp_Object event_chain_tail (Lisp_Object event); void enqueue_event (Lisp_Object event, Lisp_Object *head, Lisp_Object *tail); @@ -543,17 +564,19 @@ /* True if this is a non-internal event (keyboard press, menu, scrollbar, mouse button) */ int command_event_p (Lisp_Object event); +void define_self_inserting_symbol (Lisp_Object, Lisp_Object); +Emchar event_to_character (Lisp_Event *, int, int, int); struct console *event_console_or_selected (Lisp_Object event); /* from event-stream.c */ Lisp_Object allocate_command_builder (Lisp_Object console); void enqueue_magic_eval_event (void (*fun) (Lisp_Object), Lisp_Object object); -void event_stream_next_event (struct Lisp_Event *event); -void event_stream_handle_magic_event (struct Lisp_Event *event); +void event_stream_next_event (Lisp_Event *event); +void event_stream_handle_magic_event (Lisp_Event *event); void event_stream_select_console (struct console *con); void event_stream_unselect_console (struct console *con); -void event_stream_select_process (struct Lisp_Process *proc); -void event_stream_unselect_process (struct Lisp_Process *proc); +void event_stream_select_process (Lisp_Process *proc); +void event_stream_unselect_process (Lisp_Process *proc); USID event_stream_create_stream_pair (void* inhandle, void* outhandle, Lisp_Object* instream, Lisp_Object* outstream, int flags); USID event_stream_delete_stream_pair (Lisp_Object instream, Lisp_Object outstream); @@ -616,9 +639,9 @@ int event_stream_unixoid_select_console (struct console *con); int event_stream_unixoid_unselect_console (struct console *con); -int event_stream_unixoid_select_process (struct Lisp_Process *proc); -int event_stream_unixoid_unselect_process (struct Lisp_Process *proc); -int read_event_from_tty_or_stream_desc (struct Lisp_Event *event, +int event_stream_unixoid_select_process (Lisp_Process *proc); +int event_stream_unixoid_unselect_process (Lisp_Process *proc); +int read_event_from_tty_or_stream_desc (Lisp_Event *event, struct console *con, int fd); USID event_stream_unixoid_create_stream_pair (void* inhandle, void* outhandle, Lisp_Object* instream, @@ -638,4 +661,4 @@ #endif /* emacs */ -#endif /* _XEMACS_EVENTS_H_ */ +#endif /* INCLUDED_events_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/extents.c --- a/src/extents.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/extents.c Mon Aug 13 11:13:30 2007 +0200 @@ -260,7 +260,7 @@ Gap_Array_Marker *markers; } Gap_Array; -Gap_Array_Marker *gap_array_marker_freelist; +static Gap_Array_Marker *gap_array_marker_freelist; /* Convert a "memory position" (i.e. taking the gap into account) into the address of the element at (i.e. after) that position. "Memory @@ -301,7 +301,7 @@ Extent_List_Marker *markers; } Extent_List; -Extent_List_Marker *extent_list_marker_freelist; +static Extent_List_Marker *extent_list_marker_freelist; #define EXTENT_LESS_VALS(e,st,nd) ((extent_start (e) < (st)) || \ ((extent_start (e) == (st)) && \ @@ -444,9 +444,6 @@ Lisp_Object Qwhitespace; /* Qtext defined in general.c */ -/* partially used in redisplay */ -Lisp_Object Qglyph_invisible; - Lisp_Object Qcopy_function; Lisp_Object Qpaste_function; @@ -890,8 +887,8 @@ allocate_extent_list (void) { Extent_List *el = xnew (Extent_List); - el->start = make_gap_array (sizeof(EXTENT)); - el->end = make_gap_array (sizeof(EXTENT)); + el->start = make_gap_array (sizeof (EXTENT)); + el->end = make_gap_array (sizeof (EXTENT)); el->markers = 0; return el; } @@ -910,31 +907,31 @@ /************************************************************************/ static Lisp_Object -mark_extent_auxiliary (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_extent_auxiliary (Lisp_Object obj) { struct extent_auxiliary *data = XEXTENT_AUXILIARY (obj); - markobj (data->begin_glyph); - markobj (data->end_glyph); - markobj (data->invisible); - markobj (data->children); - markobj (data->read_only); - markobj (data->mouse_face); - markobj (data->initial_redisplay_function); - markobj (data->before_change_functions); - markobj (data->after_change_functions); + mark_object (data->begin_glyph); + mark_object (data->end_glyph); + mark_object (data->invisible); + mark_object (data->children); + mark_object (data->read_only); + mark_object (data->mouse_face); + mark_object (data->initial_redisplay_function); + mark_object (data->before_change_functions); + mark_object (data->after_change_functions); return data->parent; } DEFINE_LRECORD_IMPLEMENTATION ("extent-auxiliary", extent_auxiliary, mark_extent_auxiliary, internal_object_printer, - 0, 0, 0, struct extent_auxiliary); + 0, 0, 0, 0, struct extent_auxiliary); void allocate_extent_auxiliary (EXTENT ext) { Lisp_Object extent_aux; struct extent_auxiliary *data = - alloc_lcrecord_type (struct extent_auxiliary, lrecord_extent_auxiliary); + alloc_lcrecord_type (struct extent_auxiliary, &lrecord_extent_auxiliary); copy_lcrecord (data, &extent_auxiliary_defaults); XSETEXTENT_AUXILIARY (extent_aux, data); @@ -973,7 +970,7 @@ static void soe_invalidate (Lisp_Object obj); static Lisp_Object -mark_extent_info (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_extent_info (Lisp_Object obj) { struct extent_info *data = (struct extent_info *) XEXTENT_INFO (obj); int i; @@ -996,7 +993,7 @@ Lisp_Object exobj; XSETEXTENT (exobj, extent); - markobj (exobj); + mark_object (exobj); } } @@ -1025,7 +1022,7 @@ DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info, mark_extent_info, internal_object_printer, - finalize_extent_info, 0, 0, + finalize_extent_info, 0, 0, 0, struct extent_info); static Lisp_Object @@ -1033,7 +1030,7 @@ { Lisp_Object extent_info; struct extent_info *data = - alloc_lcrecord_type (struct extent_info, lrecord_extent_info); + alloc_lcrecord_type (struct extent_info, &lrecord_extent_info); XSETEXTENT_INFO (extent_info, data); data->extents = allocate_extent_list (); @@ -2602,12 +2599,11 @@ xfree (ef); } -/* Note: CONST is losing, but `const' is part of the interface of qsort() */ static int extent_priority_sort_function (const void *humpty, const void *dumpty) { - CONST EXTENT foo = * (CONST EXTENT *) humpty; - CONST EXTENT bar = * (CONST EXTENT *) dumpty; + const EXTENT foo = * (const EXTENT *) humpty; + const EXTENT bar = * (const EXTENT *) dumpty; if (extent_priority (foo) < extent_priority (bar)) return -1; return extent_priority (foo) > extent_priority (bar); @@ -2913,37 +2909,13 @@ extent objects. They are similar to the functions for other lrecord objects. allocate_extent() is in alloc.c, not here. */ -static Lisp_Object mark_extent (Lisp_Object, void (*) (Lisp_Object)); -static int extent_equal (Lisp_Object, Lisp_Object, int depth); -static unsigned long extent_hash (Lisp_Object obj, int depth); -static void print_extent (Lisp_Object obj, Lisp_Object printcharfun, - int escapeflag); -static Lisp_Object extent_getprop (Lisp_Object obj, Lisp_Object prop); -static int extent_putprop (Lisp_Object obj, Lisp_Object prop, - Lisp_Object value); -static int extent_remprop (Lisp_Object obj, Lisp_Object prop); -static Lisp_Object extent_plist (Lisp_Object obj); - -DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("extent", extent, - mark_extent, - print_extent, - /* NOTE: If you declare a - finalization method here, - it will NOT be called. - Shaft city. */ - 0, - extent_equal, extent_hash, - extent_getprop, extent_putprop, - extent_remprop, extent_plist, - struct extent); - static Lisp_Object -mark_extent (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_extent (Lisp_Object obj) { struct extent *extent = XEXTENT (obj); - markobj (extent_object (extent)); - markobj (extent_no_chase_normal_field (extent, face)); + mark_object (extent_object (extent)); + mark_object (extent_no_chase_normal_field (extent, face)); return extent->plist; } @@ -2962,11 +2934,9 @@ if (extent_detached_p (ext)) strcpy (bp, "detached"); else - { - Bufpos from = XINT (Fextent_start_position (obj)); - Bufpos to = XINT (Fextent_end_position (obj)); - sprintf (bp, "%d, %d", from, to); - } + sprintf (bp, "%ld, %ld", + (long) XINT (Fextent_start_position (obj)), + (long) XINT (Fextent_end_position (obj))); bp += strlen (bp); *bp++ = (extent_end_open_p (anc) ? ')': ']'); if (!NILP (extent_end_glyph (anc))) *bp++ = '*'; @@ -3004,9 +2974,9 @@ { if (escapeflag) { - CONST char *title = ""; - CONST char *name = ""; - CONST char *posttitle = ""; + const char *title = ""; + const char *name = ""; + const char *posttitle = ""; Lisp_Object obj2 = Qnil; /* Destroyed extents have 't' in the object field, causing @@ -3128,6 +3098,13 @@ internal_hash (extent_object (e), depth + 1)); } +static const struct lrecord_description extent_description[] = { + { XD_LISP_OBJECT, offsetof (struct extent, object) }, + { XD_LISP_OBJECT, offsetof (struct extent, flags.face) }, + { XD_LISP_OBJECT, offsetof (struct extent, plist) }, + { XD_END } +}; + static Lisp_Object extent_getprop (Lisp_Object obj, Lisp_Object prop) { @@ -3177,7 +3154,7 @@ return -1; } - return external_remprop (&ext->plist, prop, 0, ERROR_ME); + return external_remprop (extent_plist_addr (ext), prop, 0, ERROR_ME); } static Lisp_Object @@ -3186,6 +3163,20 @@ return Fextent_properties (obj); } +DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("extent", extent, + mark_extent, + print_extent, + /* NOTE: If you declare a + finalization method here, + it will NOT be called. + Shaft city. */ + 0, + extent_equal, extent_hash, + extent_description, + extent_getprop, extent_putprop, + extent_remprop, extent_plist, + struct extent); + /************************************************************************/ /* basic extent accessors */ @@ -3667,7 +3658,7 @@ one. */ struct extent_auxiliary *data = alloc_lcrecord_type (struct extent_auxiliary, - lrecord_extent_auxiliary); + &lrecord_extent_auxiliary); copy_lcrecord (data, XEXTENT_AUXILIARY (XCAR (original->plist))); XSETEXTENT_AUXILIARY (XCAR (e->plist), data); @@ -4616,14 +4607,9 @@ int speccount; }; -/* This juggling with the pointer to another file's global variable is - kind of yucky. Perhaps I should just export the variable. */ -static int *inside_change_hook_pointer; - static Lisp_Object report_extent_modification_restore (Lisp_Object buffer) { - *inside_change_hook_pointer = 0; if (current_buffer != XBUFFER (buffer)) Fset_buffer (buffer); return Qnil; @@ -4648,7 +4634,13 @@ /* Now that we are sure to call elisp, set up an unwind-protect so inside_change_hook gets restored in case we throw. Also record the current buffer, in case we change it. Do the recording only - once. */ + once. + + One confusing thing here is that our caller never actually calls + unbind_to (closure.speccount, Qnil). This is because + map_extents_bytind() unbinds before, and with a smaller + speccount. The additional unbind_to() in + report_extent_modification() would cause XEmacs to abort. */ if (closure->speccount == -1) { closure->speccount = specpdl_depth (); @@ -4664,7 +4656,10 @@ /* #### It's a shame that we can't use any of the existing run_hook* functions here. This is so because all of them work with symbols, to be able to retrieve default values of local hooks. - <sigh> */ + <sigh> + + #### Idea: we could set up a dummy symbol, and call the hook + functions on *that*. */ if (!CONSP (hook) || EQ (XCAR (hook), Qlambda)) call3 (hook, exobj, startobj, endobj); @@ -4672,6 +4667,8 @@ { Lisp_Object tail; EXTERNAL_LIST_LOOP (tail, hook) + /* #### Shouldn't this perform the same Fset_buffer() check as + above? */ call3 (XCAR (tail), exobj, startobj, endobj); } return 0; @@ -4679,7 +4676,7 @@ void report_extent_modification (Lisp_Object buffer, Bufpos start, Bufpos end, - int *inside, int afterp) + int afterp) { struct report_extent_modification_closure closure; @@ -4689,20 +4686,8 @@ closure.afterp = afterp; closure.speccount = -1; - inside_change_hook_pointer = inside; - *inside = 1; - map_extents (start, end, report_extent_modification_mapper, (void *)&closure, buffer, NULL, ME_MIGHT_CALL_ELISP); - - if (closure.speccount == -1) - *inside = 0; - else - { - /* We mustn't unbind when closure.speccount != -1 because - map_extents_bytind has already done that. */ - assert (*inside == 0); - } } @@ -5009,10 +4994,10 @@ EXTENT extent = decode_extent (extent_obj, DE_MUST_HAVE_BUFFER); glyph_layout layout = symbol_to_glyph_layout (layout_obj); - /* Make sure we've actually been given a glyph or it's nil (meaning - we're deleting a glyph from an extent). */ + /* Make sure we've actually been given a valid glyph or it's nil + (meaning we're deleting a glyph from an extent). */ if (!NILP (glyph)) - CHECK_GLYPH (glyph); + CHECK_BUFFER_GLYPH (glyph); set_extent_glyph (extent, glyph, endp, layout); return glyph; @@ -6715,8 +6700,6 @@ defsymbol (&Qwhitespace, "whitespace"); /* Qtext defined in general.c */ - defsymbol (&Qglyph_invisible, "glyph-invisible"); - defsymbol (&Qpaste_function, "paste-function"); defsymbol (&Qcopy_function, "copy-function"); @@ -6793,8 +6776,26 @@ } void +reinit_vars_of_extents (void) +{ + extent_auxiliary_defaults.begin_glyph = Qnil; + extent_auxiliary_defaults.end_glyph = Qnil; + extent_auxiliary_defaults.parent = Qnil; + extent_auxiliary_defaults.children = Qnil; + extent_auxiliary_defaults.priority = 0; + extent_auxiliary_defaults.invisible = Qnil; + extent_auxiliary_defaults.read_only = Qnil; + extent_auxiliary_defaults.mouse_face = Qnil; + extent_auxiliary_defaults.initial_redisplay_function = Qnil; + extent_auxiliary_defaults.before_change_functions = Qnil; + extent_auxiliary_defaults.after_change_functions = Qnil; +} + +void vars_of_extents (void) { + reinit_vars_of_extents (); + DEFVAR_INT ("mouse-highlight-priority", &mouse_highlight_priority /* The priority to use for the mouse-highlighting pseudo-extent that is used to highlight extents with the `mouse-face' attribute set. @@ -6821,18 +6822,6 @@ Vextent_face_reusable_list = Fcons (Qnil, Qnil); staticpro (&Vextent_face_reusable_list); - - extent_auxiliary_defaults.begin_glyph = Qnil; - extent_auxiliary_defaults.end_glyph = Qnil; - extent_auxiliary_defaults.parent = Qnil; - extent_auxiliary_defaults.children = Qnil; - extent_auxiliary_defaults.priority = 0; - extent_auxiliary_defaults.invisible = Qnil; - extent_auxiliary_defaults.read_only = Qnil; - extent_auxiliary_defaults.mouse_face = Qnil; - extent_auxiliary_defaults.initial_redisplay_function = Qnil; - extent_auxiliary_defaults.before_change_functions = Qnil; - extent_auxiliary_defaults.after_change_functions = Qnil; } void diff -r f4aeb21a5bad -r 74fd4e045ea6 src/extents.h --- a/src/extents.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/extents.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,14 +20,13 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_EXTENTS_H_ -#define _XEMACS_EXTENTS_H_ +#ifndef INCLUDED_extents_h_ +#define INCLUDED_extents_h_ DECLARE_LRECORD (extent, struct extent); #define XEXTENT(x) XRECORD (x, extent, struct extent) #define XSETEXTENT(x, p) XSETRECORD (x, p, extent) #define EXTENTP(x) RECORDP (x, extent) -#define GC_EXTENTP(x) GC_RECORDP (x, extent) #define CHECK_EXTENT(x) CHECK_RECORD (x, extent) #define CONCHECK_EXTENT(x) CONCHECK_RECORD (x, extent) @@ -147,7 +146,6 @@ XRECORD (x, extent_auxiliary, struct extent_auxiliary) #define XSETEXTENT_AUXILIARY(x, p) XSETRECORD (x, p, extent_auxiliary) #define EXTENT_AUXILIARYP(x) RECORDP (x, extent_auxiliary) -#define GC_EXTENT_AUXILIARYP(x) GC_RECORDP (x, extent_auxiliary) #define CHECK_EXTENT_AUXILIARY(x) CHECK_RECORD (x, extent_auxiliary) #define CONCHECK_EXTENT_AUXILIARY(x) CONCHECK_RECORD (x, extent_auxiliary) @@ -163,7 +161,6 @@ #define XEXTENT_INFO(x) XRECORD (x, extent_info, struct extent_info) #define XSETEXTENT_INFO(x, p) XSETRECORD (x, p, extent_info) #define EXTENT_INFOP(x) RECORDP (x, extent_info) -#define GC_EXTENT_INFOP(x) GC_RECORDP (x, extent_info) #define CHECK_EXTENT_INFO(x) CHECK_RECORD (x, extent_info) #define CONCHECK_EXTENT_INFO(x) CONCHECK_RECORD (x, extent_info) @@ -370,7 +367,7 @@ Bytind opoint, Bytecount length); void process_extents_for_deletion (Lisp_Object object, Bytind from, Bytind to, int destroy_them); -void report_extent_modification (Lisp_Object, Bufpos, Bufpos, int *, int); +void report_extent_modification (Lisp_Object, Bufpos, Bufpos, int); void set_extent_glyph (EXTENT extent, Lisp_Object glyph, int endp, glyph_layout layout); @@ -400,4 +397,4 @@ #endif /* emacs */ -#endif /* _XEMACS_EXTENTS_H_ */ +#endif /* INCLUDED_extents_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/extw-Xlib.h --- a/src/extw-Xlib.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/extw-Xlib.h Mon Aug 13 11:13:30 2007 +0200 @@ -17,8 +17,8 @@ /* Synched up with: Not in FSF. */ -#ifndef _EXTW_XLIB_H_ -#define _EXTW_XLIB_H_ +#ifndef INCLUDED_extw_Xlib_h_ +#define INCLUDED_extw_Xlib_h_ #define extw_shell_send 0 #define extw_client_send 1 @@ -48,4 +48,4 @@ void extw_send_notify_3(Display *display, Window win, en_extw_notify type, long data0, long data1, long data2); -#endif /* _EXTW_XLIB_H_ */ +#endif /* INCLUDED_extw_Xlib_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/extw-Xt.c --- a/src/extw-Xt.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/extw-Xt.c Mon Aug 13 11:13:30 2007 +0200 @@ -28,7 +28,7 @@ ERROR! This ought not be getting compiled if EXTERNAL_WIDGET is undefined #endif -void fatal (CONST char *fmt, ...); +void fatal (const char *fmt, ...); #else /* not emacs */ static void fatal (char *msg); #endif diff -r f4aeb21a5bad -r 74fd4e045ea6 src/extw-Xt.h --- a/src/extw-Xt.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/extw-Xt.h Mon Aug 13 11:13:30 2007 +0200 @@ -19,8 +19,8 @@ /* Synched up with: Not in FSF. */ -#ifndef _EXTW_XT_H_ -#define _EXTW_XT_H_ +#ifndef INCLUDED_extw_Xt_h_ +#define INCLUDED_extw_Xt_h_ #include "extw-Xlib.h" @@ -41,4 +41,4 @@ en_extw_notify type, unsigned long timeout); -#endif /* _EXTW_XT_H_ */ +#endif /* INCLUDED_extw_Xt_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/faces.c --- a/src/faces.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/faces.c Mon Aug 13 11:13:30 2007 +0200 @@ -57,9 +57,8 @@ Lisp_Object Vleft_margin_face, Vright_margin_face, Vtext_cursor_face; Lisp_Object Vpointer_face, Vvertical_divider_face, Vtoolbar_face, Vwidget_face; -/* Qdefault, Qhighlight defined in general.c */ -Lisp_Object Qmodeline, Qgui_element, Qleft_margin, Qright_margin, Qtext_cursor; -Lisp_Object Qvertical_divider; +/* Qdefault, Qhighlight, Qleft_margin, Qright_margin defined in general.c */ +Lisp_Object Qmodeline, Qgui_element, Qtext_cursor, Qvertical_divider; /* In the old implementation Vface_list was a list of the face names, not the faces themselves. We now distinguish between permanent and @@ -73,26 +72,26 @@ static Lisp_Object -mark_face (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_face (Lisp_Object obj) { - struct Lisp_Face *face = XFACE (obj); + Lisp_Face *face = XFACE (obj); - markobj (face->name); - markobj (face->doc_string); + mark_object (face->name); + mark_object (face->doc_string); - markobj (face->foreground); - markobj (face->background); - markobj (face->font); - markobj (face->display_table); - markobj (face->background_pixmap); - markobj (face->underline); - markobj (face->strikethru); - markobj (face->highlight); - markobj (face->dim); - markobj (face->blinking); - markobj (face->reverse); + mark_object (face->foreground); + mark_object (face->background); + mark_object (face->font); + mark_object (face->display_table); + mark_object (face->background_pixmap); + mark_object (face->underline); + mark_object (face->strikethru); + mark_object (face->highlight); + mark_object (face->dim); + mark_object (face->blinking); + mark_object (face->reverse); - markobj (face->charsets_warned_about); + mark_object (face->charsets_warned_about); return face->plist; } @@ -100,7 +99,7 @@ static void print_face (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { - struct Lisp_Face *face = XFACE (obj); + Lisp_Face *face = XFACE (obj); if (print_readably) { @@ -130,8 +129,8 @@ static int face_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { - struct Lisp_Face *f1 = XFACE (obj1); - struct Lisp_Face *f2 = XFACE (obj2); + Lisp_Face *f1 = XFACE (obj1); + Lisp_Face *f2 = XFACE (obj2); depth++; @@ -154,7 +153,7 @@ static unsigned long face_hash (Lisp_Object obj, int depth) { - struct Lisp_Face *f = XFACE (obj); + Lisp_Face *f = XFACE (obj); depth++; @@ -168,28 +167,28 @@ static Lisp_Object face_getprop (Lisp_Object obj, Lisp_Object prop) { - struct Lisp_Face *f = XFACE (obj); + Lisp_Face *f = XFACE (obj); return - ((EQ (prop, Qforeground)) ? f->foreground : - (EQ (prop, Qbackground)) ? f->background : - (EQ (prop, Qfont)) ? f->font : - (EQ (prop, Qdisplay_table)) ? f->display_table : - (EQ (prop, Qbackground_pixmap)) ? f->background_pixmap : - (EQ (prop, Qunderline)) ? f->underline : - (EQ (prop, Qstrikethru)) ? f->strikethru : - (EQ (prop, Qhighlight)) ? f->highlight : - (EQ (prop, Qdim)) ? f->dim : - (EQ (prop, Qblinking)) ? f->blinking : - (EQ (prop, Qreverse)) ? f->reverse : - (EQ (prop, Qdoc_string)) ? f->doc_string : + (EQ (prop, Qforeground) ? f->foreground : + EQ (prop, Qbackground) ? f->background : + EQ (prop, Qfont) ? f->font : + EQ (prop, Qdisplay_table) ? f->display_table : + EQ (prop, Qbackground_pixmap) ? f->background_pixmap : + EQ (prop, Qunderline) ? f->underline : + EQ (prop, Qstrikethru) ? f->strikethru : + EQ (prop, Qhighlight) ? f->highlight : + EQ (prop, Qdim) ? f->dim : + EQ (prop, Qblinking) ? f->blinking : + EQ (prop, Qreverse) ? f->reverse : + EQ (prop, Qdoc_string) ? f->doc_string : external_plist_get (&f->plist, prop, 0, ERROR_ME)); } static int face_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value) { - struct Lisp_Face *f = XFACE (obj); + Lisp_Face *f = XFACE (obj); if (EQ (prop, Qforeground) || EQ (prop, Qbackground) || @@ -219,7 +218,7 @@ static int face_remprop (Lisp_Object obj, Lisp_Object prop) { - struct Lisp_Face *f = XFACE (obj); + Lisp_Face *f = XFACE (obj); if (EQ (prop, Qforeground) || EQ (prop, Qbackground) || @@ -246,7 +245,7 @@ static Lisp_Object face_plist (Lisp_Object obj) { - struct Lisp_Face *face = XFACE (obj); + Lisp_Face *face = XFACE (obj); Lisp_Object result = face->plist; result = cons3 (Qreverse, face->reverse, result); @@ -264,11 +263,30 @@ return result; } +static const struct lrecord_description face_description[] = { + { XD_LISP_OBJECT, offsetof (Lisp_Face, name) }, + { XD_LISP_OBJECT, offsetof (Lisp_Face, doc_string) }, + { XD_LISP_OBJECT, offsetof (Lisp_Face, foreground) }, + { XD_LISP_OBJECT, offsetof (Lisp_Face, background) }, + { XD_LISP_OBJECT, offsetof (Lisp_Face, font) }, + { XD_LISP_OBJECT, offsetof (Lisp_Face, display_table) }, + { XD_LISP_OBJECT, offsetof (Lisp_Face, background_pixmap) }, + { XD_LISP_OBJECT, offsetof (Lisp_Face, underline) }, + { XD_LISP_OBJECT, offsetof (Lisp_Face, strikethru) }, + { XD_LISP_OBJECT, offsetof (Lisp_Face, highlight) }, + { XD_LISP_OBJECT, offsetof (Lisp_Face, dim) }, + { XD_LISP_OBJECT, offsetof (Lisp_Face, blinking) }, + { XD_LISP_OBJECT, offsetof (Lisp_Face, reverse) }, + { XD_LISP_OBJECT, offsetof (Lisp_Face, plist) }, + { XD_LISP_OBJECT, offsetof (Lisp_Face, charsets_warned_about) }, + { XD_END } +}; + DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("face", face, mark_face, print_face, 0, face_equal, - face_hash, face_getprop, + face_hash, face_description, face_getprop, face_putprop, face_remprop, - face_plist, struct Lisp_Face); + face_plist, Lisp_Face); /************************************************************************/ /* face read syntax */ @@ -334,7 +352,7 @@ ****************************************************************************/ static void -reset_face (struct Lisp_Face *f) +reset_face (Lisp_Face *f) { f->name = Qnil; f->doc_string = Qnil; @@ -354,11 +372,10 @@ f->charsets_warned_about = Qnil; } -static struct Lisp_Face * +static Lisp_Face * allocate_face (void) { - struct Lisp_Face *result = - alloc_lcrecord_type (struct Lisp_Face, lrecord_face); + Lisp_Face *result = alloc_lcrecord_type (Lisp_Face, &lrecord_face); reset_face (result); return result; @@ -479,7 +496,7 @@ } static int -update_face_inheritance_mapper (CONST void *hash_key, void *hash_contents, +update_face_inheritance_mapper (const void *hash_key, void *hash_contents, void *face_inheritance_closure) { Lisp_Object key, contents; @@ -753,7 +770,7 @@ (name, doc_string, temporary)) { /* This function can GC if initialized is non-zero */ - struct Lisp_Face *f; + Lisp_Face *f; Lisp_Object face; CHECK_SYMBOL (name); @@ -981,8 +998,7 @@ /* mark for GC a dynarr of face cachels. */ void -mark_face_cachels (face_cachel_dynarr *elements, - void (*markobj) (Lisp_Object)) +mark_face_cachels (face_cachel_dynarr *elements) { int elt; @@ -998,13 +1014,13 @@ for (i = 0; i < NUM_LEADING_BYTES; i++) if (!NILP (cachel->font[i]) && !UNBOUNDP (cachel->font[i])) - markobj (cachel->font[i]); + mark_object (cachel->font[i]); } - markobj (cachel->face); - markobj (cachel->foreground); - markobj (cachel->background); - markobj (cachel->display_table); - markobj (cachel->background_pixmap); + mark_object (cachel->face); + mark_object (cachel->foreground); + mark_object (cachel->background); + mark_object (cachel->display_table); + mark_object (cachel->background_pixmap); } } @@ -1122,7 +1138,7 @@ { Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i + MIN_LEADING_BYTE); Lisp_Object font_instance = FACE_CACHEL_FONT (cachel, charset); - struct Lisp_Font_Instance *fi = XFONT_INSTANCE (font_instance); + Lisp_Font_Instance *fi = XFONT_INSTANCE (font_instance); assert (CHARSETP (charset)); assert (FONT_INSTANCEP (font_instance)); @@ -1674,7 +1690,7 @@ */ (old_face, new_name, locale, tag_set, exact_p, how_to_add)) { - struct Lisp_Face *fold, *fnew; + Lisp_Face *fold, *fnew; Lisp_Object new_face = Qnil; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; @@ -1736,11 +1752,9 @@ void syms_of_faces (void) { - /* Qdefault & Qwidget defined in general.c */ + /* Qdefault, Qwidget, Qleft_margin, Qright_margin defined in general.c */ defsymbol (&Qmodeline, "modeline"); defsymbol (&Qgui_element, "gui-element"); - defsymbol (&Qleft_margin, "left-margin"); - defsymbol (&Qright_margin, "right-margin"); defsymbol (&Qtext_cursor, "text-cursor"); defsymbol (&Qvertical_divider, "vertical-divider"); @@ -1827,7 +1841,7 @@ syms[n++] = Qblinking; syms[n++] = Qreverse; - Vbuilt_in_face_specifiers = pure_list (n, syms); + Vbuilt_in_face_specifiers = Flist (n, syms); staticpro (&Vbuilt_in_face_specifiers); } } @@ -1862,6 +1876,8 @@ bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb); #endif #ifdef HAVE_MS_WINDOWS + fg_fb = acons (list1 (Qmsprinter), build_string ("black"), fg_fb); + bg_fb = acons (list1 (Qmsprinter), build_string ("white"), bg_fb); fg_fb = acons (list1 (Qmswindows), build_string ("black"), fg_fb); bg_fb = acons (list1 (Qmswindows), build_string ("white"), bg_fb); #endif @@ -1878,7 +1894,7 @@ (#### Perhaps we should remove the stuff from x-faces.el and only depend on this stuff here? That should work.) */ - CONST char *fonts[] = + const char *fonts[] = { "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*", "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*", @@ -1896,7 +1912,7 @@ "-*-*-*-*-*-*-*-120-*-*-*-*-*-*", "*" }; - CONST char **fontptr; + const char **fontptr; for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--) inst_list = Fcons (Fcons (list1 (Qx), build_string (*fontptr)), @@ -1908,6 +1924,12 @@ inst_list); #endif /* HAVE_TTY */ #ifdef HAVE_MS_WINDOWS + /* Fixedsys does not exist for printers */ + inst_list = Fcons (Fcons (list1 (Qmsprinter), + build_string ("Courier:Regular:10::Western")), inst_list); + inst_list = Fcons (Fcons (list1 (Qmsprinter), + build_string ("Courier New:Regular:10::Western")), inst_list); + inst_list = Fcons (Fcons (list1 (Qmswindows), build_string ("Fixedsys:Regular:9::Western")), inst_list); inst_list = Fcons (Fcons (list1 (Qmswindows), @@ -1951,6 +1973,8 @@ bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb); #endif #ifdef HAVE_MS_WINDOWS + fg_fb = acons (list1 (Qmsprinter), build_string ("black"), fg_fb); + bg_fb = acons (list1 (Qmsprinter), build_string ("white"), bg_fb); fg_fb = acons (list1 (Qmswindows), build_string ("black"), fg_fb); bg_fb = acons (list1 (Qmswindows), build_string ("Gray75"), bg_fb); #endif diff -r f4aeb21a5bad -r 74fd4e045ea6 src/faces.h --- a/src/faces.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/faces.h Mon Aug 13 11:13:30 2007 +0200 @@ -21,14 +21,14 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_FACES_H_ -#define _XEMACS_FACES_H_ +#ifndef INCLUDED_faces_h_ +#define INCLUDED_faces_h_ #include "buffer.h" /* for NUM_LEADING_BYTES */ -/* a struct 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 the built-in face properties, plus the plist of user-specified +/* 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 + the built-in face properties, plus the plist of user-specified properties. */ struct Lisp_Face @@ -222,11 +222,10 @@ unsigned char font_updated[NUM_LEADING_BYTES]; }; -DECLARE_LRECORD (face, struct Lisp_Face); -#define XFACE(x) XRECORD (x, face, struct Lisp_Face) +DECLARE_LRECORD (face, Lisp_Face); +#define XFACE(x) XRECORD (x, face, Lisp_Face) #define XSETFACE(x, p) XSETRECORD (x, p, face) #define FACEP(x) RECORDP (x, face) -#define GC_FACEP(x) GC_RECORDP (x, face) #define CHECK_FACE(x) CHECK_RECORD (x, face) Lisp_Object ensure_face_cachel_contains_charset (struct face_cachel *cachel, @@ -241,8 +240,7 @@ void face_cachel_charset_font_metric_info (struct face_cachel *cachel, unsigned char *charsets, struct font_metric_info *fm); -void mark_face_cachels (face_cachel_dynarr *elements, - void (*markobj) (Lisp_Object)); +void mark_face_cachels (face_cachel_dynarr *elements); void mark_face_cachels_as_clean (struct window *w); void mark_face_cachels_as_not_updated (struct window *w); void reset_face_cachel (struct face_cachel *inst); @@ -260,7 +258,7 @@ extern Lisp_Object Qstrikethru, Vbuilt_in_face_specifiers, Vdefault_face; extern Lisp_Object Vleft_margin_face, Vpointer_face, Vright_margin_face; -extern Lisp_Object Vtext_cursor_face, Vvertical_divider_face; +extern Lisp_Object Vtext_cursor_face, Vvertical_divider_face; extern Lisp_Object Vtoolbar_face, Vgui_element_face, Vwidget_face; void mark_all_faces_as_clean (void); @@ -360,6 +358,8 @@ FACE_PROPERTY_INSTANCE (face, Qbackground_pixmap, domain, 0, Qzero) #define FACE_UNDERLINE_P(face, domain) \ (!NILP (FACE_PROPERTY_INSTANCE (face, Qunderline, domain, 0, Qzero))) +#define FACE_STRIKETHRU_P(face, domain) \ + (!NILP (FACE_PROPERTY_INSTANCE (face, Qstrikethru, domain, 0, Qzero))) #define FACE_HIGHLIGHT_P(face, domain) \ (!NILP (FACE_PROPERTY_INSTANCE (face, Qhighlight, domain, 0, Qzero))) #define FACE_DIM_P(face, domain) \ @@ -369,4 +369,4 @@ #define FACE_REVERSE_P(face, domain) \ (!NILP (FACE_PROPERTY_INSTANCE (face, Qreverse, domain, 0, Qzero))) -#endif /* _XEMACS_FACES_H_ */ +#endif /* INCLUDED_faces_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/file-coding.c --- a/src/file-coding.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/file-coding.c Mon Aug 13 11:13:30 2007 +0200 @@ -25,17 +25,19 @@ #include <config.h> #include "lisp.h" + #include "buffer.h" #include "elhash.h" #include "insdel.h" #include "lstream.h" +#include "opaque.h" #ifdef MULE #include "mule-ccl.h" #include "chartab.h" #endif #include "file-coding.h" -Lisp_Object Qbuffer_file_coding_system, Qcoding_system_error; +Lisp_Object Qcoding_system_error; Lisp_Object Vkeyboard_coding_system; Lisp_Object Vterminal_coding_system; @@ -46,16 +48,39 @@ /* Table of symbols identifying each coding category. */ Lisp_Object coding_category_symbol[CODING_CATEGORY_LAST + 1]; -/* Coding system currently associated with each coding category. */ -Lisp_Object coding_category_system[CODING_CATEGORY_LAST + 1]; - -/* Table of all coding categories in decreasing order of priority. - This describes a permutation of the possible coding categories. */ -int coding_category_by_priority[CODING_CATEGORY_LAST + 1]; - -Lisp_Object Qcoding_system_p; - -Lisp_Object Qno_conversion, Qccl, Qiso2022; + + +struct file_coding_dump { + /* Coding system currently associated with each coding category. */ + Lisp_Object coding_category_system[CODING_CATEGORY_LAST + 1]; + + /* Table of all coding categories in decreasing order of priority. + This describes a permutation of the possible coding categories. */ + int coding_category_by_priority[CODING_CATEGORY_LAST + 1]; + +#ifdef MULE + Lisp_Object ucs_to_mule_table[65536]; +#endif +} *fcd; + +static const struct lrecord_description fcd_description_1[] = { + { XD_LISP_OBJECT_ARRAY, offsetof (struct file_coding_dump, coding_category_system), CODING_CATEGORY_LAST + 1 }, +#ifdef MULE + { XD_LISP_OBJECT_ARRAY, offsetof (struct file_coding_dump, ucs_to_mule_table), 65536 }, +#endif + { XD_END } +}; + +static const struct struct_description fcd_description = { + sizeof (struct file_coding_dump), + fcd_description_1 +}; + +Lisp_Object mule_to_ucs_table; + +Lisp_Object Qcoding_systemp; + +Lisp_Object Qraw_text, Qno_conversion, Qccl, Qiso2022; /* Qinternal in general.c */ Lisp_Object Qmnemonic, Qeol_type; @@ -72,7 +97,7 @@ Lisp_Object Qforce_g2_on_output, Qforce_g3_on_output; Lisp_Object Qno_iso6429; Lisp_Object Qinput_charset_conversion, Qoutput_charset_conversion; -Lisp_Object Qctext, Qescape_quoted; +Lisp_Object Qescape_quoted; Lisp_Object Qshort, Qno_ascii_eol, Qno_ascii_cntl, Qseven, Qlock_shift; #endif Lisp_Object Qencode, Qdecode; @@ -151,67 +176,67 @@ #ifdef MULE struct detection_state; static int detect_coding_sjis (struct detection_state *st, - CONST unsigned char *src, + const unsigned char *src, unsigned int n); static void decode_coding_sjis (Lstream *decoding, - CONST unsigned char *src, + const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n); static void encode_coding_sjis (Lstream *encoding, - CONST unsigned char *src, + const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n); static int detect_coding_big5 (struct detection_state *st, - CONST unsigned char *src, + const unsigned char *src, unsigned int n); static void decode_coding_big5 (Lstream *decoding, - CONST unsigned char *src, + const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n); static void encode_coding_big5 (Lstream *encoding, - CONST unsigned char *src, + const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n); static int detect_coding_ucs4 (struct detection_state *st, - CONST unsigned char *src, + const unsigned char *src, unsigned int n); static void decode_coding_ucs4 (Lstream *decoding, - CONST unsigned char *src, + const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n); static void encode_coding_ucs4 (Lstream *encoding, - CONST unsigned char *src, + const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n); static int detect_coding_utf8 (struct detection_state *st, - CONST unsigned char *src, + const unsigned char *src, unsigned int n); static void decode_coding_utf8 (Lstream *decoding, - CONST unsigned char *src, + const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n); static void encode_coding_utf8 (Lstream *encoding, - CONST unsigned char *src, + const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n); static int postprocess_iso2022_mask (int mask); static void reset_iso2022 (Lisp_Object coding_system, struct iso2022_decoder *iso); static int detect_coding_iso2022 (struct detection_state *st, - CONST unsigned char *src, + const unsigned char *src, unsigned int n); static void decode_coding_iso2022 (Lstream *decoding, - CONST unsigned char *src, + const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n); static void encode_coding_iso2022 (Lstream *encoding, - CONST unsigned char *src, + const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n); #endif /* MULE */ static void decode_coding_no_conversion (Lstream *decoding, - CONST unsigned char *src, + const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n); static void encode_coding_no_conversion (Lstream *encoding, - CONST unsigned char *src, + const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n); -static void mule_decode (Lstream *decoding, CONST unsigned char *src, +static void mule_decode (Lstream *decoding, const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n); -static void mule_encode (Lstream *encoding, CONST unsigned char *src, +static void mule_encode (Lstream *encoding, const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n); typedef struct codesys_prop codesys_prop; @@ -226,6 +251,26 @@ Dynarr_declare (codesys_prop); } codesys_prop_dynarr; +static const struct lrecord_description codesys_prop_description_1[] = { + { XD_LISP_OBJECT, offsetof (codesys_prop, sym) }, + { XD_END } +}; + +static const struct struct_description codesys_prop_description = { + sizeof (codesys_prop), + codesys_prop_description_1 +}; + +static const struct lrecord_description codesys_prop_dynarr_description_1[] = { + XD_DYNARR_DESC (codesys_prop_dynarr, &codesys_prop_description), + { XD_END } +}; + +static const struct struct_description codesys_prop_dynarr_description = { + sizeof (codesys_prop_dynarr), + codesys_prop_dynarr_description_1 +}; + codesys_prop_dynarr *the_codesys_prop_dynarr; enum codesys_prop_enum @@ -240,26 +285,69 @@ /* Coding system functions */ /************************************************************************/ -static Lisp_Object mark_coding_system (Lisp_Object, void (*) (Lisp_Object)); +static Lisp_Object mark_coding_system (Lisp_Object); static void print_coding_system (Lisp_Object, Lisp_Object, int); static void finalize_coding_system (void *header, int for_disksave); +#ifdef MULE +static const struct lrecord_description ccs_description_1[] = { + { XD_LISP_OBJECT, offsetof (charset_conversion_spec, from_charset) }, + { XD_LISP_OBJECT, offsetof (charset_conversion_spec, to_charset) }, + { XD_END } +}; + +static const struct struct_description ccs_description = { + sizeof (charset_conversion_spec), + ccs_description_1 +}; + +static const struct lrecord_description ccsd_description_1[] = { + XD_DYNARR_DESC (charset_conversion_spec_dynarr, &ccs_description), + { XD_END } +}; + +static const struct struct_description ccsd_description = { + sizeof (charset_conversion_spec_dynarr), + ccsd_description_1 +}; +#endif + +static const struct lrecord_description coding_system_description[] = { + { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, name) }, + { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, doc_string) }, + { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, mnemonic) }, + { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, post_read_conversion) }, + { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, pre_write_conversion) }, + { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, eol_lf) }, + { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, eol_crlf) }, + { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, eol_cr) }, +#ifdef MULE + { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Coding_System, iso2022.initial_charset), 4 }, + { XD_STRUCT_PTR, offsetof (Lisp_Coding_System, iso2022.input_conv), 1, &ccsd_description }, + { XD_STRUCT_PTR, offsetof (Lisp_Coding_System, iso2022.output_conv), 1, &ccsd_description }, + { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, ccl.decode) }, + { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, ccl.encode) }, +#endif + { XD_END } +}; + DEFINE_LRECORD_IMPLEMENTATION ("coding-system", coding_system, mark_coding_system, print_coding_system, finalize_coding_system, - 0, 0, struct Lisp_Coding_System); + 0, 0, coding_system_description, + Lisp_Coding_System); static Lisp_Object -mark_coding_system (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_coding_system (Lisp_Object obj) { Lisp_Coding_System *codesys = XCODING_SYSTEM (obj); - markobj (CODING_SYSTEM_NAME (codesys)); - markobj (CODING_SYSTEM_DOC_STRING (codesys)); - markobj (CODING_SYSTEM_MNEMONIC (codesys)); - markobj (CODING_SYSTEM_EOL_LF (codesys)); - markobj (CODING_SYSTEM_EOL_CRLF (codesys)); - markobj (CODING_SYSTEM_EOL_CR (codesys)); + mark_object (CODING_SYSTEM_NAME (codesys)); + mark_object (CODING_SYSTEM_DOC_STRING (codesys)); + mark_object (CODING_SYSTEM_MNEMONIC (codesys)); + mark_object (CODING_SYSTEM_EOL_LF (codesys)); + mark_object (CODING_SYSTEM_EOL_CRLF (codesys)); + mark_object (CODING_SYSTEM_EOL_CR (codesys)); switch (CODING_SYSTEM_TYPE (codesys)) { @@ -267,15 +355,15 @@ int i; case CODESYS_ISO2022: for (i = 0; i < 4; i++) - markobj (CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i)); + mark_object (CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i)); if (codesys->iso2022.input_conv) { for (i = 0; i < Dynarr_length (codesys->iso2022.input_conv); i++) { struct charset_conversion_spec *ccs = Dynarr_atp (codesys->iso2022.input_conv, i); - markobj (ccs->from_charset); - markobj (ccs->to_charset); + mark_object (ccs->from_charset); + mark_object (ccs->to_charset); } } if (codesys->iso2022.output_conv) @@ -284,22 +372,22 @@ { struct charset_conversion_spec *ccs = Dynarr_atp (codesys->iso2022.output_conv, i); - markobj (ccs->from_charset); - markobj (ccs->to_charset); + mark_object (ccs->from_charset); + mark_object (ccs->to_charset); } } break; case CODESYS_CCL: - markobj (CODING_SYSTEM_CCL_DECODE (codesys)); - markobj (CODING_SYSTEM_CCL_ENCODE (codesys)); + mark_object (CODING_SYSTEM_CCL_DECODE (codesys)); + mark_object (CODING_SYSTEM_CCL_ENCODE (codesys)); break; #endif /* MULE */ default: break; } - markobj (CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys)); + mark_object (CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys)); return CODING_SYSTEM_POST_READ_CONVERSION (codesys); } @@ -348,7 +436,7 @@ } } -static enum eol_type +static eol_type_t symbol_to_eol_type (Lisp_Object symbol) { CHECK_SYMBOL (symbol); @@ -362,7 +450,7 @@ } static Lisp_Object -eol_type_to_symbol (enum eol_type type) +eol_type_to_symbol (eol_type_t type) { switch (type) { @@ -453,15 +541,21 @@ */ (coding_system_or_name)) { - if (CODING_SYSTEMP (coding_system_or_name)) - return coding_system_or_name; - if (NILP (coding_system_or_name)) coding_system_or_name = Qbinary; + else if (CODING_SYSTEMP (coding_system_or_name)) + return coding_system_or_name; else CHECK_SYMBOL (coding_system_or_name); - return Fgethash (coding_system_or_name, Vcoding_system_hash_table, Qnil); + while (1) + { + coding_system_or_name = + Fgethash (coding_system_or_name, Vcoding_system_hash_table, Qnil); + + if (CODING_SYSTEMP (coding_system_or_name) || NILP (coding_system_or_name)) + return coding_system_or_name; + } } DEFUN ("get-coding-system", Fget_coding_system, 1, 1, 0, /* @@ -495,8 +589,7 @@ (struct coding_system_list_closure *) coding_system_list_closure; Lisp_Object *coding_system_list = cscl->coding_system_list; - *coding_system_list = Fcons (XCODING_SYSTEM (value)->name, - *coding_system_list); + *coding_system_list = Fcons (key, *coding_system_list); return 0; } @@ -531,7 +624,7 @@ allocate_coding_system (enum coding_system_type type, Lisp_Object name) { Lisp_Coding_System *codesys = - alloc_lcrecord_type (Lisp_Coding_System, lrecord_coding_system); + alloc_lcrecord_type (Lisp_Coding_System, &lrecord_coding_system); zero_lcrecord (codesys); CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys) = Qnil; @@ -949,8 +1042,168 @@ return new_coding_system; } +DEFUN ("coding-system-canonical-name-p", Fcoding_system_canonical_name_p, 1, 1, 0, /* +Return t if OBJECT names a coding system, and is not a coding system alias. +*/ + (object)) +{ + return CODING_SYSTEMP (Fgethash (object, Vcoding_system_hash_table, Qnil)) + ? Qt : Qnil; +} + +DEFUN ("coding-system-alias-p", Fcoding_system_alias_p, 1, 1, 0, /* +Return t if OBJECT is a coding system alias. +All coding system aliases are created by `define-coding-system-alias'. +*/ + (object)) +{ + return SYMBOLP (Fgethash (object, Vcoding_system_hash_table, Qzero)) + ? Qt : Qnil; +} + +DEFUN ("coding-system-aliasee", Fcoding_system_aliasee, 1, 1, 0, /* +Return the coding-system symbol for which symbol ALIAS is an alias. +*/ + (alias)) +{ + Lisp_Object aliasee = Fgethash (alias, Vcoding_system_hash_table, Qnil); + if (SYMBOLP (aliasee)) + return aliasee; + else + signal_simple_error ("Symbol is not a coding system alias", alias); +} + static Lisp_Object -subsidiary_coding_system (Lisp_Object coding_system, enum eol_type type) +append_suffix_to_symbol (Lisp_Object symbol, const char *ascii_string) +{ + return Fintern (concat2 (Fsymbol_name (symbol), build_string (ascii_string)), + Qnil); +} + +/* A maphash function, for removing dangling coding system aliases. */ +static int +dangling_coding_system_alias_p (Lisp_Object alias, + Lisp_Object aliasee, + void *dangling_aliases) +{ + if (SYMBOLP (aliasee) + && NILP (Fgethash (aliasee, Vcoding_system_hash_table, Qnil))) + { + (*(int *) dangling_aliases)++; + return 1; + } + else + return 0; +} + +DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias, 2, 2, 0, /* +Define symbol ALIAS as an alias for coding system ALIASEE. + +You can use this function to redefine an alias that has already been defined, +but you cannot redefine a name which is the canonical name for a coding system. +\(a canonical name of a coding system is what is returned when you call +`coding-system-name' on a coding system). + +ALIASEE itself can be an alias, which allows you to define nested aliases. + +You are forbidden, however, from creating alias loops or `dangling' aliases. +These will be detected, and an error will be signaled if you attempt to do so. + +If ALIASEE is nil, then ALIAS will simply be undefined. + +See also `coding-system-alias-p', `coding-system-aliasee', +and `coding-system-canonical-name-p'. +*/ + (alias, aliasee)) +{ + Lisp_Object real_coding_system, probe; + + CHECK_SYMBOL (alias); + + if (!NILP (Fcoding_system_canonical_name_p (alias))) + signal_simple_error + ("Symbol is the canonical name of a coding system and cannot be redefined", + alias); + + if (NILP (aliasee)) + { + Lisp_Object subsidiary_unix = append_suffix_to_symbol (alias, "-unix"); + Lisp_Object subsidiary_dos = append_suffix_to_symbol (alias, "-dos"); + Lisp_Object subsidiary_mac = append_suffix_to_symbol (alias, "-mac"); + + Fremhash (alias, Vcoding_system_hash_table); + + /* Undefine subsidiary aliases, + presumably created by a previous call to this function */ + if (! NILP (Fcoding_system_alias_p (subsidiary_unix)) && + ! NILP (Fcoding_system_alias_p (subsidiary_dos)) && + ! NILP (Fcoding_system_alias_p (subsidiary_mac))) + { + Fdefine_coding_system_alias (subsidiary_unix, Qnil); + Fdefine_coding_system_alias (subsidiary_dos, Qnil); + Fdefine_coding_system_alias (subsidiary_mac, Qnil); + } + + /* Undefine dangling coding system aliases. */ + { + int dangling_aliases; + + do { + dangling_aliases = 0; + elisp_map_remhash (dangling_coding_system_alias_p, + Vcoding_system_hash_table, + &dangling_aliases); + } while (dangling_aliases > 0); + } + + return Qnil; + } + + if (CODING_SYSTEMP (aliasee)) + aliasee = XCODING_SYSTEM_NAME (aliasee); + + /* Checks that aliasee names a coding-system */ + real_coding_system = Fget_coding_system (aliasee); + + /* Check for coding system alias loops */ + if (EQ (alias, aliasee)) + alias_loop: signal_simple_error_2 + ("Attempt to create a coding system alias loop", alias, aliasee); + + for (probe = aliasee; + SYMBOLP (probe); + probe = Fgethash (probe, Vcoding_system_hash_table, Qzero)) + { + if (EQ (probe, alias)) + goto alias_loop; + } + + Fputhash (alias, aliasee, Vcoding_system_hash_table); + + /* Set up aliases for subsidiaries. + #### There must be a better way to handle subsidiary coding systems. */ + { + static const char *suffixes[] = { "-unix", "-dos", "-mac" }; + int i; + for (i = 0; i < countof (suffixes); i++) + { + Lisp_Object alias_subsidiary = + append_suffix_to_symbol (alias, suffixes[i]); + Lisp_Object aliasee_subsidiary = + append_suffix_to_symbol (aliasee, suffixes[i]); + + if (! NILP (Ffind_coding_system (aliasee_subsidiary))) + Fdefine_coding_system_alias (alias_subsidiary, aliasee_subsidiary); + } + } + /* FSF return value is a vector of [ALIAS-unix ALIAS-dos ALIAS-mac], + but it doesn't look intentional, so I'd rather return something + meaningful or nothing at all. */ + return Qnil; +} + +static Lisp_Object +subsidiary_coding_system (Lisp_Object coding_system, eol_type_t type) { Lisp_Coding_System *cs = XCODING_SYSTEM (coding_system); Lisp_Object new_coding_system; @@ -1230,7 +1483,7 @@ order. */ for (j = 0; j <= CODING_CATEGORY_LAST; j++) { - int cat = coding_category_by_priority[j]; + int cat = fcd->coding_category_by_priority[j]; if (category_to_priority[cat] < 0) category_to_priority[cat] = i++; } @@ -1239,7 +1492,7 @@ constructed. */ for (i = 0; i <= CODING_CATEGORY_LAST; i++) - coding_category_by_priority[category_to_priority[i]] = i; + fcd->coding_category_by_priority[category_to_priority[i]] = i; /* Phew! That was confusing. */ return Qnil; @@ -1254,7 +1507,7 @@ Lisp_Object list = Qnil; for (i = CODING_CATEGORY_LAST; i >= 0; i--) - list = Fcons (coding_category_symbol[coding_category_by_priority[i]], + list = Fcons (coding_category_symbol[fcd->coding_category_by_priority[i]], list); return list; } @@ -1267,7 +1520,7 @@ int cat = decode_coding_category (coding_category); coding_system = Fget_coding_system (coding_system); - coding_category_system[cat] = coding_system; + fcd->coding_category_system[cat] = coding_system; return Qnil; } @@ -1277,7 +1530,7 @@ (coding_category)) { int cat = decode_coding_category (coding_category); - Lisp_Object sys = coding_category_system[cat]; + Lisp_Object sys = fcd->coding_category_system[cat]; if (!NILP (sys)) return XCODING_SYSTEM_NAME (sys); @@ -1291,7 +1544,7 @@ struct detection_state { - enum eol_type eol_type; + eol_type_t eol_type; int seen_non_ascii; int mask; #ifdef MULE @@ -1372,8 +1625,8 @@ return (mask & (mask - 1)) == 0; } -static enum eol_type -detect_eol_type (struct detection_state *st, CONST unsigned char *src, +static eol_type_t +detect_eol_type (struct detection_state *st, const unsigned char *src, unsigned int n) { int c; @@ -1381,21 +1634,19 @@ while (n--) { c = *src++; - if (c == '\r') + if (c == '\n') + { + if (st->eol.just_saw_cr) + return EOL_CRLF; + else if (st->eol.seen_anything) + return EOL_LF; + } + else if (st->eol.just_saw_cr) + return EOL_CR; + else if (c == '\r') st->eol.just_saw_cr = 1; else - { - if (c == '\n') - { - if (st->eol.just_saw_cr) - return EOL_CRLF; - else if (st->eol.seen_anything) - return EOL_LF; - } - else if (st->eol.just_saw_cr) - return EOL_CR; - st->eol.just_saw_cr = 0; - } + st->eol.just_saw_cr = 0; st->eol.seen_anything = 1; } @@ -1420,7 +1671,7 @@ */ static int -detect_coding_type (struct detection_state *st, CONST unsigned char *src, +detect_coding_type (struct detection_state *st, const Extbyte *src, unsigned int n, int just_do_eol) { int c; @@ -1497,7 +1748,7 @@ } } if (NILP (retval)) - retval = Fget_coding_system (Qno_conversion); + retval = Fget_coding_system (Qraw_text); return retval; } else @@ -1511,30 +1762,32 @@ the first one that is allowed. */ for (i = 0; i <= CODING_CATEGORY_LAST; i++) { - cat = coding_category_by_priority[i]; + cat = fcd->coding_category_by_priority[i]; if ((mask & (1 << cat)) && - !NILP (coding_category_system[cat])) + !NILP (fcd->coding_category_system[cat])) break; } if (cat >= 0) - return coding_category_system[cat]; + return fcd->coding_category_system[cat]; else - return Fget_coding_system (Qno_conversion); + return Fget_coding_system (Qraw_text); } } /* Given a seekable read stream and potential coding system and EOL type as specified, do any autodetection that is called for. If the - coding system and/or EOL type are not autodetect, they will be left + coding system and/or EOL type are not `autodetect', they will be left alone; but this function will never return an autodetect coding system or EOL type. This function does not automatically fetch subsidiary coding systems; that should be unnecessary with the explicit eol-type argument. */ +#define LENGTH(string_constant) (sizeof (string_constant) - 1) + void determine_real_coding_system (Lstream *stream, Lisp_Object *codesys_in_out, - enum eol_type *eol_type_in_out) + eol_type_t *eol_type_in_out) { struct detection_state decst; @@ -1546,27 +1799,108 @@ decst.mask = ~0; /* If autodetection is called for, do it now. */ - if (XCODING_SYSTEM_TYPE (*codesys_in_out) == CODESYS_AUTODETECT || - *eol_type_in_out == EOL_AUTODETECT) + if (XCODING_SYSTEM_TYPE (*codesys_in_out) == CODESYS_AUTODETECT + || *eol_type_in_out == EOL_AUTODETECT) { - - while (1) - { - unsigned char random_buffer[4096]; - int nread; - - nread = Lstream_read (stream, random_buffer, sizeof (random_buffer)); - if (!nread) + Extbyte buf[4096]; + Lisp_Object coding_system = Qnil; + Extbyte *p; + ssize_t nread = Lstream_read (stream, buf, sizeof (buf)); + Extbyte *scan_end; + + /* Look for initial "-*-"; mode line prefix */ + for (p = buf, + scan_end = buf + nread - LENGTH ("-*-coding:?-*-"); + p <= scan_end + && *p != '\n' + && *p != '\r'; + p++) + if (*p == '-' && *(p+1) == '*' && *(p+2) == '-') + { + Extbyte *local_vars_beg = p + 3; + /* Look for final "-*-"; mode line suffix */ + for (p = local_vars_beg, + scan_end = buf + nread - LENGTH ("-*-"); + p <= scan_end + && *p != '\n' + && *p != '\r'; + p++) + if (*p == '-' && *(p+1) == '*' && *(p+2) == '-') + { + Extbyte *suffix = p; + /* Look for "coding:" */ + for (p = local_vars_beg, + scan_end = suffix - LENGTH ("coding:?"); + p <= scan_end; + p++) + if (memcmp ("coding:", p, LENGTH ("coding:")) == 0 + && (p == local_vars_beg + || (*(p-1) == ' ' || + *(p-1) == '\t' || + *(p-1) == ';'))) + { + Extbyte save; + int n; + p += LENGTH ("coding:"); + while (*p == ' ' || *p == '\t') p++; + + /* Get coding system name */ + save = *suffix; *suffix = '\0'; + /* Characters valid in a MIME charset name (rfc 1521), + and in a Lisp symbol name. */ + n = strspn ( (char *) p, + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyz" + "0123456789" + "!$%&*+-.^_{|}~"); + *suffix = save; + if (n > 0) + { + save = p[n]; p[n] = '\0'; + coding_system = + Ffind_coding_system (intern ((char *) p)); + p[n] = save; + } + break; + } + break; + } break; - if (detect_coding_type (&decst, random_buffer, nread, - XCODING_SYSTEM_TYPE (*codesys_in_out) != - CODESYS_AUTODETECT)) - break; - } + } + + if (NILP (coding_system)) + do + { + if (detect_coding_type (&decst, buf, nread, + XCODING_SYSTEM_TYPE (*codesys_in_out) + != CODESYS_AUTODETECT)) + break; + nread = Lstream_read (stream, buf, sizeof (buf)); + if (nread == 0) + break; + } + while (1); + + else if (XCODING_SYSTEM_TYPE (*codesys_in_out) == CODESYS_AUTODETECT + && XCODING_SYSTEM_EOL_TYPE (coding_system) == EOL_AUTODETECT) + do + { + if (detect_coding_type (&decst, buf, nread, 1)) + break; + nread = Lstream_read (stream, buf, sizeof (buf)); + if (!nread) + break; + } + while (1); *eol_type_in_out = decst.eol_type; if (XCODING_SYSTEM_TYPE (*codesys_in_out) == CODESYS_AUTODETECT) - *codesys_in_out = coding_system_from_mask (decst.mask); + { + if (NILP (coding_system)) + *codesys_in_out = coding_system_from_mask (decst.mask); + else + *codesys_in_out = coding_system; + } } /* If we absolutely can't determine the EOL type, just assume LF. */ @@ -1605,7 +1939,7 @@ while (1) { unsigned char random_buffer[4096]; - int nread = Lstream_read (istr, random_buffer, sizeof (random_buffer)); + ssize_t nread = Lstream_read (istr, random_buffer, sizeof (random_buffer)); if (!nread) break; @@ -1626,10 +1960,10 @@ #endif for (i = CODING_CATEGORY_LAST; i >= 0; i--) { - int sys = coding_category_by_priority[i]; + int sys = fcd->coding_category_by_priority[i]; if (decst.mask & (1 << sys)) { - Lisp_Object codesys = coding_category_system[sys]; + Lisp_Object codesys = fcd->coding_category_system[sys]; if (!NILP (codesys)) codesys = subsidiary_coding_system (codesys, decst.eol_type); val = Fcons (codesys, val); @@ -1718,10 +2052,12 @@ #define DECODE_HANDLE_END_OF_CONVERSION(flags, ch, dst) \ do { \ - DECODE_OUTPUT_PARTIAL_CHAR (ch); \ - if ((flags & CODING_STATE_END) && \ - (flags & CODING_STATE_CR)) \ - Dynarr_add (dst, '\r'); \ + if (flags & CODING_STATE_END) \ + { \ + DECODE_OUTPUT_PARTIAL_CHAR (ch); \ + if (flags & CODING_STATE_CR) \ + Dynarr_add (dst, '\r'); \ + } \ } while (0) #define DECODING_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, decoding) @@ -1754,7 +2090,7 @@ EOL type stored in CODESYS because the latter might indicate automatic EOL-type detection while the former will always indicate a particular EOL type. */ - enum eol_type eol_type; + eol_type_t eol_type; #ifdef MULE /* Additional ISO2022 information. We define the structure above because it's also needed by the detection routines. */ @@ -1763,25 +2099,29 @@ /* Additional information (the state of the running CCL program) used by the CCL decoder. */ struct ccl_program ccl; + + /* counter for UTF-8 or UCS-4 */ + unsigned char counter; #endif struct detection_state decst; }; -static int decoding_reader (Lstream *stream, unsigned char *data, size_t size); -static int decoding_writer (Lstream *stream, CONST unsigned char *data, size_t size); +static ssize_t decoding_reader (Lstream *stream, + unsigned char *data, size_t size); +static ssize_t decoding_writer (Lstream *stream, + const unsigned char *data, size_t size); static int decoding_rewinder (Lstream *stream); static int decoding_seekable_p (Lstream *stream); static int decoding_flusher (Lstream *stream); static int decoding_closer (Lstream *stream); -static Lisp_Object decoding_marker (Lisp_Object stream, - void (*markobj) (Lisp_Object)); +static Lisp_Object decoding_marker (Lisp_Object stream); DEFINE_LSTREAM_IMPLEMENTATION ("decoding", lstream_decoding, sizeof (struct decoding_stream)); static Lisp_Object -decoding_marker (Lisp_Object stream, void (*markobj) (Lisp_Object)) +decoding_marker (Lisp_Object stream) { Lstream *str = DECODING_STREAM_DATA (XLSTREAM (stream))->other_end; Lisp_Object str_obj; @@ -1791,9 +2131,9 @@ and automatically marked. */ XSETLSTREAM (str_obj, str); - markobj (str_obj); + mark_object (str_obj); if (str->imp->marker) - return (str->imp->marker) (str_obj, markobj); + return (str->imp->marker) (str_obj); else return Qnil; } @@ -1801,12 +2141,12 @@ /* Read SIZE bytes of data and store it into DATA. We are a decoding stream so we read data from the other end, decode it, and store it into DATA. */ -static int +static ssize_t decoding_reader (Lstream *stream, unsigned char *data, size_t size) { struct decoding_stream *str = DECODING_STREAM_DATA (stream); unsigned char *orig_data = data; - int read_size; + ssize_t read_size; int error_occurred = 0; /* We need to interface to mule_decode(), which expects to take some @@ -1863,11 +2203,11 @@ return data - orig_data; } -static int -decoding_writer (Lstream *stream, CONST unsigned char *data, size_t size) +static ssize_t +decoding_writer (Lstream *stream, const unsigned char *data, size_t size) { struct decoding_stream *str = DECODING_STREAM_DATA (stream); - int retval; + ssize_t retval; /* Decode all our data into the runoff, and then attempt to write it all out to the other end. Remove whatever chunk we succeeded @@ -1897,6 +2237,7 @@ { setup_ccl_program (&str->ccl, CODING_SYSTEM_CCL_DECODE (str->codesys)); } + str->counter = 0; #endif /* MULE */ str->flags = str->ch = 0; } @@ -1973,7 +2314,7 @@ static Lisp_Object make_decoding_stream_1 (Lstream *stream, Lisp_Object codesys, - CONST char *mode) + const char *mode) { Lstream *lstr = Lstream_new (lstream_decoding, mode); struct decoding_stream *str = DECODING_STREAM_DATA (lstr); @@ -2016,7 +2357,7 @@ be used for both reading and writing. */ static void -mule_decode (Lstream *decoding, CONST unsigned char *src, +mule_decode (Lstream *decoding, const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n) { struct decoding_stream *str = DECODING_STREAM_DATA (decoding); @@ -2080,7 +2421,8 @@ decode_coding_utf8 (decoding, src, dst, n); break; case CODESYS_CCL: - ccl_driver (&str->ccl, src, dst, n, 0); + str->ccl.last_block = str->flags & CODING_STATE_END; + ccl_driver (&str->ccl, src, dst, n, 0, CCL_MODE_DECODING); break; case CODESYS_ISO2022: decode_coding_iso2022 (decoding, src, dst, n); @@ -2135,7 +2477,7 @@ char tempbuf[1024]; /* some random amount */ Bufpos newpos, even_newer_pos; Bufpos oldpos = lisp_buffer_stream_startpos (istr); - int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); + ssize_t size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); if (!size_in_bytes) break; @@ -2220,22 +2562,21 @@ #endif /* MULE */ }; -static int encoding_reader (Lstream *stream, unsigned char *data, size_t size); -static int encoding_writer (Lstream *stream, CONST unsigned char *data, - size_t size); +static ssize_t encoding_reader (Lstream *stream, unsigned char *data, size_t size); +static ssize_t encoding_writer (Lstream *stream, const unsigned char *data, + size_t size); static int encoding_rewinder (Lstream *stream); static int encoding_seekable_p (Lstream *stream); static int encoding_flusher (Lstream *stream); static int encoding_closer (Lstream *stream); -static Lisp_Object encoding_marker (Lisp_Object stream, - void (*markobj) (Lisp_Object)); +static Lisp_Object encoding_marker (Lisp_Object stream); DEFINE_LSTREAM_IMPLEMENTATION ("encoding", lstream_encoding, sizeof (struct encoding_stream)); static Lisp_Object -encoding_marker (Lisp_Object stream, void (*markobj) (Lisp_Object)) +encoding_marker (Lisp_Object stream) { Lstream *str = ENCODING_STREAM_DATA (XLSTREAM (stream))->other_end; Lisp_Object str_obj; @@ -2245,9 +2586,9 @@ and automatically marked. */ XSETLSTREAM (str_obj, str); - markobj (str_obj); + mark_object (str_obj); if (str->imp->marker) - return (str->imp->marker) (str_obj, markobj); + return (str->imp->marker) (str_obj); else return Qnil; } @@ -2255,12 +2596,12 @@ /* Read SIZE bytes of data and store it into DATA. We are a encoding stream so we read data from the other end, encode it, and store it into DATA. */ -static int +static ssize_t encoding_reader (Lstream *stream, unsigned char *data, size_t size) { struct encoding_stream *str = ENCODING_STREAM_DATA (stream); unsigned char *orig_data = data; - int read_size; + ssize_t read_size; int error_occurred = 0; /* We need to interface to mule_encode(), which expects to take some @@ -2317,11 +2658,11 @@ return data - orig_data; } -static int -encoding_writer (Lstream *stream, CONST unsigned char *data, size_t size) +static ssize_t +encoding_writer (Lstream *stream, const unsigned char *data, size_t size) { struct encoding_stream *str = ENCODING_STREAM_DATA (stream); - int retval; + ssize_t retval; /* Encode all our data into the runoff, and then attempt to write it all out to the other end. Remove whatever chunk we succeeded @@ -2429,7 +2770,7 @@ static Lisp_Object make_encoding_stream_1 (Lstream *stream, Lisp_Object codesys, - CONST char *mode) + const char *mode) { Lstream *lstr = Lstream_new (lstream_encoding, mode); struct encoding_stream *str = ENCODING_STREAM_DATA (lstr); @@ -2460,7 +2801,7 @@ Store the encoded data into DST. */ static void -mule_encode (Lstream *encoding, CONST unsigned char *src, +mule_encode (Lstream *encoding, const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n) { struct encoding_stream *str = ENCODING_STREAM_DATA (encoding); @@ -2492,7 +2833,8 @@ encode_coding_utf8 (encoding, src, dst, n); break; case CODESYS_CCL: - ccl_driver (&str->ccl, src, dst, n, 0); + str->ccl.last_block = str->flags & CODING_STATE_END; + ccl_driver (&str->ccl, src, dst, n, 0, CCL_MODE_ENCODING); break; case CODESYS_ISO2022: encode_coding_iso2022 (encoding, src, dst, n); @@ -2543,7 +2885,7 @@ char tempbuf[1024]; /* some random amount */ Bufpos newpos, even_newer_pos; Bufpos oldpos = lisp_buffer_stream_startpos (istr); - int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); + ssize_t size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); if (!size_in_bytes) break; @@ -2606,7 +2948,7 @@ ((c) >= 0xA1 && (c) <= 0xDF) static int -detect_coding_sjis (struct detection_state *st, CONST unsigned char *src, +detect_coding_sjis (struct detection_state *st, const unsigned char *src, unsigned int n) { int c; @@ -2631,7 +2973,7 @@ /* Convert Shift-JIS data to internal format. */ static void -decode_coding_sjis (Lstream *decoding, CONST unsigned char *src, +decode_coding_sjis (Lstream *decoding, const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n) { unsigned char c; @@ -2688,7 +3030,7 @@ /* Convert internally-formatted data to Shift-JIS. */ static void -encode_coding_sjis (Lstream *encoding, CONST unsigned char *src, +encode_coding_sjis (Lstream *encoding, const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n) { unsigned char c; @@ -2892,7 +3234,7 @@ } while (0) static int -detect_coding_big5 (struct detection_state *st, CONST unsigned char *src, +detect_coding_big5 (struct detection_state *st, const unsigned char *src, unsigned int n) { int c; @@ -2918,7 +3260,7 @@ /* Convert Big5 data to internal format. */ static void -decode_coding_big5 (Lstream *decoding, CONST unsigned char *src, +decode_coding_big5 (Lstream *decoding, const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n) { unsigned char c; @@ -2968,7 +3310,7 @@ /* Convert internally-formatted data to Big5. */ static void -encode_coding_big5 (Lstream *encoding, CONST unsigned char *src, +encode_coding_big5 (Lstream *encoding, const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n) { unsigned char c; @@ -3085,8 +3427,6 @@ /* */ /************************************************************************/ -Lisp_Object ucs_to_mule_table[65536]; -Lisp_Object mule_to_ucs_table; DEFUN ("set-ucs-char", Fset_ucs_char, 2, 2, 0, /* Map UCS-4 code CODE to Mule character CHARACTER. @@ -3101,9 +3441,9 @@ CHECK_INT (code); c = XINT (code); - if (c < sizeof (ucs_to_mule_table)) + if (c < sizeof (fcd->ucs_to_mule_table)) { - ucs_to_mule_table[c] = character; + fcd->ucs_to_mule_table[c] = character; return Qt; } else @@ -3113,9 +3453,9 @@ static Lisp_Object ucs_to_char (unsigned long code) { - if (code < sizeof (ucs_to_mule_table)) + if (code < sizeof (fcd->ucs_to_mule_table)) { - return ucs_to_mule_table[code]; + return fcd->ucs_to_mule_table[code]; } else if ((0xe00000 <= code) && (code <= 0xe00000 + 94 * 94 * 14)) { @@ -3164,7 +3504,8 @@ } /* Decode a UCS-4 character into a buffer. If the lookup fails, use - JIS X 0208 double-width `=' instead. + <GETA MARK> (U+3013) of JIS X 0208, which means correct character + is not found, instead. #### do something more appropriate (use blob?) Danger, Will Robinson! Data loss. Should we signal user? */ static void @@ -3236,7 +3577,7 @@ } static int -detect_coding_ucs4 (struct detection_state *st, CONST unsigned char *src, +detect_coding_ucs4 (struct detection_state *st, const unsigned char *src, unsigned int n) { while (n--) @@ -3261,41 +3602,43 @@ } static void -decode_coding_ucs4 (Lstream *decoding, CONST unsigned char *src, +decode_coding_ucs4 (Lstream *decoding, const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n) { struct decoding_stream *str = DECODING_STREAM_DATA (decoding); unsigned int flags = str->flags; unsigned int ch = str->ch; + unsigned char counter = str->counter; while (n--) { unsigned char c = *src++; - switch (flags) + switch (counter) { case 0: ch = c; - flags = 3; + counter = 3; break; case 1: decode_ucs4 ( ( ch << 8 ) | c, dst); ch = 0; - flags = 0; + counter = 0; break; default: ch = ( ch << 8 ) | c; - flags--; + counter--; } } - if (flags & CODING_STATE_END) + if (counter & CODING_STATE_END) DECODE_OUTPUT_PARTIAL_CHAR (ch); str->flags = flags; str->ch = ch; + str->counter = counter; } static void -encode_coding_ucs4 (Lstream *encoding, CONST unsigned char *src, +encode_coding_ucs4 (Lstream *encoding, const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n) { struct encoding_stream *str = ENCODING_STREAM_DATA (encoding); @@ -3308,7 +3651,7 @@ /* flags for handling composite chars. We do a little switcharoo on the source while we're outputting the composite char. */ unsigned int saved_n = 0; - CONST unsigned char *saved_src = NULL; + const unsigned char *saved_src = NULL; int in_composite = 0; back_to_square_n: @@ -3434,7 +3777,7 @@ /************************************************************************/ static int -detect_coding_utf8 (struct detection_state *st, CONST unsigned char *src, +detect_coding_utf8 (struct detection_state *st, const unsigned char *src, unsigned int n) { while (n--) @@ -3469,44 +3812,45 @@ } static void -decode_coding_utf8 (Lstream *decoding, CONST unsigned char *src, +decode_coding_utf8 (Lstream *decoding, const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n) { struct decoding_stream *str = DECODING_STREAM_DATA (decoding); unsigned int flags = str->flags; unsigned int ch = str->ch; eol_type_t eol_type = str->eol_type; + unsigned char counter = str->counter; while (n--) { unsigned char c = *src++; - switch (flags) + switch (counter) { case 0: if ( c >= 0xfc ) { ch = c & 0x01; - flags = 5; + counter = 5; } else if ( c >= 0xf8 ) { ch = c & 0x03; - flags = 4; + counter = 4; } else if ( c >= 0xf0 ) { ch = c & 0x07; - flags = 3; + counter = 3; } else if ( c >= 0xe0 ) { ch = c & 0x0f; - flags = 2; + counter = 2; } else if ( c >= 0xc0 ) { ch = c & 0x1f; - flags = 1; + counter = 1; } else { @@ -3518,11 +3862,11 @@ ch = ( ch << 6 ) | ( c & 0x3f ); decode_ucs4 (ch, dst); ch = 0; - flags = 0; + counter = 0; break; default: ch = ( ch << 6 ) | ( c & 0x3f ); - flags--; + counter--; } label_continue_loop:; } @@ -3532,6 +3876,7 @@ str->flags = flags; str->ch = ch; + str->counter = counter; } static void @@ -3581,7 +3926,7 @@ } static void -encode_coding_utf8 (Lstream *encoding, CONST unsigned char *src, +encode_coding_utf8 (Lstream *encoding, const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n) { struct encoding_stream *str = ENCODING_STREAM_DATA (encoding); @@ -3595,12 +3940,12 @@ /* flags for handling composite chars. We do a little switcharoo on the source while we're outputting the composite char. */ unsigned int saved_n = 0; - CONST unsigned char *saved_src = NULL; + const unsigned char *saved_src = NULL; int in_composite = 0; back_to_square_n: #endif /* ENABLE_COMPOSITE_CHARS */ - + while (n--) { unsigned char c = *src++; @@ -4299,7 +4644,7 @@ } static int -detect_coding_iso2022 (struct detection_state *st, CONST unsigned char *src, +detect_coding_iso2022 (struct detection_state *st, const unsigned char *src, unsigned int n) { int mask; @@ -4490,7 +4835,7 @@ /* Convert ISO2022-format data to internal format. */ static void -decode_coding_iso2022 (Lstream *decoding, CONST unsigned char *src, +decode_coding_iso2022 (Lstream *decoding, const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n) { struct decoding_stream *str = DECODING_STREAM_DATA (decoding); @@ -4731,8 +5076,8 @@ iso2022_designate (Lisp_Object charset, unsigned char reg, struct encoding_stream *str, unsigned_char_dynarr *dst) { - static CONST char inter94[] = "()*+"; - static CONST char inter96[] = ",-./"; + static const char inter94[] = "()*+"; + static const char inter96[] = ",-./"; unsigned int type; unsigned char final; Lisp_Object old_charset = str->iso2022.charset[reg]; @@ -4816,7 +5161,7 @@ /* Convert internally-formatted data to ISO2022 format. */ static void -encode_coding_iso2022 (Lstream *encoding, CONST unsigned char *src, +encode_coding_iso2022 (Lstream *encoding, const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n) { unsigned char charmask, c; @@ -4834,7 +5179,7 @@ /* flags for handling composite chars. We do a little switcharoo on the source while we're outputting the composite char. */ unsigned int saved_n = 0; - CONST unsigned char *saved_src = NULL; + const unsigned char *saved_src = NULL; int in_composite = 0; #endif /* ENABLE_COMPOSITE_CHARS */ @@ -5125,7 +5470,7 @@ contain all 256 possible byte values and that are not to be interpreted as being in any particular decoding. */ static void -decode_coding_no_conversion (Lstream *decoding, CONST unsigned char *src, +decode_coding_no_conversion (Lstream *decoding, const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n) { unsigned char c; @@ -5150,7 +5495,7 @@ } static void -encode_coding_no_conversion (Lstream *encoding, CONST unsigned char *src, +encode_coding_no_conversion (Lstream *encoding, const unsigned char *src, unsigned_char_dynarr *dst, unsigned int n) { unsigned char c; @@ -5204,171 +5549,14 @@ } -/************************************************************************/ -/* Simple internal/external functions */ -/************************************************************************/ - -static Extbyte_dynarr *conversion_out_dynarr; -static Bufbyte_dynarr *conversion_in_dynarr; - -/* Determine coding system from coding format */ - -/* #### not correct for all values of `fmt'! */ -static Lisp_Object -external_data_format_to_coding_system (enum external_data_format fmt) -{ - switch (fmt) - { - case FORMAT_FILENAME: - case FORMAT_TERMINAL: - if (EQ (Vfile_name_coding_system, Qnil) || - EQ (Vfile_name_coding_system, Qbinary)) - return Qnil; - else - return Fget_coding_system (Vfile_name_coding_system); -#ifdef MULE - case FORMAT_CTEXT: - return Fget_coding_system (Qctext); -#endif - default: - return Qnil; - } -} - -Extbyte * -convert_to_external_format (CONST Bufbyte *ptr, - Bytecount len, - Extcount *len_out, - enum external_data_format fmt) -{ - Lisp_Object coding_system = external_data_format_to_coding_system (fmt); - - if (!conversion_out_dynarr) - conversion_out_dynarr = Dynarr_new (Extbyte); - else - Dynarr_reset (conversion_out_dynarr); - - if (NILP (coding_system)) - { - CONST Bufbyte *end = ptr + len; - - for (; ptr < end;) - { - Bufbyte c = - (BYTE_ASCII_P (*ptr)) ? *ptr : - (*ptr == LEADING_BYTE_CONTROL_1) ? (*(ptr+1) - 0x20) : - (*ptr == LEADING_BYTE_LATIN_ISO8859_1) ? (*(ptr+1)) : - '~'; - - Dynarr_add (conversion_out_dynarr, (Extbyte) c); - INC_CHARPTR (ptr); - } - -#ifdef ERROR_CHECK_BUFPOS - assert (ptr == end); -#endif - } - else - { - Lisp_Object instream, outstream, da_outstream; - Lstream *istr, *ostr; - struct gcpro gcpro1, gcpro2, gcpro3; - char tempbuf[1024]; /* some random amount */ - - instream = make_fixed_buffer_input_stream ((unsigned char *) ptr, len); - da_outstream = make_dynarr_output_stream - ((unsigned_char_dynarr *) conversion_out_dynarr); - outstream = - make_encoding_output_stream (XLSTREAM (da_outstream), coding_system); - istr = XLSTREAM (instream); - ostr = XLSTREAM (outstream); - GCPRO3 (instream, outstream, da_outstream); - while (1) - { - int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); - if (!size_in_bytes) - break; - Lstream_write (ostr, tempbuf, size_in_bytes); - } - Lstream_close (istr); - Lstream_close (ostr); - UNGCPRO; - Lstream_delete (istr); - Lstream_delete (ostr); - Lstream_delete (XLSTREAM (da_outstream)); - } - - *len_out = Dynarr_length (conversion_out_dynarr); - Dynarr_add (conversion_out_dynarr, 0); /* remember to zero-terminate! */ - return Dynarr_atp (conversion_out_dynarr, 0); -} - -Bufbyte * -convert_from_external_format (CONST Extbyte *ptr, - Extcount len, - Bytecount *len_out, - enum external_data_format fmt) -{ - Lisp_Object coding_system = external_data_format_to_coding_system (fmt); - - if (!conversion_in_dynarr) - conversion_in_dynarr = Dynarr_new (Bufbyte); - else - Dynarr_reset (conversion_in_dynarr); - - if (NILP (coding_system)) - { - CONST Extbyte *end = ptr + len; - for (; ptr < end; ptr++) - { - Extbyte c = *ptr; - DECODE_ADD_BINARY_CHAR (c, conversion_in_dynarr); - } - } - else - { - Lisp_Object instream, outstream, da_outstream; - Lstream *istr, *ostr; - struct gcpro gcpro1, gcpro2, gcpro3; - char tempbuf[1024]; /* some random amount */ - - instream = make_fixed_buffer_input_stream ((unsigned char *) ptr, len); - da_outstream = make_dynarr_output_stream - ((unsigned_char_dynarr *) conversion_in_dynarr); - outstream = - make_decoding_output_stream (XLSTREAM (da_outstream), coding_system); - istr = XLSTREAM (instream); - ostr = XLSTREAM (outstream); - GCPRO3 (instream, outstream, da_outstream); - while (1) - { - int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); - if (!size_in_bytes) - break; - Lstream_write (ostr, tempbuf, size_in_bytes); - } - Lstream_close (istr); - Lstream_close (ostr); - UNGCPRO; - Lstream_delete (istr); - Lstream_delete (ostr); - Lstream_delete (XLSTREAM (da_outstream)); - } - - *len_out = Dynarr_length (conversion_in_dynarr); - Dynarr_add (conversion_in_dynarr, 0); /* remember to zero-terminate! */ - return Dynarr_atp (conversion_in_dynarr, 0); -} - - + /************************************************************************/ /* Initialization */ /************************************************************************/ void -syms_of_mule_coding (void) +syms_of_file_coding (void) { - defsymbol (&Qbuffer_file_coding_system, "buffer-file-coding-system"); deferror (&Qcoding_system_error, "coding-system-error", "Coding-system error", Qio_error); @@ -5379,6 +5567,10 @@ DEFSUBR (Fcoding_system_name); DEFSUBR (Fmake_coding_system); DEFSUBR (Fcopy_coding_system); + DEFSUBR (Fcoding_system_canonical_name_p); + DEFSUBR (Fcoding_system_alias_p); + DEFSUBR (Fcoding_system_aliasee); + DEFSUBR (Fdefine_coding_system_alias); DEFSUBR (Fsubsidiary_coding_system); DEFSUBR (Fcoding_system_type); @@ -5407,8 +5599,9 @@ DEFSUBR (Fset_char_ucs); DEFSUBR (Fchar_ucs); #endif /* MULE */ - defsymbol (&Qcoding_system_p, "coding-system-p"); + defsymbol (&Qcoding_systemp, "coding-system-p"); defsymbol (&Qno_conversion, "no-conversion"); + defsymbol (&Qraw_text, "raw-text"); #ifdef MULE defsymbol (&Qbig5, "big5"); defsymbol (&Qshift_jis, "shift-jis"); @@ -5452,7 +5645,6 @@ defsymbol (&Qdecode, "decode"); #ifdef MULE - defsymbol (&Qctext, "ctext"); defsymbol (&coding_category_symbol[CODING_CATEGORY_SHIFT_JIS], "shift-jis"); defsymbol (&coding_category_symbol[CODING_CATEGORY_BIG5], @@ -5477,7 +5669,7 @@ } void -lstream_type_create_mule_coding (void) +lstream_type_create_file_coding (void) { LSTREAM_HAS_METHOD (decoding, reader); LSTREAM_HAS_METHOD (decoding, writer); @@ -5497,15 +5689,18 @@ } void -vars_of_mule_coding (void) +vars_of_file_coding (void) { int i; + fcd = xnew (struct file_coding_dump); + dumpstruct (&fcd, &fcd_description); + /* Initialize to something reasonable ... */ for (i = 0; i <= CODING_CATEGORY_LAST; i++) { - coding_category_system[i] = Qnil; - coding_category_by_priority[i] = i; + fcd->coding_category_system[i] = Qnil; + fcd->coding_category_by_priority[i] = i; } Fprovide (intern ("file-coding")); @@ -5523,24 +5718,24 @@ Vterminal_coding_system = Qnil; DEFVAR_LISP ("coding-system-for-read", &Vcoding_system_for_read /* -Overriding coding system used when writing a file or process. -You should *bind* this, not set it. If this is non-nil, it specifies -the coding system that will be used when a file or process is read -in, and overrides `buffer-file-coding-system-for-read', +Overriding coding system used when reading from a file or process. +You should bind this variable with `let', but do not set it globally. +If this is non-nil, it specifies the coding system that will be used +to decode input on read operations, such as from a file or process. +It overrides `buffer-file-coding-system-for-read', `insert-file-contents-pre-hook', etc. Use those variables instead of -this one for permanent changes to the environment. -*/ ); +this one for permanent changes to the environment. */ ); Vcoding_system_for_read = Qnil; DEFVAR_LISP ("coding-system-for-write", &Vcoding_system_for_write /* -Overriding coding system used when writing a file or process. -You should *bind* this, not set it. If this is non-nil, it specifies -the coding system that will be used when a file or process is wrote -in, and overrides `buffer-file-coding-system', -`write-region-pre-hook', etc. Use those variables instead of this one -for permanent changes to the environment. -*/ ); +Overriding coding system used when writing to a file or process. +You should bind this variable with `let', but do not set it globally. +If this is non-nil, it specifies the coding system that will be used +to encode output for write operations, such as to a file or process. +It overrides `buffer-file-coding-system', `write-region-pre-hook', etc. +Use those variables instead of this one for permanent changes to the +environment. */ ); Vcoding_system_for_write = Qnil; DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system /* @@ -5559,13 +5754,14 @@ } void -complex_vars_of_mule_coding (void) +complex_vars_of_file_coding (void) { staticpro (&Vcoding_system_hash_table); Vcoding_system_hash_table = make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); the_codesys_prop_dynarr = Dynarr_new (codesys_prop); + dumpstruct (&the_codesys_prop_dynarr, &codesys_prop_dynarr_description); #define DEFINE_CODESYS_PROP(Prop_Type, Sym) do \ { \ @@ -5605,22 +5801,34 @@ DEFINE_CODESYS_PROP (CODESYS_PROP_CCL, Qdecode); #endif /* MULE */ /* Need to create this here or we're really screwed. */ - Fmake_coding_system (Qno_conversion, Qno_conversion, build_string ("No conversion"), - list2 (Qmnemonic, build_string ("Noconv"))); - - Fcopy_coding_system (Fcoding_system_property (Qno_conversion, Qeol_lf), - Qbinary); + Fmake_coding_system + (Qraw_text, Qno_conversion, + build_string ("Raw text, which means it converts only line-break-codes."), + list2 (Qmnemonic, build_string ("Raw"))); + + Fmake_coding_system + (Qbinary, Qno_conversion, + build_string ("Binary, which means it does not convert anything."), + list4 (Qeol_type, Qlf, + Qmnemonic, build_string ("Binary"))); + + Fdefine_coding_system_alias (Qno_conversion, Qraw_text); + + Fdefine_coding_system_alias (Qfile_name, Qbinary); + + Fdefine_coding_system_alias (Qterminal, Qbinary); + Fdefine_coding_system_alias (Qkeyboard, Qbinary); /* Need this for bootstrapping */ - coding_category_system[CODING_CATEGORY_NO_CONVERSION] = - Fget_coding_system (Qno_conversion); + fcd->coding_category_system[CODING_CATEGORY_NO_CONVERSION] = + Fget_coding_system (Qraw_text); #ifdef MULE { unsigned int i; for (i = 0; i < 65536; i++) - ucs_to_mule_table[i] = Qnil; + fcd->ucs_to_mule_table[i] = Qnil; } staticpro (&mule_to_ucs_table); mule_to_ucs_table = Fmake_char_table(Qgeneric); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/file-coding.h --- a/src/file-coding.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/file-coding.h Mon Aug 13 11:13:30 2007 +0200 @@ -24,14 +24,14 @@ /* 91.10.09 written by K.Handa <handa@etl.go.jp> */ /* Rewritten by Ben Wing <ben@xemacs.org>. */ -#ifndef _XEMACS_MULE_CODING_H_ -#define _XEMACS_MULE_CODING_H_ +#ifndef INCLUDED_file_coding_h_ +#define INCLUDED_file_coding_h_ struct decoding_stream; struct encoding_stream; /* Coding system types. These go into the TYPE field of a - struct Lisp_Coding_System. */ + Lisp_Coding_System. */ enum coding_system_type { @@ -84,7 +84,8 @@ struct lcrecord_header header; /* Name and doc string of this coding system. */ - Lisp_Object name, doc_string; + Lisp_Object name; + Lisp_Object doc_string; /* This is the major type of the coding system -- one of Big5, ISO2022, Shift-JIS, etc. See the constants above. */ @@ -94,14 +95,17 @@ system is active for a particular buffer. */ Lisp_Object mnemonic; - Lisp_Object post_read_conversion, pre_write_conversion; + Lisp_Object post_read_conversion; + Lisp_Object pre_write_conversion; - enum eol_type eol_type; + eol_type_t eol_type; /* Subsidiary coding systems that specify a particular type of EOL marking, rather than autodetecting it. These will only be non-nil if (eol_type == EOL_AUTODETECT). */ - Lisp_Object eol_lf, eol_crlf, eol_cr; + Lisp_Object eol_lf; + Lisp_Object eol_crlf; + Lisp_Object eol_cr; #ifdef MULE struct { @@ -130,17 +134,17 @@ { /* For a CCL coding system, these specify the CCL programs used for decoding (input) and encoding (output). */ - Lisp_Object decode, encode; + Lisp_Object decode; + Lisp_Object encode; } ccl; #endif }; typedef struct Lisp_Coding_System Lisp_Coding_System; -DECLARE_LRECORD (coding_system, struct Lisp_Coding_System); -#define XCODING_SYSTEM(x) XRECORD (x, coding_system, struct Lisp_Coding_System) +DECLARE_LRECORD (coding_system, Lisp_Coding_System); +#define XCODING_SYSTEM(x) XRECORD (x, coding_system, Lisp_Coding_System) #define XSETCODING_SYSTEM(x, p) XSETRECORD (x, p, coding_system) #define CODING_SYSTEMP(x) RECORDP (x, coding_system) -#define GC_CODING_SYSTEMP(x) GC_RECORDP (x, coding_system) #define CHECK_CODING_SYSTEM(x) CHECK_RECORD (x, coding_system) #define CONCHECK_CODING_SYSTEM(x) CONCHECK_RECORD (x, coding_system) @@ -250,14 +254,15 @@ EXFUN (Fsubsidiary_coding_system, 2); extern Lisp_Object Qucs4, Qutf8; -extern Lisp_Object Qbig5, Qbuffer_file_coding_system, Qccl, Qcharset_g0; +extern Lisp_Object Qbig5, Qccl, Qcharset_g0; extern Lisp_Object Qcharset_g1, Qcharset_g2, Qcharset_g3, Qcoding_system_error; -extern Lisp_Object Qcoding_system_p, Qcr, Qcrlf, Qctext, Qdecode, Qencode; +extern Lisp_Object Qcoding_systemp, Qcr, Qcrlf, Qdecode, Qencode; extern Lisp_Object Qeol_cr, Qeol_crlf, Qeol_lf, Qeol_type, Qescape_quoted; extern Lisp_Object Qforce_g0_on_output, Qforce_g1_on_output; extern Lisp_Object Qforce_g2_on_output, Qforce_g3_on_output; extern Lisp_Object Qinput_charset_conversion, Qiso2022, Qlf, Qlock_shift; extern Lisp_Object Qmnemonic, Qno_ascii_cntl, Qno_ascii_eol, Qno_conversion; +extern Lisp_Object Qraw_text; extern Lisp_Object Qno_iso6429, Qoutput_charset_conversion; extern Lisp_Object Qpost_read_conversion, Qpre_write_conversion, Qseven; extern Lisp_Object Qshift_jis, Qshort, Vcoding_system_for_read; @@ -500,7 +505,7 @@ void set_encoding_stream_coding_system (Lstream *stream, Lisp_Object codesys); void determine_real_coding_system (Lstream *stream, Lisp_Object *codesys_in_out, - enum eol_type *eol_type_in_out); + eol_type_t *eol_type_in_out); #ifndef MULE @@ -515,5 +520,6 @@ #define BUFBYTE_FIRST_BYTE_P(c) ((c) < 0xA0) #define BUFBYTE_LEADING_BYTE_P(c) BYTE_C1_P (c) #endif /* not MULE */ -#endif /* _XEMACS_MULE_CODING_H_ */ +#endif /* INCLUDED_file_coding_h_ */ + diff -r f4aeb21a5bad -r 74fd4e045ea6 src/fileio.c --- a/src/fileio.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/fileio.c Mon Aug 13 11:13:30 2007 +0200 @@ -56,7 +56,6 @@ #ifdef WINDOWSNT #define NOMINMAX 1 -#include <windows.h> #include <direct.h> #include <fcntl.h> #include <stdlib.h> @@ -71,7 +70,7 @@ /* Need to lower-case the drive letter, or else expanded filenames will sometimes compare inequal, because `expand-file-name' doesn't always down-case the drive letter. */ -#define DRIVE_LETTER(x) (tolower (x)) +#define DRIVE_LETTER(x) tolower (x) #endif /* WINDOWSNT */ int lisp_to_time (Lisp_Object, time_t *); @@ -109,8 +108,6 @@ int disable_auto_save_when_buffer_shrinks; -Lisp_Object Qfile_name_handler_alist; - Lisp_Object Vdirectory_sep_char; /* These variables describe handlers that have "already" had a chance @@ -138,7 +135,7 @@ /* signal a file error when errno contains a meaningful value. */ DOESNT_RETURN -report_file_error (CONST char *string, Lisp_Object data) +report_file_error (const char *string, Lisp_Object data) { /* #### dmoore - This uses current_buffer, better make sure no one has GC'd the current buffer. File handlers are giving me a headache @@ -151,7 +148,7 @@ } void -maybe_report_file_error (CONST char *string, Lisp_Object data, +maybe_report_file_error (const char *string, Lisp_Object data, Lisp_Object class, Error_behavior errb) { /* Optimization: */ @@ -167,14 +164,14 @@ /* signal a file error when errno does not contain a meaningful value. */ DOESNT_RETURN -signal_file_error (CONST char *string, Lisp_Object data) +signal_file_error (const char *string, Lisp_Object data) { signal_error (Qfile_error, list2 (build_translated_string (string), data)); } void -maybe_signal_file_error (CONST char *string, Lisp_Object data, +maybe_signal_file_error (const char *string, Lisp_Object data, Lisp_Object class, Error_behavior errb) { /* Optimization: */ @@ -186,7 +183,7 @@ } DOESNT_RETURN -signal_double_file_error (CONST char *string1, CONST char *string2, +signal_double_file_error (const char *string1, const char *string2, Lisp_Object data) { signal_error (Qfile_error, @@ -196,7 +193,7 @@ } void -maybe_signal_double_file_error (CONST char *string1, CONST char *string2, +maybe_signal_double_file_error (const char *string1, const char *string2, Lisp_Object data, Lisp_Object class, Error_behavior errb) { @@ -211,7 +208,7 @@ } DOESNT_RETURN -signal_double_file_error_2 (CONST char *string1, CONST char *string2, +signal_double_file_error_2 (const char *string1, const char *string2, Lisp_Object data1, Lisp_Object data2) { signal_error (Qfile_error, @@ -221,7 +218,7 @@ } void -maybe_signal_double_file_error_2 (CONST char *string1, CONST char *string2, +maybe_signal_double_file_error_2 (const char *string1, const char *string2, Lisp_Object data1, Lisp_Object data2, Lisp_Object class, Error_behavior errb) { @@ -242,7 +239,7 @@ Lisp_Object lisp_strerror (int errnum) { - return build_ext_string (strerror (errnum), FORMAT_NATIVE); + return build_ext_string (strerror (errnum), Qnative); } static Lisp_Object @@ -282,19 +279,17 @@ signal handler) because that's way too losing. (#### Actually, longjmp()ing out of the signal handler may not be - as losing as I thought. See sys_do_signal() in sysdep.c.) - - Solaris include files declare the return value as ssize_t. - Is that standard? */ -int + as losing as I thought. See sys_do_signal() in sysdep.c.) */ + +ssize_t read_allowing_quit (int fildes, void *buf, size_t size) { QUIT; return sys_read_1 (fildes, buf, size, 1); } -int -write_allowing_quit (int fildes, CONST void *buf, size_t size) +ssize_t +write_allowing_quit (int fildes, const void *buf, size_t size) { QUIT; return sys_write_1 (fildes, buf, size, 1); @@ -586,20 +581,12 @@ */ static int -directory_file_name (CONST char *src, char *dst) +directory_file_name (const char *src, char *dst) { - long slen; - - slen = strlen (src); + long slen = strlen (src); /* Process as Unix format: just remove any final slash. But leave "/" unchanged; do not change it to "". */ strcpy (dst, src); -#ifdef APOLLO - /* Handle // as root for apollo's. */ - if ((slen > 2 && dst[slen - 1] == '/') - || (slen > 1 && dst[0] != '/' && dst[slen - 1] == '/')) - dst[slen - 1] = 0; -#else if (slen > 1 && IS_DIRECTORY_SEP (dst[slen - 1]) #ifdef WINDOWSNT @@ -607,7 +594,6 @@ #endif /* WINDOWSNT */ ) dst[slen - 1] = 0; -#endif /* APOLLO */ return 1; } @@ -737,7 +723,7 @@ QUIT; - if (stat ((CONST char *) data, &ignored) < 0) + if (stat ((const char *) data, &ignored) < 0) { /* We want to return only if errno is ENOENT. */ if (errno == ENOENT) @@ -981,12 +967,14 @@ if (IS_DIRECTORY_SEP (nm[1]) || nm[1] == 0) /* ~ by itself */ { - char * newdir_external = get_home_directory (); + Extbyte *newdir_external = get_home_directory (); if (newdir_external == NULL) newdir = (Bufbyte *) ""; else - GET_C_CHARPTR_INT_FILENAME_DATA_ALLOCA (newdir_external, newdir); + TO_INTERNAL_FORMAT (C_STRING, newdir_external, + C_STRING_ALLOCA, (* ((char **) &newdir)), + Qfile_name); nm++; #ifdef WINDOWSNT @@ -1022,9 +1010,9 @@ if ((user = user_login_name (NULL)) != NULL) { /* Does the user login name match the ~name? */ - if (strcmp(user,((char *) o + 1)) == 0) + if (strcmp (user, (char *) o + 1) == 0) { - newdir = (Bufbyte *) get_home_directory(); + newdir = (Bufbyte *) get_home_directory(); nm = p; } } @@ -1303,19 +1291,21 @@ { char resolved_path[MAXPATHLEN]; - char path[MAXPATHLEN]; - char *p = path; - int elen = XSTRING_LENGTH (expanded_name); - - if (elen >= countof (path)) + Extbyte *path; + Extbyte *p; + Extcount elen; + + TO_EXTERNAL_FORMAT (LISP_STRING, expanded_name, + ALLOCA, (path, elen), + Qfile_name); + p = path; + if (elen > MAXPATHLEN) goto toolong; - - memcpy (path, XSTRING_DATA (expanded_name), elen + 1); - /* memset (resolved_path, 0, sizeof (resolved_path)); */ - + /* Try doing it all at once. */ - /* !!#### Does realpath() Mule-encapsulate? */ - if (!xrealpath (path, resolved_path)) + /* !! Does realpath() Mule-encapsulate? + Answer: Nope! So we do it above */ + if (!xrealpath ((char *) path, resolved_path)) { /* Didn't resolve it -- have to do it one component at a time. */ /* "realpath" is a typically useless, stupid un*x piece of crap. @@ -1325,12 +1315,12 @@ partial result returned. What a piece of junk. */ for (;;) { - p = (char *) memchr (p + 1, '/', elen - (p + 1 - path)); + p = (Extbyte *) memchr (p + 1, '/', elen - (p + 1 - path)); if (p) *p = 0; /* memset (resolved_path, 0, sizeof (resolved_path)); */ - if (xrealpath (path, resolved_path)) + if (xrealpath ((char *) path, resolved_path)) { if (p) *p = '/'; @@ -1378,7 +1368,7 @@ resolved_path[rlen + 1] = 0; rlen = rlen + 1; } - return make_ext_string ((Bufbyte *) resolved_path, rlen, FORMAT_BINARY); + return make_ext_string ((Bufbyte *) resolved_path, rlen, Qbinary); } toolong: @@ -1429,13 +1419,12 @@ for (p = nm; p != endp; p++) { if ((p[0] == '~' -#if defined (APOLLO) || defined (WINDOWSNT) || defined (__CYGWIN32__) - /* // at start of file name is meaningful in Apollo and - WindowsNT systems */ +#if defined (WINDOWSNT) || defined (__CYGWIN32__) + /* // at start of file name is meaningful in WindowsNT systems */ || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm) -#else /* not (APOLLO || WINDOWSNT || __CYGWIN32__) */ +#else /* not (WINDOWSNT || __CYGWIN32__) */ || IS_DIRECTORY_SEP (p[0]) -#endif /* not (APOLLO || WINDOWSNT || __CYGWIN32__) */ +#endif /* not (WINDOWSNT || __CYGWIN32__) */ ) && p != nm && (IS_DIRECTORY_SEP (p[-1]))) @@ -1561,11 +1550,11 @@ for (p = xnm; p != x; p++) if ((p[0] == '~' -#if defined (APOLLO) || defined (WINDOWSNT) +#if defined (WINDOWSNT) || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm) -#else /* not (APOLLO || WINDOWSNT) */ +#else /* not WINDOWSNT */ || IS_DIRECTORY_SEP (p[0]) -#endif /* APOLLO || WINDOWSNT */ +#endif /* not WINDOWSNT */ ) /* don't do p[-1] if that would go off the beginning --jwz */ && p != nm && p > xnm && IS_DIRECTORY_SEP (p[-1])) @@ -1622,7 +1611,7 @@ If the file does not exist, STATPTR->st_mode is set to 0. */ static void -barf_or_query_if_file_exists (Lisp_Object absname, CONST char *querystring, +barf_or_query_if_file_exists (Lisp_Object absname, const char *querystring, int interactive, struct stat *statptr) { /* This function can GC. GC checked 1997.04.06. */ @@ -1640,7 +1629,7 @@ struct gcpro gcpro1; prompt = emacs_doprnt_string_c - ((CONST Bufbyte *) GETTEXT ("File %s already exists; %s anyway? "), + ((const Bufbyte *) GETTEXT ("File %s already exists; %s anyway? "), Qnil, -1, XSTRING_DATA (absname), GETTEXT (querystring)); @@ -1732,7 +1721,7 @@ || INTP (ok_if_already_exists)) barf_or_query_if_file_exists (newname, "copy to it", INTP (ok_if_already_exists), &out_st); - else if (stat ((CONST char *) XSTRING_DATA (newname), &out_st) < 0) + else if (stat ((const char *) XSTRING_DATA (newname), &out_st) < 0) out_st.st_mode = 0; ifd = interruptible_open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0); @@ -1805,7 +1794,7 @@ mtime)) report_file_error ("I/O error", list1 (newname)); } - chmod ((CONST char *) XSTRING_DATA (newname), + chmod ((const char *) XSTRING_DATA (newname), st.st_mode & 07777); } @@ -1998,7 +1987,7 @@ Fcopy_file (filename, newname, /* We have already prompted if it was an integer, so don't have copy-file prompt again. */ - ((NILP (ok_if_already_exists)) ? Qnil : Qt), + (NILP (ok_if_already_exists) ? Qnil : Qt), Qt); Fdelete_file (filename); } @@ -2136,26 +2125,21 @@ (path, login)) { int netresult; + const char *path_ext; + const char *login_ext; CHECK_STRING (path); CHECK_STRING (login); /* netunam, being a strange-o system call only used once, is not encapsulated. */ - { - char *path_ext; - char *login_ext; - - GET_C_STRING_FILENAME_DATA_ALLOCA (path, path_ext); - GET_C_STRING_EXT_DATA_ALLOCA (login, FORMAT_OS, login_ext); - - netresult = netunam (path_ext, login_ext); - } - - if (netresult == -1) - return Qnil; - else - return Qt; + + TO_EXTERNAL_FORMAT (LISP_STRING, path, C_STRING_ALLOCA, path_ext, Qfile_name); + TO_EXTERNAL_FORMAT (LISP_STRING, login, C_STRING_ALLOCA, login_ext, Qnative); + + netresult = netunam (path_ext, login_ext); + + return netresult == -1 ? Qnil : Qt; } #endif /* HPUX_NET */ @@ -2202,7 +2186,7 @@ /* Return nonzero if file FILENAME exists and can be written. */ static int -check_writable (CONST char *filename) +check_writable (const char *filename) { #ifdef HAVE_EACCESS return (eaccess (filename, 2) >= 0); @@ -2741,15 +2725,7 @@ fd = -1; - if ( -#ifndef APOLLO - (stat ((char *) XSTRING_DATA (filename), &st) < 0) -#else /* APOLLO */ - /* Don't even bother with interruptible_open. APOLLO sucks. */ - ((fd = open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0)) < 0 - || fstat (fd, &st) < 0) -#endif /* APOLLO */ - ) + if (stat ((char *) XSTRING_DATA (filename), &st) < 0) { if (fd >= 0) close (fd); badopen: @@ -2984,7 +2960,7 @@ occurs inside of the filedesc stream. */ while (1) { - Bytecount this_len; + ssize_t this_len; Charcount cc_inserted; QUIT; @@ -3033,9 +3009,6 @@ { if (!EQ (buf->undo_list, Qt)) buf->undo_list = Qnil; -#ifdef APOLLO - stat ((char *) XSTRING_DATA (filename), &st); -#endif if (NILP (handler)) { buf->modtime = st.st_mtime; @@ -3341,21 +3314,11 @@ } #endif /* HAVE_FSYNC */ - /* Spurious "file has changed on disk" warnings have been - observed on Suns as well. - It seems that `close' can change the modtime, under nfs. - - (This has supposedly been fixed in Sunos 4, - but who knows about all the other machines with NFS?) */ - /* On VMS and APOLLO, must do the stat after the close - since closing changes the modtime. */ - /* As it does on Windows too - kkm */ - /* The spurious warnings appear on Linux too. Rather than handling - this on a per-system basis, unconditionally do the stat after the close - cgw */ - -#if 0 /* !defined (WINDOWSNT) */ /* !defined (VMS) && !defined (APOLLO) */ - fstat (desc, &st); -#endif + /* Spurious "file has changed on disk" warnings used to be seen on + systems where close() can change the modtime. This is known to + happen on various NFS file systems, on Windows, and on Linux. + Rather than handling this on a per-system basis, we + unconditionally do the stat() after the close(). */ /* NFS can report a write failure now. */ if (close (desc) < 0) @@ -3371,9 +3334,7 @@ unbind_to (speccount, Qnil); } - /* # if defined (WINDOWSNT) */ /* defined (VMS) || defined (APOLLO) */ stat ((char *) XSTRING_DATA (fn), &st); - /* #endif */ #ifdef CLASH_DETECTION if (!auto_saving) @@ -3909,7 +3870,7 @@ run_hook (Qauto_save_hook); - if (GC_STRINGP (Vauto_save_list_file_name)) + if (STRINGP (Vauto_save_list_file_name)) listfile = condition_case_1 (Qt, auto_save_expand_name, Vauto_save_list_file_name, @@ -3928,13 +3889,13 @@ for (do_handled_files = 0; do_handled_files < 2; do_handled_files++) { for (tail = Vbuffer_alist; - GC_CONSP (tail); + CONSP (tail); tail = XCDR (tail)) { buf = XCDR (XCAR (tail)); b = XBUFFER (buf); - if (!GC_NILP (current_only) + if (!NILP (current_only) && b != current_buffer) continue; @@ -3946,7 +3907,7 @@ /* Check for auto save enabled and file changed since last auto save and file changed since last real save. */ - if (GC_STRINGP (b->auto_save_file_name) + if (STRINGP (b->auto_save_file_name) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) && b->auto_save_modified < BUF_MODIFF (b) /* -1 means we've turned off autosaving for a while--see below. */ @@ -3991,19 +3952,19 @@ continue; } set_buffer_internal (b); - if (!auto_saved && GC_NILP (no_message)) + if (!auto_saved && NILP (no_message)) { - static CONST unsigned char *msg - = (CONST unsigned char *) "Auto-saving..."; + static const unsigned char *msg + = (const unsigned char *) "Auto-saving..."; echo_area_message (selected_frame (), msg, Qnil, - 0, strlen ((CONST char *) msg), + 0, strlen ((const char *) msg), Qauto_saving); } /* Open the auto-save list file, if necessary. We only do this now so that the file only exists if we actually auto-saved any files. */ - if (!auto_saved && GC_STRINGP (listfile) && listdesc < 0) + if (!auto_saved && STRINGP (listfile) && listdesc < 0) { listdesc = open ((char *) XSTRING_DATA (listfile), O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY, @@ -4022,21 +3983,22 @@ auto save name. */ if (listdesc >= 0) { - CONST Extbyte *auto_save_file_name_ext; + const Extbyte *auto_save_file_name_ext; Extcount auto_save_file_name_ext_len; - GET_STRING_FILENAME_DATA_ALLOCA - (b->auto_save_file_name, - auto_save_file_name_ext, - auto_save_file_name_ext_len); + TO_EXTERNAL_FORMAT (LISP_STRING, b->auto_save_file_name, + ALLOCA, (auto_save_file_name_ext, + auto_save_file_name_ext_len), + Qfile_name); if (!NILP (b->filename)) { - CONST Extbyte *filename_ext; + const Extbyte *filename_ext; Extcount filename_ext_len; - GET_STRING_FILENAME_DATA_ALLOCA (b->filename, - filename_ext, - filename_ext_len); + TO_EXTERNAL_FORMAT (LISP_STRING, b->filename, + ALLOCA, (filename_ext, + filename_ext_len), + Qfile_name); write (listdesc, filename_ext, filename_ext_len); } write (listdesc, "\n", 1); @@ -4092,17 +4054,17 @@ one because nothing needed to be auto-saved. Do this afterwards rather than before in case we get a crash attempting to autosave (in that case we'd still want the old one around). */ - if (listdesc < 0 && !auto_saved && GC_STRINGP (listfile)) + if (listdesc < 0 && !auto_saved && STRINGP (listfile)) unlink ((char *) XSTRING_DATA (listfile)); /* Show "...done" only if the echo area would otherwise be empty. */ if (auto_saved && NILP (no_message) && NILP (clear_echo_area (selected_frame (), Qauto_saving, 0))) { - static CONST unsigned char *msg - = (CONST unsigned char *)"Auto-saving...done"; + static const unsigned char *msg + = (const unsigned char *)"Auto-saving...done"; echo_area_message (selected_frame (), msg, Qnil, 0, - strlen ((CONST char *) msg), Qauto_saving); + strlen ((const char *) msg), Qauto_saving); } Vquit_flag = oquit; @@ -4180,7 +4142,6 @@ defsymbol (&Qset_visited_file_modtime, "set-visited-file-modtime"); defsymbol (&Qcar_less_than_car, "car-less-than-car"); /* Vomitous! */ - defsymbol (&Qfile_name_handler_alist, "file-name-handler-alist"); defsymbol (&Qauto_save_hook, "auto-save-hook"); defsymbol (&Qauto_save_error, "auto-save-error"); defsymbol (&Qauto_saving, "auto-saving"); @@ -4338,5 +4299,9 @@ on other platforms, it is initialized so that Lisp code can find out what the normal separator is. */ ); - Vdirectory_sep_char = make_char ('/'); +#ifdef WINDOWSNT + Vdirectory_sep_char = make_char ('\\'); +#else + Vdirectory_sep_char = make_char ('/'); +#endif } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/filelock.c --- a/src/filelock.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/filelock.c Mon Aug 13 11:13:30 2007 +0200 @@ -126,11 +126,11 @@ char *lock_info_str; if (STRINGP (Fuser_login_name (Qnil))) - user_name = (char *)XSTRING_DATA((Fuser_login_name (Qnil))); + user_name = (char *) XSTRING_DATA (Fuser_login_name (Qnil)); else user_name = ""; if (STRINGP (Fsystem_name ())) - host_name = (char *)XSTRING_DATA((Fsystem_name ())); + host_name = (char *) XSTRING_DATA (Fsystem_name ()); else host_name = ""; lock_info_str = (char *)alloca (strlen (user_name) + strlen (host_name) @@ -371,7 +371,7 @@ register Lisp_Object tail; register struct buffer *b; - for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail)) + for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail)) { b = XBUFFER (XCDR (XCAR (tail))); if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) diff -r f4aeb21a5bad -r 74fd4e045ea6 src/floatfns.c --- a/src/floatfns.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/floatfns.c Mon Aug 13 11:13:30 2007 +0200 @@ -55,9 +55,13 @@ #define THIS_FILENAME floatfns #include "sysfloat.h" -#ifndef HAVE_RINT +/* The code uses emacs_rint, so that it works to undefine HAVE_RINT + if `rint' exists but does not work right. */ +#ifdef HAVE_RINT +#define emacs_rint rint +#else static double -rint (double x) +emacs_rint (double x) { double r = floor (x + 0.5); double diff = fabs (r - x); @@ -75,7 +79,7 @@ /* If an argument is out of range for a mathematical function, here is the actual argument value to use in the error message. */ static Lisp_Object float_error_arg, float_error_arg2; -static CONST char *float_error_fn_name; +static const char *float_error_fn_name; /* Evaluate the floating point expression D, recording NUM as the original argument for error messages. @@ -108,21 +112,21 @@ #define arith_error(op,arg) \ - Fsignal (Qarith_error, list2 (build_string ((op)), (arg))) + Fsignal (Qarith_error, list2 (build_string (op), arg)) #define range_error(op,arg) \ - Fsignal (Qrange_error, list2 (build_string ((op)), (arg))) + Fsignal (Qrange_error, list2 (build_string (op), arg)) #define range_error2(op,a1,a2) \ - Fsignal (Qrange_error, list3 (build_string ((op)), (a1), (a2))) + Fsignal (Qrange_error, list3 (build_string (op), a1, a2)) #define domain_error(op,arg) \ - Fsignal (Qdomain_error, list2 (build_string ((op)), (arg))) + Fsignal (Qdomain_error, list2 (build_string (op), arg)) #define domain_error2(op,a1,a2) \ - Fsignal (Qdomain_error, list3 (build_string ((op)), (a1), (a2))) + Fsignal (Qdomain_error, list3 (build_string (op), a1, a2)) /* Convert float to Lisp Integer if it fits, else signal a range error using the given arguments. */ static Lisp_Object -float_to_int (double x, CONST char *name, Lisp_Object num, Lisp_Object num2) +float_to_int (double x, const char *name, Lisp_Object num, Lisp_Object num2) { if (x >= ((EMACS_INT) 1 << (VALBITS-1)) || x <= - ((EMACS_INT) 1 << (VALBITS-1)) - (EMACS_INT) 1) @@ -160,7 +164,7 @@ static Lisp_Object -mark_float (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_float (Lisp_Object obj) { return Qnil; } @@ -179,9 +183,14 @@ return (unsigned long) fmod (extract_float (obj), 4e9); } +static const struct lrecord_description float_description[] = { + { XD_END } +}; + DEFINE_BASIC_LRECORD_IMPLEMENTATION ("float", float, mark_float, print_float, 0, float_equal, - float_hash, struct Lisp_Float); + float_hash, float_description, + Lisp_Float); /* Extract a Lisp number as a `double', or signal an error. */ @@ -194,7 +203,7 @@ if (INTP (num)) return (double) XINT (num); - return extract_float (wrong_type_argument (num, Qnumberp)); + return extract_float (wrong_type_argument (Qnumberp, num)); } #endif /* LISP_FLOAT_TYPE */ @@ -666,12 +675,12 @@ if (INTP (arg)) return (XINT (arg) >= 0) ? arg : make_int (- XINT (arg)); - return Fabs (wrong_type_argument (arg, Qnumberp)); + return Fabs (wrong_type_argument (Qnumberp, arg)); } #ifdef LISP_FLOAT_TYPE DEFUN ("float", Ffloat, 1, 1, 0, /* -Return the floating point number equal to ARG. +Return the floating point number numerically equal to ARG. */ (arg)) { @@ -681,7 +690,7 @@ if (FLOATP (arg)) /* give 'em the same float back */ return arg; - return Ffloat (wrong_type_argument (arg, Qnumberp)); + return Ffloat (wrong_type_argument (Qnumberp, arg)); } #endif /* LISP_FLOAT_TYPE */ @@ -696,19 +705,19 @@ double f = extract_float (arg); if (f == 0.0) - return make_int (- (int)((((EMACS_UINT) 1) << (VALBITS - 1)))); /* most-negative-fixnum */ + return make_int (- (EMACS_INT)(((EMACS_UINT) 1) << (VALBITS - 1))); /* most-negative-fixnum */ #ifdef HAVE_LOGB { Lisp_Object val; - IN_FLOAT (val = make_int ((int) logb (f)), "logb", arg); - return (val); + IN_FLOAT (val = make_int ((EMACS_INT) logb (f)), "logb", arg); + return val; } #else #ifdef HAVE_FREXP { int exqp; IN_FLOAT (frexp (f, &exqp), "logb", arg); - return (make_int (exqp - 1)); + return make_int (exqp - 1); } #else { @@ -732,7 +741,7 @@ f /= d; val += i; } - return (make_int (val)); + return make_int (val); } #endif /* ! HAVE_FREXP */ #endif /* ! HAVE_LOGB */ @@ -757,7 +766,7 @@ if (INTP (arg)) return arg; - return Fceiling (wrong_type_argument (arg, Qnumberp)); + return Fceiling (wrong_type_argument (Qnumberp, arg)); } @@ -826,7 +835,7 @@ { double d; /* Screw the prevailing rounding mode. */ - IN_FLOAT ((d = rint (XFLOAT_DATA (arg))), "round", arg); + IN_FLOAT ((d = emacs_rint (XFLOAT_DATA (arg))), "round", arg); return (float_to_int (d, "round", arg, Qunbound)); } #endif /* LISP_FLOAT_TYPE */ @@ -834,7 +843,7 @@ if (INTP (arg)) return arg; - return Fround (wrong_type_argument (arg, Qnumberp)); + return Fround (wrong_type_argument (Qnumberp, arg)); } DEFUN ("truncate", Ftruncate, 1, 1, 0, /* @@ -851,7 +860,7 @@ if (INTP (arg)) return arg; - return Ftruncate (wrong_type_argument (arg, Qnumberp)); + return Ftruncate (wrong_type_argument (Qnumberp, arg)); } /* Float-rounding functions. */ @@ -886,7 +895,7 @@ (arg)) { double d = extract_float (arg); - IN_FLOAT (d = rint (d), "fround", arg); + IN_FLOAT (d = emacs_rint (d), "fround", arg); return make_float (d); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/fns.c --- a/src/fns.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/fns.c Mon Aug 13 11:13:30 2007 +0200 @@ -61,7 +61,7 @@ static int internal_old_equal (Lisp_Object, Lisp_Object, int); static Lisp_Object -mark_bit_vector (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_bit_vector (Lisp_Object obj) { return Qnil; } @@ -69,10 +69,10 @@ static void print_bit_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { - int i; - struct Lisp_Bit_Vector *v = XBIT_VECTOR (obj); - int len = bit_vector_length (v); - int last = len; + size_t i; + Lisp_Bit_Vector *v = XBIT_VECTOR (obj); + size_t len = bit_vector_length (v); + size_t last = len; if (INTP (Vprint_length)) last = min (len, XINT (Vprint_length)); @@ -92,8 +92,8 @@ static int bit_vector_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { - struct Lisp_Bit_Vector *v1 = XBIT_VECTOR (obj1); - struct Lisp_Bit_Vector *v2 = XBIT_VECTOR (obj2); + Lisp_Bit_Vector *v1 = XBIT_VECTOR (obj1); + Lisp_Bit_Vector *v2 = XBIT_VECTOR (obj2); return ((bit_vector_length (v1) == bit_vector_length (v2)) && !memcmp (v1->bits, v2->bits, @@ -104,17 +104,32 @@ static unsigned long bit_vector_hash (Lisp_Object obj, int depth) { - struct Lisp_Bit_Vector *v = XBIT_VECTOR (obj); + Lisp_Bit_Vector *v = XBIT_VECTOR (obj); return HASH2 (bit_vector_length (v), memory_hash (v->bits, BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)) * sizeof (long))); } -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bit-vector", bit_vector, - mark_bit_vector, print_bit_vector, 0, - bit_vector_equal, bit_vector_hash, - struct Lisp_Bit_Vector); +static size_t +size_bit_vector (const void *lheader) +{ + Lisp_Bit_Vector *v = (Lisp_Bit_Vector *) lheader; + return offsetof (Lisp_Bit_Vector, + bits[BIT_VECTOR_LONG_STORAGE (bit_vector_length (v))]); +} + +static const struct lrecord_description bit_vector_description[] = { + { XD_LISP_OBJECT, offsetof (Lisp_Bit_Vector, next) }, + { XD_END } +}; + + +DEFINE_BASIC_LRECORD_SEQUENCE_IMPLEMENTATION ("bit-vector", bit_vector, + mark_bit_vector, print_bit_vector, 0, + bit_vector_equal, bit_vector_hash, + bit_vector_description, size_bit_vector, + Lisp_Bit_Vector); DEFUN ("identity", Fidentity, 1, 1, 0, /* Return the argument unchanged. @@ -177,7 +192,7 @@ return XINT (Flength (seq)); else { - struct Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (seq); + Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (seq); return (f->flags.interactivep ? COMPILED_INTERACTIVE : f->flags.domainp ? COMPILED_DOMAIN : @@ -189,7 +204,7 @@ #endif /* LOSING_BYTECODE */ void -check_losing_bytecode (CONST char *function, Lisp_Object seq) +check_losing_bytecode (const char *function, Lisp_Object seq) { if (COMPILED_FUNCTIONP (seq)) error_with_frob @@ -208,7 +223,7 @@ return make_int (XSTRING_CHAR_LENGTH (sequence)); else if (CONSP (sequence)) { - int len; + size_t len; GET_EXTERNAL_LIST_LENGTH (sequence, len); return make_int (len); } @@ -235,7 +250,7 @@ (list)) { Lisp_Object hare, tortoise; - int len; + size_t len; for (hare = tortoise = list, len = 0; CONSP (hare) && (! EQ (hare, tortoise) || len == 0); @@ -261,7 +276,7 @@ (s1, s2)) { Bytecount len; - struct Lisp_String *p1, *p2; + Lisp_String *p1, *p2; if (SYMBOLP (s1)) p1 = XSYMBOL (s1)->name; @@ -308,7 +323,7 @@ */ (s1, s2)) { - struct Lisp_String *p1, *p2; + Lisp_String *p1, *p2; Charcount end, len2; int i; @@ -339,32 +354,41 @@ properly, it would still not work because strcoll() does not handle multiple locales. This is the fundamental flaw in the locale model. */ - Bytecount bcend = charcount_to_bytecount (string_data (p1), end); - /* Compare strings using collation order of locale. */ - /* Need to be tricky to handle embedded nulls. */ - - for (i = 0; i < bcend; i += strlen((char *) string_data (p1) + i) + 1) - { - int val = strcoll ((char *) string_data (p1) + i, - (char *) string_data (p2) + i); - if (val < 0) - return Qt; - if (val > 0) - return Qnil; - } + { + Bytecount bcend = charcount_to_bytecount (string_data (p1), end); + /* Compare strings using collation order of locale. */ + /* Need to be tricky to handle embedded nulls. */ + + for (i = 0; i < bcend; i += strlen((char *) string_data (p1) + i) + 1) + { + int val = strcoll ((char *) string_data (p1) + i, + (char *) string_data (p2) + i); + if (val < 0) + return Qt; + if (val > 0) + return Qnil; + } + } #else /* not I18N2, or MULE */ - /* #### It is not really necessary to do this: We could compare - byte-by-byte and still get a reasonable comparison, since this - would compare characters with a charset in the same way. - With a little rearrangement of the leading bytes, we could - make most inter-charset comparisons work out the same, too; - even if some don't, this is not a big deal because inter-charset - comparisons aren't really well-defined anyway. */ - for (i = 0; i < end; i++) - { - if (string_char (p1, i) != string_char (p2, i)) - return string_char (p1, i) < string_char (p2, i) ? Qt : Qnil; - } + { + Bufbyte *ptr1 = string_data (p1); + Bufbyte *ptr2 = string_data (p2); + + /* #### It is not really necessary to do this: We could compare + byte-by-byte and still get a reasonable comparison, since this + would compare characters with a charset in the same way. With + a little rearrangement of the leading bytes, we could make most + inter-charset comparisons work out the same, too; even if some + don't, this is not a big deal because inter-charset comparisons + aren't really well-defined anyway. */ + for (i = 0; i < end; i++) + { + if (charptr_emchar (ptr1) != charptr_emchar (ptr2)) + return charptr_emchar (ptr1) < charptr_emchar (ptr2) ? Qt : Qnil; + INC_CHARPTR (ptr1); + INC_CHARPTR (ptr2); + } + } #endif /* not I18N2, or MULE */ /* Can't do i < len2 because then comparison between "foo" and "foo^@" won't work right in I18N2 case */ @@ -378,7 +402,7 @@ */ (string)) { - struct Lisp_String *s; + Lisp_String *s; CHECK_STRING (string); s = XSTRING (string); @@ -391,7 +415,7 @@ void bump_string_modiff (Lisp_Object str) { - struct Lisp_String *s = XSTRING (str); + Lisp_String *s = XSTRING (str); Lisp_Object *ptr = &s->plist; #ifdef I18N3 @@ -506,7 +530,7 @@ Lisp_Object list_copy = Fcons (XCAR (list), XCDR (list)); Lisp_Object last = list_copy; Lisp_Object hare, tortoise; - int len; + size_t len; for (tortoise = hare = XCDR (list), len = 1; CONSP (hare); @@ -881,7 +905,7 @@ (string, from, to)) { Charcount ccfr, ccto; - Bytecount bfr, bto; + Bytecount bfr, blen; Lisp_Object val; CHECK_STRING (string); @@ -889,93 +913,86 @@ get_string_range_char (string, from, to, &ccfr, &ccto, GB_HISTORICAL_STRING_BEHAVIOR); bfr = charcount_to_bytecount (XSTRING_DATA (string), ccfr); - bto = charcount_to_bytecount (XSTRING_DATA (string), ccto); - val = make_string (XSTRING_DATA (string) + bfr, bto - bfr); + blen = charcount_to_bytecount (XSTRING_DATA (string) + bfr, ccto - ccfr); + val = make_string (XSTRING_DATA (string) + bfr, blen); /* Copy any applicable extent information into the new string: */ - copy_string_extents (val, string, 0, bfr, bto - bfr); + copy_string_extents (val, string, 0, bfr, blen); return val; } DEFUN ("subseq", Fsubseq, 2, 3, 0, /* -Return a subsequence of SEQ, starting at index FROM and ending before TO. -TO may be nil or omitted; then the subsequence runs to the end of SEQ. -If FROM or TO is negative, it counts from the end. -The resulting subsequence is always the same type as the original - sequence. -If SEQ is a string, relevant parts of the string-extent-data are copied - to the new string. +Return the subsequence of SEQUENCE starting at START and ending before END. +END may be omitted; then the subsequence runs to the end of SEQUENCE. +If START or END is negative, it counts from the end. +The returned subsequence is always of the same type as SEQUENCE. +If SEQUENCE is a string, relevant parts of the string-extent-data +are copied to the new string. */ - (seq, from, to)) + (sequence, start, end)) { - int len, f, t; - - if (STRINGP (seq)) - return Fsubstring (seq, from, to); - - if (!LISTP (seq) && !VECTORP (seq) && !BIT_VECTORP (seq)) - { - check_losing_bytecode ("subseq", seq); - seq = wrong_type_argument (Qsequencep, seq); - } - - len = XINT (Flength (seq)); - - CHECK_INT (from); - f = XINT (from); - if (f < 0) - f = len + f; - - if (NILP (to)) - t = len; + EMACS_INT len, s, e; + + if (STRINGP (sequence)) + return Fsubstring (sequence, start, end); + + len = XINT (Flength (sequence)); + + CHECK_INT (start); + s = XINT (start); + if (s < 0) + s = len + s; + + if (NILP (end)) + e = len; else { - CHECK_INT (to); - t = XINT (to); - if (t < 0) - t = len + t; + CHECK_INT (end); + e = XINT (end); + if (e < 0) + e = len + e; } - if (!(0 <= f && f <= t && t <= len)) - args_out_of_range_3 (seq, make_int (f), make_int (t)); - - if (VECTORP (seq)) + if (!(0 <= s && s <= e && e <= len)) + args_out_of_range_3 (sequence, make_int (s), make_int (e)); + + if (VECTORP (sequence)) { - Lisp_Object result = make_vector (t - f, Qnil); - int i; - Lisp_Object *in_elts = XVECTOR_DATA (seq); + Lisp_Object result = make_vector (e - s, Qnil); + EMACS_INT i; + Lisp_Object *in_elts = XVECTOR_DATA (sequence); Lisp_Object *out_elts = XVECTOR_DATA (result); - for (i = f; i < t; i++) - out_elts[i - f] = in_elts[i]; + for (i = s; i < e; i++) + out_elts[i - s] = in_elts[i]; return result; } - - if (LISTP (seq)) + else if (LISTP (sequence)) { Lisp_Object result = Qnil; - int i; - - seq = Fnthcdr (make_int (f), seq); - - for (i = f; i < t; i++) + EMACS_INT i; + + sequence = Fnthcdr (make_int (s), sequence); + + for (i = s; i < e; i++) { - result = Fcons (Fcar (seq), result); - seq = Fcdr (seq); + result = Fcons (Fcar (sequence), result); + sequence = Fcdr (sequence); } return Fnreverse (result); } - - /* bit vector */ - { - Lisp_Object result = make_bit_vector (t - f, Qzero); - int i; - - for (i = f; i < t; i++) - set_bit_vector_bit (XBIT_VECTOR (result), i - f, - bit_vector_bit (XBIT_VECTOR (seq), i)); - return result; - } + else if (BIT_VECTORP (sequence)) + { + Lisp_Object result = make_bit_vector (e - s, Qzero); + EMACS_INT i; + + for (i = s; i < e; i++) + set_bit_vector_bit (XBIT_VECTOR (result), i - s, + bit_vector_bit (XBIT_VECTOR (sequence), i)); + return result; + } + else + abort (); /* unreachable, since Flength (sequence) did not get an error */ } @@ -984,7 +1001,7 @@ */ (n, list)) { - REGISTER int i; + REGISTER size_t i; REGISTER Lisp_Object tail = list; CHECK_NATNUM (n); for (i = XINT (n); i; i--) @@ -1043,7 +1060,7 @@ #ifdef LOSING_BYTECODE else if (COMPILED_FUNCTIONP (sequence)) { - int idx = XINT (n); + EMACS_INT idx = XINT (n); if (idx < 0) { lose: @@ -1095,7 +1112,7 @@ */ (list, n)) { - int int_n, count; + EMACS_INT int_n, count; Lisp_Object retval, tortoise, hare; CHECK_LIST (list); @@ -1131,7 +1148,7 @@ */ (list, n)) { - int int_n; + EMACS_INT int_n; CHECK_LIST (list); @@ -1834,7 +1851,7 @@ plists_differ (Lisp_Object a, Lisp_Object b, int nil_means_not_present, int laxp, int depth) { - int eqp = (depth == -1); /* -1 as depth means us eq, not equal. */ + int eqp = (depth == -1); /* -1 as depth means use eq, not equal. */ int la, lb, m, i, fill; Lisp_Object *keys, *vals; char *flags; @@ -1878,10 +1895,10 @@ { if (!laxp ? EQ (k, keys [i]) : internal_equal (k, keys [i], depth)) { - if ((eqp - /* We narrowly escaped being Ebolified here. */ - ? !EQ_WITH_EBOLA_NOTICE (v, vals [i]) - : !internal_equal (v, vals [i], depth))) + if (eqp + /* We narrowly escaped being Ebolified here. */ + ? !EQ_WITH_EBOLA_NOTICE (v, vals [i]) + : !internal_equal (v, vals [i], depth)) /* a property in B has a different value than in A */ goto MISMATCH; flags [i] = 1; @@ -2352,8 +2369,7 @@ DEFUN ("valid-plist-p", Fvalid_plist_p, 1, 1, 0, /* Given a plist, return non-nil if its format is correct. If it returns nil, `check-valid-plist' will signal an error when given -the plist; that means it's a malformed or circular plist or has non-symbols -as keywords. +the plist; that means it's a malformed or circular plist. */ (plist)) { @@ -2430,9 +2446,7 @@ (lax_plist, prop, default_)) { Lisp_Object val = external_plist_get (&lax_plist, prop, 1, ERROR_ME); - if (UNBOUNDP (val)) - return default_; - return val; + return UNBOUNDP (val) ? default_ : val; } DEFUN ("lax-plist-put", Flax_plist_put, 3, 3, 0, /* @@ -2552,228 +2566,87 @@ return head; } -/* Symbol plists are directly accessible, so we need to protect against - invalid property list structure */ - -static Lisp_Object -symbol_getprop (Lisp_Object sym, Lisp_Object propname, Lisp_Object default_) -{ - Lisp_Object val = external_plist_get (&XSYMBOL (sym)->plist, propname, - 0, ERROR_ME); - return UNBOUNDP (val) ? default_ : val; -} - -static void -symbol_putprop (Lisp_Object sym, Lisp_Object propname, Lisp_Object value) -{ - external_plist_put (&XSYMBOL (sym)->plist, propname, value, 0, ERROR_ME); -} - -static int -symbol_remprop (Lisp_Object symbol, Lisp_Object propname) -{ - return external_remprop (&XSYMBOL (symbol)->plist, propname, 0, ERROR_ME); -} - -/* We store the string's extent info as the first element of the string's - property list; and the string's MODIFF as the first or second element - of the string's property list (depending on whether the extent info - is present), but only if the string has been modified. This is ugly - but it reduces the memory allocated for the string in the vast - majority of cases, where the string is never modified and has no - extent info. */ - - -static Lisp_Object * -string_plist_ptr (struct Lisp_String *s) -{ - Lisp_Object *ptr = &s->plist; - - if (CONSP (*ptr) && EXTENT_INFOP (XCAR (*ptr))) - ptr = &XCDR (*ptr); - if (CONSP (*ptr) && INTP (XCAR (*ptr))) - ptr = &XCDR (*ptr); - return ptr; -} - -static Lisp_Object -string_getprop (struct Lisp_String *s, Lisp_Object property, - Lisp_Object default_) -{ - Lisp_Object val = external_plist_get (string_plist_ptr (s), property, 0, - ERROR_ME); - return UNBOUNDP (val) ? default_ : val; -} - -static void -string_putprop (struct Lisp_String *s, Lisp_Object property, - Lisp_Object value) -{ - external_plist_put (string_plist_ptr (s), property, value, 0, ERROR_ME); -} - -static int -string_remprop (struct Lisp_String *s, Lisp_Object property) -{ - return external_remprop (string_plist_ptr (s), property, 0, ERROR_ME); -} - -static Lisp_Object -string_plist (struct Lisp_String *s) -{ - return *string_plist_ptr (s); -} - DEFUN ("get", Fget, 2, 3, 0, /* -Return the value of OBJECT's PROPNAME property. -This is the last VALUE stored with `(put OBJECT PROPNAME VALUE)'. +Return the value of OBJECT's PROPERTY property. +This is the last VALUE stored with `(put OBJECT PROPERTY VALUE)'. If there is no such property, return optional third arg DEFAULT -\(which defaults to `nil'). OBJECT can be a symbol, face, extent, -or string. See also `put', `remprop', and `object-plist'. +\(which defaults to `nil'). OBJECT can be a symbol, string, extent, +face, or glyph. See also `put', `remprop', and `object-plist'. */ - (object, propname, default_)) + (object, property, default_)) { /* Various places in emacs call Fget() and expect it not to quit, so don't quit. */ - - /* It's easiest to treat symbols specially because they may not - be an lrecord */ - if (SYMBOLP (object)) - return symbol_getprop (object, propname, default_); - else if (STRINGP (object)) - return string_getprop (XSTRING (object), propname, default_); - else if (LRECORDP (object)) - { - CONST struct lrecord_implementation *imp - = XRECORD_LHEADER_IMPLEMENTATION (object); - if (!imp->getprop) - goto noprops; - - { - Lisp_Object val = (imp->getprop) (object, propname); - if (UNBOUNDP (val)) - val = default_; - return val; - } - } + Lisp_Object val; + + if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->getprop) + val = XRECORD_LHEADER_IMPLEMENTATION (object)->getprop (object, property); else - { - noprops: - signal_simple_error ("Object type has no properties", object); - return Qnil; /* Not reached */ - } + signal_simple_error ("Object type has no properties", object); + + return UNBOUNDP (val) ? default_ : val; } DEFUN ("put", Fput, 3, 3, 0, /* -Store OBJECT's PROPNAME property with value VALUE. -It can be retrieved with `(get OBJECT PROPNAME)'. OBJECT can be a -symbol, face, extent, or string. - +Set OBJECT's PROPERTY to VALUE. +It can be subsequently retrieved with `(get OBJECT PROPERTY)'. +OBJECT can be a symbol, face, extent, or string. For a string, no properties currently have predefined meanings. For the predefined properties for extents, see `set-extent-property'. For the predefined properties for faces, see `set-face-property'. - See also `get', `remprop', and `object-plist'. */ - (object, propname, value)) + (object, property, value)) { - CHECK_SYMBOL (propname); - CHECK_IMPURE (object); - - if (SYMBOLP (object)) - symbol_putprop (object, propname, value); - else if (STRINGP (object)) - string_putprop (XSTRING (object), propname, value); - else if (LRECORDP (object)) + CHECK_LISP_WRITEABLE (object); + + if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->putprop) { - CONST struct lrecord_implementation - *imp = XRECORD_LHEADER_IMPLEMENTATION (object); - if (imp->putprop) - { - if (! (imp->putprop) (object, propname, value)) - signal_simple_error ("Can't set property on object", propname); - } - else - goto noprops; + if (! XRECORD_LHEADER_IMPLEMENTATION (object)->putprop + (object, property, value)) + signal_simple_error ("Can't set property on object", property); } else - { - noprops: - signal_simple_error ("Object type has no settable properties", object); - } + signal_simple_error ("Object type has no settable properties", object); return value; } -void -pure_put (Lisp_Object sym, Lisp_Object prop, Lisp_Object val) -{ - Fput (sym, prop, Fpurecopy (val)); -} - DEFUN ("remprop", Fremprop, 2, 2, 0, /* -Remove from OBJECT's property list the property PROPNAME and its -value. OBJECT can be a symbol, face, extent, or string. Returns -non-nil if the property list was actually changed (i.e. if PROPNAME -was present in the property list). See also `get', `put', and -`object-plist'. +Remove, from OBJECT's property list, PROPERTY and its corresponding value. +OBJECT can be a symbol, string, extent, face, or glyph. Return non-nil +if the property list was actually modified (i.e. if PROPERTY was present +in the property list). See also `get', `put', and `object-plist'. */ - (object, propname)) + (object, property)) { - int retval = 0; - - CHECK_SYMBOL (propname); - CHECK_IMPURE (object); - - if (SYMBOLP (object)) - retval = symbol_remprop (object, propname); - else if (STRINGP (object)) - retval = string_remprop (XSTRING (object), propname); - else if (LRECORDP (object)) + int ret = 0; + + CHECK_LISP_WRITEABLE (object); + + if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->remprop) { - CONST struct lrecord_implementation - *imp = XRECORD_LHEADER_IMPLEMENTATION (object); - if (imp->remprop) - { - retval = (imp->remprop) (object, propname); - if (retval == -1) - signal_simple_error ("Can't remove property from object", - propname); - } - else - goto noprops; + ret = XRECORD_LHEADER_IMPLEMENTATION (object)->remprop (object, property); + if (ret == -1) + signal_simple_error ("Can't remove property from object", property); } else - { - noprops: - signal_simple_error ("Object type has no removable properties", object); - } - - return retval ? Qt : Qnil; + signal_simple_error ("Object type has no removable properties", object); + + return ret ? Qt : Qnil; } DEFUN ("object-plist", Fobject_plist, 1, 1, 0, /* -Return a property list of OBJECT's props. -For a symbol this is equivalent to `symbol-plist'. -Do not modify the property list directly; this may or may not have -the desired effects. (In particular, for a property with a special -interpretation, this will probably have no effect at all.) +Return a property list of OBJECT's properties. +For a symbol, this is equivalent to `symbol-plist'. +OBJECT can be a symbol, string, extent, face, or glyph. +Do not modify the returned property list directly; +this may or may not have the desired effects. Use `put' instead. */ (object)) { - if (SYMBOLP (object)) - return Fsymbol_plist (object); - else if (STRINGP (object)) - return string_plist (XSTRING (object)); - else if (LRECORDP (object)) - { - CONST struct lrecord_implementation - *imp = XRECORD_LHEADER_IMPLEMENTATION (object); - if (imp->plist) - return (imp->plist) (object); - else - signal_simple_error ("Object type has no properties", object); - } + if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->plist) + return XRECORD_LHEADER_IMPLEMENTATION (object)->plist (object); else signal_simple_error ("Object type has no properties", object); @@ -2786,50 +2659,15 @@ { if (depth > 200) error ("Stack overflow in equal"); -#ifndef LRECORD_CONS - do_cdr: -#endif QUIT; if (EQ_WITH_EBOLA_NOTICE (obj1, obj2)) return 1; /* Note that (equal 20 20.0) should be nil */ if (XTYPE (obj1) != XTYPE (obj2)) return 0; -#ifndef LRECORD_CONS - if (CONSP (obj1)) - { - if (!internal_equal (XCAR (obj1), XCAR (obj2), depth + 1)) - return 0; - obj1 = XCDR (obj1); - obj2 = XCDR (obj2); - goto do_cdr; - } -#endif -#ifndef LRECORD_VECTOR - if (VECTORP (obj1)) - { - Lisp_Object *v1 = XVECTOR_DATA (obj1); - Lisp_Object *v2 = XVECTOR_DATA (obj2); - int len = XVECTOR_LENGTH (obj1); - if (len != XVECTOR_LENGTH (obj2)) - return 0; - while (len--) - if (!internal_equal (*v1++, *v2++, depth + 1)) - return 0; - return 1; - } -#endif -#ifndef LRECORD_STRING - if (STRINGP (obj1)) - { - Bytecount len; - return (((len = XSTRING_LENGTH (obj1)) == XSTRING_LENGTH (obj2)) && - !memcmp (XSTRING_DATA (obj1), XSTRING_DATA (obj2), len)); - } -#endif if (LRECORDP (obj1)) { - CONST struct lrecord_implementation + const struct lrecord_implementation *imp1 = XRECORD_LHEADER_IMPLEMENTATION (obj1), *imp2 = XRECORD_LHEADER_IMPLEMENTATION (obj2); @@ -2851,39 +2689,12 @@ { if (depth > 200) error ("Stack overflow in equal"); -#ifndef LRECORD_CONS - do_cdr: -#endif QUIT; if (HACKEQ_UNSAFE (obj1, obj2)) return 1; /* Note that (equal 20 20.0) should be nil */ if (XTYPE (obj1) != XTYPE (obj2)) return 0; -#ifndef LRECORD_CONS - if (CONSP (obj1)) - { - if (!internal_old_equal (XCAR (obj1), XCAR (obj2), depth + 1)) - return 0; - obj1 = XCDR (obj1); - obj2 = XCDR (obj2); - goto do_cdr; - } -#endif -#ifndef LRECORD_VECTOR - if (VECTORP (obj1)) - { - Lisp_Object *v1 = XVECTOR_DATA (obj1); - Lisp_Object *v2 = XVECTOR_DATA (obj2); - int len = XVECTOR_LENGTH (obj1); - if (len != XVECTOR_LENGTH (obj2)) - return 0; - while (len--) - if (!internal_old_equal (*v1++, *v2++, depth + 1)) - return 0; - return 1; - } -#endif return internal_equal (obj1, obj2, depth); } @@ -2916,7 +2727,7 @@ DEFUN ("fillarray", Ffillarray, 2, 2, 0, /* -Store each element of ARRAY with ITEM. +Destructively modify ARRAY by replacing each element with ITEM. ARRAY is a vector, bit vector, or string. */ (array, item)) @@ -2924,32 +2735,45 @@ retry: if (STRINGP (array)) { - Emchar charval; - struct Lisp_String *s = XSTRING (array); - Charcount len = string_char_length (s); - Charcount i; + Lisp_String *s = XSTRING (array); + Bytecount old_bytecount = string_length (s); + Bytecount new_bytecount; + Bytecount item_bytecount; + Bufbyte item_buf[MAX_EMCHAR_LEN]; + Bufbyte *p; + Bufbyte *end; + CHECK_CHAR_COERCE_INT (item); - CHECK_IMPURE (array); - charval = XCHAR (item); - for (i = 0; i < len; i++) - set_string_char (s, i, charval); + CHECK_LISP_WRITEABLE (array); + + item_bytecount = set_charptr_emchar (item_buf, XCHAR (item)); + new_bytecount = item_bytecount * string_char_length (s); + + resize_string (s, -1, new_bytecount - old_bytecount); + + for (p = string_data (s), end = p + new_bytecount; + p < end; + p += item_bytecount) + memcpy (p, item_buf, item_bytecount); + *p = '\0'; + bump_string_modiff (array); } else if (VECTORP (array)) { Lisp_Object *p = XVECTOR_DATA (array); int len = XVECTOR_LENGTH (array); - CHECK_IMPURE (array); + CHECK_LISP_WRITEABLE (array); while (len--) *p++ = item; } else if (BIT_VECTORP (array)) { - struct Lisp_Bit_Vector *v = XBIT_VECTOR (array); + Lisp_Bit_Vector *v = XBIT_VECTOR (array); int len = bit_vector_length (v); int bit; CHECK_BIT (item); - CHECK_IMPURE (array); + CHECK_LISP_WRITEABLE (array); bit = XINT (item); while (len--) set_bit_vector_bit (v, len, bit); @@ -3095,15 +2919,16 @@ } -/* This is the guts of all mapping functions. - Apply fn to each element of seq, one by one, - storing the results into elements of vals, a C vector of Lisp_Objects. - leni is the length of vals, which should also be the length of seq. +/* This is the guts of several mapping functions. + Apply FUNCTION to each element of SEQUENCE, one by one, + storing the results into elements of VALS, a C vector of Lisp_Objects. + LENI is the length of VALS, which should also be the length of SEQUENCE. If VALS is a null pointer, do not accumulate the results. */ static void -mapcar1 (size_t leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) +mapcar1 (size_t leni, Lisp_Object *vals, + Lisp_Object function, Lisp_Object sequence) { Lisp_Object result; Lisp_Object args[2]; @@ -3116,21 +2941,61 @@ gcpro1.nvars = 0; } - args[0] = fn; - - if (LISTP (seq)) + args[0] = function; + + if (LISTP (sequence)) { - for (i = 0; i < leni; i++) + /* A devious `function' could either: + - insert garbage into the list in front of us, causing XCDR to crash + - amputate the list behind us using (setcdr), causing the remaining + elts to lose their GCPRO status. + + if (vals != 0) we avoid this by copying the elts into the + `vals' array. By a stroke of luck, `vals' is exactly large + enough to hold the elts left to be traversed as well as the + results computed so far. + + if (vals == 0) we don't have any free space available and + don't want to eat up any more stack with alloca(). + So we use EXTERNAL_LIST_LOOP_3 and GCPRO the tail. */ + + if (vals) { - args[1] = XCAR (seq); - seq = XCDR (seq); - result = Ffuncall (2, args); - if (vals) vals[gcpro1.nvars++] = result; + Lisp_Object *val = vals; + Lisp_Object elt; + + LIST_LOOP_2 (elt, sequence) + *val++ = elt; + + gcpro1.nvars = leni; + + for (i = 0; i < leni; i++) + { + args[1] = vals[i]; + vals[i] = Ffuncall (2, args); + } + } + else + { + Lisp_Object elt, tail; + struct gcpro ngcpro1; + + NGCPRO1 (tail); + + { + EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) + { + args[1] = elt; + Ffuncall (2, args); + } + } + + NUNGCPRO; } } - else if (VECTORP (seq)) + else if (VECTORP (sequence)) { - Lisp_Object *objs = XVECTOR_DATA (seq); + Lisp_Object *objs = XVECTOR_DATA (sequence); for (i = 0; i < leni; i++) { args[1] = *objs++; @@ -3138,10 +3003,16 @@ if (vals) vals[gcpro1.nvars++] = result; } } - else if (STRINGP (seq)) + else if (STRINGP (sequence)) { - Bufbyte *p = XSTRING_DATA (seq); - for (i = 0; i < leni; i++) + /* The string data of `sequence' might be relocated during GC. */ + Bytecount slen = XSTRING_LENGTH (sequence); + Bufbyte *p = alloca_array (Bufbyte, slen); + Bufbyte *end = p + slen; + + memcpy (p, XSTRING_DATA (sequence), slen); + + while (p < end) { args[1] = make_char (charptr_emchar (p)); INC_CHARPTR (p); @@ -3149,9 +3020,9 @@ if (vals) vals[gcpro1.nvars++] = result; } } - else if (BIT_VECTORP (seq)) + else if (BIT_VECTORP (sequence)) { - struct Lisp_Bit_Vector *v = XBIT_VECTOR (seq); + Lisp_Bit_Vector *v = XBIT_VECTOR (sequence); for (i = 0; i < leni; i++) { args[1] = make_int (bit_vector_bit (v, i)); @@ -3160,86 +3031,87 @@ } } else - abort(); /* cannot get here since Flength(seq) did not get an error */ + abort (); /* unreachable, since Flength (sequence) did not get an error */ if (vals) UNGCPRO; } DEFUN ("mapconcat", Fmapconcat, 3, 3, 0, /* -Apply FN to each element of SEQ, and concat the results as strings. -In between each pair of results, stick in SEP. -Thus, " " as SEP results in spaces between the values returned by FN. +Apply FUNCTION to each element of SEQUENCE, and concat the results as strings. +In between each pair of results, insert SEPARATOR. Thus, using " " as +SEPARATOR results in spaces between the values returned by FUNCTION. +SEQUENCE may be a list, a vector, a bit vector, or a string. */ - (fn, seq, sep)) + (function, sequence, separator)) { - size_t len = XINT (Flength (seq)); + size_t len = XINT (Flength (sequence)); Lisp_Object *args; int i; - struct gcpro gcpro1; int nargs = len + len - 1; - if (nargs < 0) return build_string (""); + if (len == 0) return build_string (""); args = alloca_array (Lisp_Object, nargs); - GCPRO1 (sep); - mapcar1 (len, args, fn, seq); - UNGCPRO; + mapcar1 (len, args, function, sequence); for (i = len - 1; i >= 0; i--) args[i + i] = args[i]; for (i = 1; i < nargs; i += 2) - args[i] = sep; + args[i] = separator; return Fconcat (nargs, args); } DEFUN ("mapcar", Fmapcar, 2, 2, 0, /* -Apply FUNCTION to each element of SEQUENCE, and make a list of the results. -The result is a list just as long as SEQUENCE. +Apply FUNCTION to each element of SEQUENCE; return a list of the results. +The result is a list of the same length as SEQUENCE. SEQUENCE may be a list, a vector, a bit vector, or a string. */ - (fn, seq)) + (function, sequence)) { - size_t len = XINT (Flength (seq)); + size_t len = XINT (Flength (sequence)); Lisp_Object *args = alloca_array (Lisp_Object, len); - mapcar1 (len, args, fn, seq); + mapcar1 (len, args, function, sequence); return Flist (len, args); } DEFUN ("mapvector", Fmapvector, 2, 2, 0, /* -Apply FUNCTION to each element of SEQUENCE, making a vector of the results. +Apply FUNCTION to each element of SEQUENCE; return a vector of the results. The result is a vector of the same length as SEQUENCE. -SEQUENCE may be a list, a vector or a string. +SEQUENCE may be a list, a vector, a bit vector, or a string. */ - (fn, seq)) + (function, sequence)) { - size_t len = XINT (Flength (seq)); + size_t len = XINT (Flength (sequence)); Lisp_Object result = make_vector (len, Qnil); struct gcpro gcpro1; GCPRO1 (result); - mapcar1 (len, XVECTOR_DATA (result), fn, seq); + mapcar1 (len, XVECTOR_DATA (result), function, sequence); UNGCPRO; return result; } -DEFUN ("mapc", Fmapc, 2, 2, 0, /* +DEFUN ("mapc-internal", Fmapc_internal, 2, 2, 0, /* Apply FUNCTION to each element of SEQUENCE. SEQUENCE may be a list, a vector, a bit vector, or a string. This function is like `mapcar' but does not accumulate the results, which is more efficient if you do not use the results. + +The difference between this and `mapc' is that `mapc' supports all +the spiffy Common Lisp arguments. You should normally use `mapc'. */ - (fn, seq)) + (function, sequence)) { - mapcar1 (XINT (Flength (seq)), 0, fn, seq); - - return seq; + mapcar1 (XINT (Flength (sequence)), 0, function, sequence); + + return sequence; } @@ -3444,9 +3316,12 @@ } /* base64 encode/decode functions. - Based on code from GNU recode. */ - -#define MIME_LINE_LENGTH 76 + + Originally based on code from GNU recode. Ported to FSF Emacs by + Lars Magne Ingebrigtsen and Karl Heuer. Ported to XEmacs and + subsequently heavily hacked by Hrvoje Niksic. */ + +#define MIME_LINE_LENGTH 72 #define IS_ASCII(Character) \ ((Character) < 128) @@ -3502,11 +3377,11 @@ base64 characters. */ #define ADVANCE_INPUT(c, stream) \ - (ec = Lstream_get_emchar (stream), \ - ec == -1 ? 0 : \ + ((ec = Lstream_get_emchar (stream)) == -1 ? 0 : \ ((ec > 255) ? \ - (error ("Non-ascii character detected in base64 input"), 0) \ - : (c = (Bufbyte)ec, 1))) + (signal_simple_error ("Non-ascii character in base64 input", \ + make_char (ec)), 0) \ + : (c = (Bufbyte)ec), 1)) static Bytind base64_encode_1 (Lstream *istream, Bufbyte *to, int line_break) @@ -3566,105 +3441,90 @@ } #undef ADVANCE_INPUT -#define ADVANCE_INPUT(c, stream) \ - (ec = Lstream_get_emchar (stream), \ - ec == -1 ? 0 : (c = (Bufbyte)ec, 1)) - -#define INPUT_EOF_P(stream) \ - (ADVANCE_INPUT (c2, stream) \ - ? (Lstream_unget_emchar (stream, (Emchar)c2), 0) \ - : 1) - -#define STORE_BYTE(pos, val) do { \ +/* Get next character from the stream, except that non-base64 + characters are ignored. This is in accordance with rfc2045. EC + should be an Emchar, so that it can hold -1 as the value for EOF. */ +#define ADVANCE_INPUT_IGNORE_NONBASE64(ec, stream, streampos) do { \ + ec = Lstream_get_emchar (stream); \ + ++streampos; \ + /* IS_BASE64 may not be called with negative arguments so check for \ + EOF first. */ \ + if (ec < 0 || IS_BASE64 (ec) || ec == '=') \ + break; \ +} while (1) + +#define STORE_BYTE(pos, val, ccnt) do { \ pos += set_charptr_emchar (pos, (Emchar)((unsigned char)(val))); \ - ++*ccptr; \ + ++ccnt; \ } while (0) static Bytind base64_decode_1 (Lstream *istream, Bufbyte *to, Charcount *ccptr) { - EMACS_INT counter = 0; - Emchar ec; + Charcount ccnt = 0; Bufbyte *e = to; - unsigned long value; - - *ccptr = 0; + EMACS_INT streampos = 0; + while (1) { - Bufbyte c, c2; - - if (!ADVANCE_INPUT (c, istream)) - break; - - /* Accept wrapping lines, reversibly if at each 76 characters. */ - if (c == '\n') - { - if (!ADVANCE_INPUT (c, istream)) - break; - if (INPUT_EOF_P (istream)) - break; - /* FSF Emacs has this check, apparently inherited from - recode. However, I see no reason to be this picky about - line length -- why reject base64 with say 72-byte lines? - (yes, there are programs that generate them.) */ - /*if (counter != MIME_LINE_LENGTH / 4) return -1;*/ - counter = 1; - } - else - counter++; + Emchar ec; + unsigned long value; /* Process first byte of a quadruplet. */ - if (!IS_BASE64 (c)) - return -1; - value = base64_char_to_value[c] << 18; + ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos); + if (ec < 0) + break; + if (ec == '=') + signal_simple_error ("Illegal `=' character while decoding base64", + make_int (streampos)); + value = base64_char_to_value[ec] << 18; /* Process second byte of a quadruplet. */ - if (!ADVANCE_INPUT (c, istream)) - return -1; - - if (!IS_BASE64 (c)) - return -1; - value |= base64_char_to_value[c] << 12; - - STORE_BYTE (e, value >> 16); + ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos); + if (ec < 0) + error ("Premature EOF while decoding base64"); + if (ec == '=') + signal_simple_error ("Illegal `=' character while decoding base64", + make_int (streampos)); + value |= base64_char_to_value[ec] << 12; + STORE_BYTE (e, value >> 16, ccnt); /* Process third byte of a quadruplet. */ - if (!ADVANCE_INPUT (c, istream)) - return -1; - - if (c == '=') + ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos); + if (ec < 0) + error ("Premature EOF while decoding base64"); + + if (ec == '=') { - if (!ADVANCE_INPUT (c, istream)) - return -1; - if (c != '=') - return -1; + ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos); + if (ec < 0) + error ("Premature EOF while decoding base64"); + if (ec != '=') + signal_simple_error ("Padding `=' expected but not found while decoding base64", + make_int (streampos)); continue; } - if (!IS_BASE64 (c)) - return -1; - value |= base64_char_to_value[c] << 6; - - STORE_BYTE (e, 0xff & value >> 8); + value |= base64_char_to_value[ec] << 6; + STORE_BYTE (e, 0xff & value >> 8, ccnt); /* Process fourth byte of a quadruplet. */ - if (!ADVANCE_INPUT (c, istream)) - return -1; - - if (c == '=') + ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos); + if (ec < 0) + error ("Premature EOF while decoding base64"); + if (ec == '=') continue; - if (!IS_BASE64 (c)) - return -1; - value |= base64_char_to_value[c]; - - STORE_BYTE (e, 0xff & value); + value |= base64_char_to_value[ec]; + STORE_BYTE (e, 0xff & value, ccnt); } + *ccptr = ccnt; return e - to; } #undef ADVANCE_INPUT -#undef INPUT_EOF_P +#undef ADVANCE_INPUT_IGNORE_NONBASE64 +#undef STORE_BYTE static Lisp_Object free_malloced_ptr (Lisp_Object unwind_obj) @@ -3741,8 +3601,8 @@ XMALLOC_UNBIND (encoded, allength, speccount); buffer_delete_range (buf, begv + encoded_length, zv + encoded_length, 0); - /* Simulate FSF Emacs: if point was in the region, place it at the - beginning. */ + /* Simulate FSF Emacs implementation of this function: if point was + in the region, place it at the beginning. */ if (old_pt >= begv && old_pt < zv) BUF_SET_PT (buf, begv); @@ -3783,6 +3643,7 @@ Base64-decode the region between BEG and END. Return the length of the decoded text. If the region can't be decoded, return nil and don't modify the buffer. +Characters out of the base64 alphabet are ignored. */ (beg, end)) { @@ -3807,13 +3668,6 @@ abort (); Lstream_delete (XLSTREAM (input)); - if (decoded_length < 0) - { - /* The decoding wasn't possible. */ - XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount); - return Qnil; - } - /* Now we have decoded the region, so we insert the new contents and delete the old. (Insert first in order to preserve markers.) */ BUF_SET_PT (buf, begv); @@ -3822,8 +3676,8 @@ buffer_delete_range (buf, begv + cc_decoded_length, zv + cc_decoded_length, 0); - /* Simulate FSF Emacs: if point was in the region, place it at the - beginning. */ + /* Simulate FSF Emacs implementation of this function: if point was + in the region, place it at the beginning. */ if (old_pt >= begv && old_pt < zv) BUF_SET_PT (buf, begv); @@ -3832,6 +3686,7 @@ DEFUN ("base64-decode-string", Fbase64_decode_string, 1, 1, 0, /* Base64-decode STRING and return the result. +Characters out of the base64 alphabet are ignored. */ (string)) { @@ -3854,13 +3709,6 @@ abort (); Lstream_delete (XLSTREAM (input)); - if (decoded_length < 0) - { - /* The decoding wasn't possible. */ - XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount); - return Qnil; - } - result = make_string (decoded, decoded_length); XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount); return result; @@ -3948,7 +3796,7 @@ DEFSUBR (Fnconc); DEFSUBR (Fmapcar); DEFSUBR (Fmapvector); - DEFSUBR (Fmapc); + DEFSUBR (Fmapc_internal); DEFSUBR (Fmapconcat); DEFSUBR (Fload_average); DEFSUBR (Ffeaturep); @@ -3968,4 +3816,6 @@ Used by `featurep' and `require', and altered by `provide'. */ ); Vfeatures = Qnil; + + Fprovide (intern ("base64")); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/font-lock.c --- a/src/font-lock.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/font-lock.c Mon Aug 13 11:13:30 2007 +0200 @@ -414,8 +414,7 @@ find_context (struct buffer *buf, Bufpos pt) { /* This function can GC */ - struct Lisp_Char_Table *mirrortab = - XCHAR_TABLE (buf->mirror_syntax_table); + Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table); Lisp_Object syntaxtab = buf->syntax_table; Emchar prev_c, c; Bufpos target = pt; @@ -769,8 +768,14 @@ } void -vars_of_font_lock (void) +reinit_vars_of_font_lock (void) { xzero (context_cache); xzero (bol_context_cache); } + +void +vars_of_font_lock (void) +{ + reinit_vars_of_font_lock (); +} diff -r f4aeb21a5bad -r 74fd4e045ea6 src/frame-msw.c --- a/src/frame-msw.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/frame-msw.c Mon Aug 13 11:13:30 2007 +0200 @@ -70,12 +70,17 @@ /* Default properties to use when creating frames. */ Lisp_Object Vdefault_mswindows_frame_plist; +Lisp_Object Vdefault_msprinter_frame_plist; Lisp_Object Vmswindows_use_system_frame_size_defaults; /* This does not need to be GC protected, as it holds a frame Lisp_Object already protected by Fmake_frame */ Lisp_Object Vmswindows_frame_being_created; +/*---------------------------------------------------------------------*/ +/*----- DISPLAY FRAME -----*/ +/*---------------------------------------------------------------------*/ + static void mswindows_init_frame_1 (struct frame *f, Lisp_Object props) { @@ -182,8 +187,8 @@ XEMACS_CLASS, STRINGP(f->name) ? XSTRING_DATA(f->name) : (STRINGP(name) ? - (CONST Extbyte*)XSTRING_DATA(name) : - (CONST Extbyte*)XEMACS_CLASS), + (const Extbyte*)XSTRING_DATA(name) : + (const Extbyte*)XEMACS_CLASS), style, rect_default.left, rect_default.top, rect_default.width, rect_default.height, @@ -248,13 +253,13 @@ } static void -mswindows_mark_frame (struct frame *f, void (*markobj) (Lisp_Object)) +mswindows_mark_frame (struct frame *f) { - markobj (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); + mark_object (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); #ifdef HAVE_TOOLBARS - markobj (FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE (f)); + mark_object (FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE (f)); #endif - markobj (FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f)); + mark_object (FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f)); } static void @@ -308,7 +313,7 @@ static void mswindows_make_frame_visible (struct frame *f) { - if (f->iconified) + if (!FRAME_VISIBLE_P(f)) ShowWindow (FRAME_MSWINDOWS_HANDLE(f), SW_RESTORE); else ShowWindow (FRAME_MSWINDOWS_HANDLE(f), SW_SHOW); @@ -319,8 +324,11 @@ static void mswindows_make_frame_invisible (struct frame *f) { + if (!FRAME_VISIBLE_P(f)) + return; + ShowWindow (FRAME_MSWINDOWS_HANDLE(f), SW_HIDE); - f->visible = -1; + f->visible = 0; } static int @@ -591,7 +599,8 @@ bugs (and is more consistent with X) so I am going to reenable it. --andyp */ if ( FRAME_PIXWIDTH (f) && FRAME_PIXHEIGHT (f) - && (width_specified_p || height_specified_p || x_specified_p || y_specified_p)) + && (width_specified_p || height_specified_p + || x_specified_p || y_specified_p)) { XEMACS_RECT_WH dest = { x, y, width, height }; @@ -696,10 +705,362 @@ return IsZoomed (FRAME_MSWINDOWS_HANDLE (f)); } +/*---------------------------------------------------------------------*/ +/*----- PRINTER FRAME -----*/ +/*---------------------------------------------------------------------*/ + +void +msprinter_start_page (struct frame *f) +{ + if (!FRAME_MSPRINTER_PAGE_STARTED (f)) + { + FRAME_MSPRINTER_PAGE_STARTED (f) = 1; + StartPage (DEVICE_MSPRINTER_HDC (XDEVICE (FRAME_DEVICE (f)))); + } +} + +static void +error_frame_unsizable (struct frame *f) +{ + Lisp_Object frame; + XSETFRAME (frame, f); + signal_simple_error ("Cannot resize frame (margins)" + " after print job has started.", frame); +} + +static void +maybe_error_if_job_active (struct frame *f) +{ + if (FRAME_MSPRINTER_JOB_STARTED (f)) + error_frame_unsizable (f); +} + +static void +msprinter_init_frame_1 (struct frame *f, Lisp_Object props) +{ + /* Make sure this is the only frame on device. Windows printer can + handle only one job at a time. */ + if (!NILP (DEVICE_FRAME_LIST (XDEVICE (FRAME_DEVICE (f))))) + error ("Only one frame (print job) at a time is allowed on " + "this printer device."); + + f->frame_data = xnew_and_zero (struct msprinter_frame); + + /* Default margin size is 1" = 1440 twips */ + FRAME_MSPRINTER_TOP_MARGIN(f) = 1440; + FRAME_MSPRINTER_BOTTOM_MARGIN(f) = 1440; + FRAME_MSPRINTER_LEFT_MARGIN(f) = 1440; + FRAME_MSPRINTER_RIGHT_MARGIN(f) = 1440; + + /* Negative for "uinspecified" */ + FRAME_MSPRINTER_CHARWIDTH(f) = -1; + FRAME_MSPRINTER_CHARHEIGHT(f) = -1; + + /* nil is for "system default" for these properties. */ + FRAME_MSPRINTER_ORIENTATION(f) = Qnil; + FRAME_MSPRINTER_DUPLEX(f) = Qnil; +} + +static void +msprinter_init_frame_3 (struct frame *f) +{ + DOCINFO di; + struct device *device = XDEVICE (FRAME_DEVICE (f)); + HDC hdc = DEVICE_MSPRINTER_HDC (device); + int frame_left, frame_top, frame_width, frame_height; + + /* Change printer parameters */ + { + DEVMODE* devmode = msprinter_get_devmode_copy (device); + devmode->dmFields = 0; + + if (!NILP (FRAME_MSPRINTER_ORIENTATION(f))) + { + devmode->dmFields = DM_ORIENTATION; + if (EQ (FRAME_MSPRINTER_ORIENTATION(f), Qportrait)) + devmode->dmOrientation = DMORIENT_PORTRAIT; + else if (EQ (FRAME_MSPRINTER_ORIENTATION(f), Qlandscape)) + devmode->dmOrientation = DMORIENT_LANDSCAPE; + else + abort(); + } + + if (!NILP (FRAME_MSPRINTER_DUPLEX(f))) + { + devmode->dmFields = DM_DUPLEX; + if (EQ (FRAME_MSPRINTER_DUPLEX(f), Qnone)) + devmode->dmDuplex = DMDUP_SIMPLEX; + if (EQ (FRAME_MSPRINTER_DUPLEX(f), Qvertical)) + devmode->dmDuplex = DMDUP_VERTICAL; + if (EQ (FRAME_MSPRINTER_DUPLEX(f), Qhorizontal)) + devmode->dmDuplex = DMDUP_HORIZONTAL; + else + abort(); + } + + msprinter_apply_devmode (device, devmode); + } + + /* Compute geometry properties */ + frame_left = (MulDiv (GetDeviceCaps (hdc, LOGPIXELSX), + FRAME_MSPRINTER_LEFT_MARGIN(f), 1440) + - GetDeviceCaps (hdc, PHYSICALOFFSETX)); + + if (FRAME_MSPRINTER_CHARWIDTH(f) > 0) + { + char_to_real_pixel_size (f, FRAME_MSPRINTER_CHARWIDTH(f), 0, + &frame_width, NULL); + FRAME_MSPRINTER_RIGHT_MARGIN(f) = + MulDiv (GetDeviceCaps (hdc, PHYSICALWIDTH) + - (frame_left + frame_width), 1440, + GetDeviceCaps (hdc, LOGPIXELSX)); + } + else + frame_width = (GetDeviceCaps (hdc, PHYSICALWIDTH) + - frame_left + - MulDiv (GetDeviceCaps (hdc, LOGPIXELSX), + FRAME_MSPRINTER_RIGHT_MARGIN(f), 1440)); + + frame_top = (MulDiv (GetDeviceCaps (hdc, LOGPIXELSY), + FRAME_MSPRINTER_TOP_MARGIN(f), 1440) + - GetDeviceCaps (hdc, PHYSICALOFFSETY)); + + if (FRAME_MSPRINTER_CHARHEIGHT(f) > 0) + { + char_to_real_pixel_size (f, 0, FRAME_MSPRINTER_CHARHEIGHT(f), + NULL, &frame_height); + + FRAME_MSPRINTER_BOTTOM_MARGIN(f) = + MulDiv (GetDeviceCaps (hdc, PHYSICALHEIGHT) + - (frame_top + frame_height), 1440, + GetDeviceCaps (hdc, LOGPIXELSY)); + } + else + frame_height = (GetDeviceCaps (hdc, PHYSICALHEIGHT) + - frame_top + - MulDiv (GetDeviceCaps (hdc, LOGPIXELSY), + FRAME_MSPRINTER_BOTTOM_MARGIN(f), 1440)); + + /* Geometry sanity checks */ + if (!frame_pixsize_valid_p (f, frame_width, frame_height)) + error ("Area inside print margins has shrunk to naught."); + + if (frame_left < 0 + || frame_top < 0 + || frame_left + frame_width > GetDeviceCaps (hdc, HORZRES) + || frame_top + frame_height > GetDeviceCaps (hdc, VERTRES)) + error ("Print area is ouside of the printer's hardware printable area."); + + /* Apply XEmacs frame geometry and layout windows */ + { + int rows, columns; + FRAME_PIXWIDTH(f) = frame_width; + FRAME_PIXHEIGHT(f) = frame_height; + pixel_to_char_size (f, frame_width, frame_height, &columns, &rows); + change_frame_size (f, rows, columns, 0); + } + + /* Apply DC geometry */ + SetTextAlign (hdc, TA_BASELINE | TA_LEFT | TA_NOUPDATECP); + SetViewportOrgEx (hdc, frame_left, frame_top, NULL); + SetWindowOrgEx (hdc, 0, 0, NULL); + + /* Start print job */ + di.cbSize = sizeof (di); + di.lpszDocName = (STRINGP(f->name) + ? (char*) XSTRING_DATA(f->name) + : "XEmacs print document"); + di.lpszOutput = NULL; + di.lpszDatatype = NULL; + di.fwType = 0; + + if (StartDoc (hdc, &di) <= 0) + error ("Cannot start print job"); + + /* Finish frame setup */ + FRAME_MSPRINTER_CDC(f) = CreateCompatibleDC (hdc); + FRAME_MSPRINTER_JOB_STARTED (f) = 1; + FRAME_VISIBLE_P(f) = 0; +} + +static void +msprinter_mark_frame (struct frame *f) +{ + /* NOTE: These need not be marked as long as we allow only c-defined + symbols for their values. Although, marking these is safer than + expensive. [I know a proof to the theorem postulating that a + gator is longer than greener. Ask me. -- kkm] */ + mark_object (FRAME_MSPRINTER_ORIENTATION (f)); + mark_object (FRAME_MSPRINTER_DUPLEX (f)); +} + +static void +msprinter_delete_frame (struct frame *f) +{ + if (f->frame_data) + { + HDC hdc = DEVICE_MSPRINTER_HDC (XDEVICE (FRAME_DEVICE (f))); + if (FRAME_MSPRINTER_PAGE_STARTED (f)) + EndPage (hdc); + if (FRAME_MSPRINTER_JOB_STARTED (f)) + EndDoc (hdc); + if (FRAME_MSPRINTER_CDC(f)) + DeleteDC (FRAME_MSPRINTER_CDC(f)); + xfree (f->frame_data); + } + + f->frame_data = 0; +} + +static Lisp_Object +msprinter_frame_property (struct frame *f, Lisp_Object property) +{ + if (EQ (Qleft_margin, property)) + return make_int (FRAME_MSPRINTER_LEFT_MARGIN(f)); + else if (EQ (Qtop_margin, property)) + return make_int (FRAME_MSPRINTER_TOP_MARGIN(f)); + if (EQ (Qright_margin, property)) + return make_int (FRAME_MSPRINTER_RIGHT_MARGIN(f)); + else if (EQ (Qbottom_margin, property)) + return make_int (FRAME_MSPRINTER_BOTTOM_MARGIN(f)); + else if (EQ (Qorientation, property)) + return FRAME_MSPRINTER_ORIENTATION(f); + else if (EQ (Qduplex, property)) + return FRAME_MSPRINTER_DUPLEX(f); + else + return Qunbound; +} + +static int +msprinter_internal_frame_property_p (struct frame *f, Lisp_Object property) +{ + return (EQ (Qleft_margin, property) || EQ (Qtop_margin, property) || + EQ (Qright_margin, property) || EQ (Qbottom_margin, property) || + EQ (Qorientation, property) || EQ (Qduplex, property)); +} + +static Lisp_Object +msprinter_frame_properties (struct frame *f) +{ + Lisp_Object props = Qnil; + props = cons3 (Qorientation, FRAME_MSPRINTER_ORIENTATION(f), props); + props = cons3 (Qduplex, FRAME_MSPRINTER_DUPLEX(f), props); + props = cons3 (Qbottom_margin, + make_int (FRAME_MSPRINTER_BOTTOM_MARGIN(f)), props); + props = cons3 (Qright_margin, + make_int (FRAME_MSPRINTER_RIGHT_MARGIN(f)), props); + props = cons3 (Qtop_margin, + make_int (FRAME_MSPRINTER_TOP_MARGIN(f)), props); + props = cons3 (Qleft_margin, + make_int (FRAME_MSPRINTER_LEFT_MARGIN(f)), props); + return props; +} + +static void +msprinter_set_frame_properties (struct frame *f, Lisp_Object plist) +{ + Lisp_Object tail; + + /* Extract the properties from plist */ + for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail))) + { + Lisp_Object prop = Fcar (tail); + Lisp_Object val = Fcar (Fcdr (tail)); + + if (SYMBOLP (prop)) + { + if (EQ (prop, Qwidth)) + { + maybe_error_if_job_active (f); + if (!NILP (val)) + { + CHECK_NATNUM (val); + FRAME_MSPRINTER_CHARWIDTH(f) = XINT (val); + } + } + if (EQ (prop, Qheight)) + { + maybe_error_if_job_active (f); + if (!NILP (val)) + { + CHECK_NATNUM (val); + FRAME_MSPRINTER_CHARHEIGHT(f) = XINT (val); + } + } + else if (EQ (prop, Qleft_margin)) + { + maybe_error_if_job_active (f); + CHECK_NATNUM (val); + FRAME_MSPRINTER_LEFT_MARGIN(f) = XINT (val); + } + else if (EQ (prop, Qtop_margin)) + { + maybe_error_if_job_active (f); + CHECK_NATNUM (val); + FRAME_MSPRINTER_TOP_MARGIN(f) = XINT (val); + } + else if (EQ (prop, Qright_margin)) + { + maybe_error_if_job_active (f); + CHECK_NATNUM (val); + FRAME_MSPRINTER_RIGHT_MARGIN(f) = XINT (val); + } + else if (EQ (prop, Qbottom_margin)) + { + maybe_error_if_job_active (f); + CHECK_NATNUM (val); + FRAME_MSPRINTER_BOTTOM_MARGIN(f) = XINT (val); + } + else if (EQ (prop, Qorientation)) + { + maybe_error_if_job_active (f); + CHECK_SYMBOL (val); + if (!NILP(val) && + !EQ (val, Qportrait) && + !EQ (val, Qlandscape)) + signal_simple_error ("Page orientation can only be " + "'portrait or 'landscape", val); + FRAME_MSPRINTER_ORIENTATION(f) = val; + } + else if (EQ (prop, Qduplex)) + { + maybe_error_if_job_active (f); + CHECK_SYMBOL (val); + if (!NILP(val) && + !EQ (val, Qnone) && + !EQ (val, Qvertical) && + !EQ (val, Qhorizontal)) + signal_simple_error ("Duplex can only be 'none, " + "'vertical or 'horizontal", val); + FRAME_MSPRINTER_DUPLEX(f) = val; + } + } + } +} + +static void +msprinter_set_frame_size (struct frame *f, int width, int height) +{ + /* We're absolutely unsizeable */ + error_frame_unsizable (f); +} + +static void +msprinter_eject_page (struct frame *f) +{ + /* #### Should we eject empty pages? */ + if (FRAME_MSPRINTER_PAGE_STARTED (f)) + { + FRAME_MSPRINTER_PAGE_STARTED (f) = 0; + EndPage (DEVICE_MSPRINTER_HDC (XDEVICE (FRAME_DEVICE (f)))); + } +} + + void console_type_create_frame_mswindows (void) { - /* frame methods */ + /* Display frames */ CONSOLE_HAS_METHOD (mswindows, init_frame_1); CONSOLE_HAS_METHOD (mswindows, init_frame_2); CONSOLE_HAS_METHOD (mswindows, init_frame_3); @@ -730,6 +1091,18 @@ CONSOLE_HAS_METHOD (mswindows, get_frame_parent); CONSOLE_HAS_METHOD (mswindows, update_frame_external_traits); CONSOLE_HAS_METHOD (mswindows, frame_size_fixed_p); + + /* Printer frames, aka print jobs */ + CONSOLE_HAS_METHOD (msprinter, init_frame_1); + CONSOLE_HAS_METHOD (msprinter, init_frame_3); + CONSOLE_HAS_METHOD (msprinter, mark_frame); + CONSOLE_HAS_METHOD (msprinter, delete_frame); + CONSOLE_HAS_METHOD (msprinter, frame_property); + CONSOLE_HAS_METHOD (msprinter, internal_frame_property_p); + CONSOLE_HAS_METHOD (msprinter, frame_properties); + CONSOLE_HAS_METHOD (msprinter, set_frame_properties); + CONSOLE_HAS_METHOD (msprinter, set_frame_size); + CONSOLE_HAS_METHOD (msprinter, eject_page); } void @@ -738,10 +1111,16 @@ } void -vars_of_frame_mswindows (void) +reinit_vars_of_frame_mswindows (void) { /* Needn't staticpro -- see comment above. */ Vmswindows_frame_being_created = Qnil; +} + +void +vars_of_frame_mswindows (void) +{ + reinit_vars_of_frame_mswindows (); DEFVAR_LISP ("mswindows-use-system-frame-size-defaults", &Vmswindows_use_system_frame_size_defaults /* Controls whether to use system or XEmacs defaults for frame size. @@ -790,4 +1169,54 @@ mswindows_console_methods->device_specific_frame_props = &Vdefault_mswindows_frame_plist; + + DEFVAR_LISP ("default-msprinter-frame-plist", &Vdefault_msprinter_frame_plist /* +Plist of default frame-creation properties for msprinter print job frames. +These override what is specified in `default-frame-plist', but are +overridden by the arguments to the particular call to `make-frame'. + +Note: In many cases, properties of a frame are available as specifiers +instead of through the frame-properties mechanism. + +Here is a list of recognized frame properties, other than those +documented in `set-frame-properties' (they can be queried and +set at any time, except as otherwise noted): + + left-margin Margin of the page, in twips. Twip is a + top-margin typographical unit of measurement, + right-margin equal to 1/1440 of an inch, or 1/20 of a + bottom-margin point, and roughly equal to 7/400 of a + millimeter. If not specifified, each margin + defaults to one inch (25.4 mm). + + MARGINS NOTE. right-margin and bottom-margin are overridden by + the height and width properties. If you want to specify size + of the printable area in character, as with the rest of XEmacs, + use these properties. If height and/or width are nil, then + corresponding margin setting is taken into account. If you + specify height and/or width in `default-frame-plist', but still + want to specify right/bottom margins, set height/width in this + plist to nil, as in this example: + + (setq default-frame-plist '(height 55 'width 80) + default-msprinter-frame-plist '(height nil 'width nil)) + + + orientation Printer page orientation. Can be 'nil, + indicating system default, 'portrait + or 'landscape. + + duplex Duplex printing mode, subject to printer + support. Can be 'nil for the device default, + 'none for simplex printing, 'vertical or + 'horizontal for duplex page bound along + the corresponding page direction. + +See also `default-frame-plist', which specifies properties which apply +to all frames, not just mswindows frames. +*/ ); + Vdefault_msprinter_frame_plist = Qnil; + + msprinter_console_methods->device_specific_frame_props = + &Vdefault_msprinter_frame_plist; } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/frame-tty.c --- a/src/frame-tty.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/frame-tty.c Mon Aug 13 11:13:30 2007 +0200 @@ -33,10 +33,6 @@ #include "events.h" -#ifdef HAVE_GPM -#include <gpm.h> -#endif - /* Default properties to use when creating frames. */ Lisp_Object Vdefault_tty_frame_plist; @@ -86,33 +82,6 @@ call1 (Qinit_post_tty_win, FRAME_CONSOLE (f)); } -#ifdef HAVE_GPM -static int -tty_get_mouse_position (struct device *d, Lisp_Object *frame, int *x, int *y) -{ - Gpm_Event ev; - int num_buttons; - - num_buttons = Gpm_GetSnapshot(&ev); - *x = ev.x; - *y = ev.y; - *frame = DEVICE_SELECTED_FRAME (d); - return (1); -} - -static void -tty_set_mouse_position (struct window *w, int x, int y) -{ - /* XXX - I couldn't find any GPM functions that set the mouse position. - Mr. Perry had left this function empty; that must be why. - karlheg - */ -} - -#endif - - /* Change from withdrawn state to mapped state. */ static void tty_make_frame_visible (struct frame *f) @@ -223,10 +192,6 @@ CONSOLE_HAS_METHOD (tty, init_frame_1); CONSOLE_HAS_METHOD (tty, init_frame_3); CONSOLE_HAS_METHOD (tty, after_init_frame); -#ifdef HAVE_GPM - CONSOLE_HAS_METHOD (tty, get_mouse_position); - CONSOLE_HAS_METHOD (tty, set_mouse_position); -#endif CONSOLE_HAS_METHOD (tty, make_frame_visible); CONSOLE_HAS_METHOD (tty, make_frame_invisible); CONSOLE_HAS_METHOD (tty, frame_visible_p); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/frame-x.c --- a/src/frame-x.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/frame-x.c Mon Aug 13 11:13:30 2007 +0200 @@ -103,19 +103,34 @@ struct frame * x_any_window_to_frame (struct device *d, Window wdesc) { + Widget w; + assert (DEVICE_X_P (d)); + + w = XtWindowToWidget (DEVICE_X_DISPLAY (d), wdesc); + + if (!w) + return 0; + + /* We used to map over all frames here and then map over all widgets + belonging to that frame. However it turns out that this was very fragile + as it requires our display stuctures to be in sync _and_ that the + loop is told about every new widget somebody adds. Therefore we + now let Xt find it for us (which does a bottom-up search which + could even be faster) */ + return x_any_widget_or_parent_to_frame (d, w); +} + +static struct frame * +x_find_frame_for_window (struct device *d, Window wdesc) +{ Lisp_Object tail, frame; struct frame *f; - - assert (DEVICE_X_P (d)); - /* This function was previously written to accept only a window argument (and to loop over all devices looking for a matching window), but that is incorrect because window ID's are not unique across displays. */ for (tail = DEVICE_FRAME_LIST (d); CONSP (tail); tail = XCDR (tail)) { - int i; - frame = XCAR (tail); f = XFRAME (frame); /* This frame matches if the window is any of its widgets. */ @@ -138,18 +153,18 @@ would incorrectly get sucked away by Emacs if this function matched on psheet widgets. */ - for (i = 0; i < FRAME_X_NUM_TOP_WIDGETS (f); i++) - { - Widget wid = FRAME_X_TOP_WIDGETS (f)[i]; - if (wid && XtIsManaged (wid) && wdesc == XtWindow (wid)) - return f; - } - -#ifdef HAVE_SCROLLBARS - /* Match if the window is one of this frame's scrollbars. */ - if (x_window_is_scrollbar (f, wdesc)) - return f; -#endif + /* Note: that this called only from + x_any_widget_or_parent_to_frame it is unnecessary to iterate + over the top level widgets. */ + + /* Note: we use to special case scrollbars but this turns out to be a bad idea + because + 1. We sometimes get events for _unmapped_ scrollbars and our + callers don't want us to fail. + 2. Starting with the 21.2 widget stuff there are now loads of + widgets to check and it is easy to forget adding them in a loop here. + See x_any_window_to_frame + 3. We pick up all widgets now anyway. */ } return 0; @@ -160,7 +175,7 @@ { while (widget) { - struct frame *f = x_any_window_to_frame (d, XtWindow (widget)); + struct frame *f = x_find_frame_for_window (d, XtWindow (widget)); if (f) return f; widget = XtParent (widget); @@ -328,7 +343,7 @@ XSetClassHint (dpy, XtWindow (shell), &classhint); } -#ifndef HAVE_SESSION +#ifndef HAVE_WMCOMMAND static void x_wm_maybe_store_wm_command (struct frame *f) { @@ -379,7 +394,7 @@ } } -#endif /* !HAVE_SESSION */ +#endif /* !HAVE_WMCOMMAND */ static int x_frame_iconified_p (struct frame *f) @@ -421,9 +436,9 @@ init_x_prop_symbols (void) { #define def(sym, rsrc) \ - pure_put (sym, Qx_resource_name, build_string (rsrc)) + Fput (sym, Qx_resource_name, build_string (rsrc)) #define defi(sym,rsrc) \ - def (sym, rsrc); pure_put (sym, Qintegerp, Qt) + def (sym, rsrc); Fput (sym, Qintegerp, Qt) #if 0 /* this interferes with things. #### fix this right */ def (Qminibuffer, XtNminibuffer); @@ -644,15 +659,17 @@ for (ptr = value; *ptr; ptr++) if (!BYTE_ASCII_P (*ptr)) { - CONST char * tmp; + const char * tmp; encoding = DEVICE_XATOM_COMPOUND_TEXT (XDEVICE (FRAME_DEVICE (f))); - GET_C_CHARPTR_EXT_CTEXT_DATA_ALLOCA ((CONST char *) value, tmp); + TO_EXTERNAL_FORMAT (C_STRING, value, + C_STRING_ALLOCA, tmp, + Qctext); new_XtValue = (String) tmp; break; } #endif /* MULE */ - /* ### Caching is device-independent - belongs in update_frame_title. */ + /* #### Caching is device-independent - belongs in update_frame_title. */ Xt_GET_VALUE (FRAME_X_SHELL_WIDGET (f), Xt_resource_name, &old_XtValue); if (!old_XtValue || strcmp (new_XtValue, old_XtValue)) { @@ -743,18 +760,22 @@ if (STRINGP (prop)) { - CONST char *extprop; + const char *extprop; if (XSTRING_LENGTH (prop) == 0) continue; - GET_C_STRING_CTEXT_DATA_ALLOCA (prop, extprop); + TO_EXTERNAL_FORMAT (LISP_STRING, prop, + C_STRING_ALLOCA, extprop, + Qctext); if (STRINGP (val)) { - CONST Extbyte *extval; + const Extbyte *extval; Extcount extvallen; - GET_STRING_CTEXT_DATA_ALLOCA (val, extval, extvallen); + TO_EXTERNAL_FORMAT (LISP_STRING, val, + ALLOCA, (extval, extvallen), + Qctext); XtVaSetValues (w, XtVaTypedArg, extprop, XtRString, extval, extvallen + 1, (XtArgVal) NULL); @@ -1088,7 +1109,7 @@ unsigned int modifier = 0, state = 0; char *Ctext; int numItems = 0, textlen = 0, pos = 0; - struct Lisp_Event *lisp_event = XEVENT(event); + Lisp_Event *lisp_event = XEVENT (event); Lisp_Object item = Qnil; struct gcpro gcpro1; @@ -1170,7 +1191,7 @@ Ctext=NULL; break; } - strcpy (Ctext+pos, (CONST char *)XSTRING_DATA (XCAR (item))); + strcpy (Ctext+pos, (const char *)XSTRING_DATA (XCAR (item))); pos += XSTRING_LENGTH (XCAR (item)) + 1; item = XCDR (item); } @@ -1240,7 +1261,7 @@ { filePath = transferInfo->dropData->data.files[ii]; hurl = dnd_url_hexify_string ((char *)filePath, "file:"); - /* ### Mule-izing required */ + /* #### Mule-izing required */ l_data = Fcons (make_string ((Bufbyte* )hurl, strlen (hurl)), l_data); @@ -1315,7 +1336,7 @@ char *dnd_data = NULL; unsigned long dnd_len = 0; int dnd_typ = DndText, dnd_dealloc = 0; - struct Lisp_Event *lisp_event = XEVENT(event); + Lisp_Event *lisp_event = XEVENT (event); /* only drag if this is really a press */ if (EVENT_TYPE(lisp_event) != button_press_event) @@ -1346,7 +1367,7 @@ } len = XSTRING_LENGTH (XCAR (run)) + 1; dnd_data = (char *) xrealloc (dnd_data, dnd_len + len); - strcpy (dnd_data + dnd_len - 1, (CONST char *)XSTRING_DATA (XCAR (run))); + strcpy (dnd_data + dnd_len - 1, (const char *)XSTRING_DATA (XCAR (run))); dnd_len += len; run = XCDR (run); } @@ -1840,7 +1861,7 @@ #ifdef EXTERNAL_WIDGET Window window_id = 0; #endif - CONST char *name; + const char *name; Arg al [25]; int ac = 0; Widget text, container, shell; @@ -1851,7 +1872,9 @@ #endif if (STRINGP (f->name)) - GET_C_STRING_CTEXT_DATA_ALLOCA (f->name, name); + TO_EXTERNAL_FORMAT (LISP_STRING, f->name, + C_STRING_ALLOCA, name, + Qctext); else name = "emacs"; @@ -1880,7 +1903,7 @@ char *string; CHECK_STRING (lisp_window_id); - string = (char *) (XSTRING_DATA (lisp_window_id)); + string = (char *) XSTRING_DATA (lisp_window_id); if (string[0] == '0' && (string[1] == 'x' || string[1] == 'X')) sscanf (string+2, "%lxu", &window_id); #if 0 @@ -2059,9 +2082,9 @@ /* tell the window manager about us. */ x_wm_store_class_hints (shell_widget, XtName (frame_widget)); -#ifndef HAVE_SESSION +#ifndef HAVE_WMCOMMAND x_wm_maybe_store_wm_command (f); -#endif /* HAVE_SESSION */ +#endif /* HAVE_WMCOMMAND */ x_wm_hack_wm_protocols (shell_widget); } @@ -2190,10 +2213,10 @@ } static void -x_mark_frame (struct frame *f, void (*markobj) (Lisp_Object)) +x_mark_frame (struct frame *f) { - markobj (FRAME_X_ICON_PIXMAP (f)); - markobj (FRAME_X_ICON_PIXMAP_MASK (f)); + mark_object (FRAME_X_ICON_PIXMAP (f)); + mark_object (FRAME_X_ICON_PIXMAP_MASK (f)); } static void @@ -2625,10 +2648,10 @@ { Display *dpy; -#ifndef HAVE_SESSION +#ifndef HAVE_WMCOMMAND if (FRAME_X_TOP_LEVEL_FRAME_P (f)) x_wm_maybe_move_wm_command (f); -#endif /* HAVE_SESSION */ +#endif /* HAVE_WMCOMMAND */ #ifdef HAVE_CDE DtDndDropUnregister (FRAME_X_TEXT_WIDGET (f)); @@ -2649,7 +2672,7 @@ #else XtDestroyWidget (FRAME_X_SHELL_WIDGET (f)); /* make sure the windows are really gone! */ - /* ### Is this REALLY necessary? */ + /* #### Is this REALLY necessary? */ XFlush (dpy); #endif /* EXTERNAL_WIDGET */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/frame.c --- a/src/frame.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/frame.c Mon Aug 13 11:13:30 2007 +0200 @@ -34,6 +34,7 @@ #include "faces.h" #include "frame.h" #include "glyphs.h" +#include "gutter.h" #include "menubar.h" #include "redisplay.h" #include "scrollbar.h" @@ -85,7 +86,6 @@ Lisp_Object Qborder_width; Lisp_Object Qframep, Qframe_live_p; -Lisp_Object Qframe_x_p, Qframe_tty_p; Lisp_Object Qdelete_frame; Lisp_Object Qframe_title_format, Vframe_title_format; @@ -116,22 +116,24 @@ Lisp_Object Qframe_being_created; static void store_minibuf_frame_prop (struct frame *f, Lisp_Object val); - -EXFUN (Fset_frame_properties, 2); +static struct display_line title_string_display_line; +/* Used by generate_title_string. Global because they get used so much that + the dynamic allocation time adds up. */ +static Emchar_dynarr *title_string_emchar_dynarr; static Lisp_Object -mark_frame (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_frame (Lisp_Object obj) { struct frame *f = XFRAME (obj); -#define MARKED_SLOT(x) ((void) (markobj (f->x))); +#define MARKED_SLOT(x) mark_object (f->x) #include "frameslots.h" - mark_subwindow_cachels (f->subwindow_cachels, markobj); + mark_subwindow_cachels (f->subwindow_cachels); if (FRAME_LIVE_P (f)) /* device is nil for a dead frame */ - MAYBE_FRAMEMETH (f, mark_frame, (f, markobj)); + MAYBE_FRAMEMETH (f, mark_frame, (f)); return Qnil; } @@ -155,13 +157,13 @@ } DEFINE_LRECORD_IMPLEMENTATION ("frame", frame, - mark_frame, print_frame, 0, 0, 0, + mark_frame, print_frame, 0, 0, 0, 0, struct frame); static void nuke_all_frame_slots (struct frame *f) { -#define MARKED_SLOT(x) f->x = Qnil; +#define MARKED_SLOT(x) f->x = Qnil #include "frameslots.h" } @@ -175,7 +177,7 @@ /* This function can GC */ Lisp_Object frame; Lisp_Object root_window; - struct frame *f = alloc_lcrecord_type (struct frame, lrecord_frame); + struct frame *f = alloc_lcrecord_type (struct frame, &lrecord_frame); zero_lcrecord (f); nuke_all_frame_slots (f); @@ -208,6 +210,12 @@ /* cache of subwindows visible on frame */ f->subwindow_cachels = Dynarr_new (subwindow_cachel); + /* associated exposure ignore list */ + f->subwindow_exposures = 0; + f->subwindow_exposures_tail = 0; + + FRAME_SET_PAGENUMBER (f, 1); + /* Choose a buffer for the frame's root window. */ XWINDOW (root_window)->buffer = Qt; { @@ -218,7 +226,7 @@ a space), try to find another one. */ if (string_char (XSTRING (Fbuffer_name (buf)), 0) == ' ') buf = Fother_buffer (buf, Qnil, Qnil); - Fset_window_buffer (root_window, buf); + Fset_window_buffer (root_window, buf, Qnil); } return f; @@ -241,7 +249,7 @@ f->has_minibuffer = 1; XWINDOW (mini_window)->buffer = Qt; - Fset_window_buffer (mini_window, Vminibuffer_zero); + Fset_window_buffer (mini_window, Vminibuffer_zero, Qt); } /* Make a frame using a separate minibuffer window on another frame. @@ -278,7 +286,7 @@ /* Install the chosen minibuffer window, with proper buffer. */ store_minibuf_frame_prop (f, mini_window); - Fset_window_buffer (mini_window, Vminibuffer_zero); + Fset_window_buffer (mini_window, Vminibuffer_zero, Qt); } /* Make a frame containing only a minibuffer window. */ @@ -308,7 +316,7 @@ /* Put the proper buffer in that window. */ - Fset_window_buffer (mini_window, Vminibuffer_zero); + Fset_window_buffer (mini_window, Vminibuffer_zero, Qt); } static Lisp_Object @@ -372,7 +380,7 @@ else name = build_string ("emacs"); - if (!NILP (Fstring_match (make_string ((CONST Bufbyte *) "\\.", 2), name, + if (!NILP (Fstring_match (make_string ((const Bufbyte *) "\\.", 2), name, Qnil, Qnil))) signal_simple_error (". not allowed in frame names", name); @@ -409,7 +417,7 @@ update_frame_window_mirror (f); - if (initialized) + if (initialized && !DEVICE_STREAM_P (d)) { if (!NILP (f->minibuffer_window)) reset_face_cachels (XWINDOW (f->minibuffer_window)); @@ -460,12 +468,18 @@ reset_glyph_cachels (XWINDOW (FRAME_SELECTED_WINDOW (f))); reset_subwindow_cachels (f); change_frame_size (f, f->height, f->width, 0); + } MAYBE_FRAMEMETH (f, init_frame_2, (f, props)); Fset_frame_properties (frame, props); MAYBE_FRAMEMETH (f, init_frame_3, (f)); + /* now initialise the gutters, this won't change the frame size + so is ok here. */ + if (!DEVICE_STREAM_P (d)) + init_frame_gutters (f); + /* Hallelujah, praise the lord. */ f->init_finished = 1; @@ -893,7 +907,10 @@ { #ifdef HAVE_TOOLBARS if (!EQ (f->last_nonminibuf_window, window)) - MARK_TOOLBAR_CHANGED; + { + MARK_TOOLBAR_CHANGED; + MARK_GUTTER_CHANGED; + } #endif f->last_nonminibuf_window = window; } @@ -1305,7 +1322,9 @@ console = DEVICE_CONSOLE (d); con = XCONSOLE (console); - if (!called_from_delete_device) + if (!called_from_delete_device && + !(MAYBE_INT_DEVMETH (d, device_implementation_flags, ()) + & XDEVIMPF_FRAMELESS_OK)) { /* If we're deleting the only non-minibuffer frame on the device, delete the device. */ @@ -1491,7 +1510,7 @@ next_frame_internal (frame, Qt, device, called_from_delete_device); if (NILP (next_f) || EQ (next_f, frame)) - ; + set_device_selected_frame (d, Qnil); else set_device_selected_frame (d, next_f); } @@ -1506,7 +1525,7 @@ { struct frame *sel_frame = selected_frame (); Fset_window_buffer (sel_frame->minibuffer_window, - XWINDOW (minibuf_window)->buffer); + XWINDOW (minibuf_window)->buffer, Qt); minibuf_window = sel_frame->minibuffer_window; /* If the dying minibuffer window was selected, @@ -1526,6 +1545,7 @@ #ifdef HAVE_TOOLBARS free_frame_toolbars (f); #endif + free_frame_gutters (f); /* This must be done before the window and window_mirror structures are freed. The scrollbar information is attached to them. */ @@ -1838,7 +1858,7 @@ struct window *w; int pix_x, pix_y; - CHECK_WINDOW (window); + CHECK_LIVE_WINDOW (window); CHECK_INT (x); CHECK_INT (y); @@ -1862,7 +1882,7 @@ { struct window *w; - CHECK_WINDOW (window); + CHECK_LIVE_WINDOW (window); CHECK_INT (x); CHECK_INT (y); @@ -1911,7 +1931,7 @@ if (EQ (f->minibuffer_window, minibuf_window)) { Fset_window_buffer (sel_frame->minibuffer_window, - XWINDOW (minibuf_window)->buffer); + XWINDOW (minibuf_window)->buffer, Qt); minibuf_window = sel_frame->minibuffer_window; } @@ -1937,7 +1957,7 @@ if (EQ (f->minibuffer_window, minibuf_window)) { Fset_window_buffer (sel_frame->minibuffer_window, - XWINDOW (minibuf_window)->buffer); + XWINDOW (minibuf_window)->buffer, Qt); minibuf_window = sel_frame->minibuffer_window; } @@ -2069,6 +2089,31 @@ /* Ben thinks there is no need for `redirect-frame-focus' or `frame-focus', crockish FSFmacs functions. See summary on focus in event-stream.c. */ + +DEFUN ("print-job-page-number", Fprint_job_page_number, 1, 1, 0, /* +Return current page number for the print job FRAME. +*/ + (frame)) +{ + CHECK_PRINTER_FRAME (frame); + return make_int (FRAME_PAGENUMBER (XFRAME (frame))); +} + +DEFUN ("print-job-eject-page", Fprint_job_eject_page, 1, 1, 0, /* +Eject page in the print job FRAME. +*/ + (frame)) +{ + struct frame *f; + + CHECK_PRINTER_FRAME (frame); + f = XFRAME (frame); + FRAMEMETH (f, eject_page, (f)); + FRAME_SET_PAGENUMBER (f, 1 + FRAME_PAGENUMBER (f)); + f->clear = 1; + + return Qnil; +} /***************************************************************************/ @@ -2124,7 +2169,7 @@ Lisp_Object *face_prop_out) { Lisp_Object list = Vbuilt_in_face_specifiers; - struct Lisp_String *s; + Lisp_String *s; if (!SYMBOLP (sym)) return 0; @@ -2134,7 +2179,7 @@ while (!NILP (list)) { Lisp_Object prop = Fcar (list); - struct Lisp_String *prop_name; + Lisp_String *prop_name; if (!SYMBOLP (prop)) continue; @@ -2660,8 +2705,8 @@ window = FRAME_SELECTED_WINDOW (f); - egw = max (glyph_width (Vcontinuation_glyph, Vdefault_face, 0, window), - glyph_width (Vtruncation_glyph, Vdefault_face, 0, window)); + egw = max (glyph_width (Vcontinuation_glyph, window), + glyph_width (Vtruncation_glyph, window)); egw = max (egw, cpw); bdr = 2 * f->internal_border_width; obw = FRAME_SCROLLBAR_WIDTH (f) + FRAME_THEORETICAL_LEFT_TOOLBAR_WIDTH (f) + @@ -2836,9 +2881,9 @@ { int adjustment, trunc_width, cont_width; - trunc_width = glyph_width (Vtruncation_glyph, Vdefault_face, 0, + trunc_width = glyph_width (Vtruncation_glyph, FRAME_SELECTED_WINDOW (f)); - cont_width = glyph_width (Vcontinuation_glyph, Vdefault_face, 0, + cont_width = glyph_width (Vcontinuation_glyph, FRAME_SELECTED_WINDOW (f)); adjustment = max (trunc_width, cont_width); adjustment = max (adjustment, font_width); @@ -2953,6 +2998,37 @@ } +/* The caller is responsible for freeing the returned string. */ +static Bufbyte * +generate_title_string (struct window *w, Lisp_Object format_str, + face_index findex, int type) +{ + struct display_line *dl; + struct display_block *db; + int elt = 0; + + dl = &title_string_display_line; + db = get_display_block_from_line (dl, TEXT); + Dynarr_reset (db->runes); + + generate_formatted_string_db (format_str, Qnil, w, dl, db, findex, 0, + -1, type); + + Dynarr_reset (title_string_emchar_dynarr); + while (elt < Dynarr_length (db->runes)) + { + if (Dynarr_atp (db->runes, elt)->type == RUNE_CHAR) + Dynarr_add (title_string_emchar_dynarr, + Dynarr_atp (db->runes, elt)->object.chr.ch); + elt++; + } + + return + convert_emchar_string_into_malloced_string + (Dynarr_atp (title_string_emchar_dynarr, 0), + Dynarr_length (title_string_emchar_dynarr), 0); +} + void update_frame_title (struct frame *f) { @@ -2976,8 +3052,8 @@ if (HAS_FRAMEMETH_P (f, set_title_from_bufbyte)) { - title = generate_formatted_string (w, title_format, Qnil, - DEFAULT_INDEX, CURRENT_DISP); + title = generate_title_string (w, title_format, + DEFAULT_INDEX, CURRENT_DISP); FRAMEMETH (f, set_title_from_bufbyte, (f, title)); } @@ -2988,8 +3064,8 @@ if (title) xfree (title); - title = generate_formatted_string (w, icon_format, Qnil, - DEFAULT_INDEX, CURRENT_DISP); + title = generate_title_string (w, icon_format, + DEFAULT_INDEX, CURRENT_DISP); } FRAMEMETH (f, set_icon_name_from_bufbyte, (f, title)); } @@ -3048,6 +3124,24 @@ } +/***************************************************************************/ +/* */ +/* initialization */ +/* */ +/***************************************************************************/ + +void +init_frame (void) +{ +#ifndef PDUMP + if (!initialized) +#endif + { + title_string_emchar_dynarr = Dynarr_new (Emchar); + xzero (title_string_display_line); + } +} + void syms_of_frame (void) { @@ -3063,8 +3157,6 @@ defsymbol (&Qframep, "framep"); defsymbol (&Qframe_live_p, "frame-live-p"); - defsymbol (&Qframe_x_p, "frame-x-p"); - defsymbol (&Qframe_tty_p, "frame-tty-p"); defsymbol (&Qdelete_frame, "delete-frame"); defsymbol (&Qsynchronize_minibuffers, "synchronize-minibuffers"); defsymbol (&Qbuffer_predicate, "buffer-predicate"); @@ -3163,6 +3255,8 @@ DEFSUBR (Fset_frame_size); DEFSUBR (Fset_frame_position); DEFSUBR (Fset_frame_pointer); + DEFSUBR (Fprint_job_page_number); + DEFSUBR (Fprint_job_eject_page); } void @@ -3280,13 +3374,13 @@ This is the same format as `modeline-format' with the exception that %- is ignored. */ ); - Vframe_title_format = Fpurecopy (build_string ("%S: %b")); + Vframe_title_format = build_string ("%S: %b"); DEFVAR_LISP ("frame-icon-title-format", &Vframe_icon_title_format /* Controls the title of the icon corresponding to the selected frame. See also the variable `frame-title-format'. */ ); - Vframe_icon_title_format = Fpurecopy (build_string ("%b")); + Vframe_icon_title_format = build_string ("%b"); DEFVAR_LISP ("default-frame-name", &Vdefault_frame_name /* The default name to assign to newly-created frames. @@ -3294,9 +3388,9 @@ This must be a string. */ ); #ifndef INFODOCK - Vdefault_frame_name = Fpurecopy (build_string ("emacs")); + Vdefault_frame_name = build_string ("emacs"); #else - Vdefault_frame_name = Fpurecopy (build_string ("InfoDock")); + Vdefault_frame_name = build_string ("InfoDock"); #endif DEFVAR_LISP ("default-frame-plist", &Vdefault_frame_plist /* diff -r f4aeb21a5bad -r 74fd4e045ea6 src/frame.h --- a/src/frame.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/frame.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,8 +20,8 @@ /* Synched up with: FSF 19.30. */ -#ifndef _XEMACS_FRAME_H_ -#define _XEMACS_FRAME_H_ +#ifndef INCLUDED_frame_h_ +#define INCLUDED_frame_h_ #ifdef HAVE_SCROLLBARS #include "scrollbar.h" @@ -33,6 +33,7 @@ #include "device.h" #include "glyphs.h" +#include "redisplay.h" #define FRAME_TYPE_NAME(f) ((f)->framemeths->name) #define FRAME_TYPE(f) ((f)->framemeths->symbol) @@ -77,6 +78,9 @@ int order_count; #endif + /* Current page number for a printer frame. */ + int page_number; + /* Width of the internal border. This is a line of background color just inside the window's border. It is normally only non-zero on X frames, but we put it here to avoid introducing window system @@ -93,6 +97,9 @@ /* subwindow cache elements for this frame */ subwindow_cachel_dynarr *subwindow_cachels; + struct expose_ignore* subwindow_exposures; + struct expose_ignore* subwindow_exposures_tail; + #ifdef HAVE_SCROLLBARS /* frame-local scrollbar information. See scrollbar.c. */ int scrollbar_y_offset; @@ -109,6 +116,10 @@ unsigned int current_toolbar_size[4]; #endif + /* Dynamic array of display lines for gutters */ + display_line_dynarr *current_display_lines; + display_line_dynarr *desired_display_lines; + /* A structure of auxiliary data specific to the device type. struct x_frame is used for X window frames; defined in console-x.h */ void *frame_data; @@ -160,6 +171,11 @@ unsigned int bottom_toolbar_was_visible :1; unsigned int left_toolbar_was_visible :1; unsigned int right_toolbar_was_visible :1; + /* gutter visibility */ + unsigned int top_gutter_was_visible :1; + unsigned int bottom_gutter_was_visible :1; + unsigned int left_gutter_was_visible :1; + unsigned int right_gutter_was_visible :1; /* redisplay flags */ unsigned int buffers_changed :1; @@ -168,6 +184,7 @@ unsigned int faces_changed :1; unsigned int frame_changed :1; unsigned int subwindows_changed :1; + unsigned int subwindows_state_changed :1; unsigned int glyphs_changed :1; unsigned int icon_changed :1; unsigned int menubar_changed :1; @@ -175,6 +192,7 @@ unsigned int point_changed :1; unsigned int size_changed :1; unsigned int toolbar_changed :1; + unsigned int gutter_changed :1; unsigned int windows_changed :1; unsigned int windows_structure_changed :1; unsigned int window_face_cache_reset :1; /* used by expose handler */ @@ -198,6 +216,7 @@ EXFUN (Fselect_frame, 1); EXFUN (Fset_frame_pointer, 2); EXFUN (Fset_frame_position, 3); +EXFUN (Fset_frame_properties, 2); EXFUN (Fset_frame_size, 4); extern Lisp_Object Qbackground_toolbar_color, Qbell_volume, Qborder_color; @@ -222,7 +241,6 @@ #define XFRAME(x) XRECORD (x, frame, struct frame) #define XSETFRAME(x, p) XSETRECORD (x, p, frame) #define FRAMEP(x) RECORDP (x, frame) -#define GC_FRAMEP(x) GC_RECORDP (x, frame) #define CHECK_FRAME(x) CHECK_RECORD (x, frame) #define CONCHECK_FRAME(x) CONCHECK_RECORD (x, frame) @@ -249,7 +267,7 @@ return f; } # define FRAME_TYPE_DATA(f, type) \ - ((struct type##_frame *) (error_check_frame_type (f, Q##type))->frame_data) + ((struct type##_frame *) error_check_frame_type (f, Q##type)->frame_data) #else # define FRAME_TYPE_DATA(f, type) \ ((struct type##_frame *) (f)->frame_data) @@ -270,6 +288,40 @@ (type##_console_methods->predicate_symbol, x); \ } while (0) +#define FRAME_DISPLAY_P(frm) \ + (DEVICE_DISPLAY_P (XDEVICE (FRAME_DEVICE (frm)))) + +#define CHECK_DISPLAY_FRAME(frm) \ + do { \ + CHECK_FRAME (frm); \ + CHECK_LIVE_FRAME (frm); \ + CHECK_DISPLAY_DEVICE (FRAME_DEVICE (XFRAME (frm))); \ + } while (0) + +#define CONCHECK_DISPLAY_FRAME(frm) \ + do { \ + CONCHECK_FRAME (frm); \ + CONCHECK_LIVE_FRAME (frm); \ + CONCHECK_DISPLAY_DEVICE (FRAME_DEVICE (XFRAME (frm))); \ + } while (0) + +#define FRAME_PRINTER_P(frm) \ + (DEVICE_PRINTER_P (XDEVICE (FRAME_DEVICE (frm)))) + +#define CHECK_PRINTER_FRAME(frm) \ + do { \ + CHECK_FRAME (frm); \ + CHECK_LIVE_FRAME (frm); \ + CHECK_PRINTER_DEVICE (FRAME_DEVICE (XFRAME (frm))); \ + } while (0) + +#define CONCHECK_PRINTER_FRAME(frm) \ + do { \ + CONCHECK_FRAME (frm); \ + CONCHECK_LIVE_FRAME (frm); \ + CONCHECK_PRINTER_DEVICE (FRAME_DEVICE (XFRAME (frm))); \ + } while (0) + /* #### These should be in the frame-*.h files but there are too many places where the abstraction is broken. Need to fix. */ @@ -318,7 +370,7 @@ #define MARK_FRAME_SUBWINDOWS_CHANGED(f) do { \ struct frame *mfgc_f = (f); \ - mfgc_f->subwindows_changed = 1; \ + mfgc_f->subwindows_changed = 1; \ mfgc_f->modiff++; \ if (!NILP (mfgc_f->device)) \ { \ @@ -326,7 +378,20 @@ MARK_DEVICE_SUBWINDOWS_CHANGED (mfgc_d); \ } \ else \ - subwindows_changed = 1; \ + subwindows_changed = 1; \ +} while (0) + +#define MARK_FRAME_SUBWINDOWS_STATE_CHANGED(f) do { \ + struct frame *mfgc_f = (f); \ + mfgc_f->subwindows_state_changed = 1; \ + mfgc_f->modiff++; \ + if (!NILP (mfgc_f->device)) \ + { \ + struct device *mfgc_d = XDEVICE (mfgc_f->device); \ + MARK_DEVICE_SUBWINDOWS_STATE_CHANGED (mfgc_d); \ + } \ + else \ + subwindows_state_changed = 1; \ } while (0) #define MARK_FRAME_TOOLBARS_CHANGED(f) do { \ @@ -342,6 +407,19 @@ toolbar_changed = 1; \ } while (0) +#define MARK_FRAME_GUTTERS_CHANGED(f) do { \ + struct frame *mftc_f = (f); \ + mftc_f->gutter_changed = 1; \ + mftc_f->modiff++; \ + if (!NILP (mftc_f->device)) \ + { \ + struct device *mftc_d = XDEVICE (mftc_f->device); \ + MARK_DEVICE_GUTTERS_CHANGED (mftc_d); \ + } \ + else \ + gutter_changed = 1; \ +} while (0) + #define MARK_FRAME_SIZE_CHANGED(f) do { \ struct frame *mfsc_f = (f); \ mfsc_f->size_changed = 1; \ @@ -421,13 +499,15 @@ #define FRAME_MINIBUF_ONLY_P(f) \ EQ (FRAME_ROOT_WINDOW (f), FRAME_MINIBUF_WINDOW (f)) -#define FRAME_HAS_MINIBUF_P(f) ((f)->has_minibuffer) -#define FRAME_HEIGHT(f) ((f)->height) -#define FRAME_WIDTH(f) ((f)->width) -#define FRAME_CHARHEIGHT(f) ((f)->char_height) -#define FRAME_CHARWIDTH(f) ((f)->char_width) -#define FRAME_PIXHEIGHT(f) ((f)->pixheight) -#define FRAME_PIXWIDTH(f) ((f)->pixwidth) +#define FRAME_HAS_MINIBUF_P(f) ((f)->has_minibuffer) +#define FRAME_HEIGHT(f) ((f)->height) +#define FRAME_WIDTH(f) ((f)->width) +#define FRAME_CHARHEIGHT(f) ((f)->char_height) +#define FRAME_CHARWIDTH(f) ((f)->char_width) +#define FRAME_PIXHEIGHT(f) ((f)->pixheight) +#define FRAME_PIXWIDTH(f) ((f)->pixwidth) +#define FRAME_PAGENUMBER(f) ((f)->page_number + 0) +#define FRAME_SET_PAGENUMBER(f,x) (f)->page_number = (x); #ifdef HAVE_SCROLLBARS #define FRAME_SCROLLBAR_WIDTH(f) \ (NILP ((f)->vertical_scrollbar_visible_p) ? \ @@ -442,8 +522,8 @@ #define FW_FRAME(obj) \ (WINDOWP (obj) ? WINDOW_FRAME (XWINDOW (obj)) \ - : (FRAMEP (obj) ? obj \ - : Qnil)) + : (FRAMEP (obj) ? obj \ + : Qnil)) #define FRAME_NEW_HEIGHT(f) ((f)->new_height) #define FRAME_NEW_WIDTH(f) ((f)->new_width) @@ -539,7 +619,7 @@ FRAME_THEORETICAL_TOOLBAR_SIZE (f, RIGHT_TOOLBAR) #define FRAME_THEORETICAL_TOOLBAR_BORDER_WIDTH(f, pos) \ - (FRAME_RAW_THEORETICAL_TOOLBAR_VISIBLE (f, pos) \ + (FRAME_RAW_THEORETICAL_TOOLBAR_VISIBLE (f, pos) \ ? FRAME_RAW_THEORETICAL_TOOLBAR_BORDER_WIDTH (f, pos) \ : 0) @@ -598,18 +678,18 @@ if you encounter some odd toolbar behavior, you might want to look into this. --ben */ -#define FRAME_REAL_TOOLBAR_VISIBLE(f, pos) \ - ((!NILP (FRAME_REAL_TOOLBAR (f, pos)) \ - && FRAME_RAW_REAL_TOOLBAR_SIZE (f, pos) > 0) \ - ? FRAME_RAW_REAL_TOOLBAR_VISIBLE (f, pos) \ +#define FRAME_REAL_TOOLBAR_VISIBLE(f, pos) \ + ((!NILP (FRAME_REAL_TOOLBAR (f, pos)) \ + && FRAME_RAW_REAL_TOOLBAR_SIZE (f, pos) > 0) \ + ? FRAME_RAW_REAL_TOOLBAR_VISIBLE (f, pos) \ : 0) -#define FRAME_REAL_TOOLBAR_SIZE(f, pos) \ - ((!NILP (FRAME_REAL_TOOLBAR (f, pos)) \ - && FRAME_RAW_REAL_TOOLBAR_VISIBLE (f, pos)) \ - ? FRAME_RAW_REAL_TOOLBAR_SIZE (f, pos) \ +#define FRAME_REAL_TOOLBAR_SIZE(f, pos) \ + ((!NILP (FRAME_REAL_TOOLBAR (f, pos)) \ + && FRAME_RAW_REAL_TOOLBAR_VISIBLE (f, pos)) \ + ? FRAME_RAW_REAL_TOOLBAR_SIZE (f, pos) \ : 0) #define FRAME_REAL_TOOLBAR_BORDER_WIDTH(f, pos) \ - ((!NILP (FRAME_REAL_TOOLBAR (f, pos)) \ + ((!NILP (FRAME_REAL_TOOLBAR (f, pos)) \ && FRAME_RAW_REAL_TOOLBAR_VISIBLE (f, pos)) \ ? FRAME_RAW_REAL_TOOLBAR_BORDER_WIDTH (f, pos) \ : 0) @@ -641,32 +721,32 @@ #define FRAME_REAL_RIGHT_TOOLBAR_VISIBLE(f) \ FRAME_REAL_TOOLBAR_VISIBLE (f, RIGHT_TOOLBAR) -#define FRAME_TOP_BORDER_START(f) \ - (FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) + \ +#define FRAME_TOP_BORDER_START(f) \ + (FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) + \ 2 * FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f)) -#define FRAME_TOP_BORDER_END(f) \ +#define FRAME_TOP_BORDER_END(f) \ (FRAME_TOP_BORDER_START (f) + FRAME_BORDER_HEIGHT (f)) -#define FRAME_BOTTOM_BORDER_START(f) \ - (FRAME_PIXHEIGHT (f) - FRAME_BORDER_HEIGHT (f) - \ - FRAME_REAL_BOTTOM_TOOLBAR_HEIGHT (f) - \ +#define FRAME_BOTTOM_BORDER_START(f) \ + (FRAME_PIXHEIGHT (f) - FRAME_BORDER_HEIGHT (f) - \ + FRAME_REAL_BOTTOM_TOOLBAR_HEIGHT (f) - \ 2 * FRAME_REAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f)) -#define FRAME_BOTTOM_BORDER_END(f) \ - (FRAME_PIXHEIGHT (f) - FRAME_REAL_BOTTOM_TOOLBAR_HEIGHT (f) - \ +#define FRAME_BOTTOM_BORDER_END(f) \ + (FRAME_PIXHEIGHT (f) - FRAME_REAL_BOTTOM_TOOLBAR_HEIGHT (f) - \ 2 * FRAME_REAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f)) -#define FRAME_LEFT_BORDER_START(f) \ - (FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) + \ +#define FRAME_LEFT_BORDER_START(f) \ + (FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) + \ 2 * FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f)) -#define FRAME_LEFT_BORDER_END(f) \ +#define FRAME_LEFT_BORDER_END(f) \ (FRAME_LEFT_BORDER_START (f) + FRAME_BORDER_WIDTH (f)) -#define FRAME_RIGHT_BORDER_START(f) \ - (FRAME_PIXWIDTH (f) - FRAME_BORDER_WIDTH (f) - \ - FRAME_REAL_RIGHT_TOOLBAR_WIDTH(f) - \ +#define FRAME_RIGHT_BORDER_START(f) \ + (FRAME_PIXWIDTH (f) - FRAME_BORDER_WIDTH (f) - \ + FRAME_REAL_RIGHT_TOOLBAR_WIDTH(f) - \ 2 * FRAME_REAL_RIGHT_TOOLBAR_BORDER_WIDTH (f)) -#define FRAME_RIGHT_BORDER_END(f) \ - (FRAME_PIXWIDTH (f) - FRAME_REAL_RIGHT_TOOLBAR_WIDTH (f) - \ +#define FRAME_RIGHT_BORDER_END(f) \ + (FRAME_PIXWIDTH (f) - FRAME_REAL_RIGHT_TOOLBAR_WIDTH (f) - \ 2 * FRAME_REAL_RIGHT_TOOLBAR_BORDER_WIDTH(f)) /* Equivalent in FSF Emacs: @@ -690,9 +770,6 @@ Lisp_Object console); Lisp_Object prev_frame (Lisp_Object f, Lisp_Object frametype, Lisp_Object console); -void store_in_alist (Lisp_Object *alistptr, - CONST char *propname, - Lisp_Object val); void pixel_to_char_size (struct frame *f, int pixel_width, int pixel_height, int *char_width, int *char_height); void char_to_pixel_size (struct frame *f, int char_width, int char_height, @@ -737,4 +814,6 @@ void update_frame_icon (struct frame *f); void invalidate_vertical_divider_cache_in_frame (struct frame *f); -#endif /* _XEMACS_FRAME_H_ */ +void init_frame (void); + +#endif /* INCLUDED_frame_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/free-hook.c --- a/src/free-hook.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/free-hook.c Mon Aug 13 11:13:30 2007 +0200 @@ -85,14 +85,14 @@ /* System function prototypes don't belong in C source files */ /* extern void free (void *); */ -struct hash_table *pointer_table; +static struct hash_table *pointer_table; extern void (*__free_hook) (void *); extern void *(*__malloc_hook) (size_t); static void *check_malloc (size_t); -typedef void (*fun_ptr) (); +typedef void (*fun_ptr) (void); /* free_queue is not too useful without backtrace logging */ #define FREE_QUEUE_LIMIT 1 @@ -110,11 +110,11 @@ unsigned long length; } free_queue_entry; -free_queue_entry free_queue[FREE_QUEUE_LIMIT]; +static free_queue_entry free_queue[FREE_QUEUE_LIMIT]; -int current_free; +static int current_free; -int strict_free_check; +static int strict_free_check; static void check_free (void *ptr) @@ -131,7 +131,7 @@ #endif EMACS_INT present = (EMACS_INT) gethash (ptr, pointer_table, - (CONST void **) &size); + (const void **) &size); if (!present) { @@ -257,7 +257,7 @@ void *result = malloc (size); if (!ptr) return result; - present = (EMACS_INT) gethash (ptr, pointer_table, (CONST void **) &old_size); + present = (EMACS_INT) gethash (ptr, pointer_table, (const void **) &old_size); if (!present) { /* This can only happen by reallocing a pointer that didn't diff -r f4aeb21a5bad -r 74fd4e045ea6 src/gdbinit --- a/src/gdbinit Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,490 +0,0 @@ -# -*- ksh -*- -# Copyright (C) 1998 Free Software Foundation, Inc. - -# This file is part of XEmacs. - -# XEmacs is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any -# later version. - -# XEmacs is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. - -# You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. - -# Author: Martin Buchholz - -# Some useful commands for debugging emacs with gdb 4.16 or better. -# Install this as your .gdbinit file in your home directory, -# or source this file from your .gdbinit -# Configure xemacs with --debug, and compile with -g. -# -# See also the question of the XEmacs FAQ, titled -# "How to Debug an XEmacs problem with a debugger". -# -# This can be used to debug XEmacs no matter how the following are -# specified: - -# USE_UNION_TYPE -# USE_MINIMAL_TAGBITS -# USE_INDEXED_LRECORD_IMPLEMENTATION -# LRECORD_(SYMBOL|STRING|VECTOR) - -# (the above all have configure equivalents) - -# Some functions defined here require a running process, but most -# don't. Considerable effort has been expended to this end. - -# See the dbg_ C support code in src/alloc.c that allows the functions -# defined in this file to work correctly. - -set print union off -set print pretty off - -define decode_object - set $obj = (unsigned long) $arg0 - if dbg_USE_MINIMAL_TAGBITS - if $obj & 1 - # It's an int - set $val = $obj >> 1 - set $type = Lisp_Type_Int - else - set $type = $obj & dbg_typemask - if $type == Lisp_Type_Char - set $val = ($obj & dbg_valmask) >> dbg_gctypebits - else - # It's a record pointer - set $val = $obj - end - end - else - # not dbg_USE_MINIMAL_TAGBITS - set $val = $obj & dbg_valmask - set $type = ($obj & dbg_typemask) >> (dbg_valbits + 1) - end - - if $type == Lisp_Type_Record - set $lheader = (struct lrecord_header *) $val - if dbg_USE_INDEXED_LRECORD_IMPLEMENTATION - set $imp = lrecord_implementations_table[$lheader->type] - else - set $imp = $lheader->implementation - end - else - set $imp = -1 - end -end - -document decode_object -Usage: decode_object lisp_object -Extract implementation information from a Lisp Object. -Defines variables $val, $type and $imp. -end - -define xint -decode_object $arg0 -print ((long) $val) -end - -define xtype - decode_object $arg0 - if $type == Lisp_Type_Int - echo int\n - else - if $type == Lisp_Type_Char - echo char\n - else - if $type == Lisp_Type_Symbol - echo symbol\n - else - if $type == Lisp_Type_String - echo string\n - else - if $type == Lisp_Type_Vector - echo vector\n - else - if $type == Lisp_Type_Cons - echo cons\n - else - printf "record type: %s\n", $imp->name - # barf - end - end - end - end - end - end -end - -define lisp-shadows - run -batch -vanilla -f list-load-path-shadows -end - -document lisp-shadows -Usage: lisp-shadows -Run xemacs to check for lisp shadows -end - -define environment-to-run-temacs - unset env EMACSLOADPATH - set env EMACSBOOTSTRAPLOADPATH=../lisp/:.. - set env EMACSBOOTSTRAPMODULEPATH=../modules/:.. -end - -define run-temacs - environment-to-run-temacs - run -batch -l ../lisp/loadup.el run-temacs -q -end - -document run-temacs -Usage: run-temacs -Run temacs interactively, like xemacs. -Use this with debugging tools (like purify) that cannot deal with dumping, -or when temacs builds successfully, but xemacs does not. -end - -define update-elc - environment-to-run-temacs - run -batch -l ../lisp/update-elc.el -end - -document update-elc -Usage: update-elc -Run the core lisp byte compilation part of the build procedure. -Use when debugging temacs, not xemacs! -Use this when temacs builds successfully, but xemacs does not. -end - -define dump-temacs - environment-to-run-temacs - run -batch -l ../lisp/loadup.el dump -end - -document dump-temacs -Usage: dump-temacs -Run the dumping part of the build procedure. -Use when debugging temacs, not xemacs! -Use this when temacs builds successfully, but xemacs does not. -end - -# if you use Purify, do this: -# export PURIFYOPTIONS='-pointer-mask=0x0fffffff' - -define ldp - printf "%s", "Lisp => " - call debug_print($arg0) -end - -document ldp -Usage: ldp lisp_object -Print a Lisp Object value using the Lisp printer. -Requires a running xemacs process. -end - -define lbt -call debug_backtrace() -end - -document lbt -Usage: lbt -Print the current Lisp stack trace. -Requires a running xemacs process. -end - - -define leval -ldp Feval(Fcar(Fread_from_string(build_string($arg0),Qnil,Qnil))) -end - -document leval -Usage: leval "SEXP" -Eval a lisp expression. -Requires a running xemacs process. - -Example: -(gdb) leval "(+ 1 2)" -Lisp ==> 3 -end - - -define wtype -print $arg0->core.widget_class->core_class.class_name -end - -define xtname -print XrmQuarkToString(((Object)($arg0))->object.xrm_name) -end - -# GDB's command language makes you want to ... - -define pstruct - set $xstruct = (struct $arg0 *) $val - print $xstruct - print *$xstruct -end - -define pobj - decode_object $arg0 - if $type == Lisp_Type_Int - printf "Integer: %d\n", $val - else - if $type == Lisp_Type_Char - if $val > 32 && $val < 128 - printf "Char: %c\n", $val - else - printf "Char: %d\n", $val - end - else - if $type == Lisp_Type_String || $imp == lrecord_string - pstruct Lisp_String - else - if $type == Lisp_Type_Cons || $imp == lrecord_cons - pstruct Lisp_Cons - else - if $type == Lisp_Type_Symbol || $imp == lrecord_symbol - pstruct Lisp_Symbol - printf "Symbol name: %s\n", $xstruct->name->data - else - if $type == Lisp_Type_Vector || $imp == lrecord_vector - pstruct Lisp_Vector - printf "Vector of length %d\n", $xstruct->size - #print *($xstruct->data) @ $xstruct->size - else - if $imp == lrecord_bit_vector - pstruct Lisp_Bit_Vector - else - if $imp == lrecord_buffer - pstruct buffer - else - if $imp == lrecord_char_table - pstruct Lisp_Char_Table - else - if $imp == lrecord_char_table_entry - pstruct Lisp_Char_Table_Entry - else - if $imp == lrecord_charset - pstruct Lisp_Charset - else - if $imp == lrecord_coding_system - pstruct Lisp_Coding_System - else - if $imp == lrecord_color_instance - pstruct Lisp_Color_Instance - else - if $imp == lrecord_command_builder - pstruct command_builder - else - if $imp == lrecord_compiled_function - pstruct Lisp_Compiled_Function - else - if $imp == lrecord_console - pstruct console - else - if $imp == lrecord_database - pstruct Lisp_Database - else - if $imp == lrecord_device - pstruct device - else - if $imp == lrecord_event - pstruct Lisp_Event - else - if $imp == lrecord_extent - pstruct extent - else - if $imp == lrecord_extent_auxiliary - pstruct extent_auxiliary - else - if $imp == lrecord_extent_info - pstruct extent_info - else - if $imp == lrecord_face - pstruct Lisp_Face - else - if $imp == lrecord_float - pstruct Lisp_Float - else - if $imp == lrecord_font_instance - pstruct Lisp_Font_Instance - else - if $imp == lrecord_frame - pstruct frame - else - if $imp == lrecord_glyph - pstruct Lisp_Glyph - else - if $imp == lrecord_hash_table - pstruct Lisp_Hash_Table - else - if $imp == lrecord_image_instance - pstruct Lisp_Image_Instance - else - if $imp == lrecord_keymap - pstruct Lisp_Keymap - else - if $imp == lrecord_lcrecord_list - pstruct lcrecord_list - else - if $imp == lrecord_lstream - pstruct lstream - else - if $imp == lrecord_marker - pstruct Lisp_Marker - else - if $imp == lrecord_opaque - pstruct Lisp_Opaque - else - if $imp == lrecord_opaque_list - pstruct Lisp_Opaque_List - else - if $imp == lrecord_popup_data - pstruct popup_data - else - if $imp == lrecord_process - pstruct Lisp_Process - else - if $imp == lrecord_range_table - pstruct Lisp_Range_Table - else - if $imp == lrecord_specifier - pstruct Lisp_Specifier - else - if $imp == lrecord_subr - pstruct Lisp_Subr - else - if $imp == lrecord_symbol_value_buffer_local - pstruct symbol_value_buffer_local - else - if $imp == lrecord_symbol_value_forward - pstruct symbol_value_forward - else - if $imp == lrecord_symbol_value_lisp_magic - pstruct symbol_value_lisp_magic - else - if $imp == lrecord_symbol_value_varalias - pstruct symbol_value_varalias - else - if $imp == lrecord_toolbar_button - pstruct toolbar_button - else - if $imp == lrecord_tooltalk_message - pstruct Lisp_Tooltalk_Message - else - if $imp == lrecord_tooltalk_pattern - pstruct Lisp_Tooltalk_Pattern - else - if $imp == lrecord_weak_list - pstruct weak_list - else - if $imp == lrecord_window - pstruct window - else - if $imp == lrecord_window_configuration - pstruct window_config - else - echo Unknown Lisp Object type\n - print $arg0 - # Barf, gag, retch - end - end - end - end - end - end - end - end - end - end - end - end - end - end - end - # Repeat after me... gdb sux, gdb sux, gdb sux... - end - end - end - end - end - end - end - end - end - end - end - end - end - end - end - end - end - end - # Are we having fun yet?? - end - end - end - end - end - end - end - end - end - end - end - end - end - end - end - end - end -end - -document pobj -Usage: pobj lisp_object -Print the internal C structure of a underlying Lisp Object. -end - -# ------------------------------------------------------------- -# functions to test the debugging support itself. -# If you change this file, make sure the following still work... -# ------------------------------------------------------------- -define test_xtype - printf "Vemacs_major_version: " - xtype Vemacs_major_version - printf "Vhelp_char: " - xtype Vhelp_char - printf "Qnil: " - xtype Qnil - printf "Qunbound: " - xtype Qunbound - printf "Vobarray: " - xtype Vobarray - printf "Vall_weak_lists: " - xtype Vall_weak_lists - printf "Vxemacs_codename: " - xtype Vxemacs_codename -end - -define test_pobj - printf "Vemacs_major_version: " - pobj Vemacs_major_version - printf "Vhelp_char: " - pobj Vhelp_char - printf "Qnil: " - pobj Qnil - printf "Qunbound: " - pobj Qunbound - printf "Vobarray: " - pobj Vobarray - printf "Vall_weak_lists: " - pobj Vall_weak_lists - printf "Vxemacs_codename: " - pobj Vxemacs_codename -end - diff -r f4aeb21a5bad -r 74fd4e045ea6 src/general.c --- a/src/general.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/general.c Mon Aug 13 11:13:30 2007 +0200 @@ -34,24 +34,20 @@ Lisp_Object Qactually_requested; Lisp_Object Qafter; Lisp_Object Qall; -Lisp_Object Qalways; Lisp_Object Qand; Lisp_Object Qassoc; Lisp_Object Qat; -Lisp_Object Qauth; Lisp_Object Qautodetect; Lisp_Object Qbad_variable; -Lisp_Object Qbase; Lisp_Object Qbefore; Lisp_Object Qbinary; -Lisp_Object Qbinddn; Lisp_Object Qbitmap; -Lisp_Object Qblack; Lisp_Object Qboolean; Lisp_Object Qbottom; +Lisp_Object Qbottom_margin; Lisp_Object Qbuffer; Lisp_Object Qbutton; -Lisp_Object Qcase; +Lisp_Object Qcenter; Lisp_Object Qcategory; Lisp_Object Qchannel; Lisp_Object Qchar; @@ -62,17 +58,18 @@ Lisp_Object Qcommand; Lisp_Object Qconsole; Lisp_Object Qcritical; +Lisp_Object Qctext; Lisp_Object Qcursor; Lisp_Object Qdata; Lisp_Object Qdead; Lisp_Object Qdefault; Lisp_Object Qdelete; Lisp_Object Qdelq; -Lisp_Object Qderef; Lisp_Object Qdevice; Lisp_Object Qdimension; Lisp_Object Qdisplay; Lisp_Object Qdoc_string; +Lisp_Object Qduplex; Lisp_Object Qdynarr_overhead; Lisp_Object Qempty; Lisp_Object Qeq; @@ -81,7 +78,7 @@ Lisp_Object Qeval; Lisp_Object Qextents; Lisp_Object Qface; -Lisp_Object Qfind; +Lisp_Object Qfile_name; Lisp_Object Qfont; Lisp_Object Qframe; Lisp_Object Qfunction; @@ -89,8 +86,10 @@ Lisp_Object Qgeneric; Lisp_Object Qgeometry; Lisp_Object Qglobal; +Lisp_Object Qgutter; Lisp_Object Qheight; Lisp_Object Qhighlight; +Lisp_Object Qhorizontal; Lisp_Object Qicon; Lisp_Object Qid; Lisp_Object Qimage; @@ -102,23 +101,22 @@ Lisp_Object Qkey_assoc; Lisp_Object Qkeyboard; Lisp_Object Qkeymap; -Lisp_Object Qkrbv41; -Lisp_Object Qkrbv42; +Lisp_Object Qlandscape; Lisp_Object Qleft; +Lisp_Object Qleft_margin; Lisp_Object Qlist; Lisp_Object Qmagic; Lisp_Object Qmalloc_overhead; Lisp_Object Qmarkers; Lisp_Object Qmax; Lisp_Object Qmemory; -Lisp_Object Qmenubar; Lisp_Object Qmessage; Lisp_Object Qminus; Lisp_Object Qmodifiers; Lisp_Object Qmotion; +Lisp_Object Qmsprinter; Lisp_Object Qmswindows; Lisp_Object Qname; -Lisp_Object Qnever; Lisp_Object Qnone; Lisp_Object Qnot; Lisp_Object Qnothing; @@ -129,16 +127,15 @@ Lisp_Object Qold_delq; Lisp_Object Qold_rassoc; Lisp_Object Qold_rassq; -Lisp_Object Qonelevel; Lisp_Object Qonly; Lisp_Object Qor; +Lisp_Object Qorientation; Lisp_Object Qother; -Lisp_Object Qpasswd; -Lisp_Object Qpath; Lisp_Object Qpointer; Lisp_Object Qpopup; -Lisp_Object Qport; +Lisp_Object Qportrait; Lisp_Object Qprint; +Lisp_Object Qprinter; Lisp_Object Qprocess; Lisp_Object Qprovide; Lisp_Object Qrassoc; @@ -148,35 +145,34 @@ Lisp_Object Qreturn; Lisp_Object Qreverse; Lisp_Object Qright; +Lisp_Object Qright_margin; Lisp_Object Qsearch; Lisp_Object Qselected; Lisp_Object Qsignal; Lisp_Object Qsimple; Lisp_Object Qsize; -Lisp_Object Qsizelimit; Lisp_Object Qspace; Lisp_Object Qspecifier; Lisp_Object Qstream; Lisp_Object Qstring; -Lisp_Object Qsubtree; Lisp_Object Qsymbol; Lisp_Object Qsyntax; +Lisp_Object Qterminal; Lisp_Object Qtest; Lisp_Object Qtext; -Lisp_Object Qtimelimit; Lisp_Object Qtimeout; Lisp_Object Qtimestamp; Lisp_Object Qtoolbar; Lisp_Object Qtop; +Lisp_Object Qtop_margin; Lisp_Object Qtty; Lisp_Object Qtype; Lisp_Object Qundecided; Lisp_Object Qundefined; Lisp_Object Qunimplemented; Lisp_Object Qvalue_assoc; -Lisp_Object Qvector; +Lisp_Object Qvertical; Lisp_Object Qwarning; -Lisp_Object Qwhite; Lisp_Object Qwidth; Lisp_Object Qwidget; Lisp_Object Qwindow; @@ -190,25 +186,21 @@ defsymbol (&Qactually_requested, "actually-requested"); defsymbol (&Qafter, "after"); defsymbol (&Qall, "all"); - defsymbol (&Qalways, "always"); defsymbol (&Qand, "and"); defsymbol (&Qassoc, "assoc"); defsymbol (&Qat, "at"); - defsymbol (&Qauth, "auth"); defsymbol (&Qautodetect, "autodetect"); defsymbol (&Qbad_variable, "bad-variable"); - defsymbol (&Qbase, "base"); defsymbol (&Qbefore, "before"); defsymbol (&Qbinary, "binary"); - defsymbol (&Qbinddn, "binddn"); defsymbol (&Qbitmap, "bitmap"); - defsymbol (&Qblack, "black"); defsymbol (&Qboolean, "boolean"); defsymbol (&Qbottom, "bottom"); + defsymbol (&Qbottom_margin, "bottom-margin"); defsymbol (&Qbuffer, "buffer"); defsymbol (&Qbutton, "button"); - defsymbol (&Qcase, "case"); defsymbol (&Qcategory, "category"); + defsymbol (&Qcenter, "center"); defsymbol (&Qchannel, "channel"); defsymbol (&Qchar, "char"); defsymbol (&Qcharacter, "character"); @@ -218,17 +210,18 @@ defsymbol (&Qcommand, "command"); defsymbol (&Qconsole, "console"); defsymbol (&Qcritical, "critical"); + defsymbol (&Qctext, "ctext"); defsymbol (&Qcursor, "cursor"); defsymbol (&Qdata, "data"); defsymbol (&Qdead, "dead"); defsymbol (&Qdefault, "default"); defsymbol (&Qdelete, "delete"); defsymbol (&Qdelq, "delq"); - defsymbol (&Qderef, "deref"); defsymbol (&Qdevice, "device"); defsymbol (&Qdimension, "dimension"); defsymbol (&Qdisplay, "display"); defsymbol (&Qdoc_string, "doc-string"); + defsymbol (&Qduplex, "duplex"); defsymbol (&Qdynarr_overhead, "dynarr-overhead"); defsymbol (&Qempty, "empty"); defsymbol (&Qeq, "eq"); @@ -237,7 +230,7 @@ defsymbol (&Qeval, "eval"); defsymbol (&Qextents, "extents"); defsymbol (&Qface, "face"); - defsymbol (&Qfind, "find"); + defsymbol (&Qfile_name, "file-name"); defsymbol (&Qfont, "font"); defsymbol (&Qframe, "frame"); defsymbol (&Qfunction, "function"); @@ -245,8 +238,10 @@ defsymbol (&Qgeneric, "generic"); defsymbol (&Qgeometry, "geometry"); defsymbol (&Qglobal, "global"); + defsymbol (&Qgutter, "gutter"); defsymbol (&Qheight, "height"); defsymbol (&Qhighlight, "highlight"); + defsymbol (&Qhorizontal, "horizontal"); defsymbol (&Qicon, "icon"); defsymbol (&Qid, "id"); defsymbol (&Qimage, "image"); @@ -258,23 +253,22 @@ defsymbol (&Qkey_assoc, "key-assoc"); defsymbol (&Qkeyboard, "keyboard"); defsymbol (&Qkeymap, "keymap"); - defsymbol (&Qkrbv41, "krbv41"); - defsymbol (&Qkrbv42, "krbv42"); + defsymbol (&Qlandscape, "landscape"); defsymbol (&Qleft, "left"); + defsymbol (&Qleft_margin, "left-margin"); defsymbol (&Qlist, "list"); defsymbol (&Qmagic, "magic"); defsymbol (&Qmalloc_overhead, "malloc-overhead"); defsymbol (&Qmarkers, "markers"); defsymbol (&Qmax, "max"); defsymbol (&Qmemory, "memory"); - defsymbol (&Qmenubar, "menubar"); defsymbol (&Qmessage, "message"); defsymbol (&Qminus, "-"); defsymbol (&Qmodifiers, "modifiers"); defsymbol (&Qmotion, "motion"); + defsymbol (&Qmsprinter, "msprinter"); defsymbol (&Qmswindows, "mswindows"); defsymbol (&Qname, "name"); - defsymbol (&Qnever, "never"); defsymbol (&Qnone, "none"); defsymbol (&Qnot, "not"); defsymbol (&Qnothing, "nothing"); @@ -285,16 +279,15 @@ defsymbol (&Qold_delq, "old-delq"); defsymbol (&Qold_rassoc, "old-rassoc"); defsymbol (&Qold_rassq, "old-rassq"); - defsymbol (&Qonelevel, "onelevel"); defsymbol (&Qonly, "only"); defsymbol (&Qor, "or"); + defsymbol (&Qorientation, "orientation"); defsymbol (&Qother, "other"); - defsymbol (&Qpasswd, "passwd"); - defsymbol (&Qpath, "path"); defsymbol (&Qpointer, "pointer"); defsymbol (&Qpopup, "popup"); - defsymbol (&Qport, "port"); + defsymbol (&Qportrait, "portrait"); defsymbol (&Qprint, "print"); + defsymbol (&Qprinter, "printer"); defsymbol (&Qprocess, "process"); defsymbol (&Qprovide, "provide"); defsymbol (&Qrassoc, "rassoc"); @@ -304,35 +297,34 @@ defsymbol (&Qreturn, "return"); defsymbol (&Qreverse, "reverse"); defsymbol (&Qright, "right"); + defsymbol (&Qright_margin, "right-margin"); defsymbol (&Qsearch, "search"); defsymbol (&Qselected, "selected"); defsymbol (&Qsignal, "signal"); defsymbol (&Qsimple, "simple"); defsymbol (&Qsize, "size"); - defsymbol (&Qsizelimit, "sizelimit"); defsymbol (&Qspace, "space"); defsymbol (&Qspecifier, "specifier"); defsymbol (&Qstream, "stream"); defsymbol (&Qstring, "string"); - defsymbol (&Qsubtree, "subtree"); defsymbol (&Qsymbol, "symbol"); defsymbol (&Qsyntax, "syntax"); + defsymbol (&Qterminal, "terminal"); defsymbol (&Qtest, "test"); defsymbol (&Qtext, "text"); - defsymbol (&Qtimelimit, "timelimit"); defsymbol (&Qtimeout, "timeout"); defsymbol (&Qtimestamp, "timestamp"); defsymbol (&Qtoolbar, "toolbar"); defsymbol (&Qtop, "top"); + defsymbol (&Qtop_margin, "top-margin"); defsymbol (&Qtty, "tty"); defsymbol (&Qtype, "type"); defsymbol (&Qundecided, "undecided"); defsymbol (&Qundefined, "undefined"); defsymbol (&Qunimplemented, "unimplemented"); defsymbol (&Qvalue_assoc, "value-assoc"); - defsymbol (&Qvector, "vector"); + defsymbol (&Qvertical, "vertical"); defsymbol (&Qwarning, "warning"); - defsymbol (&Qwhite, "white"); defsymbol (&Qwidth, "width"); defsymbol (&Qwidget, "widget"); defsymbol (&Qwindow, "window"); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/getloadavg.c --- a/src/getloadavg.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/getloadavg.c Mon Aug 13 11:13:30 2007 +0200 @@ -19,8 +19,6 @@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -#ifndef __CYGWIN32__ - /* Compile-time symbols that this file uses: FIXUP_KERNEL_SYMBOL_ADDR() Adjust address in returned struct nlist. @@ -71,6 +69,9 @@ #include <config.h> #endif +#ifndef WINDOWSNT +#ifndef __CYGWIN32__ + #include <sys/types.h> /* Both the Emacs and non-Emacs sections want this. Some @@ -93,10 +94,6 @@ #include <errno.h> -#ifndef errno -extern int errno; -#endif - #ifndef HAVE_GETLOADAVG /* The existing Emacs configuration files define a macro called @@ -535,7 +532,7 @@ privileges to use it. Initial implementation courtesy Zlatko Calusic <zcalusic@carnet.hr>. - Integrated to XEmacs by Hrvoje Niksic <hniksic@srce.hr>. + Integrated to XEmacs by Hrvoje Niksic <hniksic@xemacs.org>. Additional cleanup by Hrvoje Niksic, based on code published by Casper Dik <Casper.Dik@Holland.Sun.Com>. */ kstat_ctl_t *kc; @@ -771,31 +768,6 @@ loadavg[elem++] = load_info.fifteen_minute; #endif /* DGUX */ -#if !defined (LDAV_DONE) && defined (apollo) -#define LDAV_DONE -/* Apollo code from lisch@mentorg.com (Ray Lischner). - - This system call is not documented. The load average is obtained as - three long integers, for the load average over the past minute, - five minutes, and fifteen minutes. Each value is a scaled integer, - with 16 bits of integer part and 16 bits of fraction part. - - I'm not sure which operating system first supported this system call, - but I know that SR10.2 supports it. */ - - extern void proc1_$get_loadav (); - unsigned long load_ave[3]; - - proc1_$get_loadav (load_ave); - - if (nelem > 0) - loadavg[elem++] = load_ave[0] / 65536.0; - if (nelem > 1) - loadavg[elem++] = load_ave[1] / 65536.0; - if (nelem > 2) - loadavg[elem++] = load_ave[2] / 65536.0; -#endif /* apollo */ - #if !defined (LDAV_DONE) && defined (OSF_MIPS) #define LDAV_DONE @@ -1006,4 +978,4 @@ } #endif /*__GNUWIN32__*/ - +#endif /* WINDOWSNT */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/getpagesize.h --- a/src/getpagesize.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/getpagesize.h Mon Aug 13 11:13:30 2007 +0200 @@ -17,6 +17,9 @@ /* Synched up with: FSF 19.30. */ +#ifndef INCLUDED_getpagesize_h_ +#define INCLUDED_getpagesize_h_ + /* Emulate getpagesize on systems that lack it. */ #if 0 @@ -64,3 +67,4 @@ #endif /* _SC_PAGESIZE */ #endif /* not HAVE_GETPAGESIZE */ +#endif /* INCLUDED_getpagesize_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/gif_io.c --- a/src/gif_io.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/gif_io.c Mon Aug 13 11:13:30 2007 +0200 @@ -3,6 +3,7 @@ #include <string.h> #include <unistd.h> #include "gifrlib.h" +#include "sysfile.h" /****************************************************************************** * Set up the GifFileType structure for use. This must be called first in any * diff -r f4aeb21a5bad -r 74fd4e045ea6 src/gifrlib.h --- a/src/gifrlib.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/gifrlib.h Mon Aug 13 11:13:30 2007 +0200 @@ -14,8 +14,8 @@ * 19 Jan 98 - Version 3.1 by Jareth Hein (Support for user-defined I/O). * ******************************************************************************/ -#ifndef GIF_LIB_H -#define GIF_LIB_H +#ifndef INCLUDED_gifrlib_h_ +#define INCLUDED_gifrlib_h_ #define GIF_ERROR 0 #define GIF_OK 1 @@ -264,5 +264,4 @@ ColorMapObject *MakeMapObject(int ColorCount, GifColorType *ColorMap); void FreeMapObject(ColorMapObject *Object); - -#endif /* GIF_LIB_H */ +#endif /* INCLUDED_gifrlib_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/glyphs-eimage.c --- a/src/glyphs-eimage.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/glyphs-eimage.c Mon Aug 13 11:13:30 2007 +0200 @@ -314,7 +314,7 @@ Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); /* It is OK for the unwind data to be local to this function, because the unwind-protect is always executed when this stack frame is still valid. */ @@ -372,13 +372,13 @@ { Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - CONST Extbyte *bytes; + const Extbyte *bytes; Extcount len; /* #### This is a definite problem under Mule due to the amount of stack data it might allocate. Need to be able to convert and write out to a file. */ - GET_STRING_BINARY_DATA_ALLOCA (data, bytes, len); + TO_EXTERNAL_FORMAT (LISP_STRING, data, ALLOCA, (bytes, len), Qbinary); jpeg_memory_src (&cinfo, (JOCTET *) bytes, len); } @@ -482,7 +482,7 @@ /* now instantiate */ MAYBE_DEVMETH (XDEVICE (ii->device), init_image_instance_from_eimage, - (ii, cinfo.output_width, cinfo.output_height, + (ii, cinfo.output_width, cinfo.output_height, 1, unwind.eimage, dest_mask, instantiator, domain)); @@ -580,12 +580,12 @@ struct gif_error_struct { - CONST char *err_str; /* return the error string */ + const char *err_str; /* return the error string */ jmp_buf setjmp_buffer; /* for return to caller */ }; static void -gif_error_func(CONST char *err_str, VoidPtr error_ptr) +gif_error_func(const char *err_str, VoidPtr error_ptr) { struct gif_error_struct *error_data = (struct gif_error_struct*)error_ptr; @@ -599,7 +599,7 @@ Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); /* It is OK for the unwind data to be local to this function, because the unwind-protect is always executed when this stack frame is still valid. */ @@ -623,7 +623,7 @@ assert (!NILP (data)); if (!(unwind.giffile = GifSetup())) - signal_image_error ("Insufficent memory to instantiate GIF image", instantiator); + signal_image_error ("Insufficient memory to instantiate GIF image", instantiator); /* set up error facilities */ if (setjmp(gif_err.setjmp_buffer)) @@ -636,7 +636,7 @@ } GifSetErrorFunc(unwind.giffile, (Gif_error_func)gif_error_func, (VoidPtr)&gif_err); - GET_STRING_BINARY_DATA_ALLOCA (data, bytes, len); + TO_EXTERNAL_FORMAT (LISP_STRING, data, ALLOCA, (bytes, len), Qbinary); mem_struct.bytes = bytes; mem_struct.len = len; mem_struct.index = 0; @@ -651,10 +651,10 @@ DGifSlurp (unwind.giffile); } - /* 3. Now create the EImage */ + /* 3. Now create the EImage(s) */ { ColorMapObject *cmo = unwind.giffile->SColorMap; - int i, j, row, pass, interlace; + int i, j, row, pass, interlace, slice; unsigned char *eip; /* interlaced gifs have rows in this order: 0, 8, 16, ..., 4, 12, 20, ..., 2, 6, 10, ..., 1, 3, 5, ... */ @@ -663,51 +663,80 @@ height = unwind.giffile->SHeight; width = unwind.giffile->SWidth; - unwind.eimage = (unsigned char*) xmalloc (width * height * 3); + unwind.eimage = (unsigned char*) + xmalloc (width * height * 3 * unwind.giffile->ImageCount); if (!unwind.eimage) signal_image_error("Unable to allocate enough memory for image", instantiator); /* write the data in EImage format (8bit RGB triples) */ - /* Note: We just use the first image in the file and ignore the rest. - We check here that that image covers the full "screen" size. - I don't know whether that's always the case. - -dkindred@cs.cmu.edu */ - if (unwind.giffile->SavedImages[0].ImageDesc.Height != height - || unwind.giffile->SavedImages[0].ImageDesc.Width != width - || unwind.giffile->SavedImages[0].ImageDesc.Left != 0 - || unwind.giffile->SavedImages[0].ImageDesc.Top != 0) - signal_image_error ("First image in GIF file is not full size", - instantiator); - - interlace = unwind.giffile->SavedImages[0].ImageDesc.Interlace; - pass = 0; - row = interlace ? InterlacedOffset[pass] : 0; - eip = unwind.eimage; - for (i = 0; i < height; i++) + for (slice = 0; slice < unwind.giffile->ImageCount; slice++) { - if (interlace) - if (row >= height) { - row = InterlacedOffset[++pass]; - while (row >= height) - row = InterlacedOffset[++pass]; - } - eip = unwind.eimage + (row * width * 3); - for (j = 0; j < width; j++) + /* We check here that that the current image covers the full "screen" size. */ + if (unwind.giffile->SavedImages[slice].ImageDesc.Height != height + || unwind.giffile->SavedImages[slice].ImageDesc.Width != width + || unwind.giffile->SavedImages[slice].ImageDesc.Left != 0 + || unwind.giffile->SavedImages[slice].ImageDesc.Top != 0) + signal_image_error ("Image in GIF file is not full size", + instantiator); + + interlace = unwind.giffile->SavedImages[slice].ImageDesc.Interlace; + pass = 0; + row = interlace ? InterlacedOffset[pass] : 0; + eip = unwind.eimage + (width * height * 3 * slice); + for (i = 0; i < height; i++) { - unsigned char pixel = unwind.giffile->SavedImages[0].RasterBits[(i * width) + j]; - *eip++ = cmo->Colors[pixel].Red; - *eip++ = cmo->Colors[pixel].Green; - *eip++ = cmo->Colors[pixel].Blue; + if (interlace) + if (row >= height) { + row = InterlacedOffset[++pass]; + while (row >= height) + row = InterlacedOffset[++pass]; + } + eip = unwind.eimage + (width * height * 3 * slice) + (row * width * 3); + for (j = 0; j < width; j++) + { + unsigned char pixel = + unwind.giffile->SavedImages[slice].RasterBits[(i * width) + j]; + *eip++ = cmo->Colors[pixel].Red; + *eip++ = cmo->Colors[pixel].Green; + *eip++ = cmo->Colors[pixel].Blue; + } + row += interlace ? InterlacedJumps[pass] : 1; } - row += interlace ? InterlacedJumps[pass] : 1; } + + /* now instantiate */ + MAYBE_DEVMETH (XDEVICE (ii->device), + init_image_instance_from_eimage, + (ii, width, height, unwind.giffile->ImageCount, unwind.eimage, dest_mask, + instantiator, domain)); } - /* now instantiate */ - MAYBE_DEVMETH (XDEVICE (ii->device), - init_image_instance_from_eimage, - (ii, width, height, unwind.eimage, dest_mask, - instantiator, domain)); + + /* We read the gif successfully. If we have more than one slice then + animate the gif. */ + if (unwind.giffile->ImageCount > 1) + { + /* See if there is a timeout value. In theory there could be one + for every image - but that makes the implementation way to + complicated for now so we just take the first. */ + unsigned short timeout = 0; + Lisp_Object tid; + + if (unwind.giffile->SavedImages[0].Function == GRAPHICS_EXT_FUNC_CODE + && + unwind.giffile->SavedImages[0].ExtensionBlockCount) + { + timeout = (unsigned short) + ((unwind.giffile->SavedImages[0].ExtensionBlocks[0].Bytes[2] << 8) + + unwind.giffile-> SavedImages[0].ExtensionBlocks[0].Bytes[1]) * 10; + } + + /* Too short a timeout will crucify us performance-wise. */ + tid = add_glyph_animated_timeout (timeout > 10 ? timeout : 10, image_instance); + + if (!NILP (tid)) + IMAGE_INSTANCE_PIXMAP_TIMEOUT (ii) = XINT (tid); + } unbind_to (speccount, Qnil); } @@ -740,7 +769,7 @@ struct png_memory_storage { - CONST Extbyte *bytes; /* The data */ + const Extbyte *bytes; /* The data */ Extcount len; /* How big is it? */ int index; /* Where are we? */ }; @@ -760,7 +789,7 @@ struct png_error_struct { - CONST char *err_str; + const char *err_str; jmp_buf setjmp_buffer; /* for return to caller */ }; @@ -815,7 +844,7 @@ Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); struct png_unwind_data unwind; int speccount = specpdl_depth (); int height, width; @@ -864,14 +893,14 @@ /* Initialize the IO layer and read in header information */ { Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - CONST Extbyte *bytes; + const Extbyte *bytes; Extcount len; assert (!NILP (data)); /* #### This is a definite problem under Mule due to the amount of stack data it might allocate. Need to think about using Lstreams */ - GET_STRING_BINARY_DATA_ALLOCA (data, bytes, len); + TO_EXTERNAL_FORMAT (LISP_STRING, data, ALLOCA, (bytes, len), Qbinary); tbr.bytes = bytes; tbr.len = len; tbr.index = 0; @@ -913,7 +942,7 @@ } else { - struct Lisp_Color_Instance *c; + Lisp_Color_Instance *c; Lisp_Object rgblist; c = XCOLOR_INSTANCE (bkgd); @@ -990,7 +1019,7 @@ /* now instantiate */ MAYBE_DEVMETH (XDEVICE (ii->device), init_image_instance_from_eimage, - (ii, width, height, unwind.eimage, dest_mask, + (ii, width, height, 1, unwind.eimage, dest_mask, instantiator, domain)); /* This will clean up everything else. */ @@ -1126,7 +1155,7 @@ struct tiff_error_struct { -#if HAVE_VSNPRINTF +#ifdef HAVE_VSNPRINTF char err_str[256]; #else char err_str[1024]; /* return the error string */ @@ -1141,12 +1170,12 @@ static struct tiff_error_struct tiff_err_data; static void -tiff_error_func(CONST char *module, CONST char *fmt, ...) +tiff_error_func(const char *module, const char *fmt, ...) { va_list vargs; va_start (vargs, fmt); -#if HAVE_VSNPRINTF +#ifdef HAVE_VSNPRINTF vsnprintf (tiff_err_data.err_str, 255, fmt, vargs); #else /* pray this doesn't overflow... */ @@ -1158,17 +1187,17 @@ } static void -tiff_warning_func(CONST char *module, CONST char *fmt, ...) +tiff_warning_func(const char *module, const char *fmt, ...) { va_list vargs; -#if HAVE_VSNPRINTF +#ifdef HAVE_VSNPRINTF char warn_str[256]; #else char warn_str[1024]; #endif va_start (vargs, fmt); -#if HAVE_VSNPRINTF +#ifdef HAVE_VSNPRINTF vsnprintf (warn_str, 255, fmt, vargs); #else vsprintf (warn_str, fmt, vargs); @@ -1183,7 +1212,7 @@ Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); tiff_memory_storage mem_struct; /* It is OK for the unwind data to be local to this function, because the unwind-protect is always executed when this @@ -1218,7 +1247,9 @@ /* #### This is a definite problem under Mule due to the amount of stack data it might allocate. Think about Lstreams... */ - GET_STRING_BINARY_DATA_ALLOCA (data, bytes, len); + TO_EXTERNAL_FORMAT (LISP_STRING, data, + ALLOCA, (bytes, len), + Qbinary); mem_struct.bytes = bytes; mem_struct.len = len; mem_struct.index = 0; @@ -1229,13 +1260,13 @@ tiff_memory_seek, tiff_memory_close, tiff_memory_size, tiff_map_noop, tiff_unmap_noop); if (!unwind.tiff) - signal_image_error ("Insufficent memory to instantiate TIFF image", instantiator); + signal_image_error ("Insufficient memory to instantiate TIFF image", instantiator); TIFFGetField (unwind.tiff, TIFFTAG_IMAGEWIDTH, &width); TIFFGetField (unwind.tiff, TIFFTAG_IMAGELENGTH, &height); unwind.eimage = (unsigned char *) xmalloc (width * height * 3); - /* ### This is little more than proof-of-concept/function testing. + /* #### This is little more than proof-of-concept/function testing. It needs to be reimplemented via scanline reads for both memory compactness. */ raster = (uint32*) _TIFFmalloc (width * height * sizeof (uint32)); @@ -1270,7 +1301,7 @@ /* now instantiate */ MAYBE_DEVMETH (XDEVICE (ii->device), init_image_instance_from_eimage, - (ii, width, height, unwind.eimage, dest_mask, + (ii, width, height, 1, unwind.eimage, dest_mask, instantiator, domain)); unbind_to (speccount, Qnil); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/glyphs-msw.c --- a/src/glyphs-msw.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/glyphs-msw.c Mon Aug 13 11:13:30 2007 +0200 @@ -1,6 +1,6 @@ /* mswindows-specific glyph objects. - Copyright (C) 1998 Andy Piper. - + Copyright (C) 1998, 1999, 2000 Andy Piper. + This file is part of XEmacs. XEmacs is free software; you can redistribute it and/or modify it @@ -53,6 +53,23 @@ #define WIDGET_GLYPH_SLOT 0 +DECLARE_IMAGE_INSTANTIATOR_FORMAT (nothing); +DECLARE_IMAGE_INSTANTIATOR_FORMAT (string); +DECLARE_IMAGE_INSTANTIATOR_FORMAT (formatted_string); +DECLARE_IMAGE_INSTANTIATOR_FORMAT (inherit); +DECLARE_IMAGE_INSTANTIATOR_FORMAT (layout); +#ifdef HAVE_JPEG +DECLARE_IMAGE_INSTANTIATOR_FORMAT (jpeg); +#endif +#ifdef HAVE_TIFF +DECLARE_IMAGE_INSTANTIATOR_FORMAT (tiff); +#endif +#ifdef HAVE_PNG +DECLARE_IMAGE_INSTANTIATOR_FORMAT (png); +#endif +#ifdef HAVE_GIF +DECLARE_IMAGE_INSTANTIATOR_FORMAT (gif); +#endif #ifdef HAVE_XPM DEFINE_DEVICE_IIFORMAT (mswindows, xpm); #endif @@ -61,16 +78,15 @@ DEFINE_DEVICE_IIFORMAT (mswindows, xface); #endif DEFINE_DEVICE_IIFORMAT (mswindows, button); -DEFINE_DEVICE_IIFORMAT (mswindows, edit); -#if 0 -DEFINE_DEVICE_IIFORMAT (mswindows, group); -#endif +DEFINE_DEVICE_IIFORMAT (mswindows, edit_field); DEFINE_DEVICE_IIFORMAT (mswindows, subwindow); DEFINE_DEVICE_IIFORMAT (mswindows, widget); DEFINE_DEVICE_IIFORMAT (mswindows, label); DEFINE_DEVICE_IIFORMAT (mswindows, scrollbar); -DEFINE_DEVICE_IIFORMAT (mswindows, combo); -DEFINE_DEVICE_IIFORMAT (mswindows, progress); +DEFINE_DEVICE_IIFORMAT (mswindows, combo_box); +DEFINE_DEVICE_IIFORMAT (mswindows, progress_gauge); +DEFINE_DEVICE_IIFORMAT (mswindows, tree_view); +DEFINE_DEVICE_IIFORMAT (mswindows, tab_control); DEFINE_IMAGE_INSTANTIATOR_FORMAT (bmp); Lisp_Object Qbmp; @@ -82,14 +98,13 @@ Lisp_Object Qmswindows_resource; static void -mswindows_initialize_dibitmap_image_instance (struct Lisp_Image_Instance *ii, - enum image_instance_type type); +mswindows_initialize_dibitmap_image_instance (Lisp_Image_Instance *ii, + int slices, + enum image_instance_type type); static void -mswindows_initialize_image_instance_mask (struct Lisp_Image_Instance* image, +mswindows_initialize_image_instance_mask (Lisp_Image_Instance* image, struct frame* f); -COLORREF mswindows_string_to_color (CONST char *name); - #define BPLINE(width) ((int)(~3UL & (unsigned long)((width) +3))) /************************************************************************/ @@ -120,7 +135,7 @@ * structure - unless it has memory / color allocation implications * .... */ bmp_info=xnew_and_zero (BITMAPINFO); - + if (!bmp_info) { return NULL; @@ -128,7 +143,7 @@ bmp_info->bmiHeader.biBitCount=24; /* just RGB triples for now */ bmp_info->bmiHeader.biCompression=BI_RGB; /* just RGB triples for now */ - bmp_info->bmiHeader.biSizeImage=width*height*3; + bmp_info->bmiHeader.biSizeImage=width*height*3; /* bitmap data needs to be in blue, green, red triples - in that order, eimage is in RGB format so we need to convert */ @@ -164,7 +179,7 @@ /* use our quantize table to allocate the colors */ ncolors = qtable->num_active_colors; - bmp_info=(BITMAPINFO*)xmalloc_and_zero (sizeof(BITMAPINFOHEADER) + + bmp_info=(BITMAPINFO*)xmalloc_and_zero (sizeof(BITMAPINFOHEADER) + sizeof(RGBQUAD) * ncolors); if (!bmp_info) { @@ -174,12 +189,12 @@ colortbl=(RGBQUAD*)(((unsigned char*)bmp_info)+sizeof(BITMAPINFOHEADER)); - bmp_info->bmiHeader.biBitCount=8; - bmp_info->bmiHeader.biCompression=BI_RGB; + bmp_info->bmiHeader.biBitCount=8; + bmp_info->bmiHeader.biCompression=BI_RGB; bmp_info->bmiHeader.biSizeImage=bpline*height; - bmp_info->bmiHeader.biClrUsed=ncolors; - bmp_info->bmiHeader.biClrImportant=ncolors; - + bmp_info->bmiHeader.biClrUsed=ncolors; + bmp_info->bmiHeader.biClrImportant=ncolors; + *bmp_data = (unsigned char *) xmalloc_and_zero (bpline * height); *bit_count = bpline * height; @@ -189,7 +204,7 @@ xfree (bmp_info); return NULL; } - + /* build up an RGBQUAD colortable */ for (i = 0; i < qtable->num_active_colors; i++) { colortbl[i].rgbRed = (BYTE) qtable->rm[i]; @@ -211,14 +226,14 @@ } } xfree (qtable); - } + } /* fix up the standard stuff */ bmp_info->bmiHeader.biWidth=width; bmp_info->bmiHeader.biHeight=height; bmp_info->bmiHeader.biPlanes=1; bmp_info->bmiHeader.biSize=sizeof(BITMAPINFOHEADER); bmp_info->bmiHeader.biXPelsPerMeter=0; /* unless you know better */ - bmp_info->bmiHeader.biYPelsPerMeter=0; + bmp_info->bmiHeader.biYPelsPerMeter=0; return bmp_info; } @@ -242,21 +257,21 @@ (IS_DIRECTORY_SEP(XSTRING_BYTE (name, 2))))))) { if (!NILP (Ffile_readable_p (name))) - return name; + return Fexpand_file_name (name, Qnil); else return Qnil; } - if (locate_file (Vmswindows_bitmap_file_path, name, "", &found, R_OK) < 0) + if (locate_file (Vmswindows_bitmap_file_path, name, Qnil, &found, R_OK) < 0) { Lisp_Object temp = list1 (Vdata_directory); struct gcpro gcpro1; GCPRO1 (temp); - locate_file (temp, name, "", &found, R_OK); + locate_file (temp, name, Qnil, &found, R_OK); UNGCPRO; } - + return found; } @@ -269,12 +284,13 @@ in the error message. */ static void -init_image_instance_from_dibitmap (struct Lisp_Image_Instance *ii, +init_image_instance_from_dibitmap (Lisp_Image_Instance *ii, BITMAPINFO *bmp_info, int dest_mask, void *bmp_data, int bmp_bits, - Lisp_Object instantiator, + int slices, + Lisp_Object instantiator, int x_hot, int y_hot, int create_mask) { @@ -282,7 +298,7 @@ struct device *d = XDEVICE (device); struct frame *f; void* bmp_buf=0; - int type; + int type = 0; HBITMAP bitmap; HDC hdc; @@ -293,20 +309,20 @@ signal_simple_error ("No selected frame on mswindows device", device); f = XFRAME (DEVICE_SELECTED_FRAME (d)); - + if (dest_mask & IMAGE_COLOR_PIXMAP_MASK) type = IMAGE_COLOR_PIXMAP; else if (dest_mask & IMAGE_POINTER_MASK) type = IMAGE_POINTER; - else + else incompatible_image_types (instantiator, dest_mask, IMAGE_COLOR_PIXMAP_MASK | IMAGE_POINTER_MASK); hdc = FRAME_MSWINDOWS_CDC (f); - bitmap=CreateDIBSection (hdc, + bitmap=CreateDIBSection (hdc, bmp_info, DIB_RGB_COLORS, - &bmp_buf, + &bmp_buf, 0,0); if (!bitmap || !bmp_buf) @@ -315,12 +331,14 @@ /* copy in the actual bitmap */ memcpy (bmp_buf, bmp_data, bmp_bits); - mswindows_initialize_dibitmap_image_instance (ii, type); + mswindows_initialize_dibitmap_image_instance (ii, slices, type); IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = find_keyword_in_vector (instantiator, Q_file); + /* Fixup a set of bitmaps. */ IMAGE_INSTANCE_MSWINDOWS_BITMAP (ii) = bitmap; + IMAGE_INSTANCE_MSWINDOWS_MASK (ii) = NULL; IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = bmp_info->bmiHeader.biWidth; IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = bmp_info->bmiHeader.biHeight; @@ -332,7 +350,7 @@ { mswindows_initialize_image_instance_mask (ii, f); } - + if (type == IMAGE_POINTER) { mswindows_initialize_image_instance_icon(ii, TRUE); @@ -340,9 +358,37 @@ } static void -mswindows_init_image_instance_from_eimage (struct Lisp_Image_Instance *ii, +image_instance_add_dibitmap (Lisp_Image_Instance *ii, + BITMAPINFO *bmp_info, + void *bmp_data, + int bmp_bits, + int slice, + Lisp_Object instantiator) +{ + Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); + struct device *d = XDEVICE (device); + struct frame *f = XFRAME (DEVICE_SELECTED_FRAME (d)); + void* bmp_buf=0; + HDC hdc = FRAME_MSWINDOWS_CDC (f); + HBITMAP bitmap = CreateDIBSection (hdc, + bmp_info, + DIB_RGB_COLORS, + &bmp_buf, + 0,0); + + if (!bitmap || !bmp_buf) + signal_simple_error ("Unable to create bitmap", instantiator); + + /* copy in the actual bitmap */ + memcpy (bmp_buf, bmp_data, bmp_bits); + IMAGE_INSTANCE_MSWINDOWS_BITMAP_SLICE (ii, slice) = bitmap; +} + +static void +mswindows_init_image_instance_from_eimage (Lisp_Image_Instance *ii, int width, int height, - unsigned char *eimage, + int slices, + unsigned char *eimage, int dest_mask, Lisp_Object instantiator, Lisp_Object domain) @@ -352,66 +398,75 @@ unsigned char* bmp_data; int bmp_bits; COLORREF bkcolor; - + int slice; + if (!DEVICE_MSWINDOWS_P (XDEVICE (device))) signal_simple_error ("Not an mswindows device", device); /* this is a hack but MaskBlt and TransparentBlt are not supported on most windows variants */ - bkcolor = COLOR_INSTANCE_MSWINDOWS_COLOR + bkcolor = COLOR_INSTANCE_MSWINDOWS_COLOR (XCOLOR_INSTANCE (FACE_BACKGROUND (Vdefault_face, domain))); - /* build a bitmap from the eimage */ - if (!(bmp_info=convert_EImage_to_DIBitmap (device, width, height, eimage, - &bmp_bits, &bmp_data))) + for (slice = 0; slice < slices; slice++) { - signal_simple_error ("EImage to DIBitmap conversion failed", - instantiator); + /* build a bitmap from the eimage */ + if (!(bmp_info=convert_EImage_to_DIBitmap (device, width, height, + eimage + (width * height * 3 * slice), + &bmp_bits, &bmp_data))) + { + signal_simple_error ("EImage to DIBitmap conversion failed", + instantiator); + } + + /* Now create the pixmap and set up the image instance */ + if (slice == 0) + init_image_instance_from_dibitmap (ii, bmp_info, dest_mask, + bmp_data, bmp_bits, slices, instantiator, + 0, 0, 0); + else + image_instance_add_dibitmap (ii, bmp_info, bmp_data, bmp_bits, slice, + instantiator); + + xfree (bmp_info); + xfree (bmp_data); } - - /* Now create the pixmap and set up the image instance */ - init_image_instance_from_dibitmap (ii, bmp_info, dest_mask, - bmp_data, bmp_bits, instantiator, - 0, 0, 0); - - xfree (bmp_info); - xfree (bmp_data); } -static void set_mono_pixel ( unsigned char* bits, - int bpline, int height, - int x, int y, int white ) -{ - int index; - unsigned char bitnum; +static void set_mono_pixel ( unsigned char* bits, + int bpline, int height, + int x, int y, int white ) +{ + int i; + unsigned char bitnum; /* Find the byte on which this scanline begins */ - index = (height - y - 1) * bpline; + i = (height - y - 1) * bpline; /* Find the byte containing this pixel */ - index += (x >> 3); + i += (x >> 3); /* Which bit is it? */ - bitnum = (unsigned char)( 7 - (x % 8) ); + bitnum = (unsigned char)( 7 - (x % 8) ); if( white ) /* Turn it on */ - bits[index] |= (1<<bitnum); + bits[i] |= (1<<bitnum); else /* Turn it off */ - bits[index] &= ~(1<<bitnum); -} + bits[i] &= ~(1<<bitnum); +} static void -mswindows_initialize_image_instance_mask (struct Lisp_Image_Instance* image, +mswindows_initialize_image_instance_mask (Lisp_Image_Instance* image, struct frame* f) { HBITMAP mask; HGDIOBJ old = NULL; HDC hcdc = FRAME_MSWINDOWS_CDC (f); unsigned char* dibits; - BITMAPINFO* bmp_info = + BITMAPINFO* bmp_info = xmalloc_and_zero (sizeof(BITMAPINFO) + sizeof(RGBQUAD)); int i, j; int height = IMAGE_INSTANCE_PIXMAP_HEIGHT (image); - - void* and_bits; - int maskbpline = BPLINE (((IMAGE_INSTANCE_PIXMAP_WIDTH (image)+7)/8)); - int bpline = BPLINE (IMAGE_INSTANCE_PIXMAP_WIDTH (image) * 3); + + void* and_bits; + int maskbpline = BPLINE ((IMAGE_INSTANCE_PIXMAP_WIDTH (image)+7)/8); + int bpline = BPLINE (IMAGE_INSTANCE_PIXMAP_WIDTH (image) * 3); if (!bmp_info) return; @@ -420,11 +475,11 @@ bmp_info->bmiHeader.biHeight = height; bmp_info->bmiHeader.biPlanes=1; bmp_info->bmiHeader.biSize=sizeof(BITMAPINFOHEADER); - bmp_info->bmiHeader.biBitCount=1; - bmp_info->bmiHeader.biCompression=BI_RGB; - bmp_info->bmiHeader.biClrUsed = 2; - bmp_info->bmiHeader.biClrImportant = 2; - bmp_info->bmiHeader.biSizeImage = height * maskbpline; + bmp_info->bmiHeader.biBitCount=1; + bmp_info->bmiHeader.biCompression=BI_RGB; + bmp_info->bmiHeader.biClrUsed = 2; + bmp_info->bmiHeader.biClrImportant = 2; + bmp_info->bmiHeader.biSizeImage = height * maskbpline; bmp_info->bmiColors[0].rgbRed = 0; bmp_info->bmiColors[0].rgbGreen = 0; bmp_info->bmiColors[0].rgbBlue = 0; @@ -433,11 +488,11 @@ bmp_info->bmiColors[1].rgbGreen = 255; bmp_info->bmiColors[1].rgbBlue = 255; bmp_info->bmiColors[0].rgbReserved = 0; - - if (!(mask = CreateDIBSection (hcdc, + + if (!(mask = CreateDIBSection (hcdc, bmp_info, DIB_RGB_COLORS, - &and_bits, + &and_bits, 0,0))) { xfree (bmp_info); @@ -452,10 +507,10 @@ bmp_info->bmiHeader.biHeight = -height; bmp_info->bmiHeader.biPlanes=1; bmp_info->bmiHeader.biSize=sizeof(BITMAPINFOHEADER); - bmp_info->bmiHeader.biBitCount=24; - bmp_info->bmiHeader.biCompression=BI_RGB; - bmp_info->bmiHeader.biClrUsed = 0; - bmp_info->bmiHeader.biClrImportant = 0; + bmp_info->bmiHeader.biBitCount=24; + bmp_info->bmiHeader.biCompression=BI_RGB; + bmp_info->bmiHeader.biClrUsed = 0; + bmp_info->bmiHeader.biClrImportant = 0; bmp_info->bmiHeader.biSizeImage = height * bpline; dibits = xmalloc_and_zero (bpline * height); @@ -473,19 +528,19 @@ /* now set the colored bits in the mask and transparent ones to black in the original */ - for(i=0; i<IMAGE_INSTANCE_PIXMAP_WIDTH (image); i++) - { - for(j=0; j<height; j++) - { + for(i=0; i<IMAGE_INSTANCE_PIXMAP_WIDTH (image); i++) + { + for(j=0; j<height; j++) + { unsigned char* idx = &dibits[j * bpline + i * 3]; if( RGB (idx[2], idx[1], idx[0]) == transparent_color ) - { + { idx[0] = idx[1] = idx[2] = 0; set_mono_pixel( and_bits, maskbpline, height, i, j, TRUE ); } - else - { + else + { set_mono_pixel( and_bits, maskbpline, height, i, j, FALSE ); } } @@ -501,14 +556,14 @@ xfree (bmp_info); xfree (dibits); - + SelectObject(hcdc, old); IMAGE_INSTANCE_MSWINDOWS_MASK (image) = mask; } void -mswindows_initialize_image_instance_icon (struct Lisp_Image_Instance* image, +mswindows_initialize_image_instance_icon (Lisp_Image_Instance* image, int cursor) { ICONINFO x_icon; @@ -519,31 +574,31 @@ x_icon.yHotspot=XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (image)); x_icon.hbmMask=IMAGE_INSTANCE_MSWINDOWS_MASK (image); x_icon.hbmColor=IMAGE_INSTANCE_MSWINDOWS_BITMAP (image); - + IMAGE_INSTANCE_MSWINDOWS_ICON (image)= CreateIconIndirect (&x_icon); } HBITMAP -mswindows_create_resized_bitmap (struct Lisp_Image_Instance* ii, +mswindows_create_resized_bitmap (Lisp_Image_Instance* ii, struct frame* f, int newx, int newy) { HBITMAP newbmp; HGDIOBJ old1, old2; HDC hcdc = FRAME_MSWINDOWS_CDC (f); - HDC hdcDst = CreateCompatibleDC (hcdc); - - old1 = SelectObject (hcdc, IMAGE_INSTANCE_MSWINDOWS_BITMAP (ii)); - + HDC hdcDst = CreateCompatibleDC (hcdc); + + old1 = SelectObject (hcdc, IMAGE_INSTANCE_MSWINDOWS_BITMAP (ii)); + newbmp = CreateCompatibleBitmap (hcdc, newx, newy); old2 = SelectObject (hdcDst, newbmp); - + if (!StretchBlt (hdcDst, 0, 0, newx, newy, - hcdc, 0, 0, - IMAGE_INSTANCE_PIXMAP_WIDTH (ii), - IMAGE_INSTANCE_PIXMAP_HEIGHT (ii), + hcdc, 0, 0, + IMAGE_INSTANCE_PIXMAP_WIDTH (ii), + IMAGE_INSTANCE_PIXMAP_HEIGHT (ii), SRCCOPY)) { DeleteObject (newbmp); @@ -559,7 +614,7 @@ } HBITMAP -mswindows_create_resized_mask (struct Lisp_Image_Instance* ii, +mswindows_create_resized_mask (Lisp_Image_Instance* ii, struct frame* f, int newx, int newy) { @@ -568,23 +623,23 @@ HBITMAP newmask; HGDIOBJ old1, old2; HDC hcdc = FRAME_MSWINDOWS_CDC (f); - HDC hdcDst = CreateCompatibleDC (hcdc); - - old1 = SelectObject (hcdc, IMAGE_INSTANCE_MSWINDOWS_MASK (ii)); + HDC hdcDst = CreateCompatibleDC (hcdc); + + old1 = SelectObject (hcdc, IMAGE_INSTANCE_MSWINDOWS_MASK (ii)); newmask = CreateCompatibleBitmap(hcdc, newx, newy); old2 = SelectObject (hdcDst, newmask); if (!StretchBlt(hdcDst, 0, 0, newx, newy, - hcdc, 0, 0, - IMAGE_INSTANCE_PIXMAP_WIDTH (ii), - IMAGE_INSTANCE_PIXMAP_HEIGHT (ii), + hcdc, 0, 0, + IMAGE_INSTANCE_PIXMAP_WIDTH (ii), + IMAGE_INSTANCE_PIXMAP_HEIGHT (ii), SRCCOPY)) { DeleteObject (newmask); DeleteDC (hdcDst); return NULL; } - + SelectObject (hdcDst, old2); SelectObject (hcdc, old1); @@ -597,7 +652,7 @@ } int -mswindows_resize_dibitmap_instance (struct Lisp_Image_Instance* ii, +mswindows_resize_dibitmap_instance (Lisp_Image_Instance* ii, struct frame* f, int newx, int newy) { @@ -606,7 +661,7 @@ if (!newbmp) return FALSE; - + if (IMAGE_INSTANCE_MSWINDOWS_BITMAP (ii)) DeleteObject (IMAGE_INSTANCE_MSWINDOWS_BITMAP (ii)); if (IMAGE_INSTANCE_MSWINDOWS_MASK (ii)) @@ -682,10 +737,12 @@ for (j=0; j<i; j++) { Lisp_Object cons = XCAR (results); - colortbl[j].color = + colortbl[j].color = COLOR_INSTANCE_MSWINDOWS_COLOR (XCOLOR_INSTANCE (XCDR (cons))); - GET_C_STRING_OS_DATA_ALLOCA (XCAR (cons), colortbl[j].name); + TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (cons), + C_STRING_ALLOCA, colortbl[j].name, + Qnative); colortbl[j].name = xstrdup (colortbl[j].name); /* mustn't lose this when we return */ free_cons (XCONS (cons)); cons = results; @@ -695,7 +752,7 @@ return colortbl; } -static int xpm_to_eimage (Lisp_Object image, CONST Extbyte *buffer, +static int xpm_to_eimage (Lisp_Object image, const Extbyte *buffer, unsigned char** data, int* width, int* height, int* x_hot, int* y_hot, @@ -709,7 +766,7 @@ unsigned char* dptr; unsigned int* sptr; COLORREF color; /* the american spelling virus hits again .. */ - COLORREF* colortbl; + COLORREF* colortbl; xzero (xpmimage); xzero (xpminfo); @@ -739,11 +796,11 @@ make_int (result), image); } } - + *width = xpmimage.width; *height = xpmimage.height; - maskbpline = BPLINE (((~7UL & (unsigned long)(*width + 7)) / 8)); - + maskbpline = BPLINE ((~7UL & (unsigned long)(*width + 7)) / 8); + *data = xnew_array_and_zero (unsigned char, *width * *height * 3); if (!*data) @@ -774,7 +831,7 @@ !strcasecmp (xpmimage.colorTable[i].symbolic,"None")) { *transp=TRUE; - colortbl[i]=transparent_color; + colortbl[i]=transparent_color; transp_idx=i; goto label_found_color; } @@ -799,7 +856,7 @@ if (!strcasecmp (xpmimage.colorTable[i].c_color,"None")) { *transp=TRUE; - colortbl[i]=transparent_color; + colortbl[i]=transparent_color; transp_idx=i; goto label_found_color; } @@ -810,14 +867,14 @@ mswindows_string_to_color (xpmimage.colorTable[i].c_color); goto label_found_color; } - + label_no_color: xfree (*data); xfree (colortbl); XpmFreeXpmImage (&xpmimage); XpmFreeXpmInfo (&xpminfo); return 0; - + label_found_color:; } @@ -849,9 +906,9 @@ Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); - CONST Extbyte *bytes; + const Extbyte *bytes; Extcount len; unsigned char *eimage; int width, height, x_hot, y_hot; @@ -860,7 +917,7 @@ int bmp_bits; int nsymbols=0, transp; struct color_symbol* color_symbols=NULL; - + Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); Lisp_Object color_symbol_alist = find_keyword_in_vector (instantiator, Q_color_symbols); @@ -870,7 +927,9 @@ assert (!NILP (data)); - GET_STRING_BINARY_DATA_ALLOCA (data, bytes, len); + TO_EXTERNAL_FORMAT (LISP_STRING, data, + ALLOCA, (bytes, len), + Qbinary); /* in case we have color symbols */ color_symbols = extract_xpm_color_names (device, domain, @@ -880,10 +939,10 @@ if (!xpm_to_eimage (image_instance, bytes, &eimage, &width, &height, &x_hot, &y_hot, &transp, color_symbols, nsymbols)) { - signal_simple_error ("XPM to EImage conversion failed", + signal_simple_error ("XPM to EImage conversion failed", image_instance); } - + if (color_symbols) { while (nsymbols--) @@ -892,7 +951,7 @@ } xfree(color_symbols); } - + /* build a bitmap from the eimage */ if (!(bmp_info=convert_EImage_to_DIBitmap (device, width, height, eimage, &bmp_bits, &bmp_data))) @@ -904,7 +963,7 @@ /* Now create the pixmap and set up the image instance */ init_image_instance_from_dibitmap (ii, bmp_info, dest_mask, - bmp_data, bmp_bits, instantiator, + bmp_data, bmp_bits, 1, instantiator, x_hot, y_hot, transp); xfree (bmp_info); @@ -939,9 +998,9 @@ Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); - CONST Extbyte *bytes; + const Extbyte *bytes; Extcount len; BITMAPFILEHEADER* bmp_file_header; BITMAPINFO* bmp_info; @@ -954,12 +1013,14 @@ assert (!NILP (data)); - GET_STRING_BINARY_DATA_ALLOCA (data, bytes, len); - + TO_EXTERNAL_FORMAT (LISP_STRING, data, + ALLOCA, (bytes, len), + Qbinary); + /* Then slurp the image into memory, decoding along the way. The result is the image in a simple one-byte-per-pixel format. */ - + bmp_file_header=(BITMAPFILEHEADER*)bytes; bmp_info = (BITMAPINFO*)(bytes + sizeof(BITMAPFILEHEADER)); bmp_data = (Extbyte*)bytes + bmp_file_header->bfOffBits; @@ -967,7 +1028,7 @@ /* Now create the pixmap and set up the image instance */ init_image_instance_from_dibitmap (ii, bmp_info, dest_mask, - bmp_data, bmp_bits, instantiator, + bmp_data, bmp_bits, 1, instantiator, 0, 0, 0); } @@ -979,9 +1040,9 @@ static void mswindows_resource_validate (Lisp_Object instantiator) { - if ((NILP (find_keyword_in_vector (instantiator, Q_file)) + if ((NILP (find_keyword_in_vector (instantiator, Q_file)) && - NILP (find_keyword_in_vector (instantiator, Q_resource_id))) + NILP (find_keyword_in_vector (instantiator, Q_resource_id))) || NILP (find_keyword_in_vector (instantiator, Q_resource_type))) signal_simple_error ("Must supply :file, :resource-id and :resource-type", @@ -998,7 +1059,7 @@ GCPRO2 (file, alist); - file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, + file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, console_type); if (CONSP (file)) /* failure locating filename */ @@ -1029,7 +1090,7 @@ return IMAGE_POINTER_MASK | IMAGE_COLOR_PIXMAP_MASK; } -typedef struct +typedef struct { char *name; int resource_id; @@ -1043,10 +1104,12 @@ #define OIC_BANG 32515 #define OIC_NOTE 32516 #define OIC_WINLOGO 32517 +#if defined (__CYGWIN32__) && CYGWIN_VERSION_DLL_MAJOR < 21 #define LR_SHARED 0x8000 #endif - -static CONST resource_t bitmap_table[] = +#endif + +static const resource_t bitmap_table[] = { /* bitmaps */ { "close", OBM_CLOSE }, @@ -1078,7 +1141,7 @@ {0} }; -static CONST resource_t cursor_table[] = +static const resource_t cursor_table[] = { /* cursors */ { "normal", OCR_NORMAL }, @@ -1097,7 +1160,7 @@ { 0 } }; -static CONST resource_t icon_table[] = +static const resource_t icon_table[] = { /* icons */ { "sample", OIC_SAMPLE }, @@ -1111,8 +1174,8 @@ static int resource_name_to_resource (Lisp_Object name, int type) { - CONST resource_t* res = (type == IMAGE_CURSOR ? cursor_table - : type == IMAGE_ICON ? icon_table + const resource_t* res = (type == IMAGE_CURSOR ? cursor_table + : type == IMAGE_ICON ? icon_table : bitmap_table); if (INTP (name)) @@ -1123,10 +1186,12 @@ { signal_simple_error ("invalid resource identifier", name); } - + do { Extbyte* nm=0; - GET_C_STRING_OS_DATA_ALLOCA (name, nm); + TO_EXTERNAL_FORMAT (LISP_STRING, name, + C_STRING_ALLOCA, nm, + Qnative); if (!strcasecmp ((char*)res->name, nm)) return res->resource_id; } while ((++res)->name); @@ -1151,7 +1216,7 @@ Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); unsigned int type = 0; HANDLE himage = NULL; LPCTSTR resid=0; @@ -1162,9 +1227,9 @@ Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); Lisp_Object file = find_keyword_in_vector (instantiator, Q_file); - Lisp_Object resource_type = find_keyword_in_vector (instantiator, + Lisp_Object resource_type = find_keyword_in_vector (instantiator, Q_resource_type); - Lisp_Object resource_id = find_keyword_in_vector (instantiator, + Lisp_Object resource_id = find_keyword_in_vector (instantiator, Q_resource_id); xzero (iconinfo); @@ -1178,7 +1243,7 @@ iitype = IMAGE_POINTER; else if (dest_mask & IMAGE_COLOR_PIXMAP_MASK) iitype = IMAGE_COLOR_PIXMAP; - else + else incompatible_image_types (instantiator, dest_mask, IMAGE_COLOR_PIXMAP_MASK | IMAGE_POINTER_MASK); @@ -1186,13 +1251,15 @@ if (!NILP (file)) { Extbyte* f=0; - GET_C_STRING_FILENAME_DATA_ALLOCA (file, f); + TO_EXTERNAL_FORMAT (LISP_STRING, file, + C_STRING_ALLOCA, f, + Qfile_name); #ifdef __CYGWIN32__ CYGWIN_WIN32_PATH (f, fname); #else fname = f; #endif - + if (NILP (resource_id)) resid = (LPCTSTR)fname; else @@ -1201,19 +1268,21 @@ LOAD_LIBRARY_AS_DATAFILE); resid = MAKEINTRESOURCE (resource_name_to_resource (resource_id, type)); - + if (!resid) - GET_C_STRING_OS_DATA_ALLOCA (resource_id, resid); + TO_EXTERNAL_FORMAT (LISP_STRING, resource_id, + C_STRING_ALLOCA, resid, + Qnative); } } else if (!(resid = MAKEINTRESOURCE (resource_name_to_resource (resource_id, type)))) signal_simple_error ("Invalid resource identifier", resource_id); - + /* load the image */ if (!(himage = LoadImage (hinst, resid, type, 0, 0, - LR_CREATEDIBSECTION | LR_DEFAULTSIZE | - LR_SHARED | + LR_CREATEDIBSECTION | LR_DEFAULTSIZE | + LR_SHARED | (!NILP (file) ? LR_LOADFROMFILE : 0)))) { signal_simple_error ("Cannot load image", instantiator); @@ -1222,12 +1291,12 @@ if (hinst) FreeLibrary (hinst); - mswindows_initialize_dibitmap_image_instance (ii, iitype); + mswindows_initialize_dibitmap_image_instance (ii, 1, iitype); IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = file; - IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = + IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = GetSystemMetrics (type == IMAGE_CURSOR ? SM_CXCURSOR : SM_CXICON); - IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = + IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = GetSystemMetrics (type == IMAGE_CURSOR ? SM_CYCURSOR : SM_CYICON); IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = 1; @@ -1271,15 +1340,6 @@ signal_simple_error ("invalid resource identifier", data); } -void -check_valid_string_or_int (Lisp_Object data) -{ - if (!INTP (data)) - CHECK_STRING (data); - else - CHECK_INT (data); -} - /********************************************************************** * XBM * **********************************************************************/ @@ -1324,7 +1384,7 @@ * and return data * * Note that this file and ../X/XRdBitF.c look very similar.... Keep them - * that way (but don't use common source code so that people can have one + * that way (but don't use common source code so that people can have one * without the other). */ @@ -1374,7 +1434,7 @@ hexTable[' '] = -1; hexTable[','] = -1; hexTable['}'] = -1; hexTable['\n'] = -1; hexTable['\t'] = -1; - + initialized = TRUE; } @@ -1387,7 +1447,7 @@ int value = 0; int gotone = 0; int done = 0; - + /* loop, accumulate hex value until find delimiter */ /* skip any initial delimiters found in read stream */ @@ -1468,7 +1528,7 @@ } continue; } - + if (sscanf(line, "static short %s = {", name_and_type) == 1) version10p = 1; else if (sscanf(line,"static unsigned char %s = {",name_and_type) == 1) @@ -1485,7 +1545,7 @@ if (strcmp("bits[]", type)) continue; - + if (!ww || !hh) RETURN (BitmapFileInvalid); @@ -1498,7 +1558,7 @@ size = bytes_per_line * hh; data = (unsigned char *) Xmalloc ((unsigned int) size); - if (!data) + if (!data) RETURN (BitmapNoMemory); if (version10p) { @@ -1517,7 +1577,7 @@ int bytes; for (bytes=0, ptr=data; bytes<size; bytes++, ptr++) { - if ((value = NextInt(fstream)) < 0) + if ((value = NextInt(fstream)) < 0) RETURN (BitmapFileInvalid); *ptr=value; } @@ -1540,7 +1600,7 @@ } -int read_bitmap_data_from_file (CONST char *filename, unsigned int *width, +int read_bitmap_data_from_file (const char *filename, unsigned int *width, unsigned int *height, unsigned char **datap, int *x_hot, int *y_hot) { @@ -1569,7 +1629,7 @@ padded to a multiple of 16. Scan lines are stored in increasing byte order from left to right, big-endian within a byte. 0 = black, 1 = white. */ -HBITMAP +static HBITMAP xbm_create_bitmap_from_data (HDC hdc, char *data, unsigned int width, unsigned int height, int mask, COLORREF fg, COLORREF bg) @@ -1580,21 +1640,21 @@ void *bmp_buf = 0; unsigned char *new_data, *new_offset; int i, j; - BITMAPINFO* bmp_info = + BITMAPINFO* bmp_info = xmalloc_and_zero (sizeof(BITMAPINFO) + sizeof(RGBQUAD)); HBITMAP bitmap; if (!bmp_info) return NULL; - + new_data = (unsigned char *) xmalloc_and_zero (height * new_width); - + if (!new_data) { xfree (bmp_info); return NULL; } - + for (i=0; i<height; i++) { offset = data + i*old_width; @@ -1622,11 +1682,11 @@ bmp_info->bmiHeader.biHeight=-(LONG)height; bmp_info->bmiHeader.biPlanes=1; bmp_info->bmiHeader.biSize=sizeof(BITMAPINFOHEADER); - bmp_info->bmiHeader.biBitCount=1; + bmp_info->bmiHeader.biBitCount=1; bmp_info->bmiHeader.biCompression=BI_RGB; - bmp_info->bmiHeader.biClrUsed = 2; - bmp_info->bmiHeader.biClrImportant = 2; - bmp_info->bmiHeader.biSizeImage = height * new_width; + bmp_info->bmiHeader.biClrUsed = 2; + bmp_info->bmiHeader.biClrImportant = 2; + bmp_info->bmiHeader.biSizeImage = height * new_width; bmp_info->bmiColors[0].rgbRed = GetRValue (fg); bmp_info->bmiColors[0].rgbGreen = GetGValue (fg); bmp_info->bmiColors[0].rgbBlue = GetBValue (fg); @@ -1635,21 +1695,21 @@ bmp_info->bmiColors[1].rgbGreen = GetGValue (bg); bmp_info->bmiColors[1].rgbBlue = GetBValue (bg); bmp_info->bmiColors[1].rgbReserved = 0; - - bitmap = CreateDIBSection (hdc, + + bitmap = CreateDIBSection (hdc, bmp_info, DIB_RGB_COLORS, - &bmp_buf, + &bmp_buf, 0,0); xfree (bmp_info); - + if (!bitmap || !bmp_buf) { xfree (new_data); return NULL; } - + /* copy in the actual bitmap */ memcpy (bmp_buf, new_data, height * new_width); xfree (new_data); @@ -1661,10 +1721,10 @@ image instance accordingly. */ static void -init_image_instance_from_xbm_inline (struct Lisp_Image_Instance *ii, +init_image_instance_from_xbm_inline (Lisp_Image_Instance *ii, int width, int height, /* Note that data is in ext-format! */ - CONST char *bits, + const char *bits, Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, @@ -1704,8 +1764,8 @@ IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK | IMAGE_POINTER_MASK); - mswindows_initialize_dibitmap_image_instance (ii, type); - + mswindows_initialize_dibitmap_image_instance (ii, 1, type); + IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = find_keyword_in_vector (instantiator, Q_file); IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = width; @@ -1714,14 +1774,14 @@ XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), 0); XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), 0); IMAGE_INSTANCE_MSWINDOWS_MASK (ii) = mask ? mask : - xbm_create_bitmap_from_data (hdc, (Extbyte *) bits, width, height, + xbm_create_bitmap_from_data (hdc, (Extbyte *) bits, width, height, TRUE, black, white); switch (type) { case IMAGE_MONO_PIXMAP: - IMAGE_INSTANCE_MSWINDOWS_BITMAP (ii) = - xbm_create_bitmap_from_data (hdc, (Extbyte *) bits, width, height, + IMAGE_INSTANCE_MSWINDOWS_BITMAP (ii) = + xbm_create_bitmap_from_data (hdc, (Extbyte *) bits, width, height, FALSE, black, black); break; @@ -1749,8 +1809,8 @@ IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground; IMAGE_INSTANCE_PIXMAP_BG (ii) = background; - IMAGE_INSTANCE_MSWINDOWS_BITMAP (ii) = - xbm_create_bitmap_from_data (hdc, (Extbyte *) bits, width, height, + IMAGE_INSTANCE_MSWINDOWS_BITMAP (ii) = + xbm_create_bitmap_from_data (hdc, (Extbyte *) bits, width, height, FALSE, fg, black); } break; @@ -1765,9 +1825,9 @@ if (NILP (background)) background = pointer_bg; - IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) = + IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) = find_keyword_in_vector (instantiator, Q_hotspot_x); - IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = + IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = find_keyword_in_vector (instantiator, Q_hotspot_y); IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground; IMAGE_INSTANCE_PIXMAP_BG (ii) = background; @@ -1776,8 +1836,8 @@ if (COLOR_INSTANCEP (background)) bg = COLOR_INSTANCE_MSWINDOWS_COLOR (XCOLOR_INSTANCE (background)); - IMAGE_INSTANCE_MSWINDOWS_BITMAP (ii) = - xbm_create_bitmap_from_data (hdc, (Extbyte *) bits, width, height, + IMAGE_INSTANCE_MSWINDOWS_BITMAP (ii) = + xbm_create_bitmap_from_data (hdc, (Extbyte *) bits, width, height, TRUE, fg, black); mswindows_initialize_image_instance_icon (ii, TRUE); } @@ -1793,29 +1853,30 @@ Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, int width, int height, /* Note that data is in ext-format! */ - CONST char *bits) + const char *bits) { Lisp_Object mask_data = find_keyword_in_vector (instantiator, Q_mask_data); Lisp_Object mask_file = find_keyword_in_vector (instantiator, Q_mask_file); - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - struct frame* f = XFRAME (DEVICE_SELECTED_FRAME + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + struct frame* f = XFRAME (DEVICE_SELECTED_FRAME (XDEVICE (IMAGE_INSTANCE_DEVICE (ii)))); HDC hdc = FRAME_MSWINDOWS_CDC (f); HBITMAP mask = 0; - CONST char *gcc_may_you_rot_in_hell; if (!NILP (mask_data)) { - GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (mask_data))), - gcc_may_you_rot_in_hell); - mask = - xbm_create_bitmap_from_data ( hdc, - (unsigned char *) - gcc_may_you_rot_in_hell, - XINT (XCAR (mask_data)), - XINT (XCAR (XCDR (mask_data))), FALSE, - PALETTERGB (0,0,0), - PALETTERGB (255,255,255)); + const char *ext_data; + + TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (XCDR (XCDR (mask_data))), + C_STRING_ALLOCA, ext_data, + Qbinary); + mask = xbm_create_bitmap_from_data (hdc, + (unsigned char *) ext_data, + XINT (XCAR (mask_data)), + XINT (XCAR (XCDR (mask_data))), + FALSE, + PALETTERGB (0,0,0), + PALETTERGB (255,255,255)); } init_image_instance_from_xbm_inline (ii, width, height, bits, @@ -1826,22 +1887,23 @@ /* Instantiate method for XBM's. */ static void -mswindows_xbm_instantiate (Lisp_Object image_instance, +mswindows_xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - CONST char *gcc_go_home; + const char *ext_data; assert (!NILP (data)); - GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (data))), - gcc_go_home); + TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (XCDR (XCDR (data))), + C_STRING_ALLOCA, ext_data, + Qbinary); xbm_instantiate_1 (image_instance, instantiator, pointer_fg, pointer_bg, dest_mask, XINT (XCAR (data)), - XINT (XCAR (XCDR (data))), gcc_go_home); + XINT (XCAR (XCDR (data))), ext_data); } #ifdef HAVE_XFACE @@ -1876,12 +1938,14 @@ Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); int i, stattis; char *p, *bits, *bp; - CONST char * volatile emsg = 0; - CONST char * volatile dstring; + const char * volatile emsg = 0; + const char * volatile dstring; assert (!NILP (data)); - GET_C_STRING_BINARY_DATA_ALLOCA (data, dstring); + TO_EXTERNAL_FORMAT (LISP_STRING, data, + C_STRING_ALLOCA, dstring, + Qbinary); if ((p = strchr (dstring, ':'))) { @@ -1937,7 +2001,7 @@ /************************************************************************/ static void -mswindows_print_image_instance (struct Lisp_Image_Instance *p, +mswindows_print_image_instance (Lisp_Image_Instance *p, Lisp_Object printcharfun, int escapeflag) { @@ -1948,12 +2012,12 @@ case IMAGE_MONO_PIXMAP: case IMAGE_COLOR_PIXMAP: case IMAGE_POINTER: - sprintf (buf, " (0x%lx", + sprintf (buf, " (0x%lx", (unsigned long) IMAGE_INSTANCE_MSWINDOWS_BITMAP (p)); write_c_string (buf, printcharfun); if (IMAGE_INSTANCE_MSWINDOWS_MASK (p)) { - sprintf (buf, "/0x%lx", + sprintf (buf, "/0x%lx", (unsigned long) IMAGE_INSTANCE_MSWINDOWS_MASK (p)); write_c_string (buf, printcharfun); } @@ -1965,24 +2029,47 @@ } } +#ifdef DEBUG_WIDGETS +extern int debug_widget_instances; +#endif + static void -mswindows_finalize_image_instance (struct Lisp_Image_Instance *p) +mswindows_finalize_image_instance (Lisp_Image_Instance *p) { if (DEVICE_LIVE_P (XDEVICE (p->device))) { if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET - || + || IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW) { +#ifdef DEBUG_WIDGETS + debug_widget_instances--; + stderr_out ("widget destroyed, %d left\n", debug_widget_instances); +#endif if (IMAGE_INSTANCE_SUBWINDOW_ID (p)) - DestroyWindow (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p)); - IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0; + { + DestroyWindow (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p)); + DestroyWindow (IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW (p)); + IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0; + } } else if (p->data) { - if (IMAGE_INSTANCE_MSWINDOWS_BITMAP (p)) - DeleteObject (IMAGE_INSTANCE_MSWINDOWS_BITMAP (p)); - IMAGE_INSTANCE_MSWINDOWS_BITMAP (p) = 0; + int i; + if (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p)) + disable_glyph_animated_timeout (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p)); + + if (IMAGE_INSTANCE_MSWINDOWS_BITMAP_SLICES (p)) + { + for (i = 0; i < IMAGE_INSTANCE_PIXMAP_MAXSLICE (p); i++) + { + if (IMAGE_INSTANCE_MSWINDOWS_BITMAP_SLICE (p, i)) + DeleteObject (IMAGE_INSTANCE_MSWINDOWS_BITMAP_SLICE (p, i)); + IMAGE_INSTANCE_MSWINDOWS_BITMAP_SLICE (p, i) = 0; + } + xfree (IMAGE_INSTANCE_MSWINDOWS_BITMAP_SLICES (p)); + IMAGE_INSTANCE_MSWINDOWS_BITMAP_SLICES (p) = 0; + } if (IMAGE_INSTANCE_MSWINDOWS_MASK (p)) DeleteObject (IMAGE_INSTANCE_MSWINDOWS_MASK (p)); IMAGE_INSTANCE_MSWINDOWS_MASK (p) = 0; @@ -2003,51 +2090,115 @@ /* subwindow and widget support */ /************************************************************************/ +static HFONT +mswindows_widget_hfont (Lisp_Image_Instance *p, + Lisp_Object domain) +{ + Lisp_Object face = IMAGE_INSTANCE_WIDGET_FACE (p); + int under = FACE_UNDERLINE_P (face, domain); + int strike = FACE_STRIKETHRU_P (face, domain); + Lisp_Object font = query_string_font (IMAGE_INSTANCE_WIDGET_TEXT (p), + face, domain); + + return mswindows_get_hfont (XFONT_INSTANCE (font), under, strike); +} + /* unmap the image if it is a widget. This is used by redisplay via redisplay_unmap_subwindows */ static void -mswindows_unmap_subwindow (struct Lisp_Image_Instance *p) +mswindows_unmap_subwindow (Lisp_Image_Instance *p) { if (IMAGE_INSTANCE_SUBWINDOW_ID (p)) { - SetWindowPos (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p), - NULL, + SetWindowPos (IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW (p), + NULL, 0, 0, 0, 0, - SWP_HIDEWINDOW | SWP_NOMOVE | SWP_NOSIZE - | SWP_NOCOPYBITS | SWP_NOSENDCHANGING); + SWP_HIDEWINDOW | SWP_NOMOVE | SWP_NOSIZE + | SWP_NOSENDCHANGING); + if (GetFocus() == WIDGET_INSTANCE_MSWINDOWS_HANDLE (p)) + SetFocus (GetParent (IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW (p))); } } /* map the subwindow. This is used by redisplay via redisplay_output_subwindow */ static void -mswindows_map_subwindow (struct Lisp_Image_Instance *p, int x, int y) +mswindows_map_subwindow (Lisp_Image_Instance *p, int x, int y, + struct display_glyph_area* dga) { - /* ShowWindow (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p), SW_SHOW);*/ - SetWindowPos (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p), - NULL, - x, y, 0, 0, - SWP_NOZORDER | SWP_SHOWWINDOW | SWP_NOSIZE + /* move the window before mapping it ... */ + SetWindowPos (IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW (p), + NULL, + x, y, dga->width, dga->height, + SWP_NOZORDER + | SWP_NOCOPYBITS | SWP_NOSENDCHANGING); + /* ... adjust the child ... */ + SetWindowPos (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p), + NULL, + -dga->xoffset, -dga->yoffset, 0, 0, + SWP_NOZORDER | SWP_NOSIZE | SWP_NOCOPYBITS | SWP_NOSENDCHANGING); + /* ... now map it - we are not allowed to move it at the same time. */ + SetWindowPos (IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW (p), + NULL, + 0, 0, 0, 0, + SWP_NOZORDER | SWP_NOSIZE | SWP_NOMOVE + | SWP_SHOWWINDOW | SWP_NOCOPYBITS + | SWP_NOSENDCHANGING); +} + +/* resize the subwindow instance */ +static void +mswindows_resize_subwindow (Lisp_Image_Instance* ii, int w, int h) +{ + /* Set the size of the control .... */ + SetWindowPos (WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii), + NULL, + 0, 0, w, h, + SWP_NOZORDER | SWP_NOMOVE + | SWP_NOCOPYBITS | SWP_NOSENDCHANGING); +} + +/* Simply resize the window here. */ +static void +mswindows_update_subwindow (Lisp_Image_Instance *p) +{ + mswindows_resize_subwindow (p, + IMAGE_INSTANCE_WIDTH (p), + IMAGE_INSTANCE_HEIGHT (p)); } /* when you click on a widget you may activate another widget this needs to be checked and all appropriate widgets updated */ static void -mswindows_update_subwindow (struct Lisp_Image_Instance *p) +mswindows_update_widget (Lisp_Image_Instance *p) { - if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET) + /* Possibly update the face font and colors. */ + if (IMAGE_INSTANCE_WIDGET_FACE_CHANGED (p)) { - /* buttons checked or otherwise */ - if ( EQ (IMAGE_INSTANCE_WIDGET_TYPE (p), Qbutton)) - { - if (gui_item_selected_p (&IMAGE_INSTANCE_WIDGET_ITEM (p))) - SendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p), - BM_SETCHECK, (WPARAM)BST_CHECKED, 0); - else - SendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p), - BM_SETCHECK, (WPARAM)BST_UNCHECKED, 0); - } + /* set the widget font from the widget face */ + SendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p), + WM_SETFONT, + (WPARAM) mswindows_widget_hfont + (p, IMAGE_INSTANCE_SUBWINDOW_FRAME (p)), + MAKELPARAM (TRUE, 0)); + } + /* Possibly update the dimensions. */ + if (IMAGE_INSTANCE_SIZE_CHANGED (p)) + { + mswindows_resize_subwindow (p, + IMAGE_INSTANCE_WIDTH (p), + IMAGE_INSTANCE_HEIGHT (p)); + } + /* Possibly update the text in the widget. */ + if (IMAGE_INSTANCE_TEXT_CHANGED (p)) + { + Extbyte* lparam=0; + TO_EXTERNAL_FORMAT (LISP_STRING, IMAGE_INSTANCE_WIDGET_TEXT (p), + C_STRING_ALLOCA, lparam, + Qnative); + SendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p), + WM_SETTEXT, 0, (LPARAM)lparam); } } @@ -2055,25 +2206,32 @@ callbacks. The hashtable is weak so deregistration is handled automatically */ static int -mswindows_register_widget_instance (Lisp_Object instance, Lisp_Object domain) +mswindows_register_gui_item (Lisp_Object gui, Lisp_Object domain) { Lisp_Object frame = FW_FRAME (domain); struct frame* f = XFRAME (frame); - int id = gui_item_hash (FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f), - &XIMAGE_INSTANCE_WIDGET_ITEM (instance), - WIDGET_GLYPH_SLOT); + int id = gui_item_id_hash (FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f), + gui, + WIDGET_GLYPH_SLOT); Fputhash (make_int (id), - XIMAGE_INSTANCE_WIDGET_CALLBACK (instance), + XGUI_ITEM (gui)->callback, FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f)); return id; } +static int +mswindows_register_widget_instance (Lisp_Object instance, Lisp_Object domain) +{ + return mswindows_register_gui_item (XIMAGE_INSTANCE_WIDGET_ITEM (instance), + domain); +} + static void mswindows_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); struct device* d = XDEVICE (device); Lisp_Object frame = FW_FRAME (domain); @@ -2085,19 +2243,39 @@ /* have to set the type this late in case there is no device instantiation for a widget */ IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW; - - wnd = CreateWindow( "STATIC", + /* Allocate space for the clip window */ + ii->data = xnew_and_zero (struct mswindows_subwindow_data); + + if ((IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW (ii) + = CreateWindowEx( + 0, /* EX flags */ + XEMACS_CONTROL_CLASS, + 0, /* text */ + WS_CLIPCHILDREN | WS_CLIPSIBLINGS | WS_CHILD, + 0, /* starting x position */ + 0, /* starting y position */ + IMAGE_INSTANCE_WIDGET_WIDTH (ii), + IMAGE_INSTANCE_WIDGET_HEIGHT (ii), + /* parent window */ + FRAME_MSWINDOWS_HANDLE (XFRAME (frame)), + NULL, /* No menu */ + NULL, /* must be null for this class */ + NULL)) == NULL) + signal_simple_error ("window creation failed with code", + make_int (GetLastError())); + + wnd = CreateWindow( "STATIC", "", - WS_CHILD, + WS_CHILD, 0, /* starting x position */ 0, /* starting y position */ IMAGE_INSTANCE_WIDGET_WIDTH (ii), IMAGE_INSTANCE_WIDGET_HEIGHT (ii), - FRAME_MSWINDOWS_HANDLE (XFRAME (frame)), /* parent window */ + IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW (ii), 0, - (HINSTANCE) + (HINSTANCE) GetWindowLong (FRAME_MSWINDOWS_HANDLE (XFRAME (frame)), - GWL_HINSTANCE), + GWL_HINSTANCE), NULL); SetWindowLong (wnd, GWL_USERDATA, (LONG)LISP_TO_VOID(image_instance)); @@ -2105,19 +2283,19 @@ } static int -mswindows_image_instance_equal (struct Lisp_Image_Instance *p1, - struct Lisp_Image_Instance *p2, int depth) +mswindows_image_instance_equal (Lisp_Image_Instance *p1, + Lisp_Image_Instance *p2, int depth) { switch (IMAGE_INSTANCE_TYPE (p1)) { case IMAGE_MONO_PIXMAP: case IMAGE_COLOR_PIXMAP: case IMAGE_POINTER: - if (IMAGE_INSTANCE_MSWINDOWS_BITMAP (p1) + if (IMAGE_INSTANCE_MSWINDOWS_BITMAP (p1) != IMAGE_INSTANCE_MSWINDOWS_BITMAP (p2)) return 0; break; - + default: break; } @@ -2126,7 +2304,7 @@ } static unsigned long -mswindows_image_instance_hash (struct Lisp_Image_Instance *p, int depth) +mswindows_image_instance_hash (Lisp_Image_Instance *p, int depth) { switch (IMAGE_INSTANCE_TYPE (p)) { @@ -2134,7 +2312,7 @@ case IMAGE_COLOR_PIXMAP: case IMAGE_POINTER: return (unsigned long) IMAGE_INSTANCE_MSWINDOWS_BITMAP (p); - + default: return 0; } @@ -2147,7 +2325,8 @@ methods are called. */ static void -mswindows_initialize_dibitmap_image_instance (struct Lisp_Image_Instance *ii, +mswindows_initialize_dibitmap_image_instance (Lisp_Image_Instance *ii, + int slices, enum image_instance_type type) { ii->data = xnew_and_zero (struct mswindows_image_instance_data); @@ -2158,46 +2337,38 @@ IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = Qnil; IMAGE_INSTANCE_PIXMAP_FG (ii) = Qnil; IMAGE_INSTANCE_PIXMAP_BG (ii) = Qnil; + IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) = slices; + IMAGE_INSTANCE_MSWINDOWS_BITMAP_SLICES (ii) = + xnew_array_and_zero (HBITMAP, slices); } +#ifdef HAVE_WIDGETS + /************************************************************************/ /* widgets */ /************************************************************************/ - static void mswindows_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain, - CONST char* class, int flags, int exflags) + const char* class, int flags, int exflags) { - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); -#if 0 - struct Lisp_Image_Instance *groupii = 0; - Lisp_Object group = find_keyword_in_vector (instantiator, Q_group); -#endif + /* this function can call lisp */ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii), style; struct device* d = XDEVICE (device); Lisp_Object frame = FW_FRAME (domain); Extbyte* nm=0; HWND wnd; int id = 0xffff; - struct gui_item* pgui = &IMAGE_INSTANCE_WIDGET_ITEM (ii); + Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii); + Lisp_Gui_Item* pgui = XGUI_ITEM (gui); if (!DEVICE_MSWINDOWS_P (d)) signal_simple_error ("Not an mswindows device", device); -#if 0 - /* if the user specified another glyph as a group pick up the - instance in our domain. */ - if (!NILP (group)) - { - if (SYMBOLP (group)) - group = XSYMBOL (group)->value; - group = glyph_image_instance (group, domain, ERROR_ME, 1); - groupii = XIMAGE_INSTANCE (group); - } -#endif - if (!gui_item_active_p (pgui)) + + if (!gui_item_active_p (gui)) flags |= WS_DISABLED; style = pgui->style; @@ -2206,45 +2377,65 @@ { id = mswindows_register_widget_instance (image_instance, domain); } - /* have to set the type this late in case there is no device - instantiation for a widget */ - IMAGE_INSTANCE_TYPE (ii) = IMAGE_WIDGET; + if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii))) - GET_C_STRING_OS_DATA_ALLOCA (IMAGE_INSTANCE_WIDGET_TEXT (ii), nm); - - wnd = CreateWindowEx( - exflags /* | WS_EX_NOPARENTNOTIFY*/, - class, - nm, - flags | WS_CHILD, - 0, /* starting x position */ - 0, /* starting y position */ - IMAGE_INSTANCE_WIDGET_WIDTH (ii), - IMAGE_INSTANCE_WIDGET_HEIGHT (ii), - /* parent window */ - FRAME_MSWINDOWS_HANDLE (XFRAME (frame)), - (HMENU)id, /* No menu */ - (HINSTANCE) - GetWindowLong (FRAME_MSWINDOWS_HANDLE (XFRAME (frame)), - GWL_HINSTANCE), - NULL); + TO_EXTERNAL_FORMAT (LISP_STRING, IMAGE_INSTANCE_WIDGET_TEXT (ii), + C_STRING_ALLOCA, nm, + Qnative); + + /* allocate space for the clip window and then allocate the clip window */ + ii->data = xnew_and_zero (struct mswindows_subwindow_data); + + if ((IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW (ii) + = CreateWindowEx( + WS_EX_CONTROLPARENT, /* EX flags */ + XEMACS_CONTROL_CLASS, + 0, /* text */ + WS_CLIPCHILDREN | WS_CLIPSIBLINGS | WS_CHILD, + 0, /* starting x position */ + 0, /* starting y position */ + IMAGE_INSTANCE_WIDGET_WIDTH (ii), + IMAGE_INSTANCE_WIDGET_HEIGHT (ii), + /* parent window */ + FRAME_MSWINDOWS_HANDLE (XFRAME (frame)), + (HMENU)id, /* No menu */ + NULL, /* must be null for this class */ + NULL)) == NULL) + signal_simple_error ("window creation failed with code", + make_int (GetLastError())); + + if ((wnd = CreateWindowEx( + exflags /* | WS_EX_NOPARENTNOTIFY*/, + class, + nm, + flags | WS_CHILD | WS_VISIBLE, + 0, /* starting x position */ + 0, /* starting y position */ + IMAGE_INSTANCE_WIDGET_WIDTH (ii), + IMAGE_INSTANCE_WIDGET_HEIGHT (ii), + /* parent window */ + IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW (ii), + (HMENU)id, /* No menu */ + (HINSTANCE) + GetWindowLong + (FRAME_MSWINDOWS_HANDLE (XFRAME (frame)), + GWL_HINSTANCE), + NULL)) == NULL) + signal_simple_error ("window creation failed with code", + make_int (GetLastError())); IMAGE_INSTANCE_SUBWINDOW_ID (ii) = wnd; SetWindowLong (wnd, GWL_USERDATA, (LONG)LISP_TO_VOID(image_instance)); /* set the widget font from the widget face */ - SendMessage (wnd, WM_SETFONT, - (WPARAM)FONT_INSTANCE_MSWINDOWS_HFONT - (XFONT_INSTANCE (widget_face_font_info - (domain, - IMAGE_INSTANCE_WIDGET_FACE (ii), - 0, 0))), + SendMessage (wnd, WM_SETFONT, + (WPARAM) mswindows_widget_hfont (ii, domain), MAKELPARAM (TRUE, 0)); } /* Instantiate a button widget. Unfortunately instantiated widgets are particular to a frame since they need to have a parent. It's not like images where you just select the image into the context you - want to display it in and BitBlt it. So images instances can have a + want to display it in and BitBlt it. So image instances can have a many-to-one relationship with things you see, whereas widgets can only be one-to-one (i.e. per frame) */ static void @@ -2252,28 +2443,31 @@ Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + /* this function can call lisp */ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); HWND wnd; - int flags = BS_NOTIFY; + int flags = WS_TABSTOP;/* BS_NOTIFY #### is needed to get exotic feedback + only. Since we seem to want nothing beyond BN_CLICK, + the style is perhaps not necessary -- kkm */ Lisp_Object style; - struct gui_item* pgui = &IMAGE_INSTANCE_WIDGET_ITEM (ii); + Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii); + Lisp_Gui_Item* pgui = XGUI_ITEM (gui); Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image); - if (!gui_item_active_p (pgui)) - flags |= WS_DISABLED; - if (!NILP (glyph)) { if (!IMAGE_INSTANCEP (glyph)) glyph = glyph_image_instance (glyph, domain, ERROR_ME, 1); if (IMAGE_INSTANCEP (glyph)) - flags |= XIMAGE_INSTANCE_MSWINDOWS_BITMAP (glyph) ? + flags |= XIMAGE_INSTANCE_MSWINDOWS_BITMAP (glyph) ? BS_BITMAP : BS_ICON; } style = pgui->style; + /* #### consider using the default face for radio and toggle + buttons. */ if (EQ (style, Qradio)) { flags |= BS_RADIOBUTTON; @@ -2283,75 +2477,271 @@ flags |= BS_AUTOCHECKBOX; } else - flags |= BS_DEFPUSHBUTTON; + { + flags |= BS_DEFPUSHBUTTON; + } mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain, "BUTTON", flags, - WS_EX_CONTROLPARENT); + pointer_bg, dest_mask, domain, "BUTTON", + flags, 0); wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); /* set the checked state */ - if (gui_item_selected_p (pgui)) - SendMessage (wnd, BM_SETCHECK, (WPARAM)BST_CHECKED, 0); + if (gui_item_selected_p (gui)) + SendMessage (wnd, BM_SETCHECK, (WPARAM)BST_CHECKED, 0); else SendMessage (wnd, BM_SETCHECK, (WPARAM)BST_UNCHECKED, 0); /* add the image if one was given */ - if (!NILP (glyph) && IMAGE_INSTANCEP (glyph)) + if (!NILP (glyph) && IMAGE_INSTANCEP (glyph) + && + IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (glyph))) { - SendMessage (wnd, BM_SETIMAGE, - (WPARAM) (XIMAGE_INSTANCE_MSWINDOWS_BITMAP (glyph) ? + SendMessage (wnd, BM_SETIMAGE, + (WPARAM) (XIMAGE_INSTANCE_MSWINDOWS_BITMAP (glyph) ? IMAGE_BITMAP : IMAGE_ICON), - (LPARAM) (XIMAGE_INSTANCE_MSWINDOWS_BITMAP (glyph) ? - XIMAGE_INSTANCE_MSWINDOWS_BITMAP (glyph) : - XIMAGE_INSTANCE_MSWINDOWS_ICON (glyph))); + (XIMAGE_INSTANCE_MSWINDOWS_BITMAP (glyph) ? + (LPARAM) XIMAGE_INSTANCE_MSWINDOWS_BITMAP (glyph) : + (LPARAM) XIMAGE_INSTANCE_MSWINDOWS_ICON (glyph))); } } +/* Update the state of a button. */ +static void +mswindows_button_update (Lisp_Object image_instance) +{ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + /* buttons checked or otherwise */ + if (gui_item_selected_p (IMAGE_INSTANCE_WIDGET_ITEM (ii))) + SendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii), + BM_SETCHECK, (WPARAM)BST_CHECKED, 0); + else + SendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii), + BM_SETCHECK, (WPARAM)BST_UNCHECKED, 0); +} + /* instantiate an edit control */ static void -mswindows_edit_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, +mswindows_edit_field_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain, "EDIT", + pointer_bg, dest_mask, domain, "EDIT", ES_LEFT | ES_AUTOHSCROLL | WS_TABSTOP - | WS_BORDER, - WS_EX_CLIENTEDGE | WS_EX_CONTROLPARENT); + | WS_BORDER, WS_EX_CLIENTEDGE); } -/* instantiate an edit control */ +/* instantiate a progress gauge */ static void -mswindows_progress_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, +mswindows_progress_gauge_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { HWND wnd; - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain, PROGRESS_CLASS, - WS_TABSTOP | WS_BORDER | PBS_SMOOTH, - WS_EX_CLIENTEDGE | WS_EX_CONTROLPARENT); + pointer_bg, dest_mask, domain, PROGRESS_CLASS, + WS_BORDER | PBS_SMOOTH, WS_EX_CLIENTEDGE); wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); /* set the colors */ #ifdef PBS_SETBKCOLOR - SendMessage (wnd, PBS_SETBKCOLOR, 0, - (LPARAM) (COLOR_INSTANCE_MSWINDOWS_COLOR - (XCOLOR_INSTANCE - (FACE_BACKGROUND + SendMessage (wnd, PBS_SETBKCOLOR, 0, + (LPARAM) (COLOR_INSTANCE_MSWINDOWS_COLOR + (XCOLOR_INSTANCE + (FACE_BACKGROUND (XIMAGE_INSTANCE_WIDGET_FACE (ii), XIMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))))); #endif #ifdef PBS_SETBARCOLOR - SendMessage (wnd, PBS_SETBARCOLOR, 0, - (L:PARAM) (COLOR_INSTANCE_MSWINDOWS_COLOR - (XCOLOR_INSTANCE - (FACE_FOREGROUND + SendMessage (wnd, PBS_SETBARCOLOR, 0, + (L:PARAM) (COLOR_INSTANCE_MSWINDOWS_COLOR + (XCOLOR_INSTANCE + (FACE_FOREGROUND (XIMAGE_INSTANCE_WIDGET_FACE (ii), XIMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))))); #endif } +/* instantiate a tree view widget */ +static HTREEITEM add_tree_item (Lisp_Object image_instance, + HWND wnd, HTREEITEM parent, Lisp_Object item, + int children, Lisp_Object domain) +{ + TV_INSERTSTRUCT tvitem; + HTREEITEM ret; + + tvitem.hParent = parent; + tvitem.hInsertAfter = TVI_LAST; + tvitem.item.mask = TVIF_TEXT | TVIF_CHILDREN; + tvitem.item.cChildren = children; + + if (GUI_ITEMP (item)) + { + tvitem.item.lParam = mswindows_register_gui_item (item, domain); + tvitem.item.mask |= TVIF_PARAM; + TO_EXTERNAL_FORMAT (LISP_STRING, XGUI_ITEM (item)->name, + C_STRING_ALLOCA, tvitem.item.pszText, + Qnative); + } + else + TO_EXTERNAL_FORMAT (LISP_STRING, item, + C_STRING_ALLOCA, tvitem.item.pszText, + Qnative); + + tvitem.item.cchTextMax = strlen (tvitem.item.pszText); + + if ((ret = (HTREEITEM)SendMessage (wnd, TVM_INSERTITEM, + 0, (LPARAM)&tvitem)) == 0) + signal_simple_error ("error adding tree view entry", item); + + return ret; +} + +static void add_tree_item_list (Lisp_Object image_instance, + HWND wnd, HTREEITEM parent, Lisp_Object list, + Lisp_Object domain) +{ + Lisp_Object rest; + + /* get the first item */ + parent = add_tree_item (image_instance, wnd, parent, XCAR (list), TRUE, domain); + /* recursively add items to the tree view */ + LIST_LOOP (rest, XCDR (list)) + { + if (LISTP (XCAR (rest))) + add_tree_item_list (image_instance, wnd, parent, XCAR (rest), domain); + else + add_tree_item (image_instance, wnd, parent, XCAR (rest), FALSE, domain); + } +} + +static void +mswindows_tree_view_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) +{ + Lisp_Object rest; + HWND wnd; + HTREEITEM parent; + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, + pointer_bg, dest_mask, domain, WC_TREEVIEW, + WS_TABSTOP | WS_BORDER | PBS_SMOOTH + | TVS_HASLINES | TVS_HASBUTTONS, + WS_EX_CLIENTEDGE); + + wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); + + /* define a root */ + parent = add_tree_item (image_instance, wnd, NULL, + XCAR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)), + TRUE, domain); + + /* recursively add items to the tree view */ + /* add items to the tab */ + LIST_LOOP (rest, XCDR (IMAGE_INSTANCE_WIDGET_ITEMS (ii))) + { + if (LISTP (XCAR (rest))) + add_tree_item_list (image_instance, wnd, parent, XCAR (rest), domain); + else + add_tree_item (image_instance, wnd, parent, XCAR (rest), FALSE, domain); + } +} + +/* instantiate a tab control */ +static TC_ITEM* add_tab_item (Lisp_Object image_instance, + HWND wnd, Lisp_Object item, + Lisp_Object domain, int i) +{ + TC_ITEM tvitem, *ret; + + tvitem.mask = TCIF_TEXT; + + if (GUI_ITEMP (item)) + { + tvitem.lParam = mswindows_register_gui_item (item, domain); + tvitem.mask |= TCIF_PARAM; + TO_EXTERNAL_FORMAT (LISP_STRING, XGUI_ITEM (item)->name, + C_STRING_ALLOCA, tvitem.pszText, + Qnative); + } + else + { + CHECK_STRING (item); + TO_EXTERNAL_FORMAT (LISP_STRING, item, + C_STRING_ALLOCA, tvitem.pszText, + Qnative); + } + + tvitem.cchTextMax = strlen (tvitem.pszText); + + if ((ret = (TC_ITEM*)SendMessage (wnd, TCM_INSERTITEM, + i, (LPARAM)&tvitem)) < 0) + signal_simple_error ("error adding tab entry", item); + + return ret; +} + +static void +mswindows_tab_control_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) +{ + Lisp_Object rest; + HWND wnd; + int i = 0; + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Object orient = find_keyword_in_vector (instantiator, Q_orientation); + unsigned int flags = WS_TABSTOP; + + if (EQ (orient, Qleft) || EQ (orient, Qright)) + { + flags |= TCS_VERTICAL | TCS_MULTILINE; + } + if (EQ (orient, Qright) || EQ (orient, Qbottom)) + { + flags |= TCS_BOTTOM; + } + + mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, + pointer_bg, dest_mask, domain, WC_TABCONTROL, + /* borders don't suit tabs so well */ + flags, 0); + + wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); + /* add items to the tab */ + LIST_LOOP (rest, XCDR (IMAGE_INSTANCE_WIDGET_ITEMS (ii))) + { + add_tab_item (image_instance, wnd, XCAR (rest), domain, i); + i++; + } +} + +/* set the properties of a tab control */ +static void +mswindows_tab_control_update (Lisp_Object image_instance) +{ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + + if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii)); + { + HWND wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); + int i = 0; + Lisp_Object rest; + + /* delete the pre-existing items */ + SendMessage (wnd, TCM_DELETEALLITEMS, 0, 0); + + /* add items to the tab */ + LIST_LOOP (rest, XCDR (IMAGE_INSTANCE_WIDGET_ITEMS (ii))) + { + add_tab_item (image_instance, wnd, XCAR (rest), + IMAGE_INSTANCE_SUBWINDOW_FRAME (ii), i); + i++; + } + } +} + /* instantiate a static control possible for putting other things in */ static void mswindows_label_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, @@ -2359,24 +2749,10 @@ int dest_mask, Lisp_Object domain) { mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain, "STATIC", + pointer_bg, dest_mask, domain, "STATIC", 0, WS_EX_STATICEDGE); } -#if 0 -/* instantiate a static control possible for putting other things in */ -static void -mswindows_group_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain, "BUTTON", - WS_GROUP | BS_GROUPBOX | WS_BORDER, - WS_EX_CLIENTEDGE ); -} -#endif - /* instantiate a scrollbar control */ static void mswindows_scrollbar_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, @@ -2384,20 +2760,22 @@ int dest_mask, Lisp_Object domain) { mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain, "SCROLLBAR", - 0, - WS_EX_CLIENTEDGE ); + pointer_bg, dest_mask, domain, "SCROLLBAR", + WS_TABSTOP, WS_EX_CLIENTEDGE); } /* instantiate a combo control */ static void -mswindows_combo_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, +mswindows_combo_box_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); HANDLE wnd; Lisp_Object rest; + Lisp_Object data = Fplist_get (find_keyword_in_vector (instantiator, Q_properties), + Q_items, Qnil); + int len, height; /* Maybe ought to generalise this more but it may be very windows specific. In windows the window height of a combo box is the @@ -2405,23 +2783,38 @@ before creating the window and then reset it to a single line after the window is created so that redisplay does the right thing. */ + widget_instantiate (image_instance, instantiator, pointer_fg, + pointer_bg, dest_mask, domain); + + /* We now have everything right apart from the height. */ + default_face_font_info (domain, 0, 0, &height, 0, 0); + GET_LIST_LENGTH (data, len); + + height = (height + WIDGET_BORDER_HEIGHT * 2 ) * len; + IMAGE_INSTANCE_HEIGHT (ii) = height; + + /* Now create the widget. */ mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain, "COMBOBOX", + pointer_bg, dest_mask, domain, "COMBOBOX", WS_BORDER | WS_TABSTOP | CBS_DROPDOWN - | CBS_AUTOHSCROLL + | CBS_AUTOHSCROLL | CBS_HASSTRINGS | WS_VSCROLL, - WS_EX_CLIENTEDGE | WS_EX_CONTROLPARENT); - /* reset the height */ - widget_text_to_pixel_conversion (domain, - IMAGE_INSTANCE_WIDGET_FACE (ii), 1, 0, - &IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii), 0); + WS_EX_CLIENTEDGE); + /* Reset the height. layout will probably do this safely, but better make sure. */ + image_instance_layout (image_instance, + IMAGE_UNSPECIFIED_GEOMETRY, + IMAGE_UNSPECIFIED_GEOMETRY, + domain); + wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); /* add items to the combo box */ SendMessage (wnd, CB_RESETCONTENT, 0, 0); LIST_LOOP (rest, Fplist_get (IMAGE_INSTANCE_WIDGET_PROPS (ii), Q_items, Qnil)) { Extbyte* lparam; - GET_C_STRING_OS_DATA_ALLOCA (XCAR (rest), lparam); + TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (rest), + C_STRING_ALLOCA, lparam, + Qnative); if (SendMessage (wnd, CB_ADDSTRING, 0, (LPARAM)lparam) == CB_ERR) signal_simple_error ("error adding combo entries", instantiator); } @@ -2431,16 +2824,16 @@ static Lisp_Object mswindows_widget_property (Lisp_Object image_instance, Lisp_Object prop) { - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); HANDLE wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); /* get the text from a control */ if (EQ (prop, Q_text)) { Extcount len = SendMessage (wnd, WM_GETTEXTLENGTH, 0, 0); Extbyte* buf =alloca (len+1); - + SendMessage (wnd, WM_GETTEXT, (WPARAM)len+1, (LPARAM) buf); - return build_ext_string (buf, FORMAT_OS); + return build_ext_string (buf, Qnative); } return Qunbound; } @@ -2449,7 +2842,7 @@ static Lisp_Object mswindows_button_property (Lisp_Object image_instance, Lisp_Object prop) { - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); HANDLE wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); /* check the state of a button */ if (EQ (prop, Q_selected)) @@ -2464,9 +2857,9 @@ /* get properties of a combo box */ static Lisp_Object -mswindows_combo_property (Lisp_Object image_instance, Lisp_Object prop) +mswindows_combo_box_property (Lisp_Object image_instance, Lisp_Object prop) { - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); HANDLE wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); /* get the text from a control */ if (EQ (prop, Q_text)) @@ -2475,47 +2868,50 @@ Extcount len = SendMessage (wnd, CB_GETLBTEXTLEN, (WPARAM)item, 0); Extbyte* buf = alloca (len+1); SendMessage (wnd, CB_GETLBTEXT, (WPARAM)item, (LPARAM)buf); - return build_ext_string (buf, FORMAT_OS); - } - return Qunbound; -} - -/* set the properties of a control */ -static Lisp_Object -mswindows_widget_set_property (Lisp_Object image_instance, Lisp_Object prop, - Lisp_Object val) -{ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - - if (EQ (prop, Q_text)) - { - Extbyte* lparam=0; - CHECK_STRING (val); - GET_C_STRING_OS_DATA_ALLOCA (val, lparam); - SendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii), - WM_SETTEXT, 0, (LPARAM)lparam); - return Qt; + return build_ext_string (buf, Qnative); } return Qunbound; } /* set the properties of a progres guage */ -static Lisp_Object -mswindows_progress_set_property (Lisp_Object image_instance, Lisp_Object prop, - Lisp_Object val) +static void +mswindows_progress_gauge_update (Lisp_Object image_instance) { - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - - if (EQ (prop, Q_percent)) + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + + if (IMAGE_INSTANCE_WIDGET_PERCENT_CHANGED (ii)) { + /* #### I'm not convinced we should store this in the plist. */ + Lisp_Object val = Fplist_get (IMAGE_INSTANCE_WIDGET_PROPS (ii), + Q_percent, Qnil); CHECK_INT (val); SendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii), PBM_SETPOS, (WPARAM)XINT (val), 0); - return Qt; } - return Qunbound; } +LRESULT WINAPI +mswindows_control_wnd_proc (HWND hwnd, UINT msg, + WPARAM wParam, LPARAM lParam) +{ + switch (msg) + { + case WM_NOTIFY: + case WM_COMMAND: + case WM_CTLCOLORBTN: + case WM_CTLCOLORLISTBOX: + case WM_CTLCOLOREDIT: + case WM_CTLCOLORSTATIC: + case WM_CTLCOLORSCROLLBAR: + + return mswindows_wnd_proc (GetParent (hwnd), msg, wParam, lParam); + default: + return DefWindowProc (hwnd, msg, wParam, lParam); + } +} + +#endif /* HAVE_WIDGETS */ + /************************************************************************/ /* initialization */ @@ -2538,15 +2934,22 @@ CONSOLE_HAS_METHOD (mswindows, unmap_subwindow); CONSOLE_HAS_METHOD (mswindows, map_subwindow); CONSOLE_HAS_METHOD (mswindows, update_subwindow); + CONSOLE_HAS_METHOD (mswindows, update_widget); CONSOLE_HAS_METHOD (mswindows, image_instance_equal); CONSOLE_HAS_METHOD (mswindows, image_instance_hash); CONSOLE_HAS_METHOD (mswindows, init_image_instance_from_eimage); CONSOLE_HAS_METHOD (mswindows, locate_pixmap_file); + CONSOLE_HAS_METHOD (mswindows, resize_subwindow); } void image_instantiator_format_create_glyphs_mswindows (void) { + IIFORMAT_VALID_CONSOLE (mswindows, nothing); + IIFORMAT_VALID_CONSOLE (mswindows, string); + IIFORMAT_VALID_CONSOLE (mswindows, layout); + IIFORMAT_VALID_CONSOLE (mswindows, formatted_string); + IIFORMAT_VALID_CONSOLE (mswindows, inherit); /* image-instantiator types */ #ifdef HAVE_XPM INITIALIZE_DEVICE_IIFORMAT (mswindows, xpm); @@ -2558,39 +2961,64 @@ INITIALIZE_DEVICE_IIFORMAT (mswindows, xface); IIFORMAT_HAS_DEVMETHOD (mswindows, xface, instantiate); #endif +#ifdef HAVE_JPEG + IIFORMAT_VALID_CONSOLE (mswindows, jpeg); +#endif +#ifdef HAVE_TIFF + IIFORMAT_VALID_CONSOLE (mswindows, tiff); +#endif +#ifdef HAVE_PNG + IIFORMAT_VALID_CONSOLE (mswindows, png); +#endif +#ifdef HAVE_GIF + IIFORMAT_VALID_CONSOLE (mswindows, gif); +#endif +#ifdef HAVE_WIDGETS + /* button widget */ INITIALIZE_DEVICE_IIFORMAT (mswindows, button); IIFORMAT_HAS_DEVMETHOD (mswindows, button, property); IIFORMAT_HAS_DEVMETHOD (mswindows, button, instantiate); - - INITIALIZE_DEVICE_IIFORMAT (mswindows, edit); - IIFORMAT_HAS_DEVMETHOD (mswindows, edit, instantiate); - + IIFORMAT_HAS_DEVMETHOD (mswindows, button, update); + + INITIALIZE_DEVICE_IIFORMAT (mswindows, edit_field); + IIFORMAT_HAS_DEVMETHOD (mswindows, edit_field, instantiate); + INITIALIZE_DEVICE_IIFORMAT (mswindows, subwindow); IIFORMAT_HAS_DEVMETHOD (mswindows, subwindow, instantiate); INITIALIZE_DEVICE_IIFORMAT (mswindows, widget); IIFORMAT_HAS_DEVMETHOD (mswindows, widget, property); - IIFORMAT_HAS_DEVMETHOD (mswindows, widget, set_property); -#if 0 - INITIALIZE_DEVICE_IIFORMAT (mswindows, group); - IIFORMAT_HAS_DEVMETHOD (mswindows, group, instantiate); -#endif + + /* label */ INITIALIZE_DEVICE_IIFORMAT (mswindows, label); IIFORMAT_HAS_DEVMETHOD (mswindows, label, instantiate); - INITIALIZE_DEVICE_IIFORMAT (mswindows, combo); - IIFORMAT_HAS_DEVMETHOD (mswindows, combo, property); - IIFORMAT_HAS_DEVMETHOD (mswindows, combo, instantiate); - + /* combo box */ + INITIALIZE_DEVICE_IIFORMAT (mswindows, combo_box); + IIFORMAT_HAS_DEVMETHOD (mswindows, combo_box, property); + IIFORMAT_HAS_DEVMETHOD (mswindows, combo_box, instantiate); + + /* scrollbar */ INITIALIZE_DEVICE_IIFORMAT (mswindows, scrollbar); IIFORMAT_HAS_DEVMETHOD (mswindows, scrollbar, instantiate); - INITIALIZE_DEVICE_IIFORMAT (mswindows, progress); - IIFORMAT_HAS_DEVMETHOD (mswindows, progress, set_property); - IIFORMAT_HAS_DEVMETHOD (mswindows, progress, instantiate); - + /* progress gauge */ + INITIALIZE_DEVICE_IIFORMAT (mswindows, progress_gauge); + IIFORMAT_HAS_DEVMETHOD (mswindows, progress_gauge, update); + IIFORMAT_HAS_DEVMETHOD (mswindows, progress_gauge, instantiate); + + /* tree view widget */ + INITIALIZE_DEVICE_IIFORMAT (mswindows, tree_view); + /* IIFORMAT_HAS_DEVMETHOD (mswindows, progress, set_property);*/ + IIFORMAT_HAS_DEVMETHOD (mswindows, tree_view, instantiate); + + /* tab control widget */ + INITIALIZE_DEVICE_IIFORMAT (mswindows, tab_control); + IIFORMAT_HAS_DEVMETHOD (mswindows, tab_control, instantiate); + IIFORMAT_HAS_DEVMETHOD (mswindows, tab_control, update); +#endif + /* windows bitmap format */ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (bmp, "bmp"); - IIFORMAT_HAS_METHOD (bmp, validate); IIFORMAT_HAS_METHOD (bmp, normalize); IIFORMAT_HAS_METHOD (bmp, possible_dest_types); @@ -2598,7 +3026,9 @@ IIFORMAT_VALID_KEYWORD (bmp, Q_data, check_valid_string); IIFORMAT_VALID_KEYWORD (bmp, Q_file, check_valid_string); - + IIFORMAT_VALID_CONSOLE (mswindows, bmp); + + /* mswindows resources */ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (mswindows_resource, "mswindows-resource"); @@ -2607,29 +3037,21 @@ IIFORMAT_HAS_METHOD (mswindows_resource, possible_dest_types); IIFORMAT_HAS_METHOD (mswindows_resource, instantiate); - IIFORMAT_VALID_KEYWORD (mswindows_resource, Q_resource_type, + IIFORMAT_VALID_KEYWORD (mswindows_resource, Q_resource_type, check_valid_resource_symbol); IIFORMAT_VALID_KEYWORD (mswindows_resource, Q_resource_id, check_valid_resource_id); IIFORMAT_VALID_KEYWORD (mswindows_resource, Q_file, check_valid_string); + IIFORMAT_VALID_CONSOLE (mswindows, mswindows_resource); } void vars_of_glyphs_mswindows (void) { - Fprovide (Qbmp); - Fprovide (Qmswindows_resource); DEFVAR_LISP ("mswindows-bitmap-file-path", &Vmswindows_bitmap_file_path /* A list of the directories in which mswindows bitmap files may be found. This is used by the `make-image-instance' function. */ ); Vmswindows_bitmap_file_path = Qnil; - - Fprovide (Qbutton); - Fprovide (Qedit); - Fprovide (Qcombo); - Fprovide (Qscrollbar); - Fprovide (Qlabel); - Fprovide (Qprogress); } void diff -r f4aeb21a5bad -r 74fd4e045ea6 src/glyphs-msw.h --- a/src/glyphs-msw.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/glyphs-msw.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,8 +20,8 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_GLYPHS_MSW_H_ -#define _XEMACS_GLYPHS_MSW_H_ +#ifndef INCLUDED_glyphs_msw_h_ +#define INCLUDED_glyphs_msw_h_ #ifdef HAVE_MS_WINDOWS @@ -34,8 +34,7 @@ struct mswindows_image_instance_data { - HBITMAP bitmap; - HBITMAP mask; + HBITMAP* bitmaps; HICON icon; }; @@ -43,33 +42,41 @@ ((struct mswindows_image_instance_data *) (i)->data) #define IMAGE_INSTANCE_MSWINDOWS_BITMAP(i) \ - (MSWINDOWS_IMAGE_INSTANCE_DATA (i)->bitmap) + (MSWINDOWS_IMAGE_INSTANCE_DATA (i)->bitmaps[0]) +#define IMAGE_INSTANCE_MSWINDOWS_BITMAP_SLICE(i,slice) \ + (MSWINDOWS_IMAGE_INSTANCE_DATA (i)->bitmaps[slice]) +#define IMAGE_INSTANCE_MSWINDOWS_BITMAP_SLICES(i) \ + (MSWINDOWS_IMAGE_INSTANCE_DATA (i)->bitmaps) #define IMAGE_INSTANCE_MSWINDOWS_MASK(i) \ - (MSWINDOWS_IMAGE_INSTANCE_DATA (i)->mask) + (HBITMAP)(IMAGE_INSTANCE_PIXMAP_MASK (i)) #define IMAGE_INSTANCE_MSWINDOWS_ICON(i) \ (MSWINDOWS_IMAGE_INSTANCE_DATA (i)->icon) #define XIMAGE_INSTANCE_MSWINDOWS_BITMAP(i) \ IMAGE_INSTANCE_MSWINDOWS_BITMAP (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_MSWINDOWS_BITMAP_SLICE(i,slice) \ + IMAGE_INSTANCE_MSWINDOWS_BITMAP_SLICE (XIMAGE_INSTANCE (i,slice)) +#define XIMAGE_INSTANCE_MSWINDOWS_BITMAP_SLICES(i) \ + IMAGE_INSTANCE_MSWINDOWS_BITMAP_SLICES (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_MSWINDOWS_MASK(i) \ IMAGE_INSTANCE_MSWINDOWS_MASK (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_MSWINDOWS_ICON(i) \ IMAGE_INSTANCE_MSWINDOWS_ICON (XIMAGE_INSTANCE (i)) int -mswindows_resize_dibitmap_instance (struct Lisp_Image_Instance* ii, +mswindows_resize_dibitmap_instance (Lisp_Image_Instance* ii, struct frame* f, int newx, int newy); HBITMAP -mswindows_create_resized_bitmap (struct Lisp_Image_Instance* ii, +mswindows_create_resized_bitmap (Lisp_Image_Instance* ii, struct frame* f, int newx, int newy); HBITMAP -mswindows_create_resized_mask (struct Lisp_Image_Instance* ii, +mswindows_create_resized_mask (Lisp_Image_Instance* ii, struct frame* f, int newx, int newy); void -mswindows_initialize_image_instance_icon (struct Lisp_Image_Instance* image, +mswindows_initialize_image_instance_icon (Lisp_Image_Instance* image, int cursor); #define WIDGET_INSTANCE_MSWINDOWS_HANDLE(i) \ @@ -78,5 +85,20 @@ #define XWIDGET_INSTANCE_MSWINDOWS_HANDLE(i) \ WIDGET_INSTANCE_MSWINDOWS_HANDLE (XIMAGE_INSTANCE (i)) +struct mswindows_subwindow_data +{ + HWND clip_window; +}; + +#define MSWINDOWS_SUBWINDOW_DATA(i) \ +((struct mswindows_subwindow_data *) (i)->data) + +#define IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW(i) \ + (MSWINDOWS_SUBWINDOW_DATA (i)->clip_window) + +#define XIMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW(i) \ + IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW (XIMAGE_INSTANCE (i)) + #endif /* HAVE_MS_WINDOWS */ -#endif /* _XEMACS_GLYPHS_MSW_H_ */ + +#endif /* INCLUDED_glyphs_msw_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/glyphs-widget.c --- a/src/glyphs-widget.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/glyphs-widget.c Mon Aug 13 11:13:30 2007 +0200 @@ -1,5 +1,5 @@ /* Widget-specific glyph objects. - Copyright (C) 1998 Andy Piper + Copyright (C) 1998, 1999, 2000 Andy Piper. This file is part of XEmacs. @@ -38,65 +38,43 @@ #include "opaque.h" DEFINE_IMAGE_INSTANTIATOR_FORMAT (button); -DEFINE_IMAGE_INSTANTIATOR_FORMAT (combo); -Lisp_Object Qcombo; -DEFINE_IMAGE_INSTANTIATOR_FORMAT (edit); -Lisp_Object Qedit; +DEFINE_IMAGE_INSTANTIATOR_FORMAT (combo_box); +Lisp_Object Qcombo_box; +DEFINE_IMAGE_INSTANTIATOR_FORMAT (edit_field); +Lisp_Object Qedit_field; DEFINE_IMAGE_INSTANTIATOR_FORMAT (scrollbar); Lisp_Object Qscrollbar; DEFINE_IMAGE_INSTANTIATOR_FORMAT (widget); -#if 0 -DEFINE_IMAGE_INSTANTIATOR_FORMAT (group); -Lisp_Object Qgroup; -#endif DEFINE_IMAGE_INSTANTIATOR_FORMAT (label); Lisp_Object Qlabel; -DEFINE_IMAGE_INSTANTIATOR_FORMAT (progress); -Lisp_Object Qprogress; +DEFINE_IMAGE_INSTANTIATOR_FORMAT (progress_gauge); +Lisp_Object Qprogress_gauge; +DEFINE_IMAGE_INSTANTIATOR_FORMAT (tree_view); +Lisp_Object Qtree_view; +DEFINE_IMAGE_INSTANTIATOR_FORMAT (tab_control); +Lisp_Object Qtab_control; +DEFINE_IMAGE_INSTANTIATOR_FORMAT (layout); +Lisp_Object Qlayout; Lisp_Object Q_descriptor, Q_height, Q_width, Q_properties, Q_items; -Lisp_Object Q_image, Q_text, Q_percent; +Lisp_Object Q_image, Q_text, Q_percent, Q_orientation, Q_justify, Q_border; +Lisp_Object Qetched_in, Qetched_out, Qbevel_in, Qbevel_out; -#define WIDGET_BORDER_HEIGHT 2 -#define WIDGET_BORDER_WIDTH 4 +#ifdef DEBUG_WIDGETS +int debug_widget_instances; +#endif /* TODO: - - more complex controls. - - tooltips for controls. + - tooltips for controls, especially buttons. + - keyboard traversal. + - lisp configurable layout. */ -/* In windows normal windows work in pixels, dialog boxes work in +/* In MS-Windows normal windows work in pixels, dialog boxes work in dialog box units. Why? sigh. We could reuse the metrics for dialogs if this were not the case. As it is we have to position things pixel wise. I'm not even sure that X has this problem at least for buttons in groups. */ -Lisp_Object -widget_face_font_info (Lisp_Object domain, Lisp_Object face, - int *height, int *width) -{ - Lisp_Object font_instance = FACE_FONT (face, domain, Vcharset_ascii); - - if (height) - *height = XFONT_INSTANCE (font_instance)->height; - if (width) - *width = XFONT_INSTANCE (font_instance)->width; - - return font_instance; -} - -void -widget_text_to_pixel_conversion (Lisp_Object domain, Lisp_Object face, - int th, int tw, - int* height, int* width) -{ - int ch=0, cw=0; - widget_face_font_info (domain, face, &ch, &cw); - if (height) - *height = th * (ch + 2 * WIDGET_BORDER_HEIGHT); - if (width) - *width = tw * cw + 2 * WIDGET_BORDER_WIDTH; -} - static int widget_possible_dest_types (void) { @@ -104,7 +82,7 @@ } static void -check_valid_glyph_or_image (Lisp_Object data) +check_valid_glyph_or_instantiator (Lisp_Object data) { Lisp_Object glyph = data; if (SYMBOLP (data)) @@ -112,11 +90,49 @@ if (IMAGE_INSTANCEP (glyph)) CHECK_IMAGE_INSTANCE (glyph); - else if (!CONSP (glyph)) + else if (!CONSP (glyph) && !VECTORP (glyph)) CHECK_BUFFER_GLYPH (glyph); } static void +check_valid_orientation (Lisp_Object data) +{ + if (!EQ (data, Qhorizontal) + && + !EQ (data, Qvertical)) + signal_simple_error ("unknown orientation for layout", data); +} + +static void +check_valid_tab_orientation (Lisp_Object data) +{ + if (!EQ (data, Qtop) + && + !EQ (data, Qbottom) + && + !EQ (data, Qleft) + && + !EQ (data, Qright)) + signal_simple_error ("unknown orientation for tab control", data); +} + +static void +check_valid_justification (Lisp_Object data) +{ + if (!EQ (data, Qleft) && !EQ (data, Qright) && !EQ (data, Qcenter)) + signal_simple_error ("unknown justification for layout", data); +} + +static void +check_valid_border (Lisp_Object data) +{ + if (!EQ (data, Qt) && !EQ (data, Qetched_in) && !EQ (data, Qetched_out) + && !EQ (data, Qbevel_in) && !EQ (data, Qbevel_out) + && !GLYPHP (data) && !VECTORP (data)) + signal_simple_error ("unknown border style for layout", data); +} + +static void check_valid_anything (Lisp_Object data) { } @@ -145,37 +161,103 @@ signal_simple_error (":descriptor must be a string or a vector", data); } -static void -check_valid_item_list (Lisp_Object data) +void +check_valid_item_list_1 (Lisp_Object items) { Lisp_Object rest; - Lisp_Object items; - Fcheck_valid_plist (data); - - items = Fplist_get (data, Q_items, Qnil); CHECK_LIST (items); EXTERNAL_LIST_LOOP (rest, items) { - CHECK_STRING (XCAR (rest)); + if (STRINGP (XCAR (rest))) + CHECK_STRING (XCAR (rest)); + else if (VECTORP (XCAR (rest))) + gui_parse_item_keywords (XCAR (rest)); + else if (LISTP (XCAR (rest))) + check_valid_item_list_1 (XCAR (rest)); + else + signal_simple_error ("Items must be vectors, lists or strings", items); + } +} + +static void +check_valid_item_list (Lisp_Object data) +{ + Lisp_Object items; + + Fcheck_valid_plist (data); + items = Fplist_get (data, Q_items, Qnil); + + check_valid_item_list_1 (items); +} + +static void +check_valid_glyph_or_instantiator_list (Lisp_Object data) +{ + Lisp_Object rest; + + CHECK_LIST (data); + EXTERNAL_LIST_LOOP (rest, data) + { + check_valid_glyph_or_instantiator (XCAR (rest)); } } -/* wire widget property invocations to specific widgets ... The - problem we are solving here is that when instantiators get converted - to instances they lose some type information (they just become - subwindows or widgets for example). For widgets we need to preserve - this type information so that we can do widget specific operations on - the instances. This is encoded in the widget type - field. widget_property gets invoked by decoding the primary type - (Qwidget), widget property then invokes based on the secondary type - (Qedit for example). It is debatable that we should wire things in this - generalised way rather than treating widgets specially in - image_instance_property. */ +static Lisp_Object +glyph_instantiator_to_glyph (Lisp_Object sym) +{ + /* This function calls lisp. */ + Lisp_Object glyph = sym; + struct gcpro gcpro1; + + GCPRO1 (glyph); + /* if we have a symbol get at the actual data */ + if (SYMBOLP (glyph)) + glyph = XSYMBOL (glyph)->value; + + if (CONSP (glyph)) + glyph = Feval (glyph); + + /* Be really helpful to the user. */ + if (VECTORP (glyph)) + { + glyph = call1 (intern ("make-glyph"), glyph); + } + + /* substitute the new glyph */ + RETURN_UNGCPRO (glyph); +} + +static void +substitute_keyword_value (Lisp_Object inst, Lisp_Object key, Lisp_Object val) +{ + int i; + /* substitute the new glyph */ + for (i = 0; i < XVECTOR_LENGTH (inst); i++) + { + if (EQ (key, XVECTOR_DATA (inst)[i])) + { + XVECTOR_DATA (inst)[i+1] = val; + break; + } + } +} + +/* Wire widget property invocations to specific widgets. The problem + we are solving here is that when instantiators get converted to + instances they lose some type information (they just become + subwindows or widgets for example). For widgets we need to preserve + this type information so that we can do widget specific operations + on the instances. This is encoded in the widget type + field. widget_property gets invoked by decoding the primary type + (Qwidget), <widget>_property then invokes based on the secondary + type (Qedit_field for example). It is debatable whether we should + wire things in this generalised way rather than treating widgets + specially in image_instance_property. */ static Lisp_Object widget_property (Lisp_Object image_instance, Lisp_Object prop) { - struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); struct image_instantiator_methods* meths; /* first see if its a general property ... */ @@ -200,11 +282,19 @@ static Lisp_Object widget_set_property (Lisp_Object image_instance, Lisp_Object prop, Lisp_Object val) { - struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); struct image_instantiator_methods* meths; Lisp_Object ret; - /* try device specific methods first ... */ + /* PIck up any generic properties that we might need to keep hold + of. */ + if (EQ (prop, Q_text)) + { + IMAGE_INSTANCE_WIDGET_TEXT (ii) = val; + IMAGE_INSTANCE_TEXT_CHANGED (ii) = 1; + } + + /* Now try device specific methods first ... */ meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii), IMAGE_INSTANCE_WIDGET_TYPE (ii), ERROR_ME_NOT); @@ -231,19 +321,128 @@ return val; } +/* Like the rest of redisplay, we want widget updates to occur +asynchronously. Thus toolkit specific methods for setting properties +must be called by redisplay instead of by *_set_property. Thus +*_set_property records the change and this function actually +implements it. We want to be slightly clever about this however by +supplying format specific functions for the updates instead of lumping +them all into this function. Note that there is no need for format +generic functions. */ +void +update_widget (Lisp_Object widget) +{ + Lisp_Image_Instance* ii = XIMAGE_INSTANCE (widget); + struct image_instantiator_methods* meths; + + if (!IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET) + return; + + /* Device generic methods. We must update the widget's size as it + may have been changed by the the layout routines. We also do this + here so that explicit resizing from lisp does not result in + synchronous updates. */ + MAYBE_DEVMETH (XDEVICE (ii->device), update_widget, (ii)); + + /* Device-format specific methods */ + meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii), + IMAGE_INSTANCE_WIDGET_TYPE (ii), + ERROR_ME_NOT); + MAYBE_IIFORMAT_METH (meths, update, (widget)); +} + +/* Query for a widgets desired geometry. If no type specific method is + provided then use the widget text to calculate sizes. */ +static void +widget_query_geometry (Lisp_Object image_instance, + unsigned int* width, unsigned int* height, + enum image_instance_geometry disp, Lisp_Object domain) +{ + Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); + struct image_instantiator_methods* meths; + + /* First just set up what we already have. */ + if (width) *width = IMAGE_INSTANCE_WIDTH (ii); + if (height) *height = IMAGE_INSTANCE_HEIGHT (ii); + + if (IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) + || + IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii)) + { + /* .. then try device specific methods ... */ + meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii), + IMAGE_INSTANCE_WIDGET_TYPE (ii), + ERROR_ME_NOT); + if (meths && HAS_IIFORMAT_METH_P (meths, query_geometry)) + IIFORMAT_METH (meths, query_geometry, (image_instance, + width, height, disp, + domain)); + else + { + /* ... then format specific methods ... */ + meths = decode_device_ii_format (Qnil, IMAGE_INSTANCE_WIDGET_TYPE (ii), + ERROR_ME_NOT); + if (meths && HAS_IIFORMAT_METH_P (meths, query_geometry)) + IIFORMAT_METH (meths, query_geometry, (image_instance, + width, height, disp, + domain)); + else + { + unsigned int w, h; + + /* Then if we are allowed to resize the widget, make the + size the same as the text dimensions. */ + query_string_geometry (IMAGE_INSTANCE_WIDGET_TEXT (ii), + IMAGE_INSTANCE_WIDGET_FACE (ii), + &w, &h, 0, domain); + /* Adjust the size for borders. */ + if (IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii)) + *width = w + 2 * WIDGET_BORDER_WIDTH; + if (IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii)) + *height = h + 2 * WIDGET_BORDER_HEIGHT; + } + } + } +} + +static void +widget_layout (Lisp_Object image_instance, + unsigned int width, unsigned int height, Lisp_Object domain) +{ + Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); + struct image_instantiator_methods* meths; + + /* .. then try device specific methods ... */ + meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii), + IMAGE_INSTANCE_WIDGET_TYPE (ii), + ERROR_ME_NOT); + if (meths && HAS_IIFORMAT_METH_P (meths, layout)) + IIFORMAT_METH (meths, layout, (image_instance, + width, height, domain)); + else + { + /* ... then format specific methods ... */ + meths = decode_device_ii_format (Qnil, IMAGE_INSTANCE_WIDGET_TYPE (ii), + ERROR_ME_NOT); + if (meths && HAS_IIFORMAT_METH_P (meths, layout)) + IIFORMAT_METH (meths, layout, (image_instance, + width, height, domain)); + } +} + static void widget_validate (Lisp_Object instantiator) { Lisp_Object desc = find_keyword_in_vector (instantiator, Q_descriptor); - struct gui_item gui; + if (NILP (desc)) signal_simple_error ("Must supply :descriptor", instantiator); if (VECTORP (desc)) - gui_parse_item_keywords (desc, &gui); + gui_parse_item_keywords (desc); if (!NILP (find_keyword_in_vector (instantiator, Q_width)) - && !NILP (find_keyword_in_vector (instantiator, Q_pixel_width))) + && !NILP (find_keyword_in_vector (instantiator, Q_pixel_width))) signal_simple_error ("Must supply only one of :width and :pixel-width", instantiator); if (!NILP (find_keyword_in_vector (instantiator, Q_height)) @@ -252,7 +451,7 @@ } static void -combo_validate (Lisp_Object instantiator) +combo_box_validate (Lisp_Object instantiator) { widget_validate (instantiator); if (NILP (find_keyword_in_vector (instantiator, Q_properties))) @@ -271,52 +470,38 @@ same reasons we normalize file to data. */ if (!NILP (glyph)) { - int i; - struct gcpro gcpro1; - if (SYMBOLP (glyph)) - glyph = XSYMBOL (glyph)->value; - GCPRO1 (glyph); + substitute_keyword_value (inst, Q_image, glyph_instantiator_to_glyph (glyph)); + } - if (CONSP (glyph)) - glyph = Feval (glyph); - /* substitute the new glyph */ - for (i = 0; i < XVECTOR_LENGTH (inst); i++) - { - if (EQ (Q_image, XVECTOR_DATA (inst)[i])) - { - XVECTOR_DATA (inst)[i+1] = glyph; - break; - } - } - UNGCPRO; - } return inst; } static void -initialize_widget_image_instance (struct Lisp_Image_Instance *ii, Lisp_Object type) +initialize_widget_image_instance (Lisp_Image_Instance *ii, Lisp_Object type) { /* initialize_subwindow_image_instance (ii);*/ IMAGE_INSTANCE_WIDGET_TYPE (ii) = type; IMAGE_INSTANCE_WIDGET_PROPS (ii) = Qnil; - IMAGE_INSTANCE_WIDGET_FACE (ii) = Vwidget_face; - gui_item_init (&IMAGE_INSTANCE_WIDGET_ITEM (ii)); + SET_IMAGE_INSTANCE_WIDGET_FACE (ii, Qnil); + IMAGE_INSTANCE_WIDGET_ITEMS (ii) = allocate_gui_item (); + IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii) = 1; + IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) = 1; + IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) = 0; + IMAGE_INSTANCE_SUBWINDOW_JUSTIFY (ii) = 0; } /* Instantiate a button widget. Unfortunately instantiated widgets are particular to a frame since they need to have a parent. It's not like images where you just select the image into the context you - want to display it in and BitBlt it. So images instances can have a + want to display it in and BitBlt it. So image instances can have a many-to-one relationship with things you see, whereas widgets can only be one-to-one (i.e. per frame) */ -static void -widget_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain, int default_textheight, - int default_pixheight) +void +widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) { - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - struct gui_item* pgui = &IMAGE_INSTANCE_WIDGET_ITEM (ii); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object face = find_keyword_in_vector (instantiator, Q_face); Lisp_Object height = find_keyword_in_vector (instantiator, Q_height); Lisp_Object width = find_keyword_in_vector (instantiator, Q_width); @@ -324,110 +509,549 @@ Lisp_Object pixheight = find_keyword_in_vector (instantiator, Q_pixel_height); Lisp_Object desc = find_keyword_in_vector (instantiator, Q_descriptor); Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image); + Lisp_Object props = find_keyword_in_vector (instantiator, Q_properties); + Lisp_Object items = find_keyword_in_vector (instantiator, Q_items); + Lisp_Object orient = find_keyword_in_vector (instantiator, Q_orientation); int pw=0, ph=0, tw=0, th=0; /* this just does pixel type sizing */ subwindow_instantiate (image_instance, instantiator, pointer_fg, pointer_bg, dest_mask, domain); - if (!(dest_mask & IMAGE_WIDGET_MASK)) - incompatible_image_types (instantiator, dest_mask, IMAGE_WIDGET_MASK); + if (!(dest_mask & (IMAGE_WIDGET_MASK | IMAGE_LAYOUT_MASK))) + incompatible_image_types (instantiator, dest_mask, + IMAGE_WIDGET_MASK | IMAGE_LAYOUT_MASK); initialize_widget_image_instance (ii, XVECTOR_DATA (instantiator)[0]); + IMAGE_INSTANCE_TYPE (ii) = IMAGE_WIDGET; + IMAGE_INSTANCE_WIDGET_PROPS (ii) = props; + /* retrieve the fg and bg colors */ if (!NILP (face)) - IMAGE_INSTANCE_WIDGET_FACE (ii) = Fget_face (face); + SET_IMAGE_INSTANCE_WIDGET_FACE (ii, Fget_face (face)); - /* data items for some widgets */ - IMAGE_INSTANCE_WIDGET_PROPS (ii) = - find_keyword_in_vector (instantiator, Q_properties); + /* Do layout specific initialisation. This feels a bit tacky, but + the alternative is a myriad of different little functions. */ + if (EQ (IMAGE_INSTANCE_WIDGET_TYPE (ii), Qlayout)) + { + Lisp_Object rest, children = Qnil; + Lisp_Object border = find_keyword_in_vector (instantiator, Q_border); + if (NILP (orient)) + { + IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) = LAYOUT_VERTICAL; + } + IMAGE_INSTANCE_TYPE (ii) = IMAGE_LAYOUT; + + if (EQ (border, Qt)) + { + IMAGE_INSTANCE_LAYOUT_BORDER (ii) = Qetched_in; + } + else if (GLYPHP (border)) + { + /* We are going to be sneaky here and add the border text as + just another child, the layout and output routines don't know + this and will just display at the offsets we prescribe. */ + Lisp_Object gii = glyph_image_instance (border, domain, ERROR_ME, 1); + /* make sure we are designated as the parent. */ + XIMAGE_INSTANCE_PARENT (gii) = image_instance; + children = Fcons (gii, children); + IMAGE_INSTANCE_LAYOUT_BORDER (ii) = make_int (0); + } + else + { + IMAGE_INSTANCE_LAYOUT_BORDER (ii) = border; + } + + /* Pick up the sub-widgets. */ + LIST_LOOP (rest, items) + { + /* make sure the image is instantiated */ + Lisp_Object gii = glyph_image_instance (XCAR (rest), domain, ERROR_ME, 1); + /* make sure we are designated as the parent. */ + XIMAGE_INSTANCE_PARENT (gii) = image_instance; + children = Fcons (gii, children); + /* Make sure elements in the layout are in the order the + user expected. */ + children = Fnreverse (children); + } + IMAGE_INSTANCE_LAYOUT_CHILDREN (ii) = children; + } /* retrieve the gui item information. This is easy if we have been provided with a vector, more difficult if we have just been given keywords */ - if (STRINGP (desc) || NILP (desc)) + else if (STRINGP (desc) || NILP (desc)) { /* big cheat - we rely on the fact that a gui item looks like an instantiator */ - gui_parse_item_keywords_no_errors (instantiator, pgui); + IMAGE_INSTANCE_WIDGET_ITEMS (ii) = + gui_parse_item_keywords_no_errors (instantiator); IMAGE_INSTANCE_WIDGET_TEXT (ii) = desc; } else - gui_parse_item_keywords_no_errors (desc, pgui); + IMAGE_INSTANCE_WIDGET_ITEMS (ii) = + gui_parse_item_keywords_no_errors (desc); + + /* Pick up the orientation before we do our first layout. */ + if (EQ (orient, Qleft) || EQ (orient, Qright) || EQ (orient, Qvertical)) + IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) = 1; + + /* parse more gui items out of the properties */ + if (!NILP (props) + && !EQ (IMAGE_INSTANCE_WIDGET_TYPE (ii), Qlayout)) + { + if (NILP (items)) + { + items = Fplist_get (props, Q_items, Qnil); + } + if (!NILP (items)) + { + IMAGE_INSTANCE_WIDGET_ITEMS (ii) = + Fcons (IMAGE_INSTANCE_WIDGET_ITEMS (ii), + parse_gui_item_tree_children (items)); + } + } - /* normalize size information */ - if (!NILP (width)) - tw = XINT (width); - if (!NILP (height)) - th = XINT (height); - if (!NILP (pixwidth)) - pw = XINT (pixwidth); + /* Normalize size information. We now only assign sizes if the user + gives us some explicitly, or there are some constraints that we + can't change later on. Otherwise we postpone sizing until query + geometry gets called. */ + if (!NILP (pixwidth)) /* pixwidth takes precendent */ + { + pw = XINT (pixwidth); + IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii) = 0; + } + else if (!NILP (width)) + { + tw = XINT (width); + IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii) = 0; + } + if (!NILP (pixheight)) - ph = XINT (pixheight); + { + ph = XINT (pixheight); + IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) = 0; + } + else if (!NILP (height) && XINT (height) > 1) + { + th = XINT (height); + IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) = 0; + } + + /* Taking the default face information when the user has specified + size in characters is probably as good as any since the widget + face is more likely to be proportional and thus give inadequate + results. Using character sizes can only ever be approximate + anyway. */ + if (tw || th) + { + int charwidth, charheight; + default_face_font_info (domain, 0, 0, &charheight, &charwidth, 0); + if (tw) + pw = charwidth * tw; + if (th) + ph = charheight * th; + } /* for a widget with an image pick up the dimensions from that */ if (!NILP (glyph)) { - if (!pw && !tw) - pw = glyph_width (glyph, Qnil, DEFAULT_INDEX, domain) - + 2 * WIDGET_BORDER_WIDTH; - if (!ph && !th) - ph = glyph_height (glyph, Qnil, DEFAULT_INDEX, domain) - + 2 * WIDGET_BORDER_HEIGHT; + if (!pw) + pw = glyph_width (glyph, domain) + 2 * WIDGET_BORDER_WIDTH; + if (!ph) + ph = glyph_height (glyph, domain) + 2 * WIDGET_BORDER_HEIGHT; + IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) = 0; + IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii) = 0; + } + + /* When we create the widgets the window system expects a valid + size, so If we still don' t have sizes, call layout to pick them + up. If query_geometry or layout relies on the widget being in + existence then we are in catch 22. */ + image_instance_layout (image_instance, + pw ? pw : IMAGE_UNSPECIFIED_GEOMETRY, + ph ? ph : IMAGE_UNSPECIFIED_GEOMETRY, + domain); + +#ifdef DEBUG_WIDGETS + debug_widget_instances++; + stderr_out ("instantiated "); + debug_print (instantiator); + stderr_out ("%d widgets instantiated\n", debug_widget_instances); +#endif +} + +/* tree-view geometry - get the height right */ +static void +tree_view_query_geometry (Lisp_Object image_instance, + unsigned int* width, unsigned int* height, + enum image_instance_geometry disp, Lisp_Object domain) +{ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Object items = IMAGE_INSTANCE_WIDGET_ITEMS (ii); + + + if (*width) + { + /* #### what should this be. reconsider when X has tree views. */ + query_string_geometry (IMAGE_INSTANCE_WIDGET_TEXT (ii), + IMAGE_INSTANCE_WIDGET_FACE (ii), + width, 0, 0, domain); + } + if (*height) + { + int len, h; + default_face_font_info (domain, 0, 0, &h, 0, 0); + GET_LIST_LENGTH (items, len); + *height = len * h; + } +} + +/* Get the geometry of a tab control. This is based on the number of + items and text therin in the tab control. */ +static void +tab_control_query_geometry (Lisp_Object image_instance, + unsigned int* width, unsigned int* height, + enum image_instance_geometry disp, Lisp_Object domain) +{ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Object items = IMAGE_INSTANCE_WIDGET_ITEMS (ii); + Lisp_Object rest; + unsigned int tw = 0, th = 0; + + LIST_LOOP (rest, items) + { + unsigned int h, w; + + query_string_geometry (XGUI_ITEM (XCAR (rest))->name, + IMAGE_INSTANCE_WIDGET_FACE (ii), + &w, &h, 0, domain); + tw += 2 * WIDGET_BORDER_WIDTH; /* some bias */ + tw += w; + th = max (th, h + 2 * WIDGET_BORDER_HEIGHT); } - /* if we still don' t have sizes, guess from text size */ - if (!tw && !pw && !NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii))) - tw = XSTRING_LENGTH (IMAGE_INSTANCE_WIDGET_TEXT (ii)); - if (!th && !ph) + /* Fixup returned values depending on orientation. */ + if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii)) + { + if (height) *height = tw; + if (width) *width = th; + } + else + { + if (height) *height = th; + if (width) *width = tw; + } +} + +/* Get the geometry of a tab control. This is based on the number of + items and text therin in the tab control. */ +static Lisp_Object +tab_control_set_property (Lisp_Object image_instance, + Lisp_Object prop, + Lisp_Object val) +{ + /* Record new items for update. *_tab_control_update will do the + rest. */ + if (EQ (prop, Q_items)) { - if (default_textheight) - th = default_textheight; - else if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii))) - th = 1; - else - ph = default_pixheight; + Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); + check_valid_item_list_1 (val); + + IMAGE_INSTANCE_WIDGET_ITEMS (ii) = + Fcons (XCAR (IMAGE_INSTANCE_WIDGET_ITEMS (ii)), + parse_gui_item_tree_children (val)); + + IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 1; + + return Qt; + } + return Qunbound; +} + +/* set the properties of a progres guage */ +static Lisp_Object +progress_gauge_set_property (Lisp_Object image_instance, + Lisp_Object prop, + Lisp_Object val) +{ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + + if (EQ (prop, Q_percent)) + { + CHECK_INT (val); + IMAGE_INSTANCE_WIDGET_PROPS (ii) + = Fplist_put (IMAGE_INSTANCE_WIDGET_PROPS (ii), prop, val); + IMAGE_INSTANCE_WIDGET_PERCENT_CHANGED (ii) = 1; + + return Qt; } - - if (tw !=0 || th !=0) - widget_text_to_pixel_conversion (domain, - IMAGE_INSTANCE_WIDGET_FACE (ii), - th, tw, th ? &ph : 0, tw ? &pw : 0); + return Qunbound; +} + + +/***************************************************************************** + * widget layout * + *****************************************************************************/ +static int +layout_possible_dest_types (void) +{ + return IMAGE_LAYOUT_MASK; +} - IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = pw; - IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = ph; +/* we need to convert things like glyphs to images, eval expressions + etc.*/ +static Lisp_Object +layout_normalize (Lisp_Object inst, Lisp_Object console_type) +{ + /* This function can call lisp */ + Lisp_Object items = find_keyword_in_vector (inst, Q_items); + Lisp_Object border = find_keyword_in_vector (inst, Q_border); + /* we need to eval glyph if its an expression, we do this for the + same reasons we normalize file to data. */ + if (!NILP (items)) + { + Lisp_Object rest; + LIST_LOOP (rest, items) + { + /* substitute the new glyph */ + Fsetcar (rest, glyph_instantiator_to_glyph (XCAR (rest))); + } + } + /* normalize the border spec. */ + if (VECTORP (border) || CONSP (border)) + { + substitute_keyword_value (inst, Q_border, glyph_instantiator_to_glyph (border)); + } + return inst; } +/* Layout widget. Sizing commentary: we have a number of problems that + we would like to address. Some consider some of these more + important than others. It used to be that size information was + determined at instantiation time and was then fixed forever + after. Generally this is not what we want. Users want size to be + "big enough" to accommodate whatever they are trying to show and + this is dependent on text length, lines, font metrics etc. Of + course these attributes can change dynamically and so the size + should changed dynamically also. Only in a few limited cases should + the size be fixed and remain fixed. Of course this actually means + that we don't really want to specifiy the size *at all* for most + widgets - we want it to be discovered dynamically. Thus we can + envisage the following scenarios: + + 1. A button is sized to accommodate its text, the text changes and the + button should change size also. + + 2. A button is given an explicit size. Its size should never change. + + 3. Layout is put inside an area. The size of the area changes, the + layout should change with it. + + 4. A button grows to accommodate additional text. The whitespace + around it should be modified to cope with the new layout + requirements. + + 5. A button grows. The area surrounding it should grow also if + possible. + + What metrics are important? + 1. Actual width and height. + + 2. Whether the width and height are what the widget actually wants, or + whether it can grow or shrink. + + Text glyphs are particularly troublesome since their metrics depend + on the context in which they are being viewed. For instance they + can appear differently depending on the window face, frame face or + glyph face. In order to simplify this text glyphs can now only have + a glyph-face or image-instance face. All other glyphs are + essentially fixed in appearance. Perhaps the problem is that text + glyphs are cached on a device basis like most other glyphs. Instead + they should be cached per-window and then the instance would be + fixed and we wouldn't have to mess around with font metrics and the + rest. */ + +/* Query the geometry of a layout widget. We assume that we can only + get here if the size is not already fixed. */ static void -widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) +layout_query_geometry (Lisp_Object image_instance, unsigned int* width, + unsigned int* height, enum image_instance_geometry disp, + Lisp_Object domain) { - widget_instantiate_1 (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain, 1, 0); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Object items = IMAGE_INSTANCE_LAYOUT_CHILDREN (ii), rest; + int maxph = 0, maxpw = 0, nitems = 0, ph_adjust = 0; + + /* Flip through the items to work out how much stuff we have to display */ + LIST_LOOP (rest, items) + { + Lisp_Object glyph = XCAR (rest); + unsigned int gheight, gwidth; + + image_instance_query_geometry (glyph, &gwidth, &gheight, disp, domain); + + /* Pick up the border text if we have one. */ + if (INTP (IMAGE_INSTANCE_LAYOUT_BORDER (ii)) + && NILP (XCDR (rest))) + { + ph_adjust = gheight / 2; + } + else + { + + nitems ++; + if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) + == LAYOUT_HORIZONTAL) + { + maxph = max (maxph, gheight); + maxpw += gwidth; + } + else + { + maxpw = max (maxpw, gwidth); + maxph += gheight; + } + } + } + + /* work out spacing between items and bounds of the layout. No user + provided width so we just do default spacing. */ + if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) + == LAYOUT_HORIZONTAL) + *width = maxpw + (nitems + 1) * WIDGET_BORDER_WIDTH * 2; + else + *width = maxpw + 2 * WIDGET_BORDER_WIDTH * 2; + + /* Work out vertical spacings. */ + if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) + == LAYOUT_VERTICAL) + *height = maxph + (nitems + 1) * WIDGET_BORDER_HEIGHT * 2 + ph_adjust; + else + *height = maxph + 2 * WIDGET_BORDER_HEIGHT * 2 + ph_adjust; } + static void -combo_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) +layout_layout (Lisp_Object image_instance, + unsigned int width, unsigned int height, Lisp_Object domain) { - Lisp_Object data = Fplist_get (find_keyword_in_vector (instantiator, Q_properties), - Q_items, Qnil); - int len; - GET_LIST_LENGTH (data, len); - widget_instantiate_1 (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain, len + 1, 0); -} + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Object rest; + Lisp_Object items = IMAGE_INSTANCE_LAYOUT_CHILDREN (ii); + int x, y, maxph = 0, maxpw = 0, nitems = 0, + horiz_spacing, vert_spacing, ph_adjust = 0; + unsigned int gheight, gwidth; + + /* flip through the items to work out how much stuff we have to display */ + LIST_LOOP (rest, items) + { + Lisp_Object glyph = XCAR (rest); + + image_instance_query_geometry (glyph, &gwidth, &gheight, + IMAGE_DESIRED_GEOMETRY, domain); + + /* Pick up the border text if we have one. */ + if (INTP (IMAGE_INSTANCE_LAYOUT_BORDER (ii)) + && NILP (XCDR (rest))) + { + XIMAGE_INSTANCE_XOFFSET (glyph) = 10; /* Really, what should this be? */ + XIMAGE_INSTANCE_YOFFSET (glyph) = 0; + ph_adjust = gheight / 2; + IMAGE_INSTANCE_LAYOUT_BORDER (ii) = make_int (ph_adjust); + } + else + { + nitems ++; + if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) + == LAYOUT_HORIZONTAL) + { + maxph = max (maxph, gheight); + maxpw += gwidth; + } + else + { + maxpw = max (maxpw, gwidth); + maxph += gheight; + } + } + } + + /* work out spacing between items and bounds of the layout */ + if (width < maxpw) + /* The user wants a smaller space than the largest item, so we + just provide default spacing and will let the output routines + clip.. */ + horiz_spacing = WIDGET_BORDER_WIDTH * 2; + else if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) + == LAYOUT_HORIZONTAL) + /* We have a larger area to display in so distribute the space + evenly. */ + horiz_spacing = (width - maxpw) / (nitems + 1); + else + horiz_spacing = (width - maxpw) / 2; -/* Instantiate a static control */ -static void -static_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - widget_instantiate_1 (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain, 0, 4); + if (height < maxph) + vert_spacing = WIDGET_BORDER_HEIGHT * 2; + else if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) + == LAYOUT_VERTICAL) + vert_spacing = (height - (maxph + ph_adjust)) / (nitems + 1); + else + vert_spacing = (height - (maxph + ph_adjust)) / 2; + + y = vert_spacing + ph_adjust; + x = horiz_spacing; + + /* Now flip through putting items where we want them, paying + attention to justification. Make sure we don't mess with the + border glyph. */ + LIST_LOOP (rest, items) + { + Lisp_Object glyph = XCAR (rest); + + image_instance_query_geometry (glyph, &gwidth, &gheight, + IMAGE_DESIRED_GEOMETRY, domain); + + if (!INTP (IMAGE_INSTANCE_LAYOUT_BORDER (ii)) + || !NILP (XCDR (rest))) + { + if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) + == LAYOUT_HORIZONTAL) + { + if (IMAGE_INSTANCE_SUBWINDOW_JUSTIFY (ii) + == LAYOUT_JUSTIFY_RIGHT) + y = height - (gheight + vert_spacing); + if (IMAGE_INSTANCE_SUBWINDOW_JUSTIFY (ii) + == LAYOUT_JUSTIFY_CENTER) + y = (height - gheight) / 2; + } + else + { + if (IMAGE_INSTANCE_SUBWINDOW_JUSTIFY (ii) + == LAYOUT_JUSTIFY_RIGHT) + x = width - (gwidth + horiz_spacing); + if (IMAGE_INSTANCE_SUBWINDOW_JUSTIFY (ii) + == LAYOUT_JUSTIFY_CENTER) + x = (width - gwidth) / 2; + } + + XIMAGE_INSTANCE_XOFFSET (glyph) = x; + XIMAGE_INSTANCE_YOFFSET (glyph) = y; + + if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) + == LAYOUT_HORIZONTAL) + { + x += (gwidth + horiz_spacing); + } + else + { + y += (gheight + vert_spacing); + } + } + + /* Now layout subwidgets if they require it. */ + image_instance_layout (glyph, gwidth, gheight, domain); + } } @@ -445,71 +1069,90 @@ defkeyword (&Q_items, ":items"); defkeyword (&Q_image, ":image"); defkeyword (&Q_percent, ":percent"); - defkeyword (&Q_text, "text"); + defkeyword (&Q_text, ":text"); + defkeyword (&Q_orientation, ":orientation"); + defkeyword (&Q_justify, ":justify"); + defkeyword (&Q_border, ":border"); + + defsymbol (&Qetched_in, "etched-in"); + defsymbol (&Qetched_out, "etched-out"); + defsymbol (&Qbevel_in, "bevel-in"); + defsymbol (&Qbevel_out, "bevel-out"); } -void -image_instantiator_format_create_glyphs_widget (void) -{ -#define VALID_GUI_KEYWORDS(type) \ - IIFORMAT_VALID_KEYWORD (type, Q_active, check_valid_anything); \ - IIFORMAT_VALID_KEYWORD (type, Q_suffix, check_valid_anything); \ - IIFORMAT_VALID_KEYWORD (type, Q_keys, check_valid_string); \ - IIFORMAT_VALID_KEYWORD (type, Q_style, check_valid_symbol); \ - IIFORMAT_VALID_KEYWORD (type, Q_selected, check_valid_anything); \ - IIFORMAT_VALID_KEYWORD (type, Q_filter, check_valid_anything); \ - IIFORMAT_VALID_KEYWORD (type, Q_config, check_valid_symbol); \ - IIFORMAT_VALID_KEYWORD (type, Q_included, check_valid_anything); \ - IIFORMAT_VALID_KEYWORD (type, Q_key_sequence, check_valid_string); \ - IIFORMAT_VALID_KEYWORD (type, Q_accelerator, check_valid_string); \ - IIFORMAT_VALID_KEYWORD (type, Q_label, check_valid_anything); \ - IIFORMAT_VALID_KEYWORD (type, Q_callback, check_valid_callback); \ - IIFORMAT_VALID_KEYWORD (type, Q_descriptor, check_valid_string_or_vector) +#define VALID_GUI_KEYWORDS(type) do { \ + IIFORMAT_VALID_NONCOPY_KEYWORD (type, Q_active, check_valid_anything); \ + IIFORMAT_VALID_KEYWORD (type, Q_suffix, check_valid_anything); \ + IIFORMAT_VALID_KEYWORD (type, Q_keys, check_valid_string); \ + IIFORMAT_VALID_KEYWORD (type, Q_style, check_valid_symbol); \ + IIFORMAT_VALID_NONCOPY_KEYWORD (type, Q_selected, check_valid_anything); \ + IIFORMAT_VALID_KEYWORD (type, Q_filter, check_valid_anything); \ + IIFORMAT_VALID_KEYWORD (type, Q_config, check_valid_symbol); \ + IIFORMAT_VALID_KEYWORD (type, Q_included, check_valid_anything); \ + IIFORMAT_VALID_KEYWORD (type, Q_key_sequence, check_valid_string); \ + IIFORMAT_VALID_KEYWORD (type, Q_accelerator, check_valid_string); \ + IIFORMAT_VALID_KEYWORD (type, Q_label, check_valid_anything); \ + IIFORMAT_VALID_NONCOPY_KEYWORD (type, Q_callback, check_valid_callback); \ + IIFORMAT_VALID_NONCOPY_KEYWORD (type, Q_descriptor, check_valid_string_or_vector); \ +} while (0) -#define VALID_WIDGET_KEYWORDS(type) \ +#define VALID_WIDGET_KEYWORDS(type) do { \ IIFORMAT_VALID_KEYWORD (type, Q_width, check_valid_int); \ IIFORMAT_VALID_KEYWORD (type, Q_height, check_valid_int); \ IIFORMAT_VALID_KEYWORD (type, Q_pixel_width, check_valid_int); \ IIFORMAT_VALID_KEYWORD (type, Q_pixel_height, check_valid_int); \ - IIFORMAT_VALID_KEYWORD (type, Q_face, check_valid_face) + IIFORMAT_VALID_KEYWORD (type, Q_face, check_valid_face); \ +} while (0) - /* we only do this for properties */ + +static void image_instantiator_widget (void) +{ /* we only do this for properties */ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT_NO_SYM (widget, "widget"); IIFORMAT_HAS_METHOD (widget, property); IIFORMAT_HAS_METHOD (widget, set_property); + IIFORMAT_HAS_METHOD (widget, query_geometry); + IIFORMAT_HAS_METHOD (widget, layout); +} - /* widget image-instantiator types - buttons */ +static void image_instantiator_buttons (void) +{ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (button, "button"); IIFORMAT_HAS_SHARED_METHOD (button, validate, widget); IIFORMAT_HAS_SHARED_METHOD (button, possible_dest_types, widget); IIFORMAT_HAS_SHARED_METHOD (button, instantiate, widget); IIFORMAT_HAS_SHARED_METHOD (button, normalize, widget); - IIFORMAT_VALID_KEYWORD (button, Q_image, check_valid_glyph_or_image); + IIFORMAT_VALID_KEYWORD (button, + Q_image, check_valid_glyph_or_instantiator); VALID_WIDGET_KEYWORDS (button); VALID_GUI_KEYWORDS (button); +} - /* edit fields */ - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (edit, "edit"); - IIFORMAT_HAS_SHARED_METHOD (edit, validate, widget); - IIFORMAT_HAS_SHARED_METHOD (edit, possible_dest_types, widget); - IIFORMAT_HAS_SHARED_METHOD (edit, instantiate, widget); - VALID_WIDGET_KEYWORDS (edit); - VALID_GUI_KEYWORDS (edit); +static void image_instantiator_edit_fields (void) +{ + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (edit_field, "edit-field"); + IIFORMAT_HAS_SHARED_METHOD (edit_field, validate, widget); + IIFORMAT_HAS_SHARED_METHOD (edit_field, possible_dest_types, widget); + IIFORMAT_HAS_SHARED_METHOD (edit_field, instantiate, widget); + VALID_WIDGET_KEYWORDS (edit_field); + VALID_GUI_KEYWORDS (edit_field); +} - /* combo box */ - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (combo, "combo"); - IIFORMAT_HAS_METHOD (combo, validate); - IIFORMAT_HAS_SHARED_METHOD (combo, possible_dest_types, widget); - IIFORMAT_HAS_METHOD (combo, instantiate); - VALID_GUI_KEYWORDS (combo); +static void image_instantiator_combo_box (void) +{ + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (combo_box, "combo-box"); + IIFORMAT_HAS_METHOD (combo_box, validate); + IIFORMAT_HAS_SHARED_METHOD (combo_box, possible_dest_types, widget); + VALID_GUI_KEYWORDS (combo_box); - IIFORMAT_VALID_KEYWORD (combo, Q_width, check_valid_int); - IIFORMAT_VALID_KEYWORD (combo, Q_height, check_valid_int); - IIFORMAT_VALID_KEYWORD (combo, Q_pixel_width, check_valid_int); - IIFORMAT_VALID_KEYWORD (combo, Q_face, check_valid_face); - IIFORMAT_VALID_KEYWORD (combo, Q_properties, check_valid_item_list); + IIFORMAT_VALID_KEYWORD (combo_box, Q_width, check_valid_int); + IIFORMAT_VALID_KEYWORD (combo_box, Q_height, check_valid_int); + IIFORMAT_VALID_KEYWORD (combo_box, Q_pixel_width, check_valid_int); + IIFORMAT_VALID_KEYWORD (combo_box, Q_face, check_valid_face); + IIFORMAT_VALID_KEYWORD (combo_box, Q_properties, check_valid_item_list); +} - /* scrollbar */ +static void image_instantiator_scrollbar (void) +{ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (scrollbar, "scrollbar"); IIFORMAT_HAS_SHARED_METHOD (scrollbar, validate, widget); IIFORMAT_HAS_SHARED_METHOD (scrollbar, possible_dest_types, widget); @@ -519,39 +1162,96 @@ IIFORMAT_VALID_KEYWORD (scrollbar, Q_pixel_width, check_valid_int); IIFORMAT_VALID_KEYWORD (scrollbar, Q_pixel_height, check_valid_int); IIFORMAT_VALID_KEYWORD (scrollbar, Q_face, check_valid_face); +} - /* progress guage */ - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (progress, "progress"); - IIFORMAT_HAS_SHARED_METHOD (progress, validate, widget); - IIFORMAT_HAS_SHARED_METHOD (progress, possible_dest_types, widget); - IIFORMAT_HAS_SHARED_METHOD (progress, instantiate, widget); - VALID_WIDGET_KEYWORDS (progress); - VALID_GUI_KEYWORDS (progress); +static void image_instantiator_progress_guage (void) +{ + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (progress_gauge, "progress-gauge"); + IIFORMAT_HAS_SHARED_METHOD (progress_gauge, validate, widget); + IIFORMAT_HAS_SHARED_METHOD (progress_gauge, possible_dest_types, widget); + IIFORMAT_HAS_SHARED_METHOD (progress_gauge, instantiate, widget); + IIFORMAT_HAS_METHOD (progress_gauge, set_property); + VALID_WIDGET_KEYWORDS (progress_gauge); + VALID_GUI_KEYWORDS (progress_gauge); +} - /* labels */ +static void image_instantiator_tree_view (void) +{ + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (tree_view, "tree-view"); + IIFORMAT_HAS_SHARED_METHOD (tree_view, validate, combo_box); + IIFORMAT_HAS_SHARED_METHOD (tree_view, possible_dest_types, widget); + IIFORMAT_HAS_SHARED_METHOD (tree_view, instantiate, widget); + IIFORMAT_HAS_METHOD (tree_view, query_geometry); + VALID_WIDGET_KEYWORDS (tree_view); + VALID_GUI_KEYWORDS (tree_view); + IIFORMAT_VALID_KEYWORD (tree_view, Q_properties, check_valid_item_list); +} + +static void image_instantiator_tab_control (void) +{ + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (tab_control, "tab-control"); + IIFORMAT_HAS_SHARED_METHOD (tab_control, validate, combo_box); + IIFORMAT_HAS_SHARED_METHOD (tab_control, possible_dest_types, widget); + IIFORMAT_HAS_SHARED_METHOD (tab_control, instantiate, widget); + IIFORMAT_HAS_METHOD (tab_control, query_geometry); + IIFORMAT_HAS_METHOD (tab_control, set_property); + VALID_WIDGET_KEYWORDS (tab_control); + VALID_GUI_KEYWORDS (tab_control); + IIFORMAT_VALID_KEYWORD (tab_control, Q_orientation, check_valid_tab_orientation); + IIFORMAT_VALID_KEYWORD (tab_control, Q_properties, check_valid_item_list); +} + +static void image_instantiator_labels (void) +{ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (label, "label"); IIFORMAT_HAS_SHARED_METHOD (label, possible_dest_types, widget); - IIFORMAT_HAS_SHARED_METHOD (label, instantiate, static); + IIFORMAT_HAS_SHARED_METHOD (label, instantiate, widget); VALID_WIDGET_KEYWORDS (label); IIFORMAT_VALID_KEYWORD (label, Q_descriptor, check_valid_string); +} -#if 0 - /* group */ - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (group, "group"); - IIFORMAT_HAS_SHARED_METHOD (group, possible_dest_types, widget); - IIFORMAT_HAS_METHOD (group, instantiate); +static void image_instantiator_layout (void) +{ + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (layout, "layout"); + IIFORMAT_HAS_METHOD (layout, possible_dest_types); + IIFORMAT_HAS_SHARED_METHOD (layout, instantiate, widget); + IIFORMAT_HAS_METHOD (layout, normalize); + IIFORMAT_HAS_METHOD (layout, query_geometry); + IIFORMAT_HAS_METHOD (layout, layout); + IIFORMAT_VALID_KEYWORD (layout, Q_pixel_width, check_valid_int); + IIFORMAT_VALID_KEYWORD (layout, Q_pixel_height, check_valid_int); + IIFORMAT_VALID_KEYWORD (layout, Q_orientation, check_valid_orientation); + IIFORMAT_VALID_KEYWORD (layout, Q_justify, check_valid_justification); + IIFORMAT_VALID_KEYWORD (layout, Q_border, check_valid_border); + IIFORMAT_VALID_KEYWORD (layout, Q_items, + check_valid_glyph_or_instantiator_list); +} - IIFORMAT_VALID_KEYWORD (group, Q_width, check_valid_int); - IIFORMAT_VALID_KEYWORD (group, Q_height, check_valid_int); - IIFORMAT_VALID_KEYWORD (group, Q_pixel_width, check_valid_int); - IIFORMAT_VALID_KEYWORD (group, Q_pixel_height, check_valid_int); - IIFORMAT_VALID_KEYWORD (group, Q_face, check_valid_face); - IIFORMAT_VALID_KEYWORD (group, Q_background, check_valid_string); - IIFORMAT_VALID_KEYWORD (group, Q_descriptor, check_valid_string); +void +image_instantiator_format_create_glyphs_widget (void) +{ + image_instantiator_widget(); + image_instantiator_buttons(); + image_instantiator_edit_fields(); + image_instantiator_combo_box(); + image_instantiator_scrollbar(); + image_instantiator_progress_guage(); + image_instantiator_tree_view(); + image_instantiator_tab_control(); + image_instantiator_labels(); + image_instantiator_layout(); +} + +void +reinit_vars_of_glyphs_widget (void) +{ +#ifdef DEBUG_WIDGETS + debug_widget_instances = 0; #endif } void vars_of_glyphs_widget (void) { + reinit_vars_of_glyphs_widget (); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/glyphs-x.c --- a/src/glyphs-x.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/glyphs-x.c Mon Aug 13 11:13:30 2007 +0200 @@ -4,6 +4,7 @@ Copyright (C) 1995 Tinker Systems Copyright (C) 1995, 1996 Ben Wing Copyright (C) 1995 Sun Microsystems + Copyright (C) 1999, 2000 Andy Piper This file is part of XEmacs. @@ -39,9 +40,11 @@ Many changes for color work and optimizations by Jareth Hein for 21.0 Switch of GIF/JPEG/PNG to new EImage intermediate code by Jareth Hein for 21.0 TIFF code by Jareth Hein for 21.0 - GIF/JPEG/PNG/TIFF code moved to new glyph-eimage.c for 21.0 + GIF/JPEG/PNG/TIFF code moved to new glyph-eimage.c by Andy Piper for 21.0 + Subwindow and Widget support by Andy Piper for 21.2 TODO: + Support the GrayScale, StaticColor and StaticGray visual classes. Convert images.el to C and stick it in here? */ @@ -51,6 +54,9 @@ #include "console-x.h" #include "glyphs-x.h" #include "objects-x.h" +#ifdef HAVE_WIDGETS +#include "gui-x.h" +#endif #include "xmu.h" #include "buffer.h" @@ -58,6 +64,8 @@ #include "frame.h" #include "insdel.h" #include "opaque.h" +#include "gui.h" +#include "faces.h" #include "imgproc.h" @@ -69,6 +77,11 @@ #include "file-coding.h" #endif +#ifdef LWLIB_WIDGETS_MOTIF +#include <Xm/Xm.h> +#endif +#include <X11/IntrinsicP.h> + #if INTBITS == 32 # define FOUR_BYTE_TYPE unsigned int #elif LONGBITS == 32 @@ -81,6 +94,23 @@ #define LISP_DEVICE_TO_X_SCREEN(dev) XDefaultScreenOfDisplay (DEVICE_X_DISPLAY (XDEVICE (dev))) +DECLARE_IMAGE_INSTANTIATOR_FORMAT (nothing); +DECLARE_IMAGE_INSTANTIATOR_FORMAT (string); +DECLARE_IMAGE_INSTANTIATOR_FORMAT (formatted_string); +DECLARE_IMAGE_INSTANTIATOR_FORMAT (inherit); +DECLARE_IMAGE_INSTANTIATOR_FORMAT (layout); +#ifdef HAVE_JPEG +DECLARE_IMAGE_INSTANTIATOR_FORMAT (jpeg); +#endif +#ifdef HAVE_TIFF +DECLARE_IMAGE_INSTANTIATOR_FORMAT (tiff); +#endif +#ifdef HAVE_PNG +DECLARE_IMAGE_INSTANTIATOR_FORMAT (png); +#endif +#ifdef HAVE_GIF +DECLARE_IMAGE_INSTANTIATOR_FORMAT (gif); +#endif #ifdef HAVE_XPM DEFINE_DEVICE_IIFORMAT (x, xpm); #endif @@ -97,6 +127,18 @@ DEFINE_IMAGE_INSTANTIATOR_FORMAT (autodetect); +#ifdef HAVE_WIDGETS +DEFINE_DEVICE_IIFORMAT (x, widget); +DEFINE_DEVICE_IIFORMAT (x, button); +DEFINE_DEVICE_IIFORMAT (x, progress_gauge); +DEFINE_DEVICE_IIFORMAT (x, edit_field); +#if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1 +DEFINE_DEVICE_IIFORMAT (x, combo_box); +#endif +DEFINE_DEVICE_IIFORMAT (x, tab_control); +DEFINE_DEVICE_IIFORMAT (x, label); +#endif + static void cursor_font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, Lisp_Object pointer_fg, @@ -104,6 +146,15 @@ int dest_mask, Lisp_Object domain); +#ifdef HAVE_WIDGETS +static void +update_widget_face (widget_value* wv, + Lisp_Image_Instance* ii, Lisp_Object domain); +static void +update_tab_widget_face (widget_value* wv, + Lisp_Image_Instance* ii, Lisp_Object domain); +#endif + #include "bitmaps.h" @@ -138,6 +189,13 @@ vis = DEVICE_X_VISUAL (XDEVICE(device)); depth = DEVICE_X_DEPTH(XDEVICE(device)); + if (vis->class == GrayScale || vis->class == StaticColor || + vis->class == StaticGray) + { + /* #### Implement me!!! */ + return NULL; + } + if (vis->class == PseudoColor) { /* Quantize the image and get a histogram while we're at it. @@ -175,7 +233,7 @@ *pixtbl = xnew_array (unsigned long, pixcount); *npixels = 0; - /* ### should implement a sort by popularity to assure proper allocation */ + /* #### should implement a sort by popularity to assure proper allocation */ n = *npixels; for (i = 0; i < qtable->num_active_colors; i++) { @@ -301,7 +359,7 @@ static void -x_print_image_instance (struct Lisp_Image_Instance *p, +x_print_image_instance (Lisp_Image_Instance *p, Lisp_Object printcharfun, int escapeflag) { @@ -326,8 +384,12 @@ } } +#ifdef DEBUG_WIDGETS +extern int debug_widget_instances; +#endif + static void -x_finalize_image_instance (struct Lisp_Image_Instance *p) +x_finalize_image_instance (Lisp_Image_Instance *p) { if (!p->data) return; @@ -336,9 +398,21 @@ { Display *dpy = DEVICE_X_DISPLAY (XDEVICE (p->device)); - if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET - || - IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW) + if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET) + { + if (IMAGE_INSTANCE_SUBWINDOW_ID (p)) + { +#ifdef DEBUG_WIDGETS + debug_widget_instances--; + stderr_out ("widget destroyed, %d left\n", debug_widget_instances); +#endif + lw_destroy_widget (IMAGE_INSTANCE_X_WIDGET_ID (p)); + lw_destroy_widget (IMAGE_INSTANCE_X_CLIPWIDGET (p)); + IMAGE_INSTANCE_X_WIDGET_ID (p) = 0; + IMAGE_INSTANCE_X_CLIPWIDGET (p) = 0; + } + } + else if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW) { if (IMAGE_INSTANCE_SUBWINDOW_ID (p)) XDestroyWindow (dpy, IMAGE_INSTANCE_X_SUBWINDOW_ID (p)); @@ -346,20 +420,33 @@ } else { - if (IMAGE_INSTANCE_X_PIXMAP (p)) - XFreePixmap (dpy, IMAGE_INSTANCE_X_PIXMAP (p)); + int i; + if (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p)) + disable_glyph_animated_timeout (IMAGE_INSTANCE_PIXMAP_TIMEOUT (p)); + if (IMAGE_INSTANCE_X_MASK (p) && IMAGE_INSTANCE_X_MASK (p) != IMAGE_INSTANCE_X_PIXMAP (p)) XFreePixmap (dpy, IMAGE_INSTANCE_X_MASK (p)); - IMAGE_INSTANCE_X_PIXMAP (p) = 0; - IMAGE_INSTANCE_X_MASK (p) = 0; - + IMAGE_INSTANCE_PIXMAP_MASK (p) = 0; + + if (IMAGE_INSTANCE_X_PIXMAP_SLICES (p)) + { + for (i = 0; i < IMAGE_INSTANCE_PIXMAP_MAXSLICE (p); i++) + if (IMAGE_INSTANCE_X_PIXMAP_SLICE (p,i)) + { + XFreePixmap (dpy, IMAGE_INSTANCE_X_PIXMAP_SLICE (p,i)); + IMAGE_INSTANCE_X_PIXMAP_SLICE (p, i) = 0; + } + xfree (IMAGE_INSTANCE_X_PIXMAP_SLICES (p)); + IMAGE_INSTANCE_X_PIXMAP_SLICES (p) = 0; + } + if (IMAGE_INSTANCE_X_CURSOR (p)) { XFreeCursor (dpy, IMAGE_INSTANCE_X_CURSOR (p)); IMAGE_INSTANCE_X_CURSOR (p) = 0; } - + if (IMAGE_INSTANCE_X_NPIXELS (p) != 0) { XFreeColors (dpy, @@ -370,7 +457,13 @@ } } } - if (IMAGE_INSTANCE_X_PIXELS (p)) + /* You can sometimes have pixels without a live device. I forget + why, but that's why we free them here if we have a pixmap type + image instance. It probably means that we might also get a memory + leak with widgets. */ + if (IMAGE_INSTANCE_TYPE (p) != IMAGE_WIDGET + && IMAGE_INSTANCE_TYPE (p) != IMAGE_SUBWINDOW + && IMAGE_INSTANCE_X_PIXELS (p)) { xfree (IMAGE_INSTANCE_X_PIXELS (p)); IMAGE_INSTANCE_X_PIXELS (p) = 0; @@ -381,8 +474,8 @@ } static int -x_image_instance_equal (struct Lisp_Image_Instance *p1, - struct Lisp_Image_Instance *p2, int depth) +x_image_instance_equal (Lisp_Image_Instance *p1, + Lisp_Image_Instance *p2, int depth) { switch (IMAGE_INSTANCE_TYPE (p1)) { @@ -401,7 +494,7 @@ } static unsigned long -x_image_instance_hash (struct Lisp_Image_Instance *p, int depth) +x_image_instance_hash (Lisp_Image_Instance *p, int depth) { switch (IMAGE_INSTANCE_TYPE (p)) { @@ -421,10 +514,14 @@ methods are called. */ static void -x_initialize_pixmap_image_instance (struct Lisp_Image_Instance *ii, +x_initialize_pixmap_image_instance (Lisp_Image_Instance *ii, + int slices, enum image_instance_type type) { ii->data = xnew_and_zero (struct x_image_instance_data); + IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) = slices; + IMAGE_INSTANCE_X_PIXMAP_SLICES (ii) = + xnew_array_and_zero (Pixmap, slices); IMAGE_INSTANCE_TYPE (ii) = type; IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = Qnil; IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (ii) = Qnil; @@ -468,7 +565,7 @@ (XSTRING_BYTE (name, 2) == '/'))))) { if (!NILP (Ffile_readable_p (name))) - return name; + return Fexpand_file_name (name, Qnil); else return Qnil; } @@ -513,13 +610,13 @@ { Lisp_Object found; - if (locate_file (Vx_bitmap_file_path, name, "", &found, R_OK) < 0) + if (locate_file (Vx_bitmap_file_path, name, Qnil, &found, R_OK) < 0) { Lisp_Object temp = list1 (Vdata_directory); struct gcpro gcpro1; GCPRO1 (temp); - locate_file (temp, name, "", &found, R_OK); + locate_file (temp, name, Qnil, &found, R_OK); UNGCPRO; } @@ -594,7 +691,7 @@ /* Get the data while doing the conversion */ while (1) { - int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); + ssize_t size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); if (!size_in_bytes) break; /* It does seem the flushes are necessary... */ @@ -737,12 +834,13 @@ Use the same code as for `xpm'. */ static void -init_image_instance_from_x_image (struct Lisp_Image_Instance *ii, +init_image_instance_from_x_image (Lisp_Image_Instance *ii, XImage *ximage, int dest_mask, Colormap cmap, unsigned long *pixels, int npixels, + int slices, Lisp_Object instantiator) { Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); @@ -778,13 +876,15 @@ XFreeGC (dpy, gc); - x_initialize_pixmap_image_instance (ii, IMAGE_COLOR_PIXMAP); + x_initialize_pixmap_image_instance (ii, slices, IMAGE_COLOR_PIXMAP); IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = find_keyword_in_vector (instantiator, Q_file); + /* Fixup a set of pixmaps. */ IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap; - IMAGE_INSTANCE_X_MASK (ii) = 0; + + IMAGE_INSTANCE_PIXMAP_MASK (ii) = 0; IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = ximage->width; IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = ximage->height; IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = ximage->depth; @@ -794,8 +894,44 @@ } static void -x_init_image_instance_from_eimage (struct Lisp_Image_Instance *ii, +image_instance_add_x_image (Lisp_Image_Instance *ii, + XImage *ximage, + int slice, + Lisp_Object instantiator) +{ + Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); + Display *dpy; + GC gc; + Drawable d; + Pixmap pixmap; + + dpy = DEVICE_X_DISPLAY (XDEVICE (device)); + d = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device))); + + pixmap = XCreatePixmap (dpy, d, ximage->width, + ximage->height, ximage->depth); + if (!pixmap) + signal_simple_error ("Unable to create pixmap", instantiator); + + gc = XCreateGC (dpy, pixmap, 0, NULL); + if (!gc) + { + XFreePixmap (dpy, pixmap); + signal_simple_error ("Unable to create GC", instantiator); + } + + XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0, + ximage->width, ximage->height); + + XFreeGC (dpy, gc); + + IMAGE_INSTANCE_X_PIXMAP_SLICE (ii, slice) = pixmap; +} + +static void +x_init_image_instance_from_eimage (Lisp_Image_Instance *ii, int width, int height, + int slices, unsigned char *eimage, int dest_mask, Lisp_Object instantiator, @@ -805,33 +941,42 @@ Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device)); unsigned long *pixtbl = NULL; int npixels = 0; + int slice; XImage* ximage; - ximage = convert_EImage_to_XImage (device, width, height, eimage, - &pixtbl, &npixels); - if (!ximage) + for (slice = 0; slice < slices; slice++) { - if (pixtbl) xfree (pixtbl); - signal_image_error("EImage to XImage conversion failed", instantiator); - } - - /* Now create the pixmap and set up the image instance */ - init_image_instance_from_x_image (ii, ximage, dest_mask, - cmap, pixtbl, npixels, - instantiator); - - if (ximage) - { - if (ximage->data) - { - xfree (ximage->data); - ximage->data = 0; - } - XDestroyImage (ximage); + ximage = convert_EImage_to_XImage (device, width, height, + eimage + (width * height * 3 * slice), + &pixtbl, &npixels); + if (!ximage) + { + if (pixtbl) xfree (pixtbl); + signal_image_error("EImage to XImage conversion failed", instantiator); + } + + /* Now create the pixmap and set up the image instance */ + if (slice == 0) + init_image_instance_from_x_image (ii, ximage, dest_mask, + cmap, pixtbl, npixels, slices, + instantiator); + else + image_instance_add_x_image (ii, ximage, slice, instantiator); + + if (ximage) + { + if (ximage->data) + { + xfree (ximage->data); + ximage->data = 0; + } + XDestroyImage (ximage); + ximage = 0; + } } } -int read_bitmap_data_from_file (CONST char *filename, unsigned int *width, +int read_bitmap_data_from_file (const char *filename, unsigned int *width, unsigned int *height, unsigned char **datap, int *x_hot, int *y_hot) { @@ -845,7 +990,7 @@ static Pixmap pixmap_from_xbm_inline (Lisp_Object device, int width, int height, /* Note that data is in ext-format! */ - CONST Extbyte *bits) + const Extbyte *bits) { return XCreatePixmapFromBitmapData (DEVICE_X_DISPLAY (XDEVICE(device)), XtWindow (DEVICE_XT_APP_SHELL (XDEVICE (device))), @@ -857,10 +1002,10 @@ image instance accordingly. */ static void -init_image_instance_from_xbm_inline (struct Lisp_Image_Instance *ii, +init_image_instance_from_xbm_inline (Lisp_Image_Instance *ii, int width, int height, /* Note that data is in ext-format! */ - CONST char *bits, + const char *bits, Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, @@ -902,7 +1047,7 @@ IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK | IMAGE_POINTER_MASK); - x_initialize_pixmap_image_instance (ii, type); + x_initialize_pixmap_image_instance (ii, 1, type); IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = width; IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = height; IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = @@ -998,24 +1143,24 @@ Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, int width, int height, /* Note that data is in ext-format! */ - CONST char *bits) + const char *bits) { Lisp_Object mask_data = find_keyword_in_vector (instantiator, Q_mask_data); Lisp_Object mask_file = find_keyword_in_vector (instantiator, Q_mask_file); - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Pixmap mask = 0; - CONST char *gcc_may_you_rot_in_hell; if (!NILP (mask_data)) { - GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (mask_data))), - gcc_may_you_rot_in_hell); - mask = - pixmap_from_xbm_inline (IMAGE_INSTANCE_DEVICE (ii), - XINT (XCAR (mask_data)), - XINT (XCAR (XCDR (mask_data))), - (CONST unsigned char *) - gcc_may_you_rot_in_hell); + const char *ext_data; + + TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (XCDR (XCDR (mask_data))), + C_STRING_ALLOCA, ext_data, + Qbinary); + mask = pixmap_from_xbm_inline (IMAGE_INSTANCE_DEVICE (ii), + XINT (XCAR (mask_data)), + XINT (XCAR (XCDR (mask_data))), + (const unsigned char *) ext_data); } init_image_instance_from_xbm_inline (ii, width, height, bits, @@ -1031,16 +1176,17 @@ int dest_mask, Lisp_Object domain) { Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - CONST char *gcc_go_home; + const char *ext_data; assert (!NILP (data)); - GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (data))), - gcc_go_home); + TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (XCDR (XCDR (data))), + C_STRING_ALLOCA, ext_data, + Qbinary); xbm_instantiate_1 (image_instance, instantiator, pointer_fg, pointer_bg, dest_mask, XINT (XCAR (data)), - XINT (XCAR (XCDR (data))), gcc_go_home); + XINT (XCAR (XCDR (data))), ext_data); } @@ -1144,11 +1290,11 @@ static void x_xpm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) { /* This function can GC */ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); Display *dpy; @@ -1206,7 +1352,7 @@ visual = DEVICE_X_VISUAL (XDEVICE(device)); #endif - x_initialize_pixmap_image_instance (ii, type); + x_initialize_pixmap_image_instance (ii, 1, type); assert (!NILP (data)); @@ -1316,7 +1462,7 @@ pixels = NULL; IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap; - IMAGE_INSTANCE_X_MASK (ii) = mask; + IMAGE_INSTANCE_PIXMAP_MASK (ii) = (void*)mask; IMAGE_INSTANCE_X_COLORMAP (ii) = cmap; IMAGE_INSTANCE_X_PIXELS (ii) = pixels; IMAGE_INSTANCE_X_NPIXELS (ii) = npixels; @@ -1516,12 +1662,14 @@ Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); int i, stattis; char *p, *bits, *bp; - CONST char * volatile emsg = 0; - CONST char * volatile dstring; + const char * volatile emsg = 0; + const char * volatile dstring; assert (!NILP (data)); - GET_C_STRING_BINARY_DATA_ALLOCA (data, dstring); + TO_EXTERNAL_FORMAT (LISP_STRING, data, + C_STRING_ALLOCA, dstring, + Qbinary); if ((p = strchr (dstring, ':'))) { @@ -1585,7 +1733,7 @@ static Lisp_Object autodetect_normalize (Lisp_Object instantiator, - Lisp_Object console_type) + Lisp_Object console_type) { Lisp_Object file = find_keyword_in_vector (instantiator, Q_data); Lisp_Object filename = Qnil; @@ -1676,10 +1824,10 @@ static void autodetect_instantiate (Lisp_Object image_instance, - Lisp_Object instantiator, - Lisp_Object pointer_fg, - Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) + Lisp_Object instantiator, + Lisp_Object pointer_fg, + Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) { Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); struct gcpro gcpro1, gcpro2, gcpro3; @@ -1692,8 +1840,10 @@ alist = tagged_vector_to_alist (instantiator); if (dest_mask & IMAGE_POINTER_MASK) { - CONST char *name_ext; - GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext); + const char *name_ext; + TO_EXTERNAL_FORMAT (LISP_STRING, data, + C_STRING_ALLOCA, name_ext, + Qfile_name); if (XmuCursorNameToIndex (name_ext) != -1) { result = alist_to_tagged_vector (Qcursor_font, alist); @@ -1780,7 +1930,7 @@ { /* This function can GC */ Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); Display *dpy; XColor fg, bg; @@ -1844,7 +1994,7 @@ /* #### call XQueryTextExtents() and check_pointer_sizes() here. */ - x_initialize_pixmap_image_instance (ii, IMAGE_POINTER); + x_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER); IMAGE_INSTANCE_X_CURSOR (ii) = XCreateGlyphCursor (dpy, source, mask, source_char, mask_char, &fg, &bg); @@ -1878,11 +2028,11 @@ { /* This function can GC */ Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); Display *dpy; int i; - CONST char *name_ext; + const char *name_ext; Lisp_Object foreground, background; if (!DEVICE_X_P (XDEVICE (device))) @@ -1893,11 +2043,13 @@ if (!(dest_mask & IMAGE_POINTER_MASK)) incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK); - GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, data, + C_STRING_ALLOCA, name_ext, + Qfile_name); if ((i = XmuCursorNameToIndex (name_ext)) == -1) signal_simple_error ("Unrecognized cursor-font name", data); - x_initialize_pixmap_image_instance (ii, IMAGE_POINTER); + x_initialize_pixmap_image_instance (ii, 1, IMAGE_POINTER); IMAGE_INSTANCE_X_CURSOR (ii) = XCreateFontCursor (dpy, i); foreground = find_keyword_in_vector (instantiator, Q_foreground); if (NILP (foreground)) @@ -1912,7 +2064,7 @@ x_colorize_image_instance (Lisp_Object image_instance, Lisp_Object foreground, Lisp_Object background) { - struct Lisp_Image_Instance *p; + Lisp_Image_Instance *p; p = XIMAGE_INSTANCE (image_instance); @@ -1922,7 +2074,7 @@ IMAGE_INSTANCE_TYPE (p) = IMAGE_COLOR_PIXMAP; /* Make sure there aren't two pointers to the same mask, causing it to get freed twice. */ - IMAGE_INSTANCE_X_MASK (p) = 0; + IMAGE_INSTANCE_PIXMAP_MASK (p) = 0; break; default: @@ -1965,21 +2117,124 @@ /* unmap the image if it is a widget. This is used by redisplay via redisplay_unmap_subwindows */ static void -x_unmap_subwindow (struct Lisp_Image_Instance *p) +x_unmap_subwindow (Lisp_Image_Instance *p) { - XUnmapWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (p)), - IMAGE_INSTANCE_X_SUBWINDOW_ID (p)); + if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW) + { + XUnmapWindow + (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p), + IMAGE_INSTANCE_X_CLIPWINDOW (p)); + } + else /* must be a widget */ + { + XtUnmapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p)); + } } /* map the subwindow. This is used by redisplay via redisplay_output_subwindow */ static void -x_map_subwindow (struct Lisp_Image_Instance *p, int x, int y) +x_map_subwindow (Lisp_Image_Instance *p, int x, int y, + struct display_glyph_area* dga) +{ + if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW) + { + Window subwindow = IMAGE_INSTANCE_X_SUBWINDOW_ID (p); + XMoveResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p), + IMAGE_INSTANCE_X_CLIPWINDOW (p), + x, y, dga->width, dga->height); + XMoveWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p), + subwindow, -dga->xoffset, -dga->yoffset); + XMapWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p), + IMAGE_INSTANCE_X_CLIPWINDOW (p)); + } + else /* must be a widget */ + { + XtConfigureWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p), + x + IMAGE_INSTANCE_X_WIDGET_XOFFSET (p), + y + IMAGE_INSTANCE_X_WIDGET_YOFFSET (p), + dga->width, dga->height, 0); + XtMoveWidget (IMAGE_INSTANCE_X_WIDGET_ID (p), + -dga->xoffset, -dga->yoffset); + XtMapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p)); + } +} + +/* when you click on a widget you may activate another widget this + needs to be checked and all appropriate widgets updated */ +static void +x_update_subwindow (Lisp_Image_Instance *p) +{ + /* Update the subwindow size if necessary. */ + if (IMAGE_INSTANCE_SIZE_CHANGED (p)) + { + XResizeWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p), + IMAGE_INSTANCE_X_SUBWINDOW_ID (p), + IMAGE_INSTANCE_WIDTH (p), + IMAGE_INSTANCE_HEIGHT (p)); + } +} + +/* Update all attributes that have changed. Lwlib actually does most + of this for us. */ +static void +x_update_widget (Lisp_Image_Instance *p) { - XMapWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (p)), - IMAGE_INSTANCE_X_SUBWINDOW_ID (p)); - XMoveWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (p)), - IMAGE_INSTANCE_X_SUBWINDOW_ID (p), x, y); +#ifdef HAVE_WIDGETS + widget_value* wv = 0; + Boolean deep_p = False; + /* Possibly update the size. */ + if (IMAGE_INSTANCE_SIZE_CHANGED (p)) + { + Arg al[2]; + + assert (IMAGE_INSTANCE_X_WIDGET_ID (p) && + IMAGE_INSTANCE_X_CLIPWIDGET (p)) ; + + if ( !XtIsManaged(IMAGE_INSTANCE_X_WIDGET_ID (p)) + || + IMAGE_INSTANCE_X_WIDGET_ID (p)->core.being_destroyed ) + { + Lisp_Object sw; + XSETIMAGE_INSTANCE (sw, p); + signal_simple_error ("XEmacs bug: subwindow is deleted", sw); + } + + XtSetArg (al [0], XtNwidth, (Dimension)IMAGE_INSTANCE_WIDTH (p)); + XtSetArg (al [1], XtNheight, (Dimension)IMAGE_INSTANCE_HEIGHT (p)); + XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (p), al, 2); + } + + /* First get the items if they have changed since this is a structural change. */ + if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p)) + { + wv = gui_items_to_widget_values + (IMAGE_INSTANCE_WIDGET_ITEMS (p)); + deep_p = True; + } + + /* Possibly update the colors and font */ + if (IMAGE_INSTANCE_WIDGET_FACE_CHANGED (p)) + { + update_widget_face (wv, p, IMAGE_INSTANCE_SUBWINDOW_FRAME (p)); + } + + /* Possibly update the text. */ + if (IMAGE_INSTANCE_TEXT_CHANGED (p)) + { + char* str; + Lisp_Object val = IMAGE_INSTANCE_WIDGET_TEXT (p); + TO_EXTERNAL_FORMAT (LISP_STRING, val, + C_STRING_ALLOCA, str, + Qnative); + wv->value = str; + } + + /* now modify the widget */ + lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (p), + wv, deep_p); + free_widget_value_tree (wv); +#endif } /* instantiate and x type subwindow */ @@ -1989,7 +2244,7 @@ int dest_mask, Lisp_Object domain) { /* This function can GC */ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); Lisp_Object frame = FW_FRAME (domain); struct frame* f = XFRAME (frame); @@ -1998,7 +2253,7 @@ Window pw, win; XSetWindowAttributes xswa; Mask valueMask = 0; - unsigned int w = IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii), + unsigned int w = IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii), h = IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii); if (!DEVICE_X_P (XDEVICE (device))) @@ -2007,28 +2262,32 @@ dpy = DEVICE_X_DISPLAY (XDEVICE (device)); xs = DefaultScreenOfDisplay (dpy); - if (dest_mask & IMAGE_SUBWINDOW_MASK) - IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW; - else - incompatible_image_types (instantiator, dest_mask, - IMAGE_SUBWINDOW_MASK); + IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW; pw = XtWindow (FRAME_X_TEXT_WIDGET (f)); ii->data = xnew_and_zero (struct x_subwindow_data); IMAGE_INSTANCE_X_SUBWINDOW_PARENT (ii) = pw; - IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (ii) = xs; + IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (ii) = DisplayOfScreen (xs); xswa.backing_store = Always; valueMask |= CWBackingStore; xswa.colormap = DefaultColormapOfScreen (xs); valueMask |= CWColormap; - - win = XCreateWindow (dpy, pw, 0, 0, w, h, 0, CopyFromParent, + + /* Create a window for clipping */ + IMAGE_INSTANCE_X_CLIPWINDOW (ii) = + XCreateWindow (dpy, pw, 0, 0, w, h, 0, CopyFromParent, + InputOutput, CopyFromParent, valueMask, + &xswa); + + /* Now put the subwindow inside the clip window. */ + win = XCreateWindow (dpy, IMAGE_INSTANCE_X_CLIPWINDOW (ii), + 0, 0, w, h, 0, CopyFromParent, InputOutput, CopyFromParent, valueMask, &xswa); - + IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)win; } @@ -2041,7 +2300,7 @@ (subwindow, property, data)) { Atom property_atom; - struct Lisp_Subwindow *sw; + Lisp_Subwindow *sw; Display *dpy; CHECK_SUBWINDOW (subwindow); @@ -2062,14 +2321,384 @@ } #endif -static void -x_resize_subwindow (struct Lisp_Image_Instance* ii, int w, int h) + +#ifdef HAVE_WIDGETS + +/************************************************************************/ +/* widgets */ +/************************************************************************/ + +static void +update_widget_face (widget_value* wv, Lisp_Image_Instance *ii, + Lisp_Object domain) +{ +#ifdef LWLIB_WIDGETS_MOTIF + XmFontList fontList; +#endif + /* Update the foreground. */ + Lisp_Object pixel = FACE_FOREGROUND + (IMAGE_INSTANCE_WIDGET_FACE (ii), + domain); + XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel)), bcolor; + lw_add_widget_value_arg (wv, XtNforeground, fcolor.pixel); + + /* Update the background. */ + pixel = FACE_BACKGROUND (IMAGE_INSTANCE_WIDGET_FACE (ii), + domain); + bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel)); + lw_add_widget_value_arg (wv, XtNbackground, bcolor.pixel); + +#ifdef LWLIB_WIDGETS_MOTIF + fontList = XmFontListCreate + (FONT_INSTANCE_X_FONT + (XFONT_INSTANCE (query_string_font + (IMAGE_INSTANCE_WIDGET_TEXT (ii), + IMAGE_INSTANCE_WIDGET_FACE (ii), + domain))), XmSTRING_DEFAULT_CHARSET); + lw_add_widget_value_arg (wv, XmNfontList, (XtArgVal)fontList); +#endif + lw_add_widget_value_arg + (wv, XtNfont, (XtArgVal)FONT_INSTANCE_X_FONT + (XFONT_INSTANCE (query_string_font + (IMAGE_INSTANCE_WIDGET_TEXT (ii), + IMAGE_INSTANCE_WIDGET_FACE (ii), + domain)))); +} + +static void +update_tab_widget_face (widget_value* wv, Lisp_Image_Instance *ii, + Lisp_Object domain) +{ + if (wv->contents) + { + widget_value* val = wv->contents, *cur; + + /* Give each child label the correct foreground color. */ + Lisp_Object pixel = FACE_FOREGROUND + (IMAGE_INSTANCE_WIDGET_FACE (ii), + domain); + XColor fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel)); + lw_add_widget_value_arg (val, XtNtabForeground, fcolor.pixel); + + for (cur = val->next; cur; cur = cur->next) + { + if (cur->value) + { + lw_copy_widget_value_args (val, cur); + } + } + } +} + +static void +x_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain, + const char* type, widget_value* wv) +{ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii), pixel; + struct device* d = XDEVICE (device); + Lisp_Object frame = FW_FRAME (domain); + struct frame* f = XFRAME (frame); + char* nm=0; + Widget wid; + Arg al [32]; + int ac = 0; + int id = new_lwlib_id (); + widget_value* clip_wv; + XColor fcolor, bcolor; + + if (!DEVICE_X_P (d)) + signal_simple_error ("Not an X device", device); + + /* have to set the type this late in case there is no device + instantiation for a widget. But we can go ahead and do it without + checking because there is always a generic instantiator. */ + IMAGE_INSTANCE_TYPE (ii) = IMAGE_WIDGET; + + if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii))) + TO_EXTERNAL_FORMAT (LISP_STRING, IMAGE_INSTANCE_WIDGET_TEXT (ii), + C_STRING_ALLOCA, nm, + Qnative); + + ii->data = xnew_and_zero (struct x_subwindow_data); + + /* Create a clip window to contain the subwidget. Incredibly the + XEmacs manager seems to be the most appropriate widget for + this. Nothing else is simple enough and yet does what is + required. */ + clip_wv = xmalloc_widget_value (); + + lw_add_widget_value_arg (clip_wv, XtNresize, False); + lw_add_widget_value_arg (clip_wv, XtNwidth, + (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); + lw_add_widget_value_arg (clip_wv, XtNheight, + (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); + clip_wv->enabled = True; + + clip_wv->name = xstrdup ("clip-window"); + clip_wv->value = xstrdup ("clip-window"); + + IMAGE_INSTANCE_X_CLIPWIDGET (ii) + = lw_create_widget ("clip-window", "clip-window", new_lwlib_id (), + clip_wv, FRAME_X_CONTAINER_WIDGET (f), + False, 0, 0, 0); + + free_widget_value_tree (clip_wv); + + /* copy any args we were given */ + ac = 0; + lw_add_value_args_to_args (wv, al, &ac); + + /* Fixup the colors. We have to do this *before* the widget gets + created so that Motif will fix up the shadow colors + correctly. Once the widget is created Motif won't do this + anymore...*/ + pixel = FACE_FOREGROUND + (IMAGE_INSTANCE_WIDGET_FACE (ii), + IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)); + fcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel)); + + pixel = FACE_BACKGROUND + (IMAGE_INSTANCE_WIDGET_FACE (ii), + IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)); + bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (pixel)); + + lw_add_widget_value_arg (wv, XtNbackground, bcolor.pixel); + lw_add_widget_value_arg (wv, XtNforeground, fcolor.pixel); + /* we cannot allow widgets to resize themselves */ + lw_add_widget_value_arg (wv, XtNresize, False); + lw_add_widget_value_arg (wv, XtNwidth, + (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); + lw_add_widget_value_arg (wv, XtNheight, + (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); + /* update the font. */ + update_widget_face (wv, ii, domain); + + wid = lw_create_widget (type, wv->name, id, wv, IMAGE_INSTANCE_X_CLIPWIDGET (ii), + False, 0, popup_selection_callback, 0); + + IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)wid; + IMAGE_INSTANCE_X_WIDGET_LWID (ii) = id; + + /* Resize the widget here so that the values do not get copied by + lwlib. */ + ac = 0; + XtSetArg (al [ac], XtNwidth, + (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); ac++; + XtSetArg (al [ac], XtNheight, + (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); ac++; + XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac); + /* because the EmacsManager is the widgets parent we have to + offset the redisplay of the widget by the amount the text + widget is inside the manager. */ + ac = 0; + XtSetArg (al [ac], XtNx, &IMAGE_INSTANCE_X_WIDGET_XOFFSET (ii)); ac++; + XtSetArg (al [ac], XtNy, &IMAGE_INSTANCE_X_WIDGET_YOFFSET (ii)); ac++; + XtGetValues (FRAME_X_TEXT_WIDGET (f), al, ac); + + XtSetMappedWhenManaged (wid, TRUE); + + free_widget_value_tree (wv); +} + +/* get properties of a control */ +static Lisp_Object +x_widget_property (Lisp_Object image_instance, Lisp_Object prop) { - XResizeWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (ii)), - IMAGE_INSTANCE_X_SUBWINDOW_ID (ii), - w, h); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + /* get the text from a control */ + if (EQ (prop, Q_text)) + { + widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii)); + return build_ext_string (wv->value, Qnative); + } + return Qunbound; +} + +/* Instantiate a button widget. Unfortunately instantiated widgets are + particular to a frame since they need to have a parent. It's not + like images where you just select the image into the context you + want to display it in and BitBlt it. So images instances can have a + many-to-one relationship with things you see, whereas widgets can + only be one-to-one (i.e. per frame) */ +static void +x_button_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) +{ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii); + Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image); + widget_value* wv = xmalloc_widget_value (); + + button_item_to_widget_value (gui, wv, 1, 1); + + if (!NILP (glyph)) + { + if (!IMAGE_INSTANCEP (glyph)) + glyph = glyph_image_instance (glyph, domain, ERROR_ME, 1); + } + + x_widget_instantiate (image_instance, instantiator, pointer_fg, + pointer_bg, dest_mask, domain, "button", wv); + + /* add the image if one was given */ + if (!NILP (glyph) && IMAGE_INSTANCEP (glyph) + && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (glyph))) + { + Arg al [2]; + int ac =0; +#ifdef LWLIB_WIDGETS_MOTIF + XtSetArg (al [ac], XmNlabelType, XmPIXMAP); ac++; + XtSetArg (al [ac], XmNlabelPixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph));ac++; +#else + XtSetArg (al [ac], XtNpixmap, XIMAGE_INSTANCE_X_PIXMAP (glyph)); ac++; +#endif + XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac); + } +} + +/* get properties of a button */ +static Lisp_Object +x_button_property (Lisp_Object image_instance, Lisp_Object prop) +{ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + /* check the state of a button */ + if (EQ (prop, Q_selected)) + { + widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii)); + + if (wv->selected) + return Qt; + else + return Qnil; + } + return Qunbound; +} + +/* instantiate a progress gauge */ +static void +x_progress_gauge_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) +{ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii); + widget_value* wv = xmalloc_widget_value (); + + button_item_to_widget_value (gui, wv, 1, 1); + + x_widget_instantiate (image_instance, instantiator, pointer_fg, + pointer_bg, dest_mask, domain, "progress", wv); } +/* set the properties of a progres guage */ +static void +x_progress_gauge_update (Lisp_Object image_instance) +{ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + + if (IMAGE_INSTANCE_WIDGET_PERCENT_CHANGED (ii)) + { + Arg al [1]; + /* #### I'm not convinced we should store this in the plist. */ + Lisp_Object val = Fplist_get (IMAGE_INSTANCE_WIDGET_PROPS (ii), + Q_percent, Qnil); + XtSetArg (al[0], XtNvalue, XINT (val)); + XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 1); + } +} + +/* instantiate an edit control */ +static void +x_edit_field_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) +{ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii); + widget_value* wv = xmalloc_widget_value (); + + button_item_to_widget_value (gui, wv, 1, 1); + + x_widget_instantiate (image_instance, instantiator, pointer_fg, + pointer_bg, dest_mask, domain, "text-field", wv); +} + +#if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1 +/* instantiate a combo control */ +static void +x_combo_box_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) +{ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + widget_value * wv = 0; + /* This is not done generically because of sizing problems under + mswindows. */ + widget_instantiate (image_instance, instantiator, pointer_fg, + pointer_bg, dest_mask, domain); + + wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii)); + + x_widget_instantiate (image_instance, instantiator, pointer_fg, + pointer_bg, dest_mask, domain, "combo-box", wv); +} +#endif + +static void +x_tab_control_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) +{ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + widget_value * wv = + gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii)); + + update_tab_widget_face (wv, ii, + IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)); + + x_widget_instantiate (image_instance, instantiator, pointer_fg, + pointer_bg, dest_mask, domain, "tab-control", wv); +} + +/* set the properties of a tab control */ +static void +x_tab_control_update (Lisp_Object image_instance) +{ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + + /* Possibly update the face. */ + if (IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii)) + { + widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii)); + update_tab_widget_face (wv, ii, + IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)); + + lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (ii), wv, True); + free_widget_value_tree (wv); + } +} + +/* instantiate a static control possible for putting other things in */ +static void +x_label_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain) +{ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii); + widget_value* wv = xmalloc_widget_value (); + + button_item_to_widget_value (gui, wv, 1, 1); + + x_widget_instantiate (image_instance, instantiator, pointer_fg, + pointer_bg, dest_mask, domain, "button", wv); +} +#endif /* HAVE_WIDGETS */ + /************************************************************************/ /* initialization */ @@ -2097,23 +2726,70 @@ CONSOLE_HAS_METHOD (x, locate_pixmap_file); CONSOLE_HAS_METHOD (x, unmap_subwindow); CONSOLE_HAS_METHOD (x, map_subwindow); - CONSOLE_HAS_METHOD (x, resize_subwindow); + CONSOLE_HAS_METHOD (x, update_widget); + CONSOLE_HAS_METHOD (x, update_subwindow); } void image_instantiator_format_create_glyphs_x (void) { + IIFORMAT_VALID_CONSOLE (x, nothing); + IIFORMAT_VALID_CONSOLE (x, string); + IIFORMAT_VALID_CONSOLE (x, layout); + IIFORMAT_VALID_CONSOLE (x, formatted_string); + IIFORMAT_VALID_CONSOLE (x, inherit); #ifdef HAVE_XPM INITIALIZE_DEVICE_IIFORMAT (x, xpm); IIFORMAT_HAS_DEVMETHOD (x, xpm, instantiate); #endif +#ifdef HAVE_JPEG + IIFORMAT_VALID_CONSOLE (x, jpeg); +#endif +#ifdef HAVE_TIFF + IIFORMAT_VALID_CONSOLE (x, tiff); +#endif +#ifdef HAVE_PNG + IIFORMAT_VALID_CONSOLE (x, png); +#endif +#ifdef HAVE_GIF + IIFORMAT_VALID_CONSOLE (x, gif); +#endif INITIALIZE_DEVICE_IIFORMAT (x, xbm); IIFORMAT_HAS_DEVMETHOD (x, xbm, instantiate); INITIALIZE_DEVICE_IIFORMAT (x, subwindow); IIFORMAT_HAS_DEVMETHOD (x, subwindow, instantiate); - +#ifdef HAVE_WIDGETS + /* button widget */ + INITIALIZE_DEVICE_IIFORMAT (x, button); + IIFORMAT_HAS_DEVMETHOD (x, button, property); + IIFORMAT_HAS_DEVMETHOD (x, button, instantiate); + + INITIALIZE_DEVICE_IIFORMAT (x, widget); + IIFORMAT_HAS_DEVMETHOD (x, widget, property); + /* progress gauge */ + INITIALIZE_DEVICE_IIFORMAT (x, progress_gauge); + IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, update); + IIFORMAT_HAS_DEVMETHOD (x, progress_gauge, instantiate); + /* text field */ + INITIALIZE_DEVICE_IIFORMAT (x, edit_field); + IIFORMAT_HAS_DEVMETHOD (x, edit_field, instantiate); +#if defined (LWLIB_WIDGETS_MOTIF) && XmVERSION > 1 + /* combo box */ + INITIALIZE_DEVICE_IIFORMAT (x, combo_box); + IIFORMAT_HAS_DEVMETHOD (x, combo_box, instantiate); + IIFORMAT_HAS_SHARED_DEVMETHOD (x, combo_box, update, tab_control); +#endif + /* tab control widget */ + INITIALIZE_DEVICE_IIFORMAT (x, tab_control); + IIFORMAT_HAS_DEVMETHOD (x, tab_control, instantiate); + IIFORMAT_HAS_DEVMETHOD (x, tab_control, update); + /* label */ + INITIALIZE_DEVICE_IIFORMAT (x, label); + IIFORMAT_HAS_DEVMETHOD (x, label, instantiate); +#endif INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font"); + IIFORMAT_VALID_CONSOLE (x, cursor_font); IIFORMAT_HAS_METHOD (cursor_font, validate); IIFORMAT_HAS_METHOD (cursor_font, possible_dest_types); @@ -2128,6 +2804,7 @@ IIFORMAT_HAS_METHOD (font, validate); IIFORMAT_HAS_METHOD (font, possible_dest_types); IIFORMAT_HAS_METHOD (font, instantiate); + IIFORMAT_VALID_CONSOLE (x, font); IIFORMAT_VALID_KEYWORD (font, Q_data, check_valid_string); IIFORMAT_VALID_KEYWORD (font, Q_foreground, check_valid_string); @@ -2145,6 +2822,7 @@ IIFORMAT_HAS_METHOD (autodetect, normalize); IIFORMAT_HAS_METHOD (autodetect, possible_dest_types); IIFORMAT_HAS_METHOD (autodetect, instantiate); + IIFORMAT_VALID_CONSOLE (x, autodetect); IIFORMAT_VALID_KEYWORD (autodetect, Q_data, check_valid_string); } @@ -2172,7 +2850,7 @@ make_int (name##_height), \ make_ext_string (name##_bits, \ sizeof (name##_bits), \ - FORMAT_BINARY))), \ + Qbinary))), \ Qglobal, Qx, Qnil) BUILD_GLYPH_INST (Vtruncation_glyph, truncator); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/glyphs-x.h --- a/src/glyphs-x.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/glyphs-x.h Mon Aug 13 11:13:30 2007 +0200 @@ -23,8 +23,8 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_GLYPHS_X_H_ -#define _XEMACS_GLYPHS_X_H_ +#ifndef INCLUDED_glyphs_x_h_ +#define INCLUDED_glyphs_x_h_ #include "glyphs.h" @@ -39,8 +39,7 @@ struct x_image_instance_data { - Pixmap pixmap; - Pixmap mask; + Pixmap* pixmaps; Cursor cursor; /* If depth>0, then that means that other colors were allocated when @@ -56,8 +55,13 @@ #define X_IMAGE_INSTANCE_DATA(i) ((struct x_image_instance_data *) (i)->data) -#define IMAGE_INSTANCE_X_PIXMAP(i) (X_IMAGE_INSTANCE_DATA (i)->pixmap) -#define IMAGE_INSTANCE_X_MASK(i) (X_IMAGE_INSTANCE_DATA (i)->mask) +#define IMAGE_INSTANCE_X_PIXMAP(i) (X_IMAGE_INSTANCE_DATA (i)->pixmaps[0]) +#define IMAGE_INSTANCE_X_PIXMAP_SLICE(i,slice) \ + (X_IMAGE_INSTANCE_DATA (i)->pixmaps[slice]) +#define IMAGE_INSTANCE_X_PIXMAP_SLICES(i) \ + (X_IMAGE_INSTANCE_DATA (i)->pixmaps) +#define IMAGE_INSTANCE_X_MASK(i) \ + (Pixmap)(IMAGE_INSTANCE_PIXMAP_MASK (i)) #define IMAGE_INSTANCE_X_CURSOR(i) (X_IMAGE_INSTANCE_DATA (i)->cursor) #define IMAGE_INSTANCE_X_COLORMAP(i) (X_IMAGE_INSTANCE_DATA (i)->colormap) #define IMAGE_INSTANCE_X_PIXELS(i) (X_IMAGE_INSTANCE_DATA (i)->pixels) @@ -65,6 +69,10 @@ #define XIMAGE_INSTANCE_X_PIXMAP(i) \ IMAGE_INSTANCE_X_PIXMAP (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_X_PIXMAP_SLICES(i) \ + IMAGE_INSTANCE_X_PIXMAP_SLICES (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_X_PIXMAP_SLICE(i) \ + IMAGE_INSTANCE_X_PIXMAP_SLICE (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_X_MASK(i) \ IMAGE_INSTANCE_X_MASK (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_X_CURSOR(i) \ @@ -80,22 +88,58 @@ struct x_subwindow_data { - Screen *xscreen; - Window parent_window; + union + { + struct + { + Display *display; + Window parent_window; + Window clip_window; + } sub; + struct + { + Widget clip_window; + Position x_offset; + Position y_offset; + LWLIB_ID id; + } wid; + } data; }; #define X_SUBWINDOW_INSTANCE_DATA(i) ((struct x_subwindow_data *) (i)->data) -#define IMAGE_INSTANCE_X_SUBWINDOW_SCREEN(i) \ - (X_SUBWINDOW_INSTANCE_DATA (i)->xscreen) +#define IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY(i) \ + (X_SUBWINDOW_INSTANCE_DATA (i)->data.sub.display) #define IMAGE_INSTANCE_X_SUBWINDOW_PARENT(i) \ - (X_SUBWINDOW_INSTANCE_DATA (i)->parent_window) + (X_SUBWINDOW_INSTANCE_DATA (i)->data.sub.parent_window) +#define IMAGE_INSTANCE_X_CLIPWINDOW(i) \ + (X_SUBWINDOW_INSTANCE_DATA (i)->data.sub.clip_window) +#define IMAGE_INSTANCE_X_WIDGET_XOFFSET(i) \ + (X_SUBWINDOW_INSTANCE_DATA (i)->data.wid.x_offset) +#define IMAGE_INSTANCE_X_WIDGET_YOFFSET(i) \ + (X_SUBWINDOW_INSTANCE_DATA (i)->data.wid.y_offset) +#define IMAGE_INSTANCE_X_WIDGET_LWID(i) \ + (X_SUBWINDOW_INSTANCE_DATA (i)->data.wid.id) +#define IMAGE_INSTANCE_X_CLIPWIDGET(i) \ + (X_SUBWINDOW_INSTANCE_DATA (i)->data.wid.clip_window) #define XIMAGE_INSTANCE_X_SUBWINDOW_PARENT(i) \ IMAGE_INSTANCE_X_SUBWINDOW_PARENT (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_X_SUBWINDOW_SCREEN(i) \ - IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_X_SUBWINDOW_DISPLAY(i) \ + IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_X_WIDGET_XOFFSET(i) \ + IMAGE_INSTANCE_X_WIDGET_XOFFSET (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_X_WIDGET_YOFFSET(i) \ + IMAGE_INSTANCE_X_WIDGET_YOFFSET (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_X_WIDGET_LWID(i) \ + IMAGE_INSTANCE_X_WIDGET_LWID (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_X_CLIPWIDGET(i) \ + IMAGE_INSTANCE_X_CLIPWIDGET (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_X_CLIPWINDOW(i) \ + IMAGE_INSTANCE_X_CLIPWINDOW (XIMAGE_INSTANCE (i)) #define IMAGE_INSTANCE_X_SUBWINDOW_ID(i) \ - ((Window) IMAGE_INSTANCE_SUBWINDOW_ID (i)) + (* (Window *) & IMAGE_INSTANCE_SUBWINDOW_ID (i)) +#define IMAGE_INSTANCE_X_WIDGET_ID(i) \ + (* (Widget *) & IMAGE_INSTANCE_SUBWINDOW_ID (i)) #endif /* HAVE_X_WINDOWS */ -#endif /* _XEMACS_GLYPHS_X_H_ */ +#endif /* INCLUDED_glyphs_x_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/glyphs.c --- a/src/glyphs.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/glyphs.c Mon Aug 13 11:13:30 2007 +0200 @@ -3,7 +3,7 @@ Copyright (C) 1995 Tinker Systems Copyright (C) 1995, 1996 Ben Wing Copyright (C) 1995 Sun Microsystems - Copyright (C) 1998 Andy Piper + Copyright (C) 1998, 1999, 2000 Andy Piper This file is part of XEmacs. @@ -24,7 +24,8 @@ /* Synched up with: Not in FSF. */ -/* Written by Ben Wing and Chuck Thompson */ +/* Written by Ben Wing and Chuck Thompson. Heavily modified / + rewritten by Andy Piper. */ #include <config.h> #include "lisp.h" @@ -42,6 +43,7 @@ #include "frame.h" #include "chartab.h" #include "rangetab.h" +#include "blocktype.h" #ifdef HAVE_XPM #include <X11/xpm.h> @@ -56,6 +58,7 @@ Lisp_Object Qcolor_pixmap_image_instance_p; Lisp_Object Qpointer_image_instance_p; Lisp_Object Qsubwindow_image_instance_p; +Lisp_Object Qlayout_image_instance_p; Lisp_Object Qwidget_image_instance_p; Lisp_Object Qconst_glyph_variable; Lisp_Object Qmono_pixmap, Qcolor_pixmap, Qsubwindow; @@ -70,11 +73,14 @@ Lisp_Object Vimage_instance_type_list; Lisp_Object Vglyph_type_list; +int disable_animated_pixmaps; + DEFINE_IMAGE_INSTANTIATOR_FORMAT (nothing); DEFINE_IMAGE_INSTANTIATOR_FORMAT (inherit); DEFINE_IMAGE_INSTANTIATOR_FORMAT (string); DEFINE_IMAGE_INSTANTIATOR_FORMAT (formatted_string); DEFINE_IMAGE_INSTANTIATOR_FORMAT (subwindow); +DEFINE_IMAGE_INSTANTIATOR_FORMAT (text); #ifdef HAVE_WINDOW_SYSTEM DEFINE_IMAGE_INSTANTIATOR_FORMAT (xbm); @@ -117,11 +123,19 @@ image_instantiator_format_entry_dynarr * the_image_instantiator_format_entry_dynarr; -static Lisp_Object allocate_image_instance (Lisp_Object device); +static Lisp_Object allocate_image_instance (Lisp_Object device, Lisp_Object glyph); static void image_validate (Lisp_Object instantiator); static void glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property, Lisp_Object locale); +static void set_image_instance_dirty_p (Lisp_Object instance, int dirty); +static void register_ignored_expose (struct frame* f, int x, int y, int width, int height); +/* Unfortunately windows and X are different. In windows BeginPaint() + will prevent WM_PAINT messages being generated so it is unnecessary + to register exposures as they will not occur. Under X they will + always occur. */ +int hold_ignored_expose_registration; + EXFUN (Fimage_instance_type, 1); EXFUN (Fglyph_type, 1); @@ -155,7 +169,7 @@ if ((NILP (d) && NILP (device)) || (!NILP (device) && - EQ (CONSOLE_TYPE (XCONSOLE + EQ (CONSOLE_TYPE (XCONSOLE (DEVICE_CONSOLE (XDEVICE (device)))), d))) return Dynarr_at (the_image_instantiator_format_entry_dynarr, i).meths; } @@ -174,21 +188,45 @@ } static int -valid_image_instantiator_format_p (Lisp_Object format) +valid_image_instantiator_format_p (Lisp_Object format, Lisp_Object locale) { - return (decode_image_instantiator_format (format, ERROR_ME_NOT) != 0); + int i; + struct image_instantiator_methods* meths = + decode_image_instantiator_format (format, ERROR_ME_NOT); + Lisp_Object contype = Qnil; + /* mess with the locale */ + if (!NILP (locale) && SYMBOLP (locale)) + contype = locale; + else + { + struct console* console = decode_console (locale); + contype = console ? CONSOLE_TYPE (console) : locale; + } + /* nothing is valid in all locales */ + if (EQ (format, Qnothing)) + return 1; + /* reject unknown formats */ + else if (NILP (contype) || !meths) + return 0; + + for (i = 0; i < Dynarr_length (meths->consoles); i++) + if (EQ (contype, Dynarr_at (meths->consoles, i).symbol)) + return 1; + return 0; } DEFUN ("valid-image-instantiator-format-p", Fvalid_image_instantiator_format_p, - 1, 1, 0, /* + 1, 2, 0, /* Given an IMAGE-INSTANTIATOR-FORMAT, return non-nil if it is valid. +If LOCALE is non-nil then the format is checked in that domain. +If LOCALE is nil the current console is used. Valid formats are some subset of 'nothing, 'string, 'formatted-string, 'xpm, 'xbm, 'xface, 'gif, 'jpeg, 'png, 'tiff, 'cursor-font, 'font, 'autodetect, 'widget and 'subwindow, depending on how XEmacs was compiled. */ - (image_instantiator_format)) + (image_instantiator_format, locale)) { - return valid_image_instantiator_format_p (image_instantiator_format) ? + return valid_image_instantiator_format_p (image_instantiator_format, locale) ? Qt : Qnil; } @@ -526,7 +564,7 @@ struct image_instantiator_methods *meths; GCPRO1 (instantiator); - + meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0], ERROR_ME); RETURN_UNGCPRO (IIFORMAT_METH_OR_GIVEN (meths, normalize, @@ -539,20 +577,25 @@ instantiate_image_instantiator (Lisp_Object device, Lisp_Object domain, Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask) + int dest_mask, Lisp_Object glyph) { - Lisp_Object ii = allocate_image_instance (device); + Lisp_Object ii = allocate_image_instance (device, glyph); struct image_instantiator_methods *meths; struct gcpro gcpro1; int methp = 0; GCPRO1 (ii); + if (!valid_image_instantiator_format_p (XVECTOR_DATA (instantiator)[0], device)) + signal_simple_error + ("Image instantiator format is invalid in this locale.", + instantiator); + meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0], ERROR_ME); methp = (int)HAS_IIFORMAT_METH_P (meths, instantiate); MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg, pointer_bg, dest_mask, domain)); - + /* now do device specific instantiation */ meths = decode_device_ii_format (device, XVECTOR_DATA (instantiator)[0], ERROR_ME_NOT); @@ -576,40 +619,43 @@ Lisp_Object Qimage_instancep; static Lisp_Object -mark_image_instance (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_image_instance (Lisp_Object obj) { - struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj); - - markobj (i->name); + Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj); + + mark_object (i->name); + /* We don't mark the glyph reference since that would create a + circularity preventing GC. */ switch (IMAGE_INSTANCE_TYPE (i)) { case IMAGE_TEXT: - markobj (IMAGE_INSTANCE_TEXT_STRING (i)); + mark_object (IMAGE_INSTANCE_TEXT_STRING (i)); break; case IMAGE_MONO_PIXMAP: case IMAGE_COLOR_PIXMAP: - markobj (IMAGE_INSTANCE_PIXMAP_FILENAME (i)); - markobj (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i)); - markobj (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i)); - markobj (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i)); - markobj (IMAGE_INSTANCE_PIXMAP_FG (i)); - markobj (IMAGE_INSTANCE_PIXMAP_BG (i)); + mark_object (IMAGE_INSTANCE_PIXMAP_FILENAME (i)); + mark_object (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i)); + mark_object (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i)); + mark_object (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i)); + mark_object (IMAGE_INSTANCE_PIXMAP_FG (i)); + mark_object (IMAGE_INSTANCE_PIXMAP_BG (i)); break; case IMAGE_WIDGET: - markobj (IMAGE_INSTANCE_WIDGET_TYPE (i)); - markobj (IMAGE_INSTANCE_WIDGET_PROPS (i)); - markobj (IMAGE_INSTANCE_WIDGET_FACE (i)); - mark_gui_item (&IMAGE_INSTANCE_WIDGET_ITEM (i), markobj); + case IMAGE_LAYOUT: + mark_object (IMAGE_INSTANCE_WIDGET_TYPE (i)); + mark_object (IMAGE_INSTANCE_WIDGET_PROPS (i)); + mark_object (IMAGE_INSTANCE_WIDGET_FACE (i)); + mark_object (IMAGE_INSTANCE_WIDGET_ITEMS (i)); case IMAGE_SUBWINDOW: - markobj (IMAGE_INSTANCE_SUBWINDOW_FRAME (i)); + mark_object (IMAGE_INSTANCE_SUBWINDOW_FRAME (i)); break; default: break; } - MAYBE_DEVMETH (XDEVICE (i->device), mark_image_instance, (i, markobj)); + MAYBE_DEVMETH (XDEVICE (i->device), mark_image_instance, (i)); return i->device; } @@ -619,7 +665,7 @@ int escapeflag) { char buf[100]; - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (obj); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (obj); if (print_readably) error ("printing unreadable object #<image-instance 0x%x>", @@ -707,11 +753,6 @@ break; case IMAGE_WIDGET: - if (!NILP (IMAGE_INSTANCE_WIDGET_CALLBACK (ii))) - { - print_internal (IMAGE_INSTANCE_WIDGET_CALLBACK (ii), printcharfun, 0); - write_c_string (", ", printcharfun); - } if (!NILP (IMAGE_INSTANCE_WIDGET_FACE (ii))) { write_c_string (" (", printcharfun); @@ -724,6 +765,7 @@ print_internal (IMAGE_INSTANCE_WIDGET_TEXT (ii), printcharfun, 0); case IMAGE_SUBWINDOW: + case IMAGE_LAYOUT: sprintf (buf, " %dx%d", IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii), IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); write_c_string (buf, printcharfun); @@ -735,10 +777,10 @@ write_c_string (" on #<", printcharfun); { struct frame* f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)); - + if (!FRAME_LIVE_P (f)) write_c_string ("dead", printcharfun); - else + else write_c_string (DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f))), printcharfun); @@ -747,7 +789,7 @@ write_c_string (">", printcharfun); sprintf (buf, " 0x%p", IMAGE_INSTANCE_SUBWINDOW_ID (ii)); write_c_string (buf, printcharfun); - + break; default: @@ -763,7 +805,7 @@ static void finalize_image_instance (void *header, int for_disksave) { - struct Lisp_Image_Instance *i = (struct Lisp_Image_Instance *) header; + Lisp_Image_Instance *i = (Lisp_Image_Instance *) header; if (IMAGE_INSTANCE_TYPE (i) == IMAGE_NOTHING) /* objects like this exist at dump time, so don't bomb out. */ @@ -773,9 +815,11 @@ /* do this so that the cachels get reset */ if (IMAGE_INSTANCE_TYPE (i) == IMAGE_WIDGET || + IMAGE_INSTANCE_TYPE (i) == IMAGE_SUBWINDOW + || IMAGE_INSTANCE_TYPE (i) == IMAGE_SUBWINDOW) { - MARK_FRAME_GLYPHS_CHANGED + MARK_FRAME_SUBWINDOWS_CHANGED (XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (i))); } @@ -785,14 +829,18 @@ static int image_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { - struct Lisp_Image_Instance *i1 = XIMAGE_INSTANCE (obj1); - struct Lisp_Image_Instance *i2 = XIMAGE_INSTANCE (obj2); + Lisp_Image_Instance *i1 = XIMAGE_INSTANCE (obj1); + Lisp_Image_Instance *i2 = XIMAGE_INSTANCE (obj2); struct device *d1 = XDEVICE (i1->device); struct device *d2 = XDEVICE (i2->device); if (d1 != d2) return 0; - if (IMAGE_INSTANCE_TYPE (i1) != IMAGE_INSTANCE_TYPE (i2)) + if (IMAGE_INSTANCE_TYPE (i1) != IMAGE_INSTANCE_TYPE (i2) + || IMAGE_INSTANCE_WIDTH (i1) != IMAGE_INSTANCE_WIDTH (i2) + || IMAGE_INSTANCE_HEIGHT (i1) != IMAGE_INSTANCE_HEIGHT (i2) + || IMAGE_INSTANCE_XOFFSET (i1) != IMAGE_INSTANCE_XOFFSET (i2) + || IMAGE_INSTANCE_YOFFSET (i1) != IMAGE_INSTANCE_YOFFSET (i2)) return 0; if (!internal_equal (IMAGE_INSTANCE_NAME (i1), IMAGE_INSTANCE_NAME (i2), depth + 1)) @@ -813,12 +861,10 @@ case IMAGE_MONO_PIXMAP: case IMAGE_COLOR_PIXMAP: case IMAGE_POINTER: - if (!(IMAGE_INSTANCE_PIXMAP_WIDTH (i1) == - IMAGE_INSTANCE_PIXMAP_WIDTH (i2) && - IMAGE_INSTANCE_PIXMAP_HEIGHT (i1) == - IMAGE_INSTANCE_PIXMAP_HEIGHT (i2) && - IMAGE_INSTANCE_PIXMAP_DEPTH (i1) == + if (!(IMAGE_INSTANCE_PIXMAP_DEPTH (i1) == IMAGE_INSTANCE_PIXMAP_DEPTH (i2) && + IMAGE_INSTANCE_PIXMAP_SLICE (i1) == + IMAGE_INSTANCE_PIXMAP_SLICE (i2) && EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i1), IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i2)) && EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i1), @@ -833,23 +879,23 @@ break; case IMAGE_WIDGET: + case IMAGE_LAYOUT: if (!(EQ (IMAGE_INSTANCE_WIDGET_TYPE (i1), - IMAGE_INSTANCE_WIDGET_TYPE (i2)) && - EQ (IMAGE_INSTANCE_WIDGET_CALLBACK (i1), - IMAGE_INSTANCE_WIDGET_CALLBACK (i2)) + IMAGE_INSTANCE_WIDGET_TYPE (i2)) + && IMAGE_INSTANCE_SUBWINDOW_ID (i1) == + IMAGE_INSTANCE_SUBWINDOW_ID (i2) + && internal_equal (IMAGE_INSTANCE_WIDGET_ITEMS (i1), + IMAGE_INSTANCE_WIDGET_ITEMS (i2), + depth + 1) && internal_equal (IMAGE_INSTANCE_WIDGET_PROPS (i1), IMAGE_INSTANCE_WIDGET_PROPS (i2), depth + 1) - && internal_equal (IMAGE_INSTANCE_WIDGET_TEXT (i1), - IMAGE_INSTANCE_WIDGET_TEXT (i2), - depth + 1))) + )) return 0; + break; + case IMAGE_SUBWINDOW: - if (!(IMAGE_INSTANCE_SUBWINDOW_WIDTH (i1) == - IMAGE_INSTANCE_SUBWINDOW_WIDTH (i2) && - IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i1) == - IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i2) && - IMAGE_INSTANCE_SUBWINDOW_ID (i1) == + if (!(IMAGE_INSTANCE_SUBWINDOW_ID (i1) == IMAGE_INSTANCE_SUBWINDOW_ID (i2))) return 0; break; @@ -864,9 +910,11 @@ static unsigned long image_instance_hash (Lisp_Object obj, int depth) { - struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj); + Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj); struct device *d = XDEVICE (i->device); - unsigned long hash = (unsigned long) d; + unsigned long hash = HASH3 ((unsigned long) d, + IMAGE_INSTANCE_WIDTH (i), + IMAGE_INSTANCE_HEIGHT (i)); switch (IMAGE_INSTANCE_TYPE (i)) { @@ -881,22 +929,20 @@ case IMAGE_MONO_PIXMAP: case IMAGE_COLOR_PIXMAP: case IMAGE_POINTER: - hash = HASH5 (hash, IMAGE_INSTANCE_PIXMAP_WIDTH (i), - IMAGE_INSTANCE_PIXMAP_HEIGHT (i), - IMAGE_INSTANCE_PIXMAP_DEPTH (i), + hash = HASH4 (hash, IMAGE_INSTANCE_PIXMAP_DEPTH (i), + IMAGE_INSTANCE_PIXMAP_SLICE (i), internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i), depth + 1)); break; case IMAGE_WIDGET: - hash = HASH4 (hash, + case IMAGE_LAYOUT: + hash = HASH4 (hash, internal_hash (IMAGE_INSTANCE_WIDGET_TYPE (i), depth + 1), internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1), - internal_hash (IMAGE_INSTANCE_WIDGET_CALLBACK (i), depth + 1)); + internal_hash (IMAGE_INSTANCE_WIDGET_ITEMS (i), depth + 1)); case IMAGE_SUBWINDOW: - hash = HASH4 (hash, IMAGE_INSTANCE_SUBWINDOW_WIDTH (i), - IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i), - (int) IMAGE_INSTANCE_SUBWINDOW_ID (i)); + hash = HASH2 (hash, (int) IMAGE_INSTANCE_SUBWINDOW_ID (i)); break; default: @@ -910,21 +956,32 @@ DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance, mark_image_instance, print_image_instance, finalize_image_instance, image_instance_equal, - image_instance_hash, - struct Lisp_Image_Instance); + image_instance_hash, 0, + Lisp_Image_Instance); static Lisp_Object -allocate_image_instance (Lisp_Object device) +allocate_image_instance (Lisp_Object device, Lisp_Object glyph) { - struct Lisp_Image_Instance *lp = - alloc_lcrecord_type (struct Lisp_Image_Instance, lrecord_image_instance); + Lisp_Image_Instance *lp = + alloc_lcrecord_type (Lisp_Image_Instance, &lrecord_image_instance); Lisp_Object val; zero_lcrecord (lp); lp->device = device; lp->type = IMAGE_NOTHING; lp->name = Qnil; + lp->x_offset = 0; + lp->y_offset = 0; + lp->width = 0; + lp->height = 0; + lp->parent = glyph; + /* So that layouts get done. */ + lp->layout_changed = 1; + lp->dirty = 1; + XSETIMAGE_INSTANCE (val, lp); + MARK_GLYPHS_CHANGED; + return val; } @@ -941,6 +998,7 @@ if (EQ (type, Qpointer)) return IMAGE_POINTER; if (EQ (type, Qsubwindow)) return IMAGE_SUBWINDOW; if (EQ (type, Qwidget)) return IMAGE_WIDGET; + if (EQ (type, Qlayout)) return IMAGE_LAYOUT; maybe_signal_simple_error ("Invalid image-instance type", type, Qimage, errb); @@ -960,6 +1018,7 @@ case IMAGE_POINTER: return Qpointer; case IMAGE_SUBWINDOW: return Qsubwindow; case IMAGE_WIDGET: return Qwidget; + case IMAGE_LAYOUT: return Qlayout; default: abort (); } @@ -972,7 +1031,7 @@ { /* This depends on the fact that enums are assigned consecutive integers starting at 0. (Remember that IMAGE_UNKNOWN is the - first enum.) I'm fairly sure this behavior in ANSI-mandated, + first enum.) I'm fairly sure this behavior is ANSI-mandated, so there should be no portability problems here. */ return (1 << ((int) (type) - 1)); } @@ -1029,7 +1088,7 @@ (Qerror, list2 (emacs_doprnt_string_lisp_2 - ((CONST Bufbyte *) + ((const Bufbyte *) "No compatible image-instance types given: wanted one of %s, got %s", Qnil, -1, 2, encode_image_instance_type_list (desired_dest_mask), @@ -1083,6 +1142,19 @@ } } +/* Recurse up the hierarchy looking for the topmost glyph. This means + that instances in layouts will inherit face properties from their + parent. */ +Lisp_Object image_instance_parent_glyph (Lisp_Image_Instance* ii) +{ + if (IMAGE_INSTANCEP (IMAGE_INSTANCE_PARENT (ii))) + { + return image_instance_parent_glyph + (XIMAGE_INSTANCE (IMAGE_INSTANCE_PARENT (ii))); + } + return IMAGE_INSTANCE_PARENT (ii); +} + static Lisp_Object make_image_instance_1 (Lisp_Object data, Lisp_Object device, Lisp_Object dest_types) @@ -1104,7 +1176,7 @@ if (VECTORP (data) && EQ (XVECTOR_DATA (data)[0], Qinherit)) signal_simple_error ("Inheritance not allowed here", data); ii = instantiate_image_instantiator (device, device, data, - Qnil, Qnil, dest_mask); + Qnil, Qnil, dest_mask, Qnil); RETURN_UNGCPRO (ii); } @@ -1143,7 +1215,9 @@ 'subwindow A child window that is treated as an image. This allows (e.g.) another program to be responsible for drawing into the window. - Not currently implemented. +'widget + A child window that contains a window-system widget, e.g. a push + button. The DEST-TYPES list is unordered. If multiple destination types are possible for a given instantiator, the "most natural" type @@ -1220,13 +1294,13 @@ } DEFUN ("image-instance-property", Fimage_instance_property, 2, 2, 0, /* -Return the given property of the given image instance. +Return the given property of the given image instance. Returns nil if the property or the property method do not exist for -the image instance in the domain. +the image instance in the domain. */ (image_instance, prop)) { - struct Lisp_Image_Instance* ii; + Lisp_Image_Instance* ii; Lisp_Object type, ret; struct image_instantiator_methods* meths; @@ -1236,10 +1310,10 @@ /* ... then try device specific methods ... */ type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii)); - meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii), + meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii), type, ERROR_ME_NOT); if (meths && HAS_IIFORMAT_METH_P (meths, property) - && + && !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop)))) { return ret; @@ -1257,13 +1331,13 @@ } DEFUN ("set-image-instance-property", Fset_image_instance_property, 3, 3, 0, /* -Set the given property of the given image instance. +Set the given property of the given image instance. Does nothing if the property or the property method do not exist for the image instance in the domain. */ (image_instance, prop, val)) { - struct Lisp_Image_Instance* ii; + Lisp_Image_Instance* ii; Lisp_Object type, ret; struct image_instantiator_methods* meths; @@ -1272,25 +1346,40 @@ ii = XIMAGE_INSTANCE (image_instance); type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii)); /* try device specific methods first ... */ - meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii), + meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii), type, ERROR_ME_NOT); if (meths && HAS_IIFORMAT_METH_P (meths, set_property) && - !UNBOUNDP (ret = + !UNBOUNDP (ret = IIFORMAT_METH (meths, set_property, (image_instance, prop, val)))) { - return ret; + val = ret; } - /* ... then format specific methods ... */ - meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT); - if (meths && HAS_IIFORMAT_METH_P (meths, set_property) - && - !UNBOUNDP (ret = - IIFORMAT_METH (meths, set_property, (image_instance, prop, val)))) + else { - return ret; + /* ... then format specific methods ... */ + meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT); + if (meths && HAS_IIFORMAT_METH_P (meths, set_property) + && + !UNBOUNDP (ret = + IIFORMAT_METH (meths, set_property, (image_instance, prop, val)))) + { + val = ret; + } + else + { + val = Qnil; + } } + /* Make sure the image instance gets redisplayed. */ + set_image_instance_dirty_p (image_instance, 1); + /* Force the glyph to be laid out again. */ + IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 1; + + MARK_SUBWINDOWS_STATE_CHANGED; + MARK_GLYPHS_CHANGED; + return val; } @@ -1364,11 +1453,10 @@ case IMAGE_MONO_PIXMAP: case IMAGE_COLOR_PIXMAP: case IMAGE_POINTER: - return make_int (XIMAGE_INSTANCE_PIXMAP_HEIGHT (image_instance)); - case IMAGE_SUBWINDOW: case IMAGE_WIDGET: - return make_int (XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (image_instance)); + case IMAGE_LAYOUT: + return make_int (XIMAGE_INSTANCE_HEIGHT (image_instance)); default: return Qnil; @@ -1387,11 +1475,10 @@ case IMAGE_MONO_PIXMAP: case IMAGE_COLOR_PIXMAP: case IMAGE_POINTER: - return make_int (XIMAGE_INSTANCE_PIXMAP_WIDTH (image_instance)); - case IMAGE_SUBWINDOW: case IMAGE_WIDGET: - return make_int (XIMAGE_INSTANCE_SUBWINDOW_WIDTH (image_instance)); + case IMAGE_LAYOUT: + return make_int (XIMAGE_INSTANCE_WIDTH (image_instance)); default: return Qnil; @@ -1465,7 +1552,7 @@ case IMAGE_WIDGET: return FACE_FOREGROUND ( XIMAGE_INSTANCE_WIDGET_FACE (image_instance), - XIMAGE_INSTANCE_SUBWINDOW_FRAME + XIMAGE_INSTANCE_SUBWINDOW_FRAME (image_instance)); default: @@ -1492,7 +1579,7 @@ case IMAGE_WIDGET: return FACE_BACKGROUND ( XIMAGE_INSTANCE_WIDGET_FACE (image_instance), - XIMAGE_INSTANCE_SUBWINDOW_FRAME + XIMAGE_INSTANCE_SUBWINDOW_FRAME (image_instance)); default: @@ -1521,7 +1608,9 @@ if (!HAS_DEVMETH_P (XDEVICE (device), colorize_image_instance)) return image_instance; - new = allocate_image_instance (device); + /* #### There should be a copy_image_instance(), which calls a + device-specific method to copy the window-system subobject. */ + new = allocate_image_instance (device, Qnil); copy_lcrecord (XIMAGE_INSTANCE (new), XIMAGE_INSTANCE (image_instance)); /* note that if this method returns non-zero, this method MUST copy any window-system resources, so that when one image instance is @@ -1532,19 +1621,156 @@ return new; } + +/************************************************************************/ +/* Geometry calculations */ +/************************************************************************/ + +/* Find out desired geometry of the image instance. If there is no + special function then just return the width and / or height. */ +void +image_instance_query_geometry (Lisp_Object image_instance, + unsigned int* width, unsigned int* height, + enum image_instance_geometry disp, + Lisp_Object domain) +{ + Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); + Lisp_Object type; + struct image_instantiator_methods* meths; + + type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii)); + meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT); + + if (meths && HAS_IIFORMAT_METH_P (meths, query_geometry)) + { + IIFORMAT_METH (meths, query_geometry, (image_instance, width, height, + disp, domain)); + } + else + { + if (width) + *width = IMAGE_INSTANCE_WIDTH (ii); + if (height) + *height = IMAGE_INSTANCE_HEIGHT (ii); + } +} + +/* Layout the image instance using the provided dimensions. Layout + widgets are going to do different kinds of calculations to + determine what size to give things so we could make the layout + function relatively simple to take account of that. An alternative + approach is to consider separately the two cases, one where you + don't mind what size you have (normal widgets) and one where you + want to specifiy something (layout widgets). */ +void +image_instance_layout (Lisp_Object image_instance, + unsigned int width, unsigned int height, + Lisp_Object domain) +{ + Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); + Lisp_Object type; + struct image_instantiator_methods* meths; + + type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii)); + meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT); + + /* If geometry is unspecified then get some reasonable values for it. */ + if (width == IMAGE_UNSPECIFIED_GEOMETRY + || + height == IMAGE_UNSPECIFIED_GEOMETRY) + { + unsigned int dwidth, dheight; + + /* Get the desired geometry. */ + if (meths && HAS_IIFORMAT_METH_P (meths, query_geometry)) + { + IIFORMAT_METH (meths, query_geometry, (image_instance, &dwidth, &dheight, + IMAGE_DESIRED_GEOMETRY, + domain)); + } + else + { + dwidth = IMAGE_INSTANCE_WIDTH (ii); + dheight = IMAGE_INSTANCE_HEIGHT (ii); + } + + /* Compare with allowed geometry. */ + if (width == IMAGE_UNSPECIFIED_GEOMETRY) + width = dwidth; + if (height == IMAGE_UNSPECIFIED_GEOMETRY) + height = dheight; + } + + /* At this point width and height should contain sane values. Thus + we set the glyph geometry and lay it out. */ + if (IMAGE_INSTANCE_WIDTH (ii) != width + || + IMAGE_INSTANCE_HEIGHT (ii) != height) + { + IMAGE_INSTANCE_SIZE_CHANGED (ii) = 1; + } + + IMAGE_INSTANCE_WIDTH (ii) = width; + IMAGE_INSTANCE_HEIGHT (ii) = height; + + if (meths && HAS_IIFORMAT_METH_P (meths, layout)) + { + IIFORMAT_METH (meths, layout, (image_instance, width, height, domain)); + } + /* else no change to the geometry. */ + + /* Do not clear the dirty flag here - redisplay will do this for + us at the end. */ + IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 0; +} + +/* + * Mark image instance in W as dirty if (a) W's faces have changed and + * (b) GLYPH_OR_II instance in W is a string. + * + * Return non-zero if instance has been marked dirty. + */ +int +invalidate_glyph_geometry_maybe (Lisp_Object glyph_or_ii, struct window* w) +{ + if (XFRAME(WINDOW_FRAME(w))->faces_changed) + { + Lisp_Object image = glyph_or_ii; + + if (GLYPHP (glyph_or_ii)) + { + Lisp_Object window; + XSETWINDOW (window, w); + image = glyph_image_instance (glyph_or_ii, window, ERROR_ME_NOT, 1); + } + + if (TEXT_IMAGE_INSTANCEP (image)) + { + Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image); + IMAGE_INSTANCE_DIRTYP (ii) = 1; + IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 1; + if (GLYPHP (glyph_or_ii)) + XGLYPH_DIRTYP (glyph_or_ii) = 1; + return 1; + } + } + + return 0; +} + /************************************************************************/ /* error helpers */ /************************************************************************/ DOESNT_RETURN -signal_image_error (CONST char *reason, Lisp_Object frob) +signal_image_error (const char *reason, Lisp_Object frob) { signal_error (Qimage_conversion_error, list2 (build_translated_string (reason), frob)); } DOESNT_RETURN -signal_image_error_2 (CONST char *reason, Lisp_Object frob0, Lisp_Object frob1) +signal_image_error_2 (const char *reason, Lisp_Object frob0, Lisp_Object frob1) { signal_error (Qimage_conversion_error, list3 (build_translated_string (reason), frob0, frob1)); @@ -1565,7 +1791,7 @@ Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); if (dest_mask & IMAGE_NOTHING_MASK) IMAGE_INSTANCE_TYPE (ii) = IMAGE_NOTHING; @@ -1628,25 +1854,153 @@ return IMAGE_TEXT_MASK; } -/* called from autodetect_instantiate() */ +/* Called from autodetect_instantiate() */ void string_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { - Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - - assert (!NILP (data)); + Lisp_Object string = find_keyword_in_vector (instantiator, Q_data); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + + /* Should never get here with a domain other than a window. */ + assert (!NILP (string) && WINDOWP (domain)); if (dest_mask & IMAGE_TEXT_MASK) { IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT; - IMAGE_INSTANCE_TEXT_STRING (ii) = data; + IMAGE_INSTANCE_TEXT_STRING (ii) = string; } else incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK); } +/* Sort out the size of the text that is being displayed. Calculating + it dynamically allows us to change the text and still see + everything. Note that the following methods are for text not string + since that is what the instantiated type is. The first method is a + helper that is used elsewhere for calculating text geometry. */ +void +query_string_geometry (Lisp_Object string, Lisp_Object face, + unsigned int* width, unsigned int* height, + unsigned int* descent, Lisp_Object domain) +{ + struct font_metric_info fm; + unsigned char charsets[NUM_LEADING_BYTES]; + struct face_cachel frame_cachel; + struct face_cachel *cachel; + Lisp_Object frame = FW_FRAME (domain); + + /* Compute height */ + if (height) + { + /* Compute string metric info */ + find_charsets_in_bufbyte_string (charsets, + XSTRING_DATA (string), + XSTRING_LENGTH (string)); + + /* Fallback to the default face if none was provided. */ + if (!NILP (face)) + { + reset_face_cachel (&frame_cachel); + update_face_cachel_data (&frame_cachel, frame, face); + cachel = &frame_cachel; + } + else + { + cachel = WINDOW_FACE_CACHEL (XWINDOW (domain), DEFAULT_INDEX); + } + + ensure_face_cachel_complete (cachel, domain, charsets); + face_cachel_charset_font_metric_info (cachel, charsets, &fm); + + *height = fm.ascent + fm.descent; + /* #### descent only gets set if we query the height as well. */ + if (descent) + *descent = fm.descent; + } + + /* Compute width */ + if (width) + { + if (!NILP (face)) + *width = redisplay_frame_text_width_string (XFRAME (frame), + face, + 0, string, 0, -1); + else + *width = redisplay_frame_text_width_string (XFRAME (frame), + Vdefault_face, + 0, string, 0, -1); + } +} + +Lisp_Object +query_string_font (Lisp_Object string, Lisp_Object face, Lisp_Object domain) +{ + unsigned char charsets[NUM_LEADING_BYTES]; + struct face_cachel frame_cachel; + struct face_cachel *cachel; + int i; + Lisp_Object frame = FW_FRAME (domain); + + /* Compute string font info */ + find_charsets_in_bufbyte_string (charsets, + XSTRING_DATA (string), + XSTRING_LENGTH (string)); + + reset_face_cachel (&frame_cachel); + update_face_cachel_data (&frame_cachel, frame, face); + cachel = &frame_cachel; + + ensure_face_cachel_complete (cachel, domain, charsets); + + for (i = 0; i < NUM_LEADING_BYTES; i++) + { + if (charsets[i]) + { + return FACE_CACHEL_FONT (cachel, + CHARSET_BY_LEADING_BYTE (i + + MIN_LEADING_BYTE)); + + } + } + + return Qnil; /* NOT REACHED */ +} + +static void +text_query_geometry (Lisp_Object image_instance, + unsigned int* width, unsigned int* height, + enum image_instance_geometry disp, Lisp_Object domain) +{ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + unsigned int descent = 0; + + query_string_geometry (IMAGE_INSTANCE_TEXT_STRING (ii), + IMAGE_INSTANCE_FACE (ii), + width, height, &descent, domain); + + /* The descent gets set as a side effect of querying the + geometry. */ + IMAGE_INSTANCE_TEXT_DESCENT (ii) = descent; +} + +/* set the properties of a string */ +static Lisp_Object +text_set_property (Lisp_Object image_instance, Lisp_Object prop, + Lisp_Object val) +{ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + + if (EQ (prop, Q_data)) + { + CHECK_STRING (val); + IMAGE_INSTANCE_TEXT_STRING (ii) = val; + + return Qt; + } + return Qunbound; +} + /**************************************************************************** * formatted-string * @@ -1670,20 +2024,12 @@ Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { - Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - - assert (!NILP (data)); /* #### implement this */ warn_when_safe (Qunimplemented, Qnotice, "`formatted-string' not yet implemented; assuming `string'"); - if (dest_mask & IMAGE_TEXT_MASK) - { - IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT; - IMAGE_INSTANCE_TEXT_STRING (ii) = data; - } - else - incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK); + + string_instantiate (image_instance, instantiator, + pointer_fg, pointer_bg, dest_mask, domain); } @@ -1847,9 +2193,11 @@ unsigned int w, h; Extbyte *data; int result; - CONST char *filename_ext; - - GET_C_STRING_FILENAME_DATA_ALLOCA (name, filename_ext); + const char *filename_ext; + + TO_EXTERNAL_FORMAT (LISP_STRING, name, + C_STRING_ALLOCA, filename_ext, + Qfile_name); result = read_bitmap_data_from_file (filename_ext, &w, &h, &data, xhot, yhot); @@ -1859,7 +2207,7 @@ int len = (w + 7) / 8 * h; retval = list3 (make_int (w), make_int (h), - make_ext_string (data, len, FORMAT_BINARY)); + make_ext_string (data, len, Qbinary)); XFree ((char *) data); return retval; } @@ -2092,8 +2440,10 @@ char **data; int result; char *fname = 0; - - GET_C_STRING_FILENAME_DATA_ALLOCA (name, fname); + + TO_EXTERNAL_FORMAT (LISP_STRING, name, + C_STRING_ALLOCA, fname, + Qfile_name); result = XpmReadFileToData (fname, &data); if (result == XpmSuccess) @@ -2303,7 +2653,7 @@ static void image_create (Lisp_Object obj) { - struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj); + Lisp_Specifier *image = XIMAGE_SPECIFIER (obj); IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */ IMAGE_SPECIFIER_ATTACHEE (image) = Qnil; @@ -2311,12 +2661,12 @@ } static void -image_mark (Lisp_Object obj, void (*markobj) (Lisp_Object)) +image_mark (Lisp_Object obj) { - struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj); - - markobj (IMAGE_SPECIFIER_ATTACHEE (image)); - markobj (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image)); + Lisp_Specifier *image = XIMAGE_SPECIFIER (obj); + + mark_object (IMAGE_SPECIFIER_ATTACHEE (image)); + mark_object (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image)); } static Lisp_Object @@ -2340,6 +2690,7 @@ { Lisp_Object device = DFW_DEVICE (domain); struct device *d = XDEVICE (device); + Lisp_Object glyph = IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier)); int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier); int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER); @@ -2393,7 +2744,7 @@ /* For the image instance cache, we do comparisons with EQ rather than with EQUAL, as we do for color and font names. The reasons are: - + 1) pixmap data can be very long, and thus the hashing and comparing will take awhile. 2) It's not so likely that we'll run into things that are EQUAL @@ -2429,13 +2780,15 @@ round it. */ if (UNBOUNDP (instance) && - dest_mask & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK)) + dest_mask & (IMAGE_SUBWINDOW_MASK + | IMAGE_WIDGET_MASK + | IMAGE_TEXT_MASK)) { if (!WINDOWP (domain)) - signal_simple_error ("Can't instantiate subwindow outside a window", + signal_simple_error ("Can't instantiate text or subwindow outside a window", instantiator); - instance = Fgethash (instantiator, - XWINDOW (domain)->subwindow_instance_cache, + instance = Fgethash (instantiator, + XWINDOW (domain)->subwindow_instance_cache, Qunbound); } } @@ -2447,7 +2800,7 @@ noseeum_cons (pointerp ? ls3 : instantiator, subtable)); int speccount = specpdl_depth (); - + /* make sure we cache the failures, too. Use an unwind-protect to catch such errors. If we fail, the unwind-protect records nil in @@ -2460,8 +2813,9 @@ domain, instantiator, pointer_fg, pointer_bg, - dest_mask); - + dest_mask, + glyph); + Fsetcar (locative, instance); /* only after the image has been instantiated do we know whether we need to put it in the per-window image instance @@ -2473,7 +2827,7 @@ if (!WINDOWP (domain)) signal_simple_error ("Can't instantiate subwindow outside a window", instantiator); - + Fsetcdr (XCDR (locative), XWINDOW (domain)->subwindow_instance_cache ); } unbind_to (speccount, Qnil); @@ -2571,7 +2925,7 @@ set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph, Lisp_Object property) { - struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj); + Lisp_Specifier *image = XIMAGE_SPECIFIER (obj); IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph; IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property; @@ -2626,6 +2980,76 @@ return retlist; } +/* Copy an image instantiator. We can't use Fcopy_tree since widgets + may contain circular references which would send Fcopy_tree into + infloop death. */ +static Lisp_Object +image_copy_vector_instantiator (Lisp_Object instantiator) +{ + int i; + struct image_instantiator_methods *meths; + Lisp_Object *elt; + int instantiator_len; + + CHECK_VECTOR (instantiator); + + instantiator = Fcopy_sequence (instantiator); + elt = XVECTOR_DATA (instantiator); + instantiator_len = XVECTOR_LENGTH (instantiator); + + meths = decode_image_instantiator_format (elt[0], ERROR_ME); + + for (i = 1; i < instantiator_len; i += 2) + { + int j; + Lisp_Object keyword = elt[i]; + Lisp_Object value = elt[i+1]; + + /* Find the keyword entry. */ + for (j = 0; j < Dynarr_length (meths->keywords); j++) + { + if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword)) + break; + } + + /* Only copy keyword values that should be copied. */ + if (Dynarr_at (meths->keywords, j).copy_p + && + (CONSP (value) || VECTORP (value))) + { + elt [i+1] = Fcopy_tree (value, Qt); + } + } + + return instantiator; +} + +static Lisp_Object +image_copy_instantiator (Lisp_Object arg) +{ + if (CONSP (arg)) + { + Lisp_Object rest; + rest = arg = Fcopy_sequence (arg); + while (CONSP (rest)) + { + Lisp_Object elt = XCAR (rest); + if (CONSP (elt)) + XCAR (rest) = Fcopy_tree (elt, Qt); + else if (VECTORP (elt)) + XCAR (rest) = image_copy_vector_instantiator (elt); + if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */ + XCDR (rest) = Fcopy_tree (XCDR (rest), Qt); + rest = XCDR (rest); + } + } + else if (VECTORP (arg)) + { + arg = image_copy_vector_instantiator (arg); + } + return arg; +} + DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /* Return non-nil if OBJECT is an image specifier. @@ -2710,9 +3134,21 @@ Currently can only be instanced as `pointer', although this should probably be fixed.) 'subwindow - (An embedded X window; not currently implemented.) -'widget - (A widget control, for instance text field or radio button.) + (An embedded windowing system window.) +'edit-field + (A text editing widget glyph.) +'button + (A button widget glyph; either a push button, radio button or toggle button.) +'tab-control + (A tab widget glyph; a series of user selectable tabs.) +'progress-gauge + (A sliding widget glyph, for showing progress.) +'combo-box + (A drop list of selectable items in a widget glyph, for editing text.) +'label + (A static, text-only, widget glyph; for displaying text.) +'tree-view + (A folding widget glyph.) 'autodetect (XEmacs tries to guess what format the data is in. If X support exists, the data string will be checked to see if it names a filename. @@ -2774,7 +3210,14 @@ object). If this is not specified, the contents of `xpm-color-symbols' are used to generate the alist.) :face - (Only for `inherit'. This specifies the face to inherit from.) + (Only for `inherit'. This specifies the face to inherit from. + For widget glyphs this also specifies the face to use for + display. It defaults to gui-element-face.) + +Keywords accepted as menu item specs are also accepted by widget +glyphs. These are `:selected', `:active', `:suffix', `:keys', +`:style', `:filter', `:config', `:included', `:key-sequence', +`:accelerator', `:label' and `:callback'. If instead of a vector, the instantiator is a string, it will be converted into a vector by looking it up according to the specs in the @@ -2802,14 +3245,14 @@ ****************************************************************************/ static Lisp_Object -mark_glyph (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_glyph (Lisp_Object obj) { - struct Lisp_Glyph *glyph = XGLYPH (obj); - - markobj (glyph->image); - markobj (glyph->contrib_p); - markobj (glyph->baseline); - markobj (glyph->face); + Lisp_Glyph *glyph = XGLYPH (obj); + + mark_object (glyph->image); + mark_object (glyph->contrib_p); + mark_object (glyph->baseline); + mark_object (glyph->face); return glyph->plist; } @@ -2817,7 +3260,7 @@ static void print_glyph (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { - struct Lisp_Glyph *glyph = XGLYPH (obj); + Lisp_Glyph *glyph = XGLYPH (obj); char buf[20]; if (print_readably) @@ -2840,8 +3283,8 @@ static int glyph_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { - struct Lisp_Glyph *g1 = XGLYPH (obj1); - struct Lisp_Glyph *g2 = XGLYPH (obj2); + Lisp_Glyph *g1 = XGLYPH (obj1); + Lisp_Glyph *g2 = XGLYPH (obj2); depth++; @@ -2866,7 +3309,7 @@ static Lisp_Object glyph_getprop (Lisp_Object obj, Lisp_Object prop) { - struct Lisp_Glyph *g = XGLYPH (obj); + Lisp_Glyph *g = XGLYPH (obj); if (EQ (prop, Qimage)) return g->image; if (EQ (prop, Qcontrib_p)) return g->contrib_p; @@ -2879,9 +3322,9 @@ static int glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value) { - if ((EQ (prop, Qimage)) || - (EQ (prop, Qcontrib_p)) || - (EQ (prop, Qbaseline))) + if (EQ (prop, Qimage) || + EQ (prop, Qcontrib_p) || + EQ (prop, Qbaseline)) return 0; if (EQ (prop, Qface)) @@ -2897,9 +3340,9 @@ static int glyph_remprop (Lisp_Object obj, Lisp_Object prop) { - if ((EQ (prop, Qimage)) || - (EQ (prop, Qcontrib_p)) || - (EQ (prop, Qbaseline))) + if (EQ (prop, Qimage) || + EQ (prop, Qcontrib_p) || + EQ (prop, Qbaseline)) return -1; if (EQ (prop, Qface)) @@ -2914,7 +3357,7 @@ static Lisp_Object glyph_plist (Lisp_Object obj) { - struct Lisp_Glyph *glyph = XGLYPH (obj); + Lisp_Glyph *glyph = XGLYPH (obj); Lisp_Object result = glyph->plist; result = cons3 (Qface, glyph->face, result); @@ -2925,12 +3368,21 @@ return result; } +static const struct lrecord_description glyph_description[] = { + { XD_LISP_OBJECT, offsetof (Lisp_Glyph, image) }, + { XD_LISP_OBJECT, offsetof (Lisp_Glyph, contrib_p) }, + { XD_LISP_OBJECT, offsetof (Lisp_Glyph, baseline) }, + { XD_LISP_OBJECT, offsetof (Lisp_Glyph, face) }, + { XD_LISP_OBJECT, offsetof (Lisp_Glyph, plist) }, + { XD_END } +}; + DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph, mark_glyph, print_glyph, 0, - glyph_equal, glyph_hash, + glyph_equal, glyph_hash, glyph_description, glyph_getprop, glyph_putprop, glyph_remprop, glyph_plist, - struct Lisp_Glyph); + Lisp_Glyph); Lisp_Object allocate_glyph (enum glyph_type type, @@ -2939,18 +3391,19 @@ { /* This function can GC */ Lisp_Object obj = Qnil; - struct Lisp_Glyph *g = - alloc_lcrecord_type (struct Lisp_Glyph, lrecord_glyph); + Lisp_Glyph *g = alloc_lcrecord_type (Lisp_Glyph, &lrecord_glyph); g->type = type; g->image = Fmake_specifier (Qimage); /* This function can GC */ + g->dirty = 0; switch (g->type) { case GLYPH_BUFFER: XIMAGE_SPECIFIER_ALLOWED (g->image) = - IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK - | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK - | IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK; + IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK + | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK + | IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK + | IMAGE_LAYOUT_MASK; break; case GLYPH_POINTER: XIMAGE_SPECIFIER_ALLOWED (g->image) = @@ -2958,7 +3411,8 @@ break; case GLYPH_ICON: XIMAGE_SPECIFIER_ALLOWED (g->image) = - IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK; + IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK + | IMAGE_COLOR_PIXMAP_MASK; break; default: abort (); @@ -3091,68 +3545,53 @@ } } +Lisp_Object +glyph_image_instance (Lisp_Object glyph, Lisp_Object domain, + Error_behavior errb, int no_quit) +{ + Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph)); + + /* This can never return Qunbound. All glyphs have 'nothing as + a fallback. */ + Lisp_Object image_instance = specifier_instance (specifier, Qunbound, + domain, errb, no_quit, 0, + Qzero); + assert (!UNBOUNDP (image_instance)); + + return image_instance; +} + +static Lisp_Object +glyph_image_instance_maybe (Lisp_Object glyph_or_image, Lisp_Object window) +{ + Lisp_Object instance = glyph_or_image; + + if (GLYPHP (glyph_or_image)) + instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1); + + return instance; +} + /***************************************************************************** glyph_width - Return the width of the given GLYPH on the given WINDOW. If the - instance is a string then the width is calculated using the font of - the given FACE, unless a face is defined by the glyph itself. + Return the width of the given GLYPH on the given WINDOW. + Calculations are done based on recursively querying the geometry of + the associated image instances. ****************************************************************************/ unsigned short -glyph_width (Lisp_Object glyph, Lisp_Object frame_face, - face_index window_findex, Lisp_Object window) +glyph_width (Lisp_Object glyph_or_image, Lisp_Object domain) { - Lisp_Object instance; - Lisp_Object frame = XWINDOW (window)->frame; - - /* #### We somehow need to distinguish between the user causing this - error condition and a bug causing it. */ - if (!GLYPHP (glyph)) - return 0; - else - instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1); - + Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image, + domain); if (!IMAGE_INSTANCEP (instance)) return 0; - switch (XIMAGE_INSTANCE_TYPE (instance)) - { - case IMAGE_TEXT: - { - Lisp_Object str = XIMAGE_INSTANCE_TEXT_STRING (instance); - Lisp_Object private_face = XGLYPH_FACE(glyph); - - if (!NILP (private_face)) - return redisplay_frame_text_width_string (XFRAME (frame), - private_face, - 0, str, 0, -1); - else - if (!NILP (frame_face)) - return redisplay_frame_text_width_string (XFRAME (frame), - frame_face, - 0, str, 0, -1); - else - return redisplay_text_width_string (XWINDOW (window), - window_findex, - 0, str, 0, -1); - } - - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - return XIMAGE_INSTANCE_PIXMAP_WIDTH (instance); - - case IMAGE_NOTHING: - return 0; - - case IMAGE_SUBWINDOW: - case IMAGE_WIDGET: - return XIMAGE_INSTANCE_SUBWINDOW_WIDTH (instance); - - default: - abort (); - return 0; - } + if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance)) + image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY, + IMAGE_UNSPECIFIED_GEOMETRY, domain); + + return XIMAGE_INSTANCE_WIDTH (instance); } DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /* @@ -3165,127 +3604,60 @@ XSETWINDOW (window, decode_window (window)); CHECK_GLYPH (glyph); - return make_int (glyph_width (glyph, Qnil, DEFAULT_INDEX, window)); -} - -#define RETURN_ASCENT 0 -#define RETURN_DESCENT 1 -#define RETURN_HEIGHT 2 - -Lisp_Object -glyph_image_instance (Lisp_Object glyph, Lisp_Object domain, - Error_behavior errb, int no_quit) -{ - Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph)); - - /* This can never return Qunbound. All glyphs have 'nothing as - a fallback. */ - return specifier_instance (specifier, Qunbound, domain, errb, no_quit, 0, - Qzero); -} - -static unsigned short -glyph_height_internal (Lisp_Object glyph, Lisp_Object frame_face, - face_index window_findex, Lisp_Object window, - int function) -{ - Lisp_Object instance; - Lisp_Object frame = XWINDOW (window)->frame; - - if (!GLYPHP (glyph)) - return 0; - else - instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1); - - if (!IMAGE_INSTANCEP (instance)) - return 0; - - switch (XIMAGE_INSTANCE_TYPE (instance)) - { - case IMAGE_TEXT: - { - struct font_metric_info fm; - Lisp_Object string = XIMAGE_INSTANCE_TEXT_STRING (instance); - unsigned char charsets[NUM_LEADING_BYTES]; - struct face_cachel frame_cachel; - struct face_cachel *cachel; - - find_charsets_in_bufbyte_string (charsets, - XSTRING_DATA (string), - XSTRING_LENGTH (string)); - - if (!NILP (frame_face)) - { - reset_face_cachel (&frame_cachel); - update_face_cachel_data (&frame_cachel, frame, frame_face); - cachel = &frame_cachel; - } - else - cachel = WINDOW_FACE_CACHEL (XWINDOW (window), window_findex); - ensure_face_cachel_complete (cachel, window, charsets); - - face_cachel_charset_font_metric_info (cachel, charsets, &fm); - - switch (function) - { - case RETURN_ASCENT: return fm.ascent; - case RETURN_DESCENT: return fm.descent; - case RETURN_HEIGHT: return fm.ascent + fm.descent; - default: - abort (); - return 0; /* not reached */ - } - } - - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - /* #### Ugh ugh ugh -- temporary crap */ - if (function == RETURN_ASCENT || function == RETURN_HEIGHT) - return XIMAGE_INSTANCE_PIXMAP_HEIGHT (instance); - else - return 0; - - case IMAGE_NOTHING: - return 0; - - case IMAGE_SUBWINDOW: - case IMAGE_WIDGET: - /* #### Ugh ugh ugh -- temporary crap */ - if (function == RETURN_ASCENT || function == RETURN_HEIGHT) - return XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (instance); - else - return 0; - - default: - abort (); - return 0; - } + return make_int (glyph_width (glyph, window)); } unsigned short -glyph_ascent (Lisp_Object glyph, Lisp_Object frame_face, - face_index window_findex, Lisp_Object window) +glyph_ascent (Lisp_Object glyph_or_image, Lisp_Object domain) { - return glyph_height_internal (glyph, frame_face, window_findex, window, - RETURN_ASCENT); + Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image, + domain); + if (!IMAGE_INSTANCEP (instance)) + return 0; + + if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance)) + image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY, + IMAGE_UNSPECIFIED_GEOMETRY, domain); + + if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT) + return XIMAGE_INSTANCE_TEXT_ASCENT (instance); + else + return XIMAGE_INSTANCE_HEIGHT (instance); } unsigned short -glyph_descent (Lisp_Object glyph, Lisp_Object frame_face, - face_index window_findex, Lisp_Object window) +glyph_descent (Lisp_Object glyph_or_image, Lisp_Object domain) { - return glyph_height_internal (glyph, frame_face, window_findex, window, - RETURN_DESCENT); + Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image, + domain); + if (!IMAGE_INSTANCEP (instance)) + return 0; + + if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance)) + image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY, + IMAGE_UNSPECIFIED_GEOMETRY, domain); + + if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT) + return XIMAGE_INSTANCE_TEXT_DESCENT (instance); + else + return 0; } /* strictly a convenience function. */ unsigned short -glyph_height (Lisp_Object glyph, Lisp_Object frame_face, - face_index window_findex, Lisp_Object window) +glyph_height (Lisp_Object glyph_or_image, Lisp_Object domain) { - return glyph_height_internal (glyph, frame_face, window_findex, window, - RETURN_HEIGHT); + Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image, + domain); + + if (!IMAGE_INSTANCEP (instance)) + return 0; + + if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance)) + image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY, + IMAGE_UNSPECIFIED_GEOMETRY, domain); + + return XIMAGE_INSTANCE_HEIGHT (instance); } DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /* @@ -3298,7 +3670,7 @@ XSETWINDOW (window, decode_window (window)); CHECK_GLYPH (glyph); - return make_int (glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window)); + return make_int (glyph_ascent (glyph, window)); } DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /* @@ -3311,7 +3683,7 @@ XSETWINDOW (window, decode_window (window)); CHECK_GLYPH (glyph); - return make_int (glyph_descent (glyph, Qnil, DEFAULT_INDEX, window)); + return make_int (glyph_descent (glyph, window)); } /* This is redundant but I bet a lot of people expect it to exist. */ @@ -3325,12 +3697,42 @@ XSETWINDOW (window, decode_window (window)); CHECK_GLYPH (glyph); - return make_int (glyph_height (glyph, Qnil, DEFAULT_INDEX, window)); + return make_int (glyph_height (glyph, window)); } -#undef RETURN_ASCENT -#undef RETURN_DESCENT -#undef RETURN_HEIGHT +static void +set_glyph_dirty_p (Lisp_Object glyph_or_image, Lisp_Object window, int dirty) +{ + Lisp_Object instance = glyph_or_image; + + if (!NILP (glyph_or_image)) + { + if (GLYPHP (glyph_or_image)) + { + instance = glyph_image_instance (glyph_or_image, window, + ERROR_ME_NOT, 1); + XGLYPH_DIRTYP (glyph_or_image) = dirty; + } + + XIMAGE_INSTANCE_DIRTYP (instance) = dirty; + } +} + +static void +set_image_instance_dirty_p (Lisp_Object instance, int dirty) +{ + if (IMAGE_INSTANCEP (instance)) + { + XIMAGE_INSTANCE_DIRTYP (instance) = dirty; + /* Now cascade up the hierarchy. */ + set_image_instance_dirty_p (XIMAGE_INSTANCE_PARENT (instance), + dirty); + } + else if (GLYPHP (instance)) + { + XGLYPH_DIRTYP (instance) = dirty; + } +} /* #### do we need to cache this info to speed things up? */ @@ -3386,20 +3788,51 @@ (XGLYPH (glyph)->after_change) (glyph, property, locale); } +#if 0 /* Not used for now */ +static void +glyph_query_geometry (Lisp_Object glyph_or_image, Lisp_Object window, + unsigned int* width, unsigned int* height, + enum image_instance_geometry disp, Lisp_Object domain) +{ + Lisp_Object instance = glyph_or_image; + + if (GLYPHP (glyph_or_image)) + instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1); + + image_instance_query_geometry (instance, width, height, disp, domain); +} + +static void +glyph_layout (Lisp_Object glyph_or_image, Lisp_Object window, + unsigned int width, unsigned int height, Lisp_Object domain) +{ + Lisp_Object instance = glyph_or_image; + + if (GLYPHP (glyph_or_image)) + instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1); + + image_instance_layout (instance, width, height, domain); +} +#endif + /***************************************************************************** * glyph cachel functions * *****************************************************************************/ -/* - #### All of this is 95% copied from face cachels. - Consider consolidating. - #### We need to add a dirty flag to the glyphs. - */ - +/* #### All of this is 95% copied from face cachels. Consider + consolidating. + + Why do we need glyph_cachels? Simply because a glyph_cachel captures + per-window information about a particular glyph. A glyph itself is + not created in any particular context, so if we were to rely on a + glyph to tell us about its dirtiness we would not be able to reset + the dirty flag after redisplaying it as it may exist in other + contexts. When we have redisplayed we need to know which glyphs to + reset the dirty flags on - the glyph_cachels give us a nice list we + can iterate through doing this. */ void -mark_glyph_cachels (glyph_cachel_dynarr *elements, - void (*markobj) (Lisp_Object)) +mark_glyph_cachels (glyph_cachel_dynarr *elements) { int elt; @@ -3409,7 +3842,7 @@ for (elt = 0; elt < Dynarr_length (elements); elt++) { struct glyph_cachel *cachel = Dynarr_atp (elements, elt); - markobj (cachel->glyph); + mark_object (cachel->glyph); } } @@ -3417,19 +3850,29 @@ update_glyph_cachel_data (struct window *w, Lisp_Object glyph, struct glyph_cachel *cachel) { - /* #### This should be || !cachel->updated */ - if (NILP (cachel->glyph) || !EQ (cachel->glyph, glyph)) + if (!cachel->updated || NILP (cachel->glyph) || !EQ (cachel->glyph, glyph) + || XGLYPH_DIRTYP (cachel->glyph) + || XFRAME(WINDOW_FRAME(w))->faces_changed) { - Lisp_Object window; + Lisp_Object window, instance; XSETWINDOW (window, w); - /* #### This could be sped up if we redid things to grab the glyph - instantiation and passed it to the size functions. */ cachel->glyph = glyph; - cachel->width = glyph_width (glyph, Qnil, DEFAULT_INDEX, window); - cachel->ascent = glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window); - cachel->descent = glyph_descent (glyph, Qnil, DEFAULT_INDEX, window); + /* Speed things up slightly by grabbing the glyph instantiation + and passing it to the size functions. */ + instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1); + + /* Mark text instance of the glyph dirty if faces have changed, + because its geometry might have changed. */ + invalidate_glyph_geometry_maybe (instance, w); + + /* #### Do the following 2 lines buy us anything? --kkm */ + XGLYPH_DIRTYP (glyph) = XIMAGE_INSTANCE_DIRTYP (instance); + cachel->dirty = XGLYPH_DIRTYP (glyph); + cachel->width = glyph_width (instance, window); + cachel->ascent = glyph_ascent (instance, window); + cachel->descent = glyph_descent (instance, window); } cachel->updated = 1; @@ -3447,7 +3890,7 @@ Dynarr_add (w->glyph_cachels, new_cachel); } -static glyph_index +glyph_index get_glyph_cachel_index (struct window *w, Lisp_Object glyph) { int elt; @@ -3462,8 +3905,7 @@ if (EQ (cachel->glyph, glyph) && !NILP (glyph)) { - if (!cachel->updated) - update_glyph_cachel_data (w, glyph, cachel); + update_glyph_cachel_data (w, glyph, cachel); return elt; } } @@ -3506,7 +3948,24 @@ #undef FROB for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++) - Dynarr_atp (w->glyph_cachels, elt)->updated = 0; + { + Dynarr_atp (w->glyph_cachels, elt)->updated = 0; + } +} + +/* Unset the dirty bit on all the glyph cachels that have it. */ +void +mark_glyph_cachels_as_clean (struct window* w) +{ + int elt; + Lisp_Object window; + XSETWINDOW (window, w); + for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++) + { + struct glyph_cachel *cachel = Dynarr_atp (w->glyph_cachels, elt); + cachel->dirty = 0; + set_glyph_dirty_p (cachel->glyph, window, 0); + } } #ifdef MEMORY_USAGE_STATS @@ -3530,7 +3989,7 @@ /***************************************************************************** * subwindow cachel functions * *****************************************************************************/ -/* subwindows are curious in that you have to physically unmap them to +/* Subwindows are curious in that you have to physically unmap them to not display them. It is problematic deciding what to do in redisplay. We have two caches - a per-window instance cache that keeps track of subwindows on a window, these are linked to their @@ -3540,7 +3999,7 @@ obscuring an area that we want to clear. We need to be able to flip through this quickly so a hashtable is not suitable hence the subwindow_cachels. The question is should we just not mark - instances in the subwindow_cachelsnor should we try and invalidate + instances in the subwindow_cachels or should we try and invalidate the cache at suitable points in redisplay? If we don't invalidate the cache it will fill up with crud that will only get removed when the frame is deleted. So invalidation is good, the question is when @@ -3548,8 +4007,7 @@ MARK_SUBWINDOWS_CHANGED when a subwindow gets deleted. */ void -mark_subwindow_cachels (subwindow_cachel_dynarr *elements, - void (*markobj) (Lisp_Object)) +mark_subwindow_cachels (subwindow_cachel_dynarr *elements) { int elt; @@ -3559,7 +4017,7 @@ for (elt = 0; elt < Dynarr_length (elements); elt++) { struct subwindow_cachel *cachel = Dynarr_atp (elements, elt); - markobj (cachel->subwindow); + mark_object (cachel->subwindow); } } @@ -3567,13 +4025,9 @@ update_subwindow_cachel_data (struct frame *f, Lisp_Object subwindow, struct subwindow_cachel *cachel) { - if (NILP (cachel->subwindow) || !EQ (cachel->subwindow, subwindow)) - { - cachel->subwindow = subwindow; - cachel->width = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow); - cachel->height = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow); - } - + cachel->subwindow = subwindow; + cachel->width = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow); + cachel->height = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow); cachel->updated = 1; } @@ -3618,6 +4072,29 @@ return elt; } +static void +update_subwindow_cachel (Lisp_Object subwindow) +{ + struct frame* f; + int elt; + + if (NILP (subwindow)) + return; + + f = XFRAME ( XIMAGE_INSTANCE_SUBWINDOW_FRAME (subwindow)); + + for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++) + { + struct subwindow_cachel *cachel = + Dynarr_atp (f->subwindow_cachels, elt); + + if (EQ (cachel->subwindow, subwindow) && !NILP (subwindow)) + { + update_subwindow_cachel_data (f, subwindow, cachel); + } + } +} + /* redisplay in general assumes that drawing something will erase what was there before. unfortunately this does not apply to subwindows that need to be specifically unmapped in order to @@ -3634,8 +4111,10 @@ if (!NILP (cachel->subwindow) && cachel->being_displayed) { - struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (cachel->subwindow); - MAYBE_DEVMETH (XDEVICE (f->device), unmap_subwindow, (ii)); + cachel->updated = 1; + /* #### This is not optimal as update_subwindow will search + the cachels for ourselves as well. We could easily optimize. */ + unmap_subwindow (cachel->subwindow); } } Dynarr_reset (f->subwindow_cachels); @@ -3650,36 +4129,166 @@ Dynarr_atp (f->subwindow_cachels, elt)->updated = 0; } + + +/***************************************************************************** + * subwindow exposure ignorance * + *****************************************************************************/ +/* when we unmap subwindows the associated window system will generate + expose events. This we do not want as redisplay already copes with + the repainting necessary. Worse, we can get in an endless cycle of + redisplay if we are not careful. Thus we keep a per-frame list of + expose events that are going to come and ignore them as + required. */ + +struct expose_ignore_blocktype +{ + Blocktype_declare (struct expose_ignore); +} *the_expose_ignore_blocktype; + +int +check_for_ignored_expose (struct frame* f, int x, int y, int width, int height) +{ + struct expose_ignore *ei, *prev; + /* the ignore list is FIFO so we should generally get a match with + the first element in the list */ + for (ei = f->subwindow_exposures, prev = 0; ei; ei = ei->next) + { + /* Checking for exact matches just isn't good enough as we + mighte get exposures for partially obscure subwindows, thus + we have to check for overlaps. Being conservative we will + check for exposures wholly contained by the subwindow, this + might give us what we want.*/ + if (ei->x <= x && ei->y <= y + && ei->x + ei->width >= x + width + && ei->y + ei->height >= y + height) + { +#ifdef DEBUG_WIDGETS + stderr_out ("ignored %d+%d, %dx%d for exposure %d+%d, %dx%d\n", + x, y, width, height, ei->x, ei->y, ei->width, ei->height); +#endif + if (!prev) + f->subwindow_exposures = ei->next; + else + prev->next = ei->next; + + if (ei == f->subwindow_exposures_tail) + f->subwindow_exposures_tail = prev; + + Blocktype_free (the_expose_ignore_blocktype, ei); + return 1; + } + prev = ei; + } + return 0; +} + +static void +register_ignored_expose (struct frame* f, int x, int y, int width, int height) +{ + if (!hold_ignored_expose_registration) + { + struct expose_ignore *ei; + + ei = Blocktype_alloc (the_expose_ignore_blocktype); + + ei->next = NULL; + ei->x = x; + ei->y = y; + ei->width = width; + ei->height = height; + + /* we have to add the exposure to the end of the list, since we + want to check the oldest events first. for speed we keep a record + of the end so that we can add right to it. */ + if (f->subwindow_exposures_tail) + { + f->subwindow_exposures_tail->next = ei; + } + if (!f->subwindow_exposures) + { + f->subwindow_exposures = ei; + } + f->subwindow_exposures_tail = ei; + } +} + +/**************************************************************************** + find_matching_subwindow + + See if there is a subwindow that completely encloses the requested + area. + ****************************************************************************/ +int find_matching_subwindow (struct frame* f, int x, int y, int width, int height) +{ + int elt; + + for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++) + { + struct subwindow_cachel *cachel = + Dynarr_atp (f->subwindow_cachels, elt); + + if (cachel->being_displayed + && + cachel->x <= x && cachel->y <= y + && + cachel->x + cachel->width >= x + width + && + cachel->y + cachel->height >= y + height) + { + return 1; + } + } + return 0; +} + /***************************************************************************** * subwindow functions * *****************************************************************************/ /* update the displayed characteristics of a subwindow */ -static void +void update_subwindow (Lisp_Object subwindow) { - struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); - - if (!IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET + Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); + + if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET || - NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii))) - return; - - MAYBE_DEVMETH (XDEVICE (ii->device), update_subwindow, (ii)); + IMAGE_INSTANCE_TYPE (ii) == IMAGE_LAYOUT) + { + if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET) + update_widget (subwindow); + /* Reset the changed flags. */ + IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii) = 0; + IMAGE_INSTANCE_WIDGET_PERCENT_CHANGED (ii) = 0; + IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 0; + IMAGE_INSTANCE_TEXT_CHANGED (ii) = 0; + } + else if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW + && + !NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii))) + { + MAYBE_DEVMETH (XDEVICE (ii->device), update_subwindow, (ii)); + } + + IMAGE_INSTANCE_SIZE_CHANGED (ii) = 0; } +/* Update all the subwindows on a frame. */ void update_frame_subwindows (struct frame *f) { int elt; - if (f->subwindows_changed || f->glyphs_changed) + /* #### Checking all of these might be overkill now that we update + subwindows in the actual redisplay code. */ + if (f->subwindows_changed || f->subwindows_state_changed || f->faces_changed) for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++) { struct subwindow_cachel *cachel = Dynarr_atp (f->subwindow_cachels, elt); - + if (cachel->being_displayed) { update_subwindow (cachel->subwindow); @@ -3690,7 +4299,7 @@ /* remove a subwindow from its frame */ void unmap_subwindow (Lisp_Object subwindow) { - struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); + Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); int elt; struct subwindow_cachel* cachel; struct frame* f; @@ -3701,13 +4310,17 @@ || NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii))) return; - +#ifdef DEBUG_WIDGETS + stderr_out ("unmapping subwindow %d\n", IMAGE_INSTANCE_SUBWINDOW_ID (ii)); +#endif f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)); elt = get_subwindow_cachel_index (f, subwindow); cachel = Dynarr_atp (f->subwindow_cachels, elt); - cachel->x = -1; - cachel->y = -1; + /* make sure we don't get expose events */ + register_ignored_expose (f, cachel->x, cachel->y, cachel->width, cachel->height); + cachel->x = ~0; + cachel->y = ~0; cachel->being_displayed = 0; IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0; @@ -3715,10 +4328,11 @@ } /* show a subwindow in its frame */ -void map_subwindow (Lisp_Object subwindow, int x, int y) +void map_subwindow (Lisp_Object subwindow, int x, int y, + struct display_glyph_area *dga) { - struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); - int elt; + Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); + int elt; struct subwindow_cachel* cachel; struct frame* f; @@ -3729,15 +4343,33 @@ NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii))) return; +#ifdef DEBUG_WIDGETS + stderr_out ("mapping subwindow %d, %dx%d@%d+%d\n", + IMAGE_INSTANCE_SUBWINDOW_ID (ii), + dga->width, dga->height, x, y); +#endif f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)); IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 1; elt = get_subwindow_cachel_index (f, subwindow); cachel = Dynarr_atp (f->subwindow_cachels, elt); cachel->x = x; cachel->y = y; + cachel->width = dga->width; + cachel->height = dga->height; cachel->being_displayed = 1; - MAYBE_DEVMETH (XDEVICE (ii->device), map_subwindow, (ii, x, y)); +#if 0 + /* This forces any pending display changes to happen to the image + before we show it. I'm not sure whether or not we need mark as + clean here, but for now we will. */ + if (IMAGE_INSTANCE_DIRTYP (ii)) + { + update_subwindow (subwindow); + IMAGE_INSTANCE_DIRTYP (ii) = 0; + } +#endif + + MAYBE_DEVMETH (XDEVICE (ii->device), map_subwindow, (ii, x, y, dga)); } static int @@ -3752,7 +4384,7 @@ Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain) { - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); Lisp_Object frame = FW_FRAME (domain); Lisp_Object width = find_keyword_in_vector (instantiator, Q_pixel_width); @@ -3760,17 +4392,19 @@ if (NILP (frame)) signal_simple_error ("No selected frame", device); - + if (!(dest_mask & IMAGE_SUBWINDOW_MASK)) incompatible_image_types (instantiator, dest_mask, IMAGE_SUBWINDOW_MASK); ii->data = 0; IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0; - IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = Qnil; IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0; IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = frame; - /* this stuff may get overidden by the widget code */ + /* #### This stuff may get overidden by the widget code and is + actually really dumb now that we have dynamic geometry + calculations. What should really happen is that the subwindow + should query its child for an appropriate geometry. */ if (NILP (width)) IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = 20; else @@ -3808,7 +4442,7 @@ (subwindow)) { CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow); - return make_int ((int) (XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow))); + return make_int ((int) XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow)); } DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /* @@ -3818,25 +4452,29 @@ (subwindow, width, height)) { int neww, newh; + Lisp_Image_Instance* ii; CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow); + ii = XIMAGE_INSTANCE (subwindow); if (NILP (width)) - neww = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow); + neww = IMAGE_INSTANCE_WIDTH (ii); else neww = XINT (width); if (NILP (height)) - newh = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow); + newh = IMAGE_INSTANCE_HEIGHT (ii); else newh = XINT (height); - - MAYBE_DEVMETH (XDEVICE (XIMAGE_INSTANCE_DEVICE (subwindow)), - resize_subwindow, (XIMAGE_INSTANCE (subwindow), neww, newh)); - - XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow) = newh; - XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow) = neww; + /* The actual resizing gets done asychronously by + update_subwindow. */ + IMAGE_INSTANCE_HEIGHT (ii) = newh; + IMAGE_INSTANCE_WIDTH (ii) = neww; + IMAGE_INSTANCE_SIZE_CHANGED (ii) = 1; + + /* need to update the cachels as redisplay will not do this */ + update_subwindow_cachel (subwindow); return subwindow; } @@ -3847,9 +4485,9 @@ (subwindow)) { CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow); - +#if 0 map_subwindow (subwindow, 0, 0); - +#endif return subwindow; } @@ -3935,6 +4573,82 @@ abort (); } } + +/***************************************************************************** + * timeouts for animated glyphs * + *****************************************************************************/ +static Lisp_Object Qglyph_animated_timeout_handler; + +DEFUN ("glyph-animated-timeout-handler", Fglyph_animated_timeout_handler, 1, 1, 0, /* +Callback function for updating animated images. +Don't use this. +*/ + (arg)) +{ + CHECK_WEAK_LIST (arg); + + if (!NILP (XWEAK_LIST_LIST (arg)) && !NILP (XCAR (XWEAK_LIST_LIST (arg)))) + { + Lisp_Object value = XCAR (XWEAK_LIST_LIST (arg)); + + if (IMAGE_INSTANCEP (value)) + { + Lisp_Image_Instance* ii = XIMAGE_INSTANCE (value); + + if (COLOR_PIXMAP_IMAGE_INSTANCEP (value) + && + IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) > 1 + && + !disable_animated_pixmaps) + { + /* Increment the index of the image slice we are currently + viewing. */ + IMAGE_INSTANCE_PIXMAP_SLICE (ii) = + (IMAGE_INSTANCE_PIXMAP_SLICE (ii) + 1) + % IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii); + /* We might need to kick redisplay at this point - but we + also might not. */ + MARK_DEVICE_FRAMES_GLYPHS_CHANGED + (XDEVICE (IMAGE_INSTANCE_DEVICE (ii))); + /* Cascade dirtiness so that we can have an animated glyph in a layout + for instance. */ + set_image_instance_dirty_p (value, 1); + } + } + } + return Qnil; +} + +Lisp_Object add_glyph_animated_timeout (EMACS_INT tickms, Lisp_Object image) +{ + Lisp_Object ret = Qnil; + + if (tickms > 0 && IMAGE_INSTANCEP (image)) + { + double ms = ((double)tickms) / 1000.0; + struct gcpro gcpro1; + Lisp_Object holder = make_weak_list (WEAK_LIST_SIMPLE); + + GCPRO1 (holder); + XWEAK_LIST_LIST (holder) = Fcons (image, Qnil); + + ret = Fadd_timeout (make_float (ms), + Qglyph_animated_timeout_handler, + holder, make_float (ms)); + + UNGCPRO; + } + return ret; +} + +void disable_glyph_animated_timeout (int i) +{ + Lisp_Object id; + XSETINT (id, i); + + Fdisable_timeout (id); +} + /***************************************************************************** * initialization * @@ -3983,6 +4697,7 @@ defsymbol (&Qpointer_image_instance_p, "pointer-image-instance-p"); defsymbol (&Qwidget_image_instance_p, "widget-image-instance-p"); defsymbol (&Qsubwindow_image_instance_p, "subwindow-image-instance-p"); + defsymbol (&Qlayout_image_instance_p, "layout-image-instance-p"); DEFSUBR (Fmake_image_instance); DEFSUBR (Fimage_instance_p); @@ -4041,6 +4756,12 @@ /* Qbuffer defined in general.c. */ /* Qpointer defined above */ + /* Unfortunately, timeout handlers must be lisp functions. This is + for animated glyphs. */ + defsymbol (&Qglyph_animated_timeout_handler, + "glyph-animated-timeout-handler"); + DEFSUBR (Fglyph_animated_timeout_handler); + /* Errors */ deferror (&Qimage_conversion_error, "image-conversion-error", @@ -4048,6 +4769,12 @@ } +static const struct lrecord_description image_specifier_description[] = { + { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct image_specifier, attachee) }, + { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct image_specifier, attachee_property) }, + { XD_END } +}; + void specifier_type_create_image (void) { @@ -4061,9 +4788,72 @@ SPECIFIER_HAS_METHOD (image, validate); SPECIFIER_HAS_METHOD (image, after_change); SPECIFIER_HAS_METHOD (image, going_to_add); + SPECIFIER_HAS_METHOD (image, copy_instantiator); } void +reinit_specifier_type_create_image (void) +{ + REINITIALIZE_SPECIFIER_TYPE (image); +} + + +static const struct lrecord_description iike_description_1[] = { + { XD_LISP_OBJECT, offsetof (ii_keyword_entry, keyword) }, + { XD_END } +}; + +static const struct struct_description iike_description = { + sizeof (ii_keyword_entry), + iike_description_1 +}; + +static const struct lrecord_description iiked_description_1[] = { + XD_DYNARR_DESC (ii_keyword_entry_dynarr, &iike_description), + { XD_END } +}; + +static const struct struct_description iiked_description = { + sizeof (ii_keyword_entry_dynarr), + iiked_description_1 +}; + +static const struct lrecord_description iife_description_1[] = { + { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, symbol) }, + { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, device) }, + { XD_STRUCT_PTR, offsetof (image_instantiator_format_entry, meths), 1, &iim_description }, + { XD_END } +}; + +static const struct struct_description iife_description = { + sizeof (image_instantiator_format_entry), + iife_description_1 +}; + +static const struct lrecord_description iifed_description_1[] = { + XD_DYNARR_DESC (image_instantiator_format_entry_dynarr, &iife_description), + { XD_END } +}; + +static const struct struct_description iifed_description = { + sizeof (image_instantiator_format_entry_dynarr), + iifed_description_1 +}; + +static const struct lrecord_description iim_description_1[] = { + { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, symbol) }, + { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, device) }, + { XD_STRUCT_PTR, offsetof (struct image_instantiator_methods, keywords), 1, &iiked_description }, + { XD_STRUCT_PTR, offsetof (struct image_instantiator_methods, consoles), 1, &cted_description }, + { XD_END } +}; + +const struct struct_description iim_description = { + sizeof(struct image_instantiator_methods), + iim_description_1 +}; + +void image_instantiator_format_create (void) { /* image instantiators */ @@ -4074,6 +4864,8 @@ Vimage_instantiator_format_list = Qnil; staticpro (&Vimage_instantiator_format_list); + dumpstruct (&the_image_instantiator_format_entry_dynarr, &iifed_description); + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing"); IIFORMAT_HAS_METHOD (nothing, possible_dest_types); @@ -4095,13 +4887,16 @@ IIFORMAT_HAS_METHOD (string, instantiate); IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string); + /* Do this so we can set strings. */ + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (text, "text"); + IIFORMAT_HAS_METHOD (text, set_property); + IIFORMAT_HAS_METHOD (text, query_geometry); INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string"); IIFORMAT_HAS_METHOD (formatted_string, validate); IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types); IIFORMAT_HAS_METHOD (formatted_string, instantiate); - IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string); /* subwindows */ @@ -4157,15 +4952,27 @@ } void +reinit_vars_of_glyphs (void) +{ + the_expose_ignore_blocktype = + Blocktype_new (struct expose_ignore_blocktype); + + hold_ignored_expose_registration = 0; +} + + +void vars_of_glyphs (void) { + reinit_vars_of_glyphs (); + Vthe_nothing_vector = vector1 (Qnothing); staticpro (&Vthe_nothing_vector); /* image instances */ - Vimage_instance_type_list = Fcons (Qnothing, - list6 (Qtext, Qmono_pixmap, Qcolor_pixmap, + Vimage_instance_type_list = Fcons (Qnothing, + list6 (Qtext, Qmono_pixmap, Qcolor_pixmap, Qpointer, Qsubwindow, Qwidget)); staticpro (&Vimage_instance_type_list); @@ -4224,6 +5031,12 @@ #ifdef HAVE_XFACE Fprovide (Qxface); #endif + + DEFVAR_BOOL ("disable-animated-pixmaps", &disable_animated_pixmaps /* +Whether animated pixmaps should be animated. +Default is t. +*/); + disable_animated_pixmaps = 0; } void @@ -4247,8 +5060,7 @@ set_specifier_fallback (Vcurrent_display_table, list1 (Fcons (Qnil, Qnil))); set_specifier_caching (Vcurrent_display_table, - slot_offset (struct window, - display_table), + offsetof (struct window, display_table), some_window_value_changed, 0, 0); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/glyphs.h --- a/src/glyphs.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/glyphs.h Mon Aug 13 11:13:30 2007 +0200 @@ -21,8 +21,8 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_GLYPHS_H_ -#define _XEMACS_GLYPHS_H_ +#ifndef INCLUDED_glyphs_h_ +#define INCLUDED_glyphs_h_ #include "specifier.h" #include "gui.h" @@ -55,11 +55,14 @@ subwindow subwindow inherit mono-pixmap autodetect mono-pixmap, color-pixmap, pointer, text - button widget - edit widget - combo widget + button widget + edit-field widget + combo -box widget + progress-gauge widget + tab-control widget + tree-view widget scrollbar widget - static widget + static widget */ /* These are methods specific to a particular format of image instantiator @@ -71,6 +74,7 @@ Lisp_Object keyword; void (*validate) (Lisp_Object data); int multiple_p; + int copy_p; }; typedef struct @@ -78,6 +82,20 @@ Dynarr_declare (ii_keyword_entry); } ii_keyword_entry_dynarr; +extern const struct struct_description iim_description; + +enum image_instance_geometry +{ + IMAGE_GEOMETRY, + IMAGE_DESIRED_GEOMETRY, + IMAGE_MIN_GEOMETRY, + IMAGE_MAX_GEOMETRY, + IMAGE_UNSPECIFIED_GEOMETRY = ~0 +}; + +#define WIDGET_BORDER_HEIGHT 4 +#define WIDGET_BORDER_WIDTH 4 + struct image_instantiator_methods { Lisp_Object symbol; @@ -85,6 +103,8 @@ Lisp_Object device; /* sometimes used */ ii_keyword_entry_dynarr *keywords; + /* consoles this ii is supported on */ + console_type_entry_dynarr *consoles; /* Implementation specific methods: */ /* Validate method: Given an instantiator vector, signal an error if @@ -123,6 +143,22 @@ Lisp_Object (*set_property_method) (Lisp_Object image_instance, Lisp_Object property, Lisp_Object val); + /* Asynchronously update properties. */ + void (*update_method) (Lisp_Object image_instance); + + /* Find out the desired geometry, as given by disp, of this image + instance. Actual geometry is stored in the appropriate slots in the + image instance. */ + void (*query_geometry_method) (Lisp_Object image_instance, + unsigned int* width, unsigned int* height, + enum image_instance_geometry disp, + Lisp_Object domain); + + /* Layout the instance and its children bounded by the provided + dimensions. */ + void (*layout_method) (Lisp_Object image_instance, + unsigned int width, unsigned int height, + Lisp_Object domain); }; /***** Calling an image-instantiator method *****/ @@ -170,14 +206,18 @@ format##_image_instantiator_methods->device = Qnil; \ format##_image_instantiator_methods->keywords = \ Dynarr_new (ii_keyword_entry); \ + format##_image_instantiator_methods->consoles = \ + Dynarr_new (console_type_entry); \ add_entry_to_image_instantiator_format_list \ (Q##format, format##_image_instantiator_methods); \ + dumpstruct (&format##_image_instantiator_methods, \ + &iim_description); \ } while (0) #define INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(format, obj_name) \ do { \ defsymbol (&Q##format, obj_name); \ - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT_NO_SYM(format, obj_name); \ + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT_NO_SYM(format, obj_name);\ } while (0) /* Declare that image-instantiator format FORMAT has method M; used in @@ -191,49 +231,69 @@ /* Declare that KEYW is a valid keyword for image-instantiator format FORMAT. VALIDATE_FUN if a function that returns whether the data is valid. The keyword may not appear more than once. */ -#define IIFORMAT_VALID_KEYWORD(format, keyw, validate_fun) \ +#define IIFORMAT_VALID_GENERIC_KEYWORD(format, keyw, validate_fun, copy, multi) \ do { \ struct ii_keyword_entry entry; \ \ entry.keyword = keyw; \ entry.validate = validate_fun; \ - entry.multiple_p = 0; \ + entry.multiple_p = multi; \ + entry.copy_p = copy; \ Dynarr_add (format##_image_instantiator_methods->keywords, \ entry); \ } while (0) +#define IIFORMAT_VALID_KEYWORD(format, keyw, validate_fun) \ +IIFORMAT_VALID_GENERIC_KEYWORD(format, keyw, validate_fun, 1, 0) + /* Same as IIFORMAT_VALID_KEYWORD except that the keyword may appear multiple times. */ -#define IIFORMAT_VALID_MULTI_KEYWORD(format, keyword, validate_fun) \ - do { \ - struct ii_keyword_entry entry; \ - \ - entry.keyword = keyword; \ - entry.validate = validate_fun; \ - entry.multiple_p = 1; \ - Dynarr_add (format##_image_instantiator_methods->keywords, \ - entry); \ +#define IIFORMAT_VALID_MULTI_KEYWORD(format, keyw, validate_fun) \ +IIFORMAT_VALID_GENERIC_KEYWORD(format, keyw, validate_fun, 1, 1) + +/* Same as IIFORMAT_VALID_KEYWORD execpt that the argument is not + copied by the specifier functions. This is necessary for things + like callbacks etc. */ +#define IIFORMAT_VALID_NONCOPY_KEYWORD(format, keyw, validate_fun) \ +IIFORMAT_VALID_GENERIC_KEYWORD(format, keyw, validate_fun, 0, 0) + +/* Declare that image-instantiator format FORMAT is supported on + CONSOLE type. */ +#define IIFORMAT_VALID_CONSOLE(console, format) \ + do { \ + struct console_type_entry entry; \ + \ + entry.symbol = Q##console; \ + entry.meths = console##_console_methods; \ + Dynarr_add (format##_image_instantiator_methods->consoles, \ + entry); \ } while (0) -#define DEFINE_DEVICE_IIFORMAT(type, format)\ +#define DEFINE_DEVICE_IIFORMAT(type, format) \ +DECLARE_IMAGE_INSTANTIATOR_FORMAT(format); \ struct image_instantiator_methods *type##_##format##_image_instantiator_methods -#define INITIALIZE_DEVICE_IIFORMAT(type, format) \ -do { \ - type##_##format##_image_instantiator_methods = \ - xnew_and_zero (struct image_instantiator_methods); \ +#define INITIALIZE_DEVICE_IIFORMAT(type, format) \ +do { \ + type##_##format##_image_instantiator_methods = \ + xnew_and_zero (struct image_instantiator_methods); \ type##_##format##_image_instantiator_methods->symbol = Q##format; \ type##_##format##_image_instantiator_methods->device = Q##type; \ type##_##format##_image_instantiator_methods->keywords = \ - Dynarr_new (ii_keyword_entry); \ - add_entry_to_device_ii_format_list \ + Dynarr_new (ii_keyword_entry); \ + add_entry_to_device_ii_format_list \ (Q##type, Q##format, type##_##format##_image_instantiator_methods); \ + IIFORMAT_VALID_CONSOLE(type,format); \ + dumpstruct (&type##_##format##_image_instantiator_methods, \ + &iim_description); \ } while (0) /* Declare that image-instantiator format FORMAT has method M; used in initialization routines */ #define IIFORMAT_HAS_DEVMETHOD(type, format, m) \ (type##_##format##_image_instantiator_methods->m##_method = type##_##format##_##m) +#define IIFORMAT_HAS_SHARED_DEVMETHOD(type, format, m, fromformat) \ + (type##_##format##_image_instantiator_methods->m##_method = type##_##fromformat##_##m) struct image_instantiator_methods * decode_device_ii_format (Lisp_Object device, Lisp_Object format, @@ -261,17 +321,29 @@ void check_valid_int (Lisp_Object data); void check_valid_face (Lisp_Object data); void check_valid_vector (Lisp_Object data); +void check_valid_item_list_1 (Lisp_Object items); -void initialize_subwindow_image_instance (struct Lisp_Image_Instance*); +void initialize_subwindow_image_instance (Lisp_Image_Instance*); void subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain); +void widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object pointer_fg, Lisp_Object pointer_bg, + int dest_mask, Lisp_Object domain); +void image_instance_query_geometry (Lisp_Object image_instance, + unsigned int* width, unsigned int* height, + enum image_instance_geometry disp, + Lisp_Object domain); +void image_instance_layout (Lisp_Object image_instance, + unsigned int width, unsigned int height, + Lisp_Object domain); +int invalidate_glyph_geometry_maybe (Lisp_Object glyph_or_ii, struct window* w); DECLARE_DOESNT_RETURN (incompatible_image_types (Lisp_Object instantiator, int given_dest_mask, int desired_dest_mask)); -DECLARE_DOESNT_RETURN (signal_image_error (CONST char *, Lisp_Object)); -DECLARE_DOESNT_RETURN (signal_image_error_2 (CONST char *, Lisp_Object, Lisp_Object)); +DECLARE_DOESNT_RETURN (signal_image_error (const char *, Lisp_Object)); +DECLARE_DOESNT_RETURN (signal_image_error_2 (const char *, Lisp_Object, Lisp_Object)); /************************************************************************/ /* Image Specifier Object */ @@ -307,12 +379,10 @@ /* Image Instance Object */ /************************************************************************/ -DECLARE_LRECORD (image_instance, struct Lisp_Image_Instance); -#define XIMAGE_INSTANCE(x) \ - XRECORD (x, image_instance, struct Lisp_Image_Instance) +DECLARE_LRECORD (image_instance, Lisp_Image_Instance); +#define XIMAGE_INSTANCE(x) XRECORD (x, image_instance, Lisp_Image_Instance) #define XSETIMAGE_INSTANCE(x, p) XSETRECORD (x, p, image_instance) #define IMAGE_INSTANCEP(x) RECORDP (x, image_instance) -#define GC_IMAGE_INSTANCEP(x) GC_RECORDP (x, image_instance) #define CHECK_IMAGE_INSTANCE(x) CHECK_RECORD (x, image_instance) #define CONCHECK_IMAGE_INSTANCE(x) CONCHECK_RECORD (x, image_instance) @@ -325,7 +395,8 @@ IMAGE_COLOR_PIXMAP, IMAGE_POINTER, IMAGE_SUBWINDOW, - IMAGE_WIDGET + IMAGE_WIDGET, + IMAGE_LAYOUT }; #define IMAGE_NOTHING_MASK (1 << 0) @@ -335,6 +406,7 @@ #define IMAGE_POINTER_MASK (1 << 4) #define IMAGE_SUBWINDOW_MASK (1 << 5) #define IMAGE_WIDGET_MASK (1 << 6) +#define IMAGE_LAYOUT_MASK (1 << 7) #define IMAGE_INSTANCE_TYPE_P(ii, type) \ (IMAGE_INSTANCEP (ii) && XIMAGE_INSTANCE_TYPE (ii) == type) @@ -353,6 +425,8 @@ IMAGE_INSTANCE_TYPE_P (ii, IMAGE_SUBWINDOW) #define WIDGET_IMAGE_INSTANCEP(ii) \ IMAGE_INSTANCE_TYPE_P (ii, IMAGE_WIDGET) +#define LAYOUT_IMAGE_INSTANCEP(ii) \ + IMAGE_INSTANCE_TYPE_P (ii, IMAGE_LAYOUT) #define CHECK_NOTHING_IMAGE_INSTANCE(x) do { \ CHECK_IMAGE_INSTANCE (x); \ @@ -397,21 +471,39 @@ x = wrong_type_argument (Qwidget_image_instance_p, (x)); \ } while (0) +#define CHECK_LAYOUT_IMAGE_INSTANCE(x) do { \ + CHECK_IMAGE_INSTANCE (x); \ + if (!LAYOUT_IMAGE_INSTANCEP (x)) \ + x = wrong_type_argument (Qlayout_image_instance_p, (x)); \ +} while (0) + struct Lisp_Image_Instance { struct lcrecord_header header; Lisp_Object device; Lisp_Object name; + /* The glyph from which we were instantiated. This is a weak + reference. */ + Lisp_Object parent; enum image_instance_type type; + unsigned int x_offset, y_offset; /* for layout purposes */ + unsigned int width, height; + unsigned int dirty : 1; + unsigned int size_changed : 1; + unsigned int text_changed : 1; + unsigned int layout_changed : 1; + union { struct { + unsigned int descent; Lisp_Object string; } text; struct { - int width, height, depth; + unsigned int depth; + unsigned int slice, maxslice, timeout; Lisp_Object hotspot_x, hotspot_y; /* integer or Qnil */ Lisp_Object filename; /* string or Qnil */ Lisp_Object mask_filename; /* string or Qnil */ @@ -420,20 +512,29 @@ or a pointer */ Lisp_Object auxdata; /* list or Qnil: any additional data to be seen from lisp */ + void* mask; /* mask that can be seen from all windowing systems */ } pixmap; /* used for pointers as well */ struct { Lisp_Object frame; - unsigned int width, height; void* subwindow; /* specific devices can use this as necessary */ - int being_displayed; /* used to detect when needs to be unmapped */ - struct - { - Lisp_Object face; /* foreground and background colors */ - Lisp_Object type; - Lisp_Object props; /* properties */ - struct gui_item gui_item; - } widget; /* widgets are subwindows */ + unsigned int being_displayed : 1; /* used to detect when needs to be unmapped */ + unsigned int v_resize : 1; /* Whether the vsize is allowed to change. */ + unsigned int h_resize : 1; /* Whether the hsize is allowed to change. */ + unsigned int orientation : 1; /* Vertical or horizontal. */ + unsigned int justification : 2; /* Left, right or center. */ + /* Face for colors and font. We specify this here becuase we + want people to be able to put :face in the instantiator + spec. Using gyph-face is more inconvenient, although more + general. */ + Lisp_Object face; + Lisp_Object type; + Lisp_Object props; /* properties or border*/ + Lisp_Object items; /* a list of gui_items or children */ + /* Change flags to augment dirty. */ + unsigned int face_changed : 1; + unsigned int items_changed : 1; + unsigned int percent_changed : 1; } subwindow; } u; @@ -441,17 +542,60 @@ void *data; }; +/* Layout bit-fields. */ +#define LAYOUT_HORIZONTAL 0 +#define LAYOUT_VERTICAL 1 + +#define LAYOUT_JUSTIFY_LEFT 0 +#define LAYOUT_JUSTIFY_RIGHT 1 +#define LAYOUT_JUSTIFY_CENTER 2 + +/* Accessor macros. */ #define IMAGE_INSTANCE_DEVICE(i) ((i)->device) #define IMAGE_INSTANCE_NAME(i) ((i)->name) +#define IMAGE_INSTANCE_PARENT(i) ((i)->parent) +#define IMAGE_INSTANCE_GLYPH(i) (image_instance_parent_glyph(i)) #define IMAGE_INSTANCE_TYPE(i) ((i)->type) -#define IMAGE_INSTANCE_PIXMAP_TYPE_P(i) \ - ((IMAGE_INSTANCE_TYPE (i) == IMAGE_MONO_PIXMAP) \ +#define IMAGE_INSTANCE_XOFFSET(i) ((i)->x_offset) +#define IMAGE_INSTANCE_YOFFSET(i) ((i)->y_offset) +#define IMAGE_INSTANCE_WIDTH(i) ((i)->width) +#define IMAGE_INSTANCE_HEIGHT(i) ((i)->height) +#define IMAGE_INSTANCE_PIXMAP_TYPE_P(i) \ + ((IMAGE_INSTANCE_TYPE (i) == IMAGE_MONO_PIXMAP) \ || (IMAGE_INSTANCE_TYPE (i) == IMAGE_COLOR_PIXMAP)) +#define IMAGE_INSTANCE_DIRTYP(i) ((i)->dirty) +#define IMAGE_INSTANCE_NEEDS_LAYOUT(i) \ + (IMAGE_INSTANCE_DIRTYP (i) && IMAGE_INSTANCE_LAYOUT_CHANGED (i)) +#define IMAGE_INSTANCE_FACE(i) \ + XGLYPH_FACE (IMAGE_INSTANCE_GLYPH (i)) -#define IMAGE_INSTANCE_TEXT_STRING(i) ((i)->u.text.string) +/* Changed flags */ +#define IMAGE_INSTANCE_TEXT_CHANGED(i) ((i)->text_changed) +#define IMAGE_INSTANCE_SIZE_CHANGED(i) ((i)->size_changed) +#define IMAGE_INSTANCE_WIDGET_FACE_CHANGED(i) \ + ((i)->u.subwindow.face_changed) +#define IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED(i) \ + ((i)->u.subwindow.items_changed) +#define IMAGE_INSTANCE_WIDGET_PERCENT_CHANGED(i) \ + ((i)->u.subwindow.percent_changed) +#define IMAGE_INSTANCE_LAYOUT_CHANGED(i) \ + ((i)->layout_changed) -#define IMAGE_INSTANCE_PIXMAP_WIDTH(i) ((i)->u.pixmap.width) -#define IMAGE_INSTANCE_PIXMAP_HEIGHT(i) ((i)->u.pixmap.height) +/* Text properties */ +#define IMAGE_INSTANCE_TEXT_STRING(i) ((i)->u.text.string) +#define IMAGE_INSTANCE_TEXT_WIDTH(i) \ + IMAGE_INSTANCE_WIDTH(i) +#define IMAGE_INSTANCE_TEXT_HEIGHT(i) \ + IMAGE_INSTANCE_HEIGHT(i) +#define IMAGE_INSTANCE_TEXT_DESCENT(i) ((i)->u.text.descent) +#define IMAGE_INSTANCE_TEXT_ASCENT(i) \ + (IMAGE_INSTANCE_TEXT_HEIGHT(i) - IMAGE_INSTANCE_TEXT_DESCENT(i)) + +/* Pixmap properties */ +#define IMAGE_INSTANCE_PIXMAP_WIDTH(i) \ + IMAGE_INSTANCE_WIDTH(i) +#define IMAGE_INSTANCE_PIXMAP_HEIGHT(i) \ + IMAGE_INSTANCE_HEIGHT(i) #define IMAGE_INSTANCE_PIXMAP_DEPTH(i) ((i)->u.pixmap.depth) #define IMAGE_INSTANCE_PIXMAP_FILENAME(i) ((i)->u.pixmap.filename) #define IMAGE_INSTANCE_PIXMAP_MASK_FILENAME(i) ((i)->u.pixmap.mask_filename) @@ -460,35 +604,88 @@ #define IMAGE_INSTANCE_PIXMAP_FG(i) ((i)->u.pixmap.fg) #define IMAGE_INSTANCE_PIXMAP_BG(i) ((i)->u.pixmap.bg) #define IMAGE_INSTANCE_PIXMAP_AUXDATA(i) ((i)->u.pixmap.auxdata) +#define IMAGE_INSTANCE_PIXMAP_MASK(i) ((i)->u.pixmap.mask) +#define IMAGE_INSTANCE_PIXMAP_SLICE(i) ((i)->u.pixmap.slice) +#define IMAGE_INSTANCE_PIXMAP_MAXSLICE(i) ((i)->u.pixmap.maxslice) +#define IMAGE_INSTANCE_PIXMAP_TIMEOUT(i) ((i)->u.pixmap.timeout) -#define IMAGE_INSTANCE_SUBWINDOW_WIDTH(i) ((i)->u.subwindow.width) -#define IMAGE_INSTANCE_SUBWINDOW_HEIGHT(i) ((i)->u.subwindow.height) +/* Subwindow properties */ +#define IMAGE_INSTANCE_SUBWINDOW_WIDTH(i) \ + IMAGE_INSTANCE_WIDTH(i) +#define IMAGE_INSTANCE_SUBWINDOW_HEIGHT(i) \ + IMAGE_INSTANCE_HEIGHT(i) #define IMAGE_INSTANCE_SUBWINDOW_ID(i) ((i)->u.subwindow.subwindow) #define IMAGE_INSTANCE_SUBWINDOW_FRAME(i) ((i)->u.subwindow.frame) #define IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP(i) \ ((i)->u.subwindow.being_displayed) +#define IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP(i) \ +((i)->u.subwindow.v_resize) +#define IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP(i) \ +((i)->u.subwindow.h_resize) +#define IMAGE_INSTANCE_SUBWINDOW_ORIENT(i) \ +((i)->u.subwindow.orientation) +#define IMAGE_INSTANCE_SUBWINDOW_JUSTIFY(i) \ +((i)->u.subwindow.justification) +/* Widget properties */ #define IMAGE_INSTANCE_WIDGET_WIDTH(i) \ - IMAGE_INSTANCE_SUBWINDOW_WIDTH(i) + IMAGE_INSTANCE_WIDTH(i) #define IMAGE_INSTANCE_WIDGET_HEIGHT(i) \ - IMAGE_INSTANCE_SUBWINDOW_HEIGHT(i) -#define IMAGE_INSTANCE_WIDGET_CALLBACK(i) \ - ((i)->u.subwindow.widget.gui_item.callback) -#define IMAGE_INSTANCE_WIDGET_TYPE(i) ((i)->u.subwindow.widget.type) -#define IMAGE_INSTANCE_WIDGET_PROPS(i) ((i)->u.subwindow.widget.props) -#define IMAGE_INSTANCE_WIDGET_FACE(i) ((i)->u.subwindow.widget.face) -#define IMAGE_INSTANCE_WIDGET_TEXT(i) ((i)->u.subwindow.widget.gui_item.name) -#define IMAGE_INSTANCE_WIDGET_ITEM(i) ((i)->u.subwindow.widget.gui_item) + IMAGE_INSTANCE_HEIGHT(i) +#define IMAGE_INSTANCE_WIDGET_TYPE(i) ((i)->u.subwindow.type) +#define IMAGE_INSTANCE_WIDGET_PROPS(i) ((i)->u.subwindow.props) +#define SET_IMAGE_INSTANCE_WIDGET_FACE(i,f) \ + ((i)->u.subwindow.face = f) +#define IMAGE_INSTANCE_WIDGET_FACE(i) \ + (!NILP ((i)->u.subwindow.face) ? (i)->u.subwindow.face : \ + !NILP (IMAGE_INSTANCE_FACE (i)) ? IMAGE_INSTANCE_FACE (i) : \ + Vwidget_face) +#define IMAGE_INSTANCE_WIDGET_ITEMS(i) ((i)->u.subwindow.items) +#define IMAGE_INSTANCE_WIDGET_ITEM(i) \ +(CONSP (IMAGE_INSTANCE_WIDGET_ITEMS (i)) ? \ +XCAR (IMAGE_INSTANCE_WIDGET_ITEMS (i)) : \ + IMAGE_INSTANCE_WIDGET_ITEMS (i)) +#define IMAGE_INSTANCE_WIDGET_TEXT(i) XGUI_ITEM (IMAGE_INSTANCE_WIDGET_ITEM (i))->name + +/* Layout properties */ +#define IMAGE_INSTANCE_LAYOUT_CHILDREN(i) ((i)->u.subwindow.items) +#define IMAGE_INSTANCE_LAYOUT_BORDER(i) ((i)->u.subwindow.props) #define XIMAGE_INSTANCE_DEVICE(i) \ IMAGE_INSTANCE_DEVICE (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_NAME(i) \ IMAGE_INSTANCE_NAME (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_GLYPH(i) \ + IMAGE_INSTANCE_GLYPH (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_PARENT(i) \ + IMAGE_INSTANCE_PARENT (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_TYPE(i) \ IMAGE_INSTANCE_TYPE (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_XOFFSET(i) \ + IMAGE_INSTANCE_XOFFSET (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_YOFFSET(i) \ + IMAGE_INSTANCE_YOFFSET (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_DIRTYP(i) \ + IMAGE_INSTANCE_DIRTYP (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_NEEDS_LAYOUT(i) \ + IMAGE_INSTANCE_NEEDS_LAYOUT (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_WIDTH(i) \ + IMAGE_INSTANCE_WIDTH (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_HEIGHT(i) \ + IMAGE_INSTANCE_HEIGHT (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_FACE(i) \ + IMAGE_INSTANCE_FACE (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_TEXT_STRING(i) \ IMAGE_INSTANCE_TEXT_STRING (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_TEXT_WIDTH(i) \ + IMAGE_INSTANCE_TEXT_WIDTH (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_TEXT_HEIGHT(i) \ + IMAGE_INSTANCE_TEXT_HEIGHT (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_TEXT_ASCENT(i) \ + IMAGE_INSTANCE_TEXT_ASCENT (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_TEXT_DESCENT(i) \ + IMAGE_INSTANCE_TEXT_DESCENT (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_PIXMAP_WIDTH(i) \ IMAGE_INSTANCE_PIXMAP_WIDTH (XIMAGE_INSTANCE (i)) @@ -508,23 +705,38 @@ IMAGE_INSTANCE_PIXMAP_FG (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_PIXMAP_BG(i) \ IMAGE_INSTANCE_PIXMAP_BG (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_PIXMAP_MASK(i) \ + IMAGE_INSTANCE_PIXMAP_MASK (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_PIXMAP_SLICE(i) \ + IMAGE_INSTANCE_PIXMAP_SLICE (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_PIXMAP_MAXSLICE(i) \ + IMAGE_INSTANCE_PIXMAP_MAXSLICE (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_PIXMAP_TIMEOUT(i) \ + IMAGE_INSTANCE_PIXMAP_TIMEOUT (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_WIDGET_WIDTH(i) \ IMAGE_INSTANCE_WIDGET_WIDTH (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_WIDGET_HEIGHT(i) \ IMAGE_INSTANCE_WIDGET_HEIGHT (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_WIDGET_CALLBACK(i) \ - IMAGE_INSTANCE_WIDGET_CALLBACK (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_WIDGET_TYPE(i) \ IMAGE_INSTANCE_WIDGET_TYPE (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_WIDGET_PROPS(i) \ IMAGE_INSTANCE_WIDGET_PROPS (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_WIDGET_FACE(i) \ IMAGE_INSTANCE_WIDGET_FACE (XIMAGE_INSTANCE (i)) +#define XSET_IMAGE_INSTANCE_WIDGET_FACE(i) \ + SET_IMAGE_INSTANCE_WIDGET_FACE (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_WIDGET_ITEM(i) \ + IMAGE_INSTANCE_WIDGET_ITEM (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_WIDGET_ITEMS(i) \ + IMAGE_INSTANCE_WIDGET_ITEMS (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_WIDGET_TEXT(i) \ IMAGE_INSTANCE_WIDGET_TEXT (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_WIDGET_ITEM(i) \ - IMAGE_INSTANCE_WIDGET_ITEM (XIMAGE_INSTANCE (i)) + +#define XIMAGE_INSTANCE_LAYOUT_CHILDREN(i) \ + IMAGE_INSTANCE_LAYOUT_CHILDREN (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_LAYOUT_BORDER(i) \ + IMAGE_INSTANCE_LAYOUT_BORDER (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_SUBWINDOW_WIDTH(i) \ IMAGE_INSTANCE_SUBWINDOW_WIDTH (XIMAGE_INSTANCE (i)) @@ -536,6 +748,13 @@ IMAGE_INSTANCE_SUBWINDOW_FRAME (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP(i) \ IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_SUBWINDOW_ORIENT(i) \ + IMAGE_INSTANCE_SUBWINDOW_ORIENT (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_SUBWINDOW_JUSTIFY(i) \ + IMAGE_INSTANCE_SUBWINDOW_JUSTIFY (XIMAGE_INSTANCE (i)) + +#define MARK_IMAGE_INSTANCE_CHANGED(i) \ + (IMAGE_INSTANCE_DIRTYP (i) = 1); #ifdef HAVE_XPM Lisp_Object evaluate_xpm_color_symbols (void); @@ -544,7 +763,7 @@ #ifdef HAVE_WINDOW_SYSTEM Lisp_Object bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot, int ok_if_data_invalid); -int read_bitmap_data_from_file (CONST char *filename, unsigned int *width, +int read_bitmap_data_from_file (const char *filename, unsigned int *width, unsigned int *height, unsigned char **datap, int *x_hot, int *y_hot); Lisp_Object xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file, @@ -580,13 +799,16 @@ Lisp_Object plist; void (*after_change) (Lisp_Object glyph, Lisp_Object property, Lisp_Object locale); -}; -DECLARE_LRECORD (glyph, struct Lisp_Glyph); -#define XGLYPH(x) XRECORD (x, glyph, struct Lisp_Glyph) + unsigned int dirty : 1; /* So that we can selectively + redisplay changed glyphs. */ +}; +typedef struct Lisp_Glyph Lisp_Glyph; + +DECLARE_LRECORD (glyph, Lisp_Glyph); +#define XGLYPH(x) XRECORD (x, glyph, Lisp_Glyph) #define XSETGLYPH(x, p) XSETRECORD (x, p, glyph) #define GLYPHP(x) RECORDP (x, glyph) -#define GC_GLYPHP(x) GC_RECORDP (x, glyph) #define CHECK_GLYPH(x) CHECK_RECORD (x, glyph) #define CONCHECK_GLYPH(x) CONCHECK_RECORD (x, glyph) @@ -613,37 +835,34 @@ #define GLYPH_CONTRIB_P(g) ((g)->contrib_p) #define GLYPH_BASELINE(g) ((g)->baseline) #define GLYPH_FACE(g) ((g)->face) +#define GLYPH_DIRTYP(g) ((g)->dirty) #define XGLYPH_TYPE(g) GLYPH_TYPE (XGLYPH (g)) #define XGLYPH_IMAGE(g) GLYPH_IMAGE (XGLYPH (g)) #define XGLYPH_CONTRIB_P(g) GLYPH_CONTRIB_P (XGLYPH (g)) #define XGLYPH_BASELINE(g) GLYPH_BASELINE (XGLYPH (g)) #define XGLYPH_FACE(g) GLYPH_FACE (XGLYPH (g)) +#define XGLYPH_DIRTYP(g) GLYPH_DIRTYP (XGLYPH (g)) -extern Lisp_Object Qxpm, Qxface; +#define MARK_GLYPH_CHANGED(g) (GLYPH_DIRTYP (g) = 1); + +extern Lisp_Object Qxpm, Qxface, Qetched_in, Qetched_out, Qbevel_in, Qbevel_out; extern Lisp_Object Q_data, Q_file, Q_color_symbols, Qconst_glyph_variable; -extern Lisp_Object Qxbm, Qedit, Qgroup, Qlabel, Qcombo, Qscrollbar, Qprogress; +extern Lisp_Object Qxbm, Qedit_field, Qgroup, Qlabel, Qcombo_box, Qscrollbar; +extern Lisp_Object Qtree_view, Qtab_control, Qprogress_gauge, Q_border; extern Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y; extern Lisp_Object Q_foreground, Q_background, Q_face, Q_descriptor, Q_group; extern Lisp_Object Q_width, Q_height, Q_pixel_width, Q_pixel_height, Q_text; extern Lisp_Object Q_items, Q_properties, Q_image, Q_percent, Qimage_conversion_error; +extern Lisp_Object Q_orientation; extern Lisp_Object Vcontinuation_glyph, Vcontrol_arrow_glyph, Vhscroll_glyph; extern Lisp_Object Vinvisible_text_glyph, Voctal_escape_glyph, Vtruncation_glyph; extern Lisp_Object Vxemacs_logo; -unsigned short glyph_width (Lisp_Object glyph, Lisp_Object frame_face, - face_index window_findex, - Lisp_Object window); -unsigned short glyph_ascent (Lisp_Object glyph, Lisp_Object frame_face, - face_index window_findex, - Lisp_Object window); -unsigned short glyph_descent (Lisp_Object glyph, - Lisp_Object frame_face, - face_index window_findex, - Lisp_Object window); -unsigned short glyph_height (Lisp_Object glyph, Lisp_Object frame_face, - face_index window_findex, - Lisp_Object window); +unsigned short glyph_width (Lisp_Object glyph, Lisp_Object domain); +unsigned short glyph_ascent (Lisp_Object glyph, Lisp_Object domain); +unsigned short glyph_descent (Lisp_Object glyph, Lisp_Object domain); +unsigned short glyph_height (Lisp_Object glyph, Lisp_Object domain); Lisp_Object glyph_baseline (Lisp_Object glyph, Lisp_Object domain); Lisp_Object glyph_face (Lisp_Object glyph, Lisp_Object domain); int glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain); @@ -662,11 +881,13 @@ void (*after_change) (Lisp_Object glyph, Lisp_Object property, Lisp_Object locale)); -Lisp_Object widget_face_font_info (Lisp_Object domain, Lisp_Object face, - int *height, int *width); -void widget_text_to_pixel_conversion (Lisp_Object domain, Lisp_Object face, - int th, int tw, - int* height, int* width); +void query_string_geometry ( Lisp_Object string, Lisp_Object face, + unsigned int* width, unsigned int* height, + unsigned int* descent, Lisp_Object domain); +Lisp_Object query_string_font (Lisp_Object string, + Lisp_Object face, Lisp_Object domain); +Lisp_Object add_glyph_animated_timeout (EMACS_INT tickms, Lisp_Object device); +void disable_glyph_animated_timeout (int i); /************************************************************************/ /* Glyph Cachels */ @@ -677,7 +898,14 @@ { Lisp_Object glyph; + unsigned int dirty :1; /* I'm copying faces here. I'm not + sure why we need two dirty + flags. Maybe because an image + instance can be dirty and so we + need to frob this in the same way + as other image instance properties. */ unsigned int updated :1; + unsigned short width; unsigned short ascent; unsigned short descent; @@ -700,11 +928,14 @@ Dynarr_atp (window->glyph_cachels, index)->ascent #define GLYPH_CACHEL_DESCENT(window, index) \ Dynarr_atp (window->glyph_cachels, index)->descent +#define GLYPH_CACHEL_DIRTYP(window, index) \ + Dynarr_atp (window->glyph_cachels, index)->dirty -void mark_glyph_cachels (glyph_cachel_dynarr *elements, - void (*markobj) (Lisp_Object)); +void mark_glyph_cachels (glyph_cachel_dynarr *elements); void mark_glyph_cachels_as_not_updated (struct window *w); +void mark_glyph_cachels_as_clean (struct window *w); void reset_glyph_cachels (struct window *w); +glyph_index get_glyph_cachel_index (struct window *w, Lisp_Object glyph); #ifdef MEMORY_USAGE_STATS int compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels, @@ -729,10 +960,10 @@ struct subwindow_cachel { Lisp_Object subwindow; - int x, y; - int width, height; - int being_displayed; - int updated; + unsigned int x, y; + unsigned int width, height; + unsigned int being_displayed : 1; + unsigned int updated : 1; }; typedef struct @@ -740,12 +971,26 @@ Dynarr_declare (subwindow_cachel); } subwindow_cachel_dynarr; -void mark_subwindow_cachels (subwindow_cachel_dynarr *elements, - void (*markobj) (Lisp_Object)); +void mark_subwindow_cachels (subwindow_cachel_dynarr *elements); void mark_subwindow_cachels_as_not_updated (struct frame *f); void reset_subwindow_cachels (struct frame *f); void unmap_subwindow (Lisp_Object subwindow); -void map_subwindow (Lisp_Object subwindow, int x, int y); +void map_subwindow (Lisp_Object subwindow, int x, int y, + struct display_glyph_area *dga); void update_frame_subwindows (struct frame *f); +int find_matching_subwindow (struct frame* f, int x, int y, int width, int height); +void update_widget (Lisp_Object widget); +void update_subwindow (Lisp_Object subwindow); +Lisp_Object image_instance_parent_glyph (struct Lisp_Image_Instance*); -#endif /* _XEMACS_GLYPHS_H_ */ +struct expose_ignore +{ + unsigned int x, y; + unsigned int width, height; + struct expose_ignore *next; +}; + +int check_for_ignored_expose (struct frame* f, int x, int y, int width, int height); +extern int hold_ignored_expose_registration; + +#endif /* INCLUDED_glyphs_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/gmalloc.c --- a/src/gmalloc.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/gmalloc.c Mon Aug 13 11:13:30 2007 +0200 @@ -25,8 +25,6 @@ # define STDC_HEADERS #endif -#define __const const - /* DO NOT EDIT THIS FILE -- it is automagically generated. -*- C -*- */ /* Bwaa-haa-haa! Not a chance that this is actually true! */ @@ -273,7 +271,7 @@ /* Call WARNFUN with a warning message when memory usage is high. */ extern void memory_warnings __P ((__ptr_t __start, - void (*__warnfun) __P ((__const char *)))); + void (*__warnfun) __P ((const char *)))); #if 0 /* unused in this file, and conflicting prototypes anyway */ @@ -1018,79 +1016,6 @@ #include <malloc.h> #endif -#if 0 /* FSFmacs */ -/* XEmacs requires an ANSI compiler, and memmove() is part of the ANSI- - mandated functions. For losing systems like SunOS 4, we provide - our own memmove(). */ - -#if (defined (MEMMOVE_MISSING) || \ - !defined(_LIBC) && !defined(STDC_HEADERS) && !defined(USG)) - -/* Snarfed directly from Emacs src/dispnew.c: - XXX Should use system bcopy if it handles overlap. */ -#ifndef emacs - -/* Like bcopy except never gets confused by overlap. */ - -static void -safe_bcopy (char *from, char *to, int size) -{ - if (size <= 0 || from == to) - return; - - /* If the source and destination don't overlap, then bcopy can - handle it. If they do overlap, but the destination is lower in - memory than the source, we'll assume bcopy can handle that. */ - if (to < from || from + size <= to) - bcopy (from, to, size); - - /* Otherwise, we'll copy from the end. */ - else - { - char *endf = from + size; - char *endt = to + size; - - /* If TO - FROM is large, then we should break the copy into - nonoverlapping chunks of TO - FROM bytes each. However, if - TO - FROM is small, then the bcopy function call overhead - makes this not worth it. The crossover point could be about - anywhere. Since I don't think the obvious copy loop is too - bad, I'm trying to err in its favor. */ - if (to - from < 64) - { - do - *--endt = *--endf; - while (endf != from); - } - else - { - for (;;) - { - endt -= (to - from); - endf -= (to - from); - - if (endt < to) - break; - - bcopy (endf, endt, to - from); - } - - /* If SIZE wasn't a multiple of TO - FROM, there will be a - little left over. The amount left over is - (endt + (to - from)) - to, which is endt - from. */ - bcopy (from, to, endt - from); - } - } -} -#endif /* Not emacs. */ - -#define memmove(to, from, size) safe_bcopy ((from), (to), (size)) - -#endif - -#endif /* FSFmacs */ - - #ifndef min #define min(A, B) ((A) < (B) ? (A) : (B)) #endif diff -r f4aeb21a5bad -r 74fd4e045ea6 src/gpmevent.c --- a/src/gpmevent.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/gpmevent.c Mon Aug 13 11:13:30 2007 +0200 @@ -1,4 +1,27 @@ -/* William Perry 1997 */ +/* GPM (General purpose mouse) functions + Copyright (C) 1997 William M. Perry <wmperry@gnu.org> + Copyright (C) 1999 Free Software Foundation, Inc. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +/* Authors: William Perry */ #include <config.h> #include "lisp.h" @@ -8,6 +31,10 @@ #include "events.h" #include "events-mod.h" #include "sysdep.h" +#include "commands.h" +#include "lstream.h" +#include "sysproc.h" /* for MAXDESC */ +#include "process.h" #ifdef HAVE_GPM #include "gpmevent.h" @@ -21,94 +48,601 @@ #include <linux/keyboard.h> #endif -int -handle_gpm_read (struct Lisp_Event *event, struct console *con, int fd) +extern int gpm_tried; +extern void *gpm_stack; + +static int (*orig_event_pending_p) (int); +static void (*orig_next_event_cb) (Lisp_Event *); + +static Lisp_Object gpm_event_queue; +static Lisp_Object gpm_event_queue_tail; + +struct __gpm_state { + int gpm_tried; + int gpm_flag; + void *gpm_stack; +}; + +static struct __gpm_state gpm_state_information[MAXDESC]; + +static void +store_gpm_state (int fd) { - Gpm_Event ev; - int modifiers = 0; - int type = -1; - int button = 1; + gpm_state_information[fd].gpm_tried = gpm_tried; + gpm_state_information[fd].gpm_flag = gpm_flag; + gpm_state_information[fd].gpm_stack = gpm_stack; +} + +static void +restore_gpm_state (int fd) +{ + gpm_tried = gpm_state_information[fd].gpm_tried; + gpm_flag = gpm_state_information[fd].gpm_flag; + gpm_stack = gpm_state_information[fd].gpm_stack; + gpm_consolefd = gpm_fd = fd; +} - if (!Gpm_GetEvent(&ev)) - return 0; +static void +clear_gpm_state (int fd) +{ + if (fd >= 0) + { + memset(&gpm_state_information[fd], '\0', sizeof(struct __gpm_state)); + } + gpm_tried = gpm_flag = 1; + gpm_fd = gpm_consolefd = -1; + gpm_stack = NULL; +} + +static int +get_process_infd (Lisp_Process *p) +{ + Lisp_Object instr, outstr; + get_process_streams (p, &instr, &outstr); + assert (!NILP (instr)); + return filedesc_stream_fd (XLSTREAM (instr)); +} - event->timestamp = 0; - event->channel = CONSOLE_SELECTED_FRAME (con); +DEFUN ("receive-gpm-event", Freceive_gpm_event, 0, 2, 0, /* +Run GPM_GetEvent(). +This function is the process handler for the GPM connection. +*/ + (process, string)) +{ + Gpm_Event ev; + int modifiers = 0; + int button = 1; + Lisp_Object fake_event; + Lisp_Event *event = NULL; + struct gcpro gcpro1; + static int num_events; + + CHECK_PROCESS (process); + + restore_gpm_state (get_process_infd (XPROCESS (process))); + + if (!Gpm_GetEvent(&ev)) + { + warn_when_safe (Qnil, Qcritical, "Gpm_GetEvent failed - %d", gpm_fd); + return(Qzero); + } + + GCPRO1(fake_event); - /* Whow, wouldn't named defines be NICE!?!?! */ - modifiers = 0; + num_events++; + + fake_event = Fmake_event (Qnil, Qnil); + event = XEVENT(fake_event); + + event->timestamp = 0; + event->channel = Fselected_frame (Qnil); /* CONSOLE_SELECTED_FRAME (con); */ + + /* Whow, wouldn't named defines be NICE!?!?! */ + modifiers = 0; - if (ev.modifiers & 1) modifiers |= MOD_SHIFT; - if (ev.modifiers & 2) modifiers |= MOD_META; - if (ev.modifiers & 4) modifiers |= MOD_CONTROL; - if (ev.modifiers & 8) modifiers |= MOD_META; + if (ev.modifiers & 1) modifiers |= MOD_SHIFT; + if (ev.modifiers & 2) modifiers |= MOD_META; + if (ev.modifiers & 4) modifiers |= MOD_CONTROL; + if (ev.modifiers & 8) modifiers |= MOD_META; + + if (ev.buttons & GPM_B_LEFT) + { + button = 1; + } + else if (ev.buttons & GPM_B_MIDDLE) + { + button = 2; + } + else if (ev.buttons & GPM_B_RIGHT) + { + button = 3; + } - if (ev.type & GPM_DOWN) - type = GPM_DOWN; - else if (ev.type & GPM_UP) - type = GPM_UP; - else if (ev.type & GPM_MOVE) { - type = GPM_MOVE; - GPM_DRAWPOINTER(&ev); - } + switch (GPM_BARE_EVENTS(ev.type)) { + case GPM_DOWN: + case GPM_UP: + event->event_type = + (ev.type & GPM_DOWN) ? button_press_event : button_release_event; + event->event.button.x = ev.x; + event->event.button.y = ev.y; + event->event.button.button = button; + event->event.button.modifiers = modifiers; + break; + case GPM_MOVE: + case GPM_DRAG: + event->event_type = pointer_motion_event; + event->event.motion.x = ev.x; + event->event.motion.y = ev.y; + event->event.motion.modifiers = modifiers; + default: + /* This will never happen */ + break; + } + + /* Handle the event */ + enqueue_event (fake_event, &gpm_event_queue, &gpm_event_queue_tail); + + UNGCPRO; + + return (Qzero); +} + +static void turn_off_gpm (char *process_name) +{ + Lisp_Object process = Fget_process (build_string (process_name)); + int fd = -1; - if (ev.buttons & GPM_B_LEFT) - button = 1; - else if (ev.buttons & GPM_B_MIDDLE) - button = 2; - else if (ev.buttons & GPM_B_RIGHT) - button = 3; + if (NILP (process)) + { + /* Something happened to our GPM process - fail silently */ + return; + } + + fd = get_process_infd (XPROCESS (process)); + + restore_gpm_state (fd); + + Gpm_Close(); + + clear_gpm_state (fd); + + Fdelete_process (build_string (process_name)); +} + +#ifdef TIOCLINUX +static Lisp_Object +tty_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type) +{ + /* This function can GC */ + struct device *d = decode_device (Qnil); + int fd = DEVICE_INFD (d); + char c = 3; + Lisp_Object output_stream; + Lisp_Object terminal_stream; + Lisp_Object output_string; + struct gcpro gcpro1,gcpro2,gcpro3; + + GCPRO3(output_stream,terminal_stream,output_string); + + /* The ioctl() to paste actually puts things in the input queue of + ** the virtual console, so we need to trap that data, since we are + ** supposed to return the actual string selection from this + ** function. + */ - switch (type) { - case GPM_DOWN: - case GPM_UP: - event->event_type = - type == GPM_DOWN ? button_press_event : button_release_event; - event->event.button.x = ev.x; - event->event.button.y = ev.y; - event->event.button.button = button; - event->event.button.modifiers = modifiers; - break; - case GPM_MOVE: - event->event_type = pointer_motion_event; - event->event.motion.x = ev.x; - event->event.motion.y = ev.y; - event->event.motion.modifiers = modifiers; - default: - return 0; - } - return 1; + /* I really hate doing this, but it doesn't seem to cause any + ** problems, and it makes the Lstream_read stuff further down + ** error out correctly instead of trying to indefinitely read from + ** the console. + ** + ** There is no set_descriptor_blocking() function call, but in my + ** testing under linux, it has not proved fatal to leave the + ** descriptor in non-blocking mode. + ** + ** William Perry Nov 5, 1999 + */ + set_descriptor_non_blocking (fd); + + /* We need two streams, one for reading from the selected device, + ** and one to write the data into. There is no writable version + ** of the lisp-string lstream, so we make do with a resizing + ** buffer stream, and make a string out of it after we are + ** done. + */ + output_stream = make_resizing_buffer_output_stream (); + terminal_stream = make_filedesc_input_stream (fd, 0, -1, LSTR_BLOCKED_OK); + output_string = Qnil; + + /* #### We should arguably use a specbind() and an unwind routine here, + ** #### but I don't care that much right now. + */ + if (NILP (output_stream) || NILP (terminal_stream)) + { + /* Should we signal an error here? */ + goto out; + } + + if (ioctl (fd, TIOCLINUX, &c) < 0) + { + /* Could not get the selection - eek */ + UNGCPRO; + return (Qnil); + } + + while (1) + { + Bufbyte tempbuf[1024]; /* some random amount */ + ssize_t i; + ssize_t size_in_bytes = + Lstream_read (XLSTREAM (terminal_stream), + tempbuf, sizeof (tempbuf)); + + if (size_in_bytes <= 0) + { + /* end of the stream */ + break; + } + + /* convert CR->LF */ + for (i = 0; i < size_in_bytes; i++) + { + if (tempbuf[i] == '\r') + { + tempbuf[i] = '\n'; + } + } + + Lstream_write (XLSTREAM (output_stream), tempbuf, size_in_bytes); + } + + Lstream_flush (XLSTREAM (output_stream)); + + output_string = make_string (resizing_buffer_stream_ptr (XLSTREAM (output_stream)), + Lstream_byte_count (XLSTREAM (output_stream))); + + Lstream_delete (XLSTREAM (output_stream)); + Lstream_delete (XLSTREAM (terminal_stream)); + + out: + UNGCPRO; + return (output_string); } -void -connect_to_gpm (struct console *con) +static Lisp_Object +tty_selection_exists_p (Lisp_Object selection) +{ + return (Qt); +} +#endif /* TIOCLINUX */ + +#if 0 +static Lisp_Object +tty_own_selection (Lisp_Object selection_name, Lisp_Object selection_value) +{ + /* There is no way to do this cleanly - the GPM selection + ** 'protocol' (actually the TIOCLINUX ioctl) requires a start and + ** end position on the _screen_, not a string to stick in there. + ** Lame. + ** + ** William Perry Nov 4, 1999 + */ +} +#endif + +/* This function appears to work once in a blue moon. I'm not sure +** exactly why either. *sigh* +** +** William Perry Nov 4, 1999 +** +** Apparently, this is the way (mouse-position) is supposed to work, +** and I was just expecting something else. (mouse-pixel-position) +** works just fine. +** +** William Perry Nov 7, 1999 +*/ +static int +tty_get_mouse_position (struct device *d, Lisp_Object *frame, int *x, int *y) { - /* Only do this if we are running after dumping and really interactive */ - if (!noninteractive && initialized) { - /* We really only want to do this on a TTY */ - CONSOLE_TTY_MOUSE_FD (con) = -1; - if (EQ (CONSOLE_TYPE (con), Qtty)) { - Gpm_Connect conn; - int rval; + Gpm_Event ev; + int num_buttons; + + memset(&ev,'\0',sizeof(ev)); + + num_buttons = Gpm_GetSnapshot(&ev); + + if (!num_buttons) + { + /* This means there are events pending... */ + + /* #### In theory, we should drain the events pending, stick + ** #### them in the queue, and return the mouse position + ** #### anyway. + */ + return(-1); + } + *x = ev.x; + *y = ev.y; + *frame = DEVICE_SELECTED_FRAME (d); + return (1); +} + +static void +tty_set_mouse_position (struct window *w, int x, int y) +{ + /* + #### I couldn't find any GPM functions that set the mouse position. + #### Mr. Perry had left this function empty; that must be why. + #### karlheg + */ +} + +static int gpm_event_pending_p (int user_p) +{ + Lisp_Object event; - conn.eventMask = GPM_DOWN|GPM_UP|GPM_MOVE; - conn.defaultMask = GPM_MOVE; - conn.minMod = 0; - conn.maxMod = ((1<<KG_SHIFT)|(1<<KG_ALT)|(1<<KG_CTRL)); + EVENT_CHAIN_LOOP (event, gpm_event_queue) + { + if (!user_p || command_event_p (event)) + { + return (1); + } + } + return (orig_event_pending_p (user_p)); +} + +static void gpm_next_event_cb (Lisp_Event *event) +{ + /* #### It would be nice to preserve some sort of ordering of the + ** #### different types of events, but that would be quite a bit + ** #### of work, and would more than likely break the abstraction + ** #### between the other event loops and this one. + */ + + if (!NILP (gpm_event_queue)) + { + Lisp_Object queued_event = dequeue_event (&gpm_event_queue, &gpm_event_queue_tail); + *event = *(XEVENT (queued_event)); + + if (event->event_type == pointer_motion_event) + { + struct device *d = decode_device (event->channel); + int fd = DEVICE_INFD (d); - rval = Gpm_Open (&conn, 0); - switch (rval) { - case -1: /* General failure */ - break; - case -2: /* We are running under an XTerm */ - Gpm_Close(); - break; - default: - set_descriptor_non_blocking (gpm_fd); - CONSOLE_TTY_MOUSE_FD (con) = gpm_fd; - } - } - } + /* Ok, now this is just freaky. Bear with me though. + ** + ** If you run gnuclient and attach to a XEmacs running in + ** X or on another TTY, the mouse cursor does not get + ** drawn correctly. This is because the ioctl() fails + ** with EPERM because the TTY specified is not our + ** controlling terminal. If you are the superuser, it + ** will work just spiffy. The appropriate source file (at + ** least in linux 2.2.x) is + ** .../linux/drivers/char/console.c in the function + ** tioclinux(). The following bit of code is brutal to + ** us: + ** + ** if (current->tty != tty && !suser()) + ** return -EPERM; + ** + ** I even tried setting us as a process leader, removing + ** our controlling terminal, and then using the TIOCSCTTY + ** to set up a new controlling terminal, all with no luck. + ** + ** What is even weirder is if you run XEmacs in a VC, and + ** attach to it from another VC with gnuclient, go back to + ** the original VC and hit a key, the mouse pointer + ** displays (in BOTH VCs), until you hit a key in the + ** second VC, after which it does not display in EITHER + ** VC. Bizarre, no? + ** + ** All I can say is thank god Linux comes with source code + ** or I would have been completely confused. Well, ok, + ** I'm still completely confused. I don't see why they + ** don't just check the permissions on the device + ** (actually, if you have enough access to it to get the + ** console's file descriptor, you should be able to do + ** with it as you wish, but maybe that is just me). + ** + ** William M. Perry - Nov 9, 1999 + */ + + Gpm_DrawPointer (event->event.motion.x,event->event.motion.y, fd); + } + + return; + } + + orig_next_event_cb (event); +} + +static void hook_event_callbacks_once (void) +{ + static int hooker; + + if (!hooker) + { + orig_event_pending_p = event_stream->event_pending_p; + orig_next_event_cb = event_stream->next_event_cb; + event_stream->event_pending_p = gpm_event_pending_p; + event_stream->next_event_cb = gpm_next_event_cb; + hooker = 1; + } } +static void hook_console_methods_once (void) +{ + static int hooker; + + if (!hooker) + { + /* Install the mouse position methods for the TTY console type */ + CONSOLE_HAS_METHOD (tty, get_mouse_position); + CONSOLE_HAS_METHOD (tty, set_mouse_position); + CONSOLE_HAS_METHOD (tty, get_foreign_selection); + CONSOLE_HAS_METHOD (tty, selection_exists_p); +#if 0 + CONSOLE_HAS_METHOD (tty, own_selection); #endif + } +} + +DEFUN ("gpm-enabled-p", Fgpm_enabled_p, 0, 1, 0, /* +Return non-nil if GPM mouse support is currently enabled on DEVICE. +*/ + (device)) +{ + char *console_name = ttyname (DEVICE_INFD (decode_device (device))); + char process_name[1024]; + Lisp_Object proc; + + if (!console_name) + { + return (Qnil); + } + + memset (process_name, '\0', sizeof(process_name)); + snprintf (process_name, sizeof(process_name) - 1, "gpm for %s", console_name); + + proc = Fget_process (build_string (process_name)); + + if (NILP (proc)) + { + return (Qnil); + } + + if (1) /* (PROCESS_LIVE_P (proc)) */ + { + return (Qt); + } + return (Qnil); +} + +DEFUN ("gpm-enable", Fgpm_enable, 0, 2, 0, /* +Toggle accepting of GPM mouse events. +*/ + (device, arg)) +{ + Gpm_Connect conn; + int rval; + Lisp_Object gpm_process; + Lisp_Object gpm_filter; + struct device *d = decode_device (device); + int fd = DEVICE_INFD (d); + char *console_name = ttyname (fd); + char process_name[1024]; + + hook_event_callbacks_once (); + hook_console_methods_once (); + + if (noninteractive) + { + error ("Can't connect to GPM in batch mode."); + } + + if (!console_name) + { + /* Something seriously wrong here... */ + return (Qnil); + } + + memset (process_name, '\0', sizeof(process_name)); + snprintf (process_name, sizeof(process_name) - 1, "gpm for %s", console_name); + + if (NILP (arg)) + { + turn_off_gpm (process_name); + return (Qnil); + } + + /* DANGER DANGER. + ** Though shalt not call (gpm-enable t) after we have already + ** started, or stuff blows up. + */ + if (!NILP (Fgpm_enabled_p (device))) + { + error ("GPM already enabled for this console."); + } + + conn.eventMask = GPM_DOWN|GPM_UP|GPM_MOVE|GPM_DRAG; + conn.defaultMask = GPM_MOVE; + conn.minMod = 0; + conn.maxMod = ((1<<KG_SHIFT)|(1<<KG_ALT)|(1<<KG_CTRL)); + + /* Reset some silly static variables so that multiple Gpm_Open() + ** calls have even a sligh chance of working + */ + gpm_tried = 0; + gpm_flag = 0; + gpm_stack = NULL; + + /* Make sure Gpm_Open() does ioctl() on the correct + ** descriptor, or it can get the wrong terminal sizes, etc. + */ + gpm_consolefd = fd; + + /* We have to pass the virtual console manually, otherwise if you + ** use 'gnuclient -nw' to connect to an XEmacs that is running in + ** X, Gpm_Open() tries to use ttyname(0 | 1 | 2) to find out which + ** console you are using, which is of course not correct for the + ** new tty device. + */ + if (strncmp (console_name, "/dev/tty",8) || !isdigit (console_name[8])) + { + /* Urk, something really wrong */ + return (Qnil); + } + + rval = Gpm_Open (&conn, atoi(console_name + 8)); + + switch (rval) { + case -1: /* General failure */ + break; + case -2: /* We are running under an XTerm */ + Gpm_Close(); + break; + default: + /* Is this really necessary? */ + set_descriptor_non_blocking (gpm_fd); + store_gpm_state (gpm_fd); + gpm_process = connect_to_file_descriptor (build_string (process_name), Qnil, + make_int (gpm_fd), + make_int (gpm_fd)); + + if (!NILP (gpm_process)) + { + rval = 0; + Fprocess_kill_without_query (gpm_process, Qnil); + XSETSUBR (gpm_filter, &SFreceive_gpm_event); + set_process_filter (gpm_process, gpm_filter, 1); + + /* Keep track of the device for later */ + /* Fput (gpm_process, intern ("gpm-device"), device); */ + } + else + { + Gpm_Close(); + rval = -1; + } + } + + return(rval ? Qnil : Qt); +} + +void vars_of_gpmevent (void) +{ + gpm_event_queue = Qnil; + gpm_event_queue_tail = Qnil; + staticpro (&gpm_event_queue); + staticpro (&gpm_event_queue_tail); + pdump_wire (&gpm_event_queue); + pdump_wire (&gpm_event_queue_tail); +} + +void syms_of_gpmevent (void) +{ + DEFSUBR (Freceive_gpm_event); + DEFSUBR (Fgpm_enable); + DEFSUBR (Fgpm_enabled_p); +} + +#endif /* HAVE_GPM */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/gpmevent.h --- a/src/gpmevent.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/gpmevent.h Mon Aug 13 11:13:30 2007 +0200 @@ -1,7 +1,28 @@ -#ifndef _HAVE_GPM -#define _HAVE_GPM +/* GPM (General purpose mouse) support + Copyright (C) 1997 William M. Perry <wmperry@gnu.org> + Copyright (C) 1999 Free Software Foundation, Inc. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. -int handle_gpm_read (struct Lisp_Event *event, struct console *con, int fd); +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifndef INCLUDED_gpmevent_h_ +#define INCLUDED_gpmevent_h_ + +int handle_gpm_read (Lisp_Event *event, struct console *con, int fd); void connect_to_gpm (struct console *con); -#endif +#endif /* INCLUDED_gpmevent_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/gui-msw.c --- a/src/gui-msw.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/gui-msw.c Mon Aug 13 11:13:30 2007 +0200 @@ -27,6 +27,7 @@ #include "frame.h" #include "elhash.h" #include "console-msw.h" +#include "buffer.h" /* * Return value is Qt if we have dispatched the command, @@ -35,18 +36,21 @@ * command if we return nil */ Lisp_Object -mswindows_handle_gui_wm_command (struct frame* f, HWND ctrl, WORD id) +mswindows_handle_gui_wm_command (struct frame* f, HWND ctrl, DWORD id) { /* Try to map the command id through the proper hash table */ Lisp_Object data, fn, arg, frame; + /* #### make_int should assert that --kkm */ + assert (XINT (make_int (id)) == id); + data = Fgethash (make_int (id), FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f), Qnil); if (NILP (data) || UNBOUNDP (data)) return Qnil; - MARK_SUBWINDOWS_CHANGED; + MARK_SUBWINDOWS_STATE_CHANGED; /* Ok, this is our one. Enqueue it. */ get_gui_callback (data, &fn, &arg); XSETFRAME (frame, f); @@ -55,3 +59,97 @@ return Qt; } +DEFUN ("mswindows-shell-execute", Fmswindows_shell_execute, 2, 4, 0, /* +Get Windows to perform OPERATION on DOCUMENT. +This is a wrapper around the ShellExecute system function, which +invokes the application registered to handle OPERATION for DOCUMENT. +OPERATION is typically \"open\", \"print\" or \"explore\" (but can be +nil for the default action), and DOCUMENT is typically the name of a +document file or URL, but can also be a program executable to run or +a directory to open in the Windows Explorer. + +If DOCUMENT is a program executable, PARAMETERS can be a string +containing command line parameters, but otherwise should be nil. + +SHOW-FLAG can be used to control whether the invoked application is hidden +or minimized. If SHOW-FLAG is nil, the application is displayed normally, +otherwise it is an integer representing a ShowWindow flag: + + 0 - start hidden + 1 - start normally + 3 - start maximized + 6 - start minimized +*/ + (operation, document, parameters, show_flag)) +{ + /* Encode filename and current directory. */ + Lisp_Object current_dir = Ffile_name_directory (document); + char* path = NULL; + char* doc = NULL; + Extbyte* f=0; + int ret; + struct gcpro gcpro1, gcpro2; + + CHECK_STRING (document); + + /* Just get the filename if we were given it. */ + document = Ffile_name_nondirectory (document); + + if (NILP (current_dir)) + current_dir = current_buffer->directory; + + GCPRO2 (current_dir, document); + + /* Use mule and cygwin-safe APIs top get at file data. */ + if (STRINGP (current_dir)) + { + TO_EXTERNAL_FORMAT (LISP_STRING, current_dir, + C_STRING_ALLOCA, f, + Qfile_name); +#ifdef __CYGWIN32__ + CYGWIN_WIN32_PATH (f, path); +#else + path = f; +#endif + } + + if (STRINGP (document)) + { + TO_EXTERNAL_FORMAT (LISP_STRING, document, + C_STRING_ALLOCA, f, + Qfile_name); + doc = f; + } + + UNGCPRO; + + ret = (int) ShellExecute (NULL, + (STRINGP (operation) ? + XSTRING_DATA (operation) : NULL), + doc, + (STRINGP (parameters) ? + XSTRING_DATA (parameters) : NULL), + path, + (INTP (show_flag) ? + XINT (show_flag) : SW_SHOWDEFAULT)); + + if (ret > 32) + return Qt; + + if (ret == ERROR_FILE_NOT_FOUND || ret == SE_ERR_FNF) + signal_simple_error ("file not found", document); + else if (ret == ERROR_PATH_NOT_FOUND || ret == SE_ERR_PNF) + signal_simple_error ("path not found", current_dir); + else if (ret == ERROR_BAD_FORMAT) + signal_simple_error ("bad executable format", document); + else + error ("internal error"); + + return Qnil; +} + +void +syms_of_gui_mswindows (void) +{ + DEFSUBR (Fmswindows_shell_execute); +} diff -r f4aeb21a5bad -r 74fd4e045ea6 src/gui-x.c --- a/src/gui-x.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/gui-x.c Mon Aug 13 11:13:30 2007 +0200 @@ -35,11 +35,10 @@ #include "device.h" #include "frame.h" #include "gui.h" +#include "redisplay.h" #include "opaque.h" -#ifdef HAVE_POPUPS Lisp_Object Qmenu_no_selection_hook; -#endif /* we need a unique id for each popup menu, dialog box, and scrollbar */ static unsigned int lwlib_id_tick; @@ -59,36 +58,26 @@ } -#ifdef HAVE_POPUPS - -struct mark_widget_value_closure -{ - void (*markobj) (Lisp_Object); -}; - static int mark_widget_value_mapper (widget_value *val, void *closure) { Lisp_Object markee; - - struct mark_widget_value_closure *cl = - (struct mark_widget_value_closure *) closure; if (val->call_data) { VOID_TO_LISP (markee, val->call_data); - (cl->markobj) (markee); + mark_object (markee); } if (val->accel) { VOID_TO_LISP (markee, val->accel); - (cl->markobj) (markee); + mark_object (markee); } return 0; } static Lisp_Object -mark_popup_data (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_popup_data (Lisp_Object obj) { struct popup_data *data = (struct popup_data *) XPOPUP_DATA (obj); @@ -96,19 +85,14 @@ call-data */ if (data->id) - { - struct mark_widget_value_closure closure; - - closure.markobj = markobj; - lw_map_widget_values (data->id, mark_widget_value_mapper, &closure); - } + lw_map_widget_values (data->id, mark_widget_value_mapper, 0); return data->last_menubar_buffer; } DEFINE_LRECORD_IMPLEMENTATION ("popup-data", popup_data, mark_popup_data, internal_object_printer, - 0, 0, 0, struct popup_data); + 0, 0, 0, 0, struct popup_data); /* This is like FRAME_MENUBAR_DATA (f), but contains an alist of (id . popup-data) for GCPRO'ing the callbacks of the popup menus @@ -123,7 +107,7 @@ Lisp_Object lpdata; assert (NILP (assq_no_quit (lid, Vpopup_callbacks))); - pdata = alloc_lcrecord_type (struct popup_data, lrecord_popup_data); + pdata = alloc_lcrecord_type (struct popup_data, &lrecord_popup_data); pdata->id = id; pdata->last_menubar_buffer = Qnil; pdata->menubar_contents_up_to_date = 0; @@ -159,7 +143,7 @@ widget_value *wv = (widget_value *) get_opaque_ptr (closure); free_opaque_ptr (closure); if (wv) - free_widget_value (wv); + free_widget_value_tree (wv); return Qnil; } @@ -202,6 +186,7 @@ if (! wv) return; if (wv->key) xfree (wv->key); if (wv->value) xfree (wv->value); + if (wv->name) xfree (wv->name); wv->name = wv->value = wv->key = (char *) 0xDEADBEEF; @@ -259,7 +244,10 @@ arg = Qmenu_no_selection_hook; } else - get_gui_callback (data, &fn, &arg); + { + MARK_SUBWINDOWS_STATE_CHANGED; + get_gui_callback (data, &fn, &arg); + } /* This is the timestamp used for asserting focus so we need to get an up-to-date value event if no events has been dispatched to emacs @@ -287,9 +275,9 @@ #endif char * -menu_separator_style (CONST char *s) +menu_separator_style (const char *s) { - CONST char *p; + const char *p; char first; if (!s || s[0] == '\0') @@ -315,151 +303,73 @@ return NULL; } -/* set menu accelerator key to first underlined character in menu name */ - -Lisp_Object -menu_name_to_accelerator (char *name) -{ - while (*name) { - if (*name=='%') { - ++name; - if (!(*name)) - return Qnil; - if (*name=='_' && *(name+1)) - { - int accelerator = (int) (unsigned char) (*(name+1)); - return make_char (tolower (accelerator)); - } - } - ++name; - } - return Qnil; -} /* This does the dirty work. gc_currently_forbidden is 1 when this is called. */ - int -button_item_to_widget_value (Lisp_Object desc, widget_value *wv, +button_item_to_widget_value (Lisp_Object gui_item, widget_value *wv, int allow_text_field_p, int no_keys_p) { /* !!#### This function has not been Mule-ized */ /* This function cannot GC because gc_currently_forbidden is set when it's called */ - Lisp_Object name = Qnil; - Lisp_Object callback = Qnil; - Lisp_Object suffix = Qnil; - Lisp_Object active_p = Qt; - Lisp_Object include_p = Qt; - Lisp_Object selected_p = Qnil; - Lisp_Object keys = Qnil; - Lisp_Object style = Qnil; - Lisp_Object config_tag = Qnil; - Lisp_Object accel = Qnil; - int length = XVECTOR_LENGTH (desc); - Lisp_Object *contents = XVECTOR_DATA (desc); - int plist_p; - int selected_spec = 0, included_spec = 0; - - if (length < 2) - signal_simple_error ("Button descriptors must be at least 2 long", desc); + Lisp_Gui_Item* pgui = 0; - /* length 2: [ "name" callback ] - length 3: [ "name" callback active-p ] - length 4: [ "name" callback active-p suffix ] - or [ "name" callback keyword value ] - length 5+: [ "name" callback [ keyword value ]+ ] - */ - plist_p = (length >= 5 || (length > 2 && KEYWORDP (contents [2]))); - - if (!plist_p && length > 2) - /* the old way */ - { - name = contents [0]; - callback = contents [1]; - active_p = contents [2]; - if (length == 4) - suffix = contents [3]; - } - else + /* degenerate case */ + if (STRINGP (gui_item)) { - /* the new way */ - int i; - if (length & 1) - signal_simple_error ( - "Button descriptor has an odd number of keywords and values", - desc); - - name = contents [0]; - callback = contents [1]; - for (i = 2; i < length;) - { - Lisp_Object key = contents [i++]; - Lisp_Object val = contents [i++]; - if (!KEYWORDP (key)) - signal_simple_error_2 ("Not a keyword", key, desc); + wv->type = TEXT_TYPE; + wv->name = (char *) XSTRING_DATA (gui_item); + wv->name = xstrdup (wv->name); + return 1; + } + else if (!GUI_ITEMP (gui_item)) + signal_simple_error("need a string or a gui_item here", gui_item); - if (EQ (key, Q_active)) active_p = val; - else if (EQ (key, Q_suffix)) suffix = val; - else if (EQ (key, Q_keys)) keys = val; - else if (EQ (key, Q_style)) style = val; - else if (EQ (key, Q_selected)) selected_p = val, selected_spec = 1; - else if (EQ (key, Q_included)) include_p = val, included_spec = 1; - else if (EQ (key, Q_config)) config_tag = val; - else if (EQ (key, Q_accelerator)) - { - if ( SYMBOLP (val) - || CHARP (val)) - accel = val; - else - signal_simple_error ("Bad keyboard accelerator", val); - } - else if (EQ (key, Q_filter)) - signal_simple_error(":filter keyword not permitted on leaf nodes", desc); - else - signal_simple_error_2 ("Unknown menu item keyword", key, desc); - } - } + pgui = XGUI_ITEM (gui_item); + + if (!NILP (pgui->filter)) + signal_simple_error(":filter keyword not permitted on leaf nodes", gui_item); #ifdef HAVE_MENUBARS - if ((!NILP (config_tag) && NILP (Fmemq (config_tag, Vmenubar_configuration))) - || (included_spec && NILP (Feval (include_p)))) + if (!gui_item_included_p (gui_item, Vmenubar_configuration)) { /* the include specification says to ignore this item. */ return 0; } #endif /* HAVE_MENUBARS */ - CHECK_STRING (name); - wv->name = (char *) XSTRING_DATA (name); + CHECK_STRING (pgui->name); + wv->name = (char *) XSTRING_DATA (pgui->name); + wv->name = xstrdup (wv->name); + wv->accel = LISP_TO_VOID (gui_item_accelerator (gui_item)); - if (NILP (accel)) - accel = menu_name_to_accelerator (wv->name); - wv->accel = LISP_TO_VOID (accel); - - if (!NILP (suffix)) + if (!NILP (pgui->suffix)) { - CONST char *const_bogosity; + const char *const_bogosity; Lisp_Object suffix2; /* Shortcut to avoid evaluating suffix each time */ - if (STRINGP (suffix)) - suffix2 = suffix; + if (STRINGP (pgui->suffix)) + suffix2 = pgui->suffix; else { - suffix2 = Feval (suffix); + suffix2 = Feval (pgui->suffix); CHECK_STRING (suffix2); } - GET_C_STRING_FILENAME_DATA_ALLOCA (suffix2, const_bogosity); + TO_EXTERNAL_FORMAT (LISP_STRING, suffix2, + C_STRING_ALLOCA, const_bogosity, + Qfile_name); wv->value = (char *) const_bogosity; wv->value = xstrdup (wv->value); } - wv_set_evalable_slot (wv->enabled, active_p); - wv_set_evalable_slot (wv->selected, selected_p); + wv_set_evalable_slot (wv->enabled, pgui->active); + wv_set_evalable_slot (wv->selected, pgui->selected); - wv->call_data = LISP_TO_VOID (callback); + if (!NILP (pgui->callback)) + wv->call_data = LISP_TO_VOID (pgui->callback); if (no_keys_p #ifdef HAVE_MENUBARS @@ -467,28 +377,28 @@ #endif ) wv->key = 0; - else if (!NILP (keys)) /* Use this string to generate key bindings */ + else if (!NILP (pgui->keys)) /* Use this string to generate key bindings */ { - CHECK_STRING (keys); - keys = Fsubstitute_command_keys (keys); - if (XSTRING_LENGTH (keys) > 0) - wv->key = xstrdup ((char *) XSTRING_DATA (keys)); + CHECK_STRING (pgui->keys); + pgui->keys = Fsubstitute_command_keys (pgui->keys); + if (XSTRING_LENGTH (pgui->keys) > 0) + wv->key = xstrdup ((char *) XSTRING_DATA (pgui->keys)); else wv->key = 0; } - else if (SYMBOLP (callback)) /* Show the binding of this command. */ + else if (SYMBOLP (pgui->callback)) /* Show the binding of this command. */ { char buf [1024]; /* #### Warning, dependency here on current_buffer and point */ - where_is_to_char (callback, buf); + where_is_to_char (pgui->callback, buf); if (buf [0]) wv->key = xstrdup (buf); else wv->key = 0; } - CHECK_SYMBOL (style); - if (NILP (style)) + CHECK_SYMBOL (pgui->style); + if (NILP (pgui->style)) { /* If the callback is nil, treat this item like unselectable text. This way, dashes will show up as a separator. */ @@ -515,13 +425,13 @@ wv->type = BUTTON_TYPE; } } - else if (EQ (style, Qbutton)) + else if (EQ (pgui->style, Qbutton)) wv->type = BUTTON_TYPE; - else if (EQ (style, Qtoggle)) + else if (EQ (pgui->style, Qtoggle)) wv->type = TOGGLE_TYPE; - else if (EQ (style, Qradio)) + else if (EQ (pgui->style, Qradio)) wv->type = RADIO_TYPE; - else if (EQ (style, Qtext)) + else if (EQ (pgui->style, Qtext)) { wv->type = TEXT_TYPE; #if 0 @@ -530,19 +440,123 @@ #endif } else - signal_simple_error_2 ("Unknown style", style, desc); + signal_simple_error_2 ("Unknown style", pgui->style, gui_item); if (!allow_text_field_p && (wv->type == TEXT_TYPE)) - signal_simple_error ("Text field not allowed in this context", desc); + signal_simple_error ("Text field not allowed in this context", gui_item); - if (selected_spec && EQ (style, Qtext)) + if (!NILP (pgui->selected) && EQ (pgui->style, Qtext)) signal_simple_error ( - ":selected only makes sense with :style toggle, radio or button", - desc); + ":selected only makes sense with :style toggle, radio or button", + gui_item); return 1; } -#endif /* HAVE_POPUPS */ +/* parse tree's of gui items into widget_value hierarchies */ +static void gui_item_children_to_widget_values (Lisp_Object items, widget_value* parent); + +static widget_value * +gui_items_to_widget_values_1 (Lisp_Object items, widget_value* parent, + widget_value* prev) +{ + widget_value* wv = 0; + + assert ((parent || prev) && !(parent && prev)); + /* now walk the tree creating widget_values as appropriate */ + if (!CONSP (items)) + { + wv = xmalloc_widget_value(); + if (parent) + parent->contents = wv; + else + prev->next = wv; + if (!button_item_to_widget_value (items, wv, 0, 1)) + { + free_widget_value_tree (wv); + if (parent) + parent->contents = 0; + else + prev->next = 0; + } + else + { + wv->value = xstrdup (wv->name); /* what a mess... */ + } + } + else + { + /* first one is the parent */ + if (CONSP (XCAR (items))) + signal_simple_error ("parent item must not be a list", XCAR (items)); + + if (parent) + wv = gui_items_to_widget_values_1 (XCAR (items), parent, 0); + else + wv = gui_items_to_widget_values_1 (XCAR (items), 0, prev); + /* the rest are the children */ + gui_item_children_to_widget_values (XCDR (items), wv); + } + return wv; +} + +static void +gui_item_children_to_widget_values (Lisp_Object items, widget_value* parent) +{ + widget_value* wv = 0, *prev = 0; + Lisp_Object rest; + CHECK_CONS (items); + + /* first one is master */ + prev = gui_items_to_widget_values_1 (XCAR (items), parent, 0); + /* the rest are the children */ + LIST_LOOP (rest, XCDR (items)) + { + Lisp_Object tab = XCAR (rest); + wv = gui_items_to_widget_values_1 (tab, 0, prev); + prev = wv; + } +} + +widget_value * +gui_items_to_widget_values (Lisp_Object items) +{ + /* !!#### This function has not been Mule-ized */ + /* This function can GC */ + widget_value *control = 0, *tmp = 0; + int count = specpdl_depth (); + Lisp_Object wv_closure; + + if (NILP (items)) + signal_simple_error ("must have some items", items); + + /* Inhibit GC during this conversion. The reasons for this are + the same as in menu_item_descriptor_to_widget_value(); see + the large comment above that function. */ + record_unwind_protect (restore_gc_inhibit, + make_int (gc_currently_forbidden)); + gc_currently_forbidden = 1; + + /* Also make sure that we free the partially-created widget_value + tree on Lisp error. */ + control = xmalloc_widget_value(); + wv_closure = make_opaque_ptr (control); + record_unwind_protect (widget_value_unwind, wv_closure); + + gui_items_to_widget_values_1 (items, control, 0); + + /* mess about getting the data we really want */ + tmp = control; + control = control->contents; + tmp->next = 0; + tmp->contents = 0; + free_widget_value_tree (tmp); + + /* No more need to free the half-filled-in structures. */ + set_opaque_ptr (wv_closure, 0); + unbind_to (count, Qnil); + + return control; +} /* This is a kludge to make sure emacs can only link against a version of lwlib that was compiled in the right way. Emacs references symbols which @@ -593,6 +607,11 @@ #elif defined (HAVE_DIALOGS) MACROLET (lwlib_dialogs_athena); #endif +#ifdef LWLIB_WIDGETS_MOTIF + MACROLET (lwlib_widgets_motif); +#elif defined (HAVE_WIDGETS) + MACROLET (lwlib_widgets_athena); +#endif #undef MACROLET } @@ -600,18 +619,25 @@ void syms_of_gui_x (void) { + defsymbol (&Qmenu_no_selection_hook, "menu-no-selection-hook"); +} + +void +reinit_vars_of_gui_x (void) +{ + lwlib_id_tick = (1<<16); /* start big, to not conflict with Energize */ #ifdef HAVE_POPUPS - defsymbol (&Qmenu_no_selection_hook, "menu-no-selection-hook"); + popup_up_p = 0; #endif + + /* this makes only safe calls as in emacs.c */ + sanity_check_lwlib (); } void vars_of_gui_x (void) { - lwlib_id_tick = (1<<16); /* start big, to not conflict with Energize */ - -#ifdef HAVE_POPUPS - popup_up_p = 0; + reinit_vars_of_gui_x (); Vpopup_callbacks = Qnil; staticpro (&Vpopup_callbacks); @@ -625,8 +651,4 @@ */ ); #endif Fset (Qmenu_no_selection_hook, Qnil); -#endif /* HAVE_POPUPS */ - - /* this makes only safe calls as in emacs.c */ - sanity_check_lwlib (); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/gui-x.h --- a/src/gui-x.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/gui-x.h Mon Aug 13 11:13:30 2007 +0200 @@ -21,8 +21,8 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_XLWLIB_H_ -#define _XEMACS_XLWLIB_H_ +#ifndef INCLUDED_gui_x_h_ +#define INCLUDED_gui_x_h_ #include "../lwlib/lwlib.h" @@ -30,8 +30,6 @@ LWLIB_ID new_lwlib_id (void); -#ifdef HAVE_POPUPS - /* Each frame has one of these, and they are also contained in Vpopup_callbacks. It doesn't really need to be an lrecord (it's not lisp-accessible) @@ -62,7 +60,6 @@ #define XPOPUP_DATA(x) XRECORD (x, popup_data, struct popup_data) #define XSETPOPUP_DATA(x, p) XSETRECORD (x, p, popup_data) #define POPUP_DATAP(x) RECORDP (x, popup_data) -#define GC_POPUP_DATAP(x) GC_RECORDP (x, popup_data) #define CHECK_POPUP_DATA(x) CHECK_RECORD (x, popup_data) void gcpro_popup_callbacks (LWLIB_ID id); @@ -73,10 +70,9 @@ XtPointer client_data); int button_item_to_widget_value (Lisp_Object desc, widget_value *wv, int allow_text_field_p, int no_keys_p); +widget_value * gui_items_to_widget_values (Lisp_Object items); Lisp_Object menu_name_to_accelerator (char *name); -char *menu_separator_style (CONST char *s); +char *menu_separator_style (const char *s); Lisp_Object widget_value_unwind (Lisp_Object closure); -#endif /* HAVE_POPUPS */ - -#endif /* _XEMACS_XLWLIB_H_ */ +#endif /* INCLUDED_gui_x_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/gui.c --- a/src/gui.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/gui.c Mon Aug 13 11:13:30 2007 +0200 @@ -34,6 +34,8 @@ Lisp_Object Q_accelerator, Q_label, Q_callback; Lisp_Object Qtoggle, Qradio; +static Lisp_Object parse_gui_item_tree_list (Lisp_Object list); + #ifdef HAVE_POPUPS /* count of menus/dboxes currently up */ @@ -50,9 +52,9 @@ #endif /* HAVE_POPUPS */ int -separator_string_p (CONST char *s) +separator_string_p (const char *s) { - CONST char *p; + const char *p; char first; if (!s || s[0] == '\0') @@ -74,7 +76,7 @@ if (SYMBOLP (data) || (COMPILED_FUNCTIONP (data) && XCOMPILED_FUNCTION (data)->flags.interactivep) - || (EQ (XCAR (data), Qlambda) + || (CONSP (data) && (EQ (XCAR (data), Qlambda)) && !NILP (Fassq (Qinteractive, Fcdr (Fcdr (data)))))) { *fn = Qcall_interactively; @@ -97,35 +99,17 @@ } /* - * Initialize the gui_item structure by setting all (GC-protected) - * fields to their default values. The defaults are t for :active and - * :included values, and nil for others. - */ -void -gui_item_init (struct gui_item *pgui_item) -{ - pgui_item->name = Qnil; - pgui_item->callback = Qnil; - pgui_item->suffix = Qnil; - pgui_item->active = Qt; - pgui_item->included = Qt; - pgui_item->config = Qnil; - pgui_item->filter = Qnil; - pgui_item->style = Qnil; - pgui_item->selected = Qnil; - pgui_item->keys = Qnil; -} - -/* * Add a value VAL associated with keyword KEY into PGUI_ITEM * structure. If KEY is not a keyword, or is an unknown keyword, then * error is signaled. */ void -gui_item_add_keyval_pair (struct gui_item *pgui_item, - Lisp_Object key, Lisp_Object val, +gui_item_add_keyval_pair (Lisp_Object gui_item, + Lisp_Object key, Lisp_Object val, Error_behavior errb) { + Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); + if (!KEYWORDP (key)) signal_simple_error_2 ("Non-keyword in gui item", key, pgui_item->name); @@ -138,23 +122,64 @@ else if (EQ (key, Q_selected)) pgui_item->selected = val; else if (EQ (key, Q_keys)) pgui_item->keys = val; else if (EQ (key, Q_callback)) pgui_item->callback = val; - else if (EQ (key, Q_key_sequence)) ; /* ignored for FSF compatability */ + else if (EQ (key, Q_key_sequence)) ; /* ignored for FSF compatibility */ else if (EQ (key, Q_label)) ; /* ignored for 21.0 implement in 21.2 */ + else if (EQ (key, Q_accelerator)) + { + if (SYMBOLP (val) || CHARP (val)) + pgui_item->accelerator = val; + else if (ERRB_EQ (errb, ERROR_ME)) + signal_simple_error ("Bad keyboard accelerator", val); + } else if (ERRB_EQ (errb, ERROR_ME)) signal_simple_error_2 ("Unknown keyword in gui item", key, pgui_item->name); } +void +gui_item_init (Lisp_Object gui_item) +{ + Lisp_Gui_Item *lp = XGUI_ITEM (gui_item); + + lp->name = Qnil; + lp->callback = Qnil; + lp->suffix = Qnil; + lp->active = Qt; + lp->included = Qt; + lp->config = Qnil; + lp->filter = Qnil; + lp->style = Qnil; + lp->selected = Qnil; + lp->keys = Qnil; + lp->accelerator = Qnil; +} + +Lisp_Object +allocate_gui_item (void) +{ + Lisp_Gui_Item *lp = alloc_lcrecord_type (Lisp_Gui_Item, &lrecord_gui_item); + Lisp_Object val; + + zero_lcrecord (lp); + XSETGUI_ITEM (val, lp); + + gui_item_init (val); + + return val; +} + /* * ITEM is a lisp vector, describing a menu item or a button. The * function extracts the description of the item into the PGUI_ITEM * structure. */ -static void -gui_parse_item_keywords_internal (Lisp_Object item, struct gui_item *pgui_item, - Error_behavior errb) +static Lisp_Object +make_gui_item_from_keywords_internal (Lisp_Object item, + Error_behavior errb) { int length, plist_p, start; Lisp_Object *contents; + Lisp_Object gui_item = allocate_gui_item (); + Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); CHECK_VECTOR (item); length = XVECTOR_LENGTH (item); @@ -181,7 +206,7 @@ pgui_item->callback = contents [1]; start = 2; } - else + else start =1; if (!plist_p && length > 2) @@ -204,21 +229,50 @@ { Lisp_Object key = contents [i++]; Lisp_Object val = contents [i++]; - gui_item_add_keyval_pair (pgui_item, key, val, errb); + gui_item_add_keyval_pair (gui_item, key, val, errb); } } + return gui_item; +} + +Lisp_Object +gui_parse_item_keywords (Lisp_Object item) +{ + return make_gui_item_from_keywords_internal (item, ERROR_ME); +} + +Lisp_Object +gui_parse_item_keywords_no_errors (Lisp_Object item) +{ + return make_gui_item_from_keywords_internal (item, ERROR_ME_NOT); } +/* convert a gui item into plist properties */ void -gui_parse_item_keywords (Lisp_Object item, struct gui_item *pgui_item) +gui_add_item_keywords_to_plist (Lisp_Object plist, Lisp_Object gui_item) { - gui_parse_item_keywords_internal (item, pgui_item, ERROR_ME); -} + Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); -void -gui_parse_item_keywords_no_errors (Lisp_Object item, struct gui_item *pgui_item) -{ - gui_parse_item_keywords_internal (item, pgui_item, ERROR_ME_NOT); + if (!NILP (pgui_item->callback)) + Fplist_put (plist, Q_callback, pgui_item->callback); + if (!NILP (pgui_item->suffix)) + Fplist_put (plist, Q_suffix, pgui_item->suffix); + if (!NILP (pgui_item->active)) + Fplist_put (plist, Q_active, pgui_item->active); + if (!NILP (pgui_item->included)) + Fplist_put (plist, Q_included, pgui_item->included); + if (!NILP (pgui_item->config)) + Fplist_put (plist, Q_config, pgui_item->config); + if (!NILP (pgui_item->filter)) + Fplist_put (plist, Q_filter, pgui_item->filter); + if (!NILP (pgui_item->style)) + Fplist_put (plist, Q_style, pgui_item->style); + if (!NILP (pgui_item->selected)) + Fplist_put (plist, Q_selected, pgui_item->selected); + if (!NILP (pgui_item->keys)) + Fplist_put (plist, Q_keys, pgui_item->keys); + if (!NILP (pgui_item->accelerator)) + Fplist_put (plist, Q_accelerator, pgui_item->accelerator); } /* @@ -226,13 +280,48 @@ * if any */ int -gui_item_active_p (CONST struct gui_item *pgui_item) +gui_item_active_p (Lisp_Object gui_item) { /* This function can call lisp */ /* Shortcut to avoid evaluating Qt each time */ - return (EQ (pgui_item->active, Qt) - || !NILP (Feval (pgui_item->active))); + return (EQ (XGUI_ITEM (gui_item)->active, Qt) + || !NILP (Feval (XGUI_ITEM (gui_item)->active))); +} + +/* set menu accelerator key to first underlined character in menu name */ +Lisp_Object +gui_item_accelerator (Lisp_Object gui_item) +{ + Lisp_Gui_Item* pgui = XGUI_ITEM (gui_item); + + if (!NILP (pgui->accelerator)) + return pgui->accelerator; + + else + return gui_name_accelerator (pgui->name); +} + +Lisp_Object +gui_name_accelerator (Lisp_Object nm) +{ + /* !!#### This function has not been Mule-ized */ + char* name = (char*)XSTRING_DATA (nm); + + while (*name) { + if (*name=='%') { + ++name; + if (!(*name)) + return Qnil; + if (*name=='_' && *(name+1)) + { + int accelerator = (int) (unsigned char) (*(name+1)); + return make_char (tolower (accelerator)); + } + } + ++name; + } + return Qnil; } /* @@ -240,13 +329,13 @@ * if any */ int -gui_item_selected_p (CONST struct gui_item *pgui_item) +gui_item_selected_p (Lisp_Object gui_item) { /* This function can call lisp */ /* Shortcut to avoid evaluating Qt each time */ - return (EQ (pgui_item->selected, Qt) - || !NILP (Feval (pgui_item->selected))); + return (EQ (XGUI_ITEM (gui_item)->selected, Qt) + || !NILP (Feval (XGUI_ITEM (gui_item)->selected))); } /* @@ -255,9 +344,10 @@ * configuration variable */ int -gui_item_included_p (CONST struct gui_item *pgui_item, Lisp_Object conflist) +gui_item_included_p (Lisp_Object gui_item, Lisp_Object conflist) { /* This function can call lisp */ + Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); /* Evaluate :included first. Shortcut to avoid evaluating Qt each time */ if (!EQ (pgui_item->included, Qt) @@ -289,11 +379,13 @@ * buffer. */ unsigned int -gui_item_display_flush_left (CONST struct gui_item *pgui_item, +gui_item_display_flush_left (Lisp_Object gui_item, char* buf, Bytecount buf_len) { + /* This function can call lisp */ char *p = buf; Bytecount len; + Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); /* Copy item name first */ CHECK_STRING (pgui_item->name); @@ -336,14 +428,17 @@ * buffer. */ unsigned int -gui_item_display_flush_right (CONST struct gui_item *pgui_item, +gui_item_display_flush_right (Lisp_Object gui_item, char* buf, Bytecount buf_len) { + Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); *buf = 0; +#ifdef HAVE_MENUBARS /* Have keys? */ if (!menubar_show_keybindings) return 0; +#endif /* Try :keys first */ if (!NILP (pgui_item->keys)) @@ -351,7 +446,7 @@ CHECK_STRING (pgui_item->keys); if (XSTRING_LENGTH (pgui_item->keys) > buf_len) signal_too_long_error (pgui_item->name); - strcpy (buf, (CONST char *) XSTRING_DATA (pgui_item->keys)); + strcpy (buf, (const char *) XSTRING_DATA (pgui_item->keys)); return XSTRING_LENGTH (pgui_item->keys); } @@ -374,27 +469,48 @@ } #endif /* HAVE_WINDOW_SYSTEM */ -Lisp_Object -mark_gui_item (struct gui_item* p, void (*markobj) (Lisp_Object)) +static Lisp_Object +mark_gui_item (Lisp_Object obj) { - markobj (p->name); - markobj (p->callback); - markobj (p->suffix); - markobj (p->active); - markobj (p->included); - markobj (p->config); - markobj (p->filter); - markobj (p->style); - markobj (p->selected); - markobj (p->keys); + Lisp_Gui_Item *p = XGUI_ITEM (obj); + + mark_object (p->name); + mark_object (p->callback); + mark_object (p->config); + mark_object (p->suffix); + mark_object (p->active); + mark_object (p->included); + mark_object (p->config); + mark_object (p->filter); + mark_object (p->style); + mark_object (p->selected); + mark_object (p->keys); + mark_object (p->accelerator); return Qnil; } +static unsigned long +gui_item_hash (Lisp_Object obj, int depth) +{ + Lisp_Gui_Item *p = XGUI_ITEM (obj); + + return HASH2 (HASH5 (internal_hash (p->name, depth + 1), + internal_hash (p->callback, depth + 1), + internal_hash (p->suffix, depth + 1), + internal_hash (p->active, depth + 1), + internal_hash (p->included, depth + 1)), + HASH5 (internal_hash (p->config, depth + 1), + internal_hash (p->filter, depth + 1), + internal_hash (p->style, depth + 1), + internal_hash (p->selected, depth + 1), + internal_hash (p->keys, depth + 1))); +} + int -gui_item_hash (Lisp_Object hashtable, struct gui_item* g, int slot) +gui_item_id_hash (Lisp_Object hashtable, Lisp_Object gitem, int slot) { - int hashid = HASH2 (internal_hash (g->callback, 0), internal_hash (g->name, 0)); + int hashid = gui_item_hash (gitem, 0); int id = GUI_ITEM_ID_BITS (hashid, slot); while (!NILP (Fgethash (make_int (id), hashtable, Qnil))) @@ -404,6 +520,108 @@ return id; } +static int +gui_item_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) +{ + Lisp_Gui_Item *p1 = XGUI_ITEM (obj1); + Lisp_Gui_Item *p2 = XGUI_ITEM (obj2); + + if (!(internal_equal (p1->name, p2->name, depth + 1) + && + internal_equal (p1->callback, p2->callback, depth + 1) + && + EQ (p1->suffix, p2->suffix) + && + EQ (p1->active, p2->active) + && + EQ (p1->included, p2->included) + && + EQ (p1->config, p2->config) + && + EQ (p1->filter, p2->filter) + && + EQ (p1->style, p2->style) + && + EQ (p1->selected, p2->selected) + && + EQ (p1->accelerator, p2->accelerator) + && + EQ (p1->keys, p2->keys))) + return 0; + return 1; +} + +static void +print_gui_item (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) +{ + Lisp_Gui_Item *g = XGUI_ITEM (obj); + char buf[20]; + + if (print_readably) + error ("printing unreadable object #<gui-item 0x%x>", g->header.uid); + + write_c_string ("#<gui-item ", printcharfun); + sprintf (buf, "0x%x>", g->header.uid); + write_c_string (buf, printcharfun); +} + +/* parse a glyph descriptor into a tree of gui items. + + The gui_item slot of an image instance can be a single item or an + arbitrarily nested hierarchy of item lists. */ + +static Lisp_Object parse_gui_item_tree_item (Lisp_Object entry) +{ + Lisp_Object ret = entry; + if (VECTORP (entry)) + { + ret = gui_parse_item_keywords_no_errors (entry); + } + else if (STRINGP (entry)) + { + CHECK_STRING (entry); + } + else + signal_simple_error ("item must be a vector or a string", entry); + + return ret; +} + +Lisp_Object parse_gui_item_tree_children (Lisp_Object list) +{ + Lisp_Object rest, ret = Qnil; + CHECK_CONS (list); + /* recursively add items to the tree view */ + LIST_LOOP (rest, list) + { + Lisp_Object sub; + if (CONSP (XCAR (rest))) + sub = parse_gui_item_tree_list (XCAR (rest)); + else + sub = parse_gui_item_tree_item (XCAR (rest)); + + ret = Fcons (sub, ret); + } + /* make the order the same as the items we have parsed */ + return Fnreverse (ret); +} + +static Lisp_Object parse_gui_item_tree_list (Lisp_Object list) +{ + Lisp_Object ret; + CHECK_CONS (list); + /* first one can never be a list */ + ret = parse_gui_item_tree_item (XCAR (list)); + return Fcons (ret, parse_gui_item_tree_children (XCDR (list))); +} + +DEFINE_LRECORD_IMPLEMENTATION ("gui-item", gui_item, + mark_gui_item, print_gui_item, + 0, gui_item_equal, + gui_item_hash, + 0, + Lisp_Gui_Item); + void syms_of_gui (void) { diff -r f4aeb21a5bad -r 74fd4e045ea6 src/gui.h --- a/src/gui.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/gui.h Mon Aug 13 11:13:30 2007 +0200 @@ -24,18 +24,23 @@ /* Written by kkm on 12/24/97 */ -#ifndef _XEMACS_GUI_H_ -#define _XEMACS_GUI_H_ +#ifndef INCLUDED_gui_h_ +#define INCLUDED_gui_h_ -int separator_string_p (CONST char *s); +int separator_string_p (const char *s); void get_gui_callback (Lisp_Object, Lisp_Object *, Lisp_Object *); extern int popup_up_p; +/************************************************************************/ +/* Image Instance Object */ +/************************************************************************/ + /* This structure describes gui button, menu item or submenu properties */ -struct gui_item +struct Lisp_Gui_Item { + struct lcrecord_header header; Lisp_Object name; /* String */ Lisp_Object callback; /* Symbol or form */ Lisp_Object suffix; /* String */ @@ -46,50 +51,47 @@ Lisp_Object style; /* Symbol */ Lisp_Object selected; /* Form */ Lisp_Object keys; /* String */ + Lisp_Object accelerator; /* Char or Symbol */ }; -#define GUI_ITEM_LAST_GCPROED keys -#define GUI_ITEM_GCPRO_COUNT \ - (slot_offset(struct gui_item, GUI_ITEM_LAST_GCPROED) / sizeof(Lisp_Object) + 1) -/* - * gui_item is a struct containing a bunch of Lisp_Object - * members. We need to GC-protect all the member slots. - * Rather than build a long chain of individual gcpro structs - * that protect the slots individually, we protect all the - * member slots by pretending the struct is an array. ANSI C - * requires this hack to work, ugly though it is. - */ -#define GCPRO_GUI_ITEM(pgui_item) \ - do { \ - Lisp_Object *gui_item_array = (Lisp_Object *) pgui_item; \ - GCPRO1 (gui_item_array[0]); \ - gcpro1.nvars = GUI_ITEM_GCPRO_COUNT; \ - } while (0); +DECLARE_LRECORD (gui_item, Lisp_Gui_Item); +#define XGUI_ITEM(x) XRECORD (x, gui_item, Lisp_Gui_Item) +#define XSETGUI_ITEM(x, p) XSETRECORD (x, p, gui_item) +#define GUI_ITEMP(x) RECORDP (x, gui_item) +#define CHECK_GUI_ITEM(x) CHECK_RECORD (x, gui_item) +#define CONCHECK_GUI_ITEM(x) CONCHECK_RECORD (x, gui_item) extern Lisp_Object Q_accelerator, Q_active, Q_config, Q_filter, Q_included; extern Lisp_Object Q_keys, Q_selected, Q_suffix, Qradio, Qtoggle; extern Lisp_Object Q_key_sequence, Q_label, Q_callback; -void gui_item_init (struct gui_item *pgui_item); -void gui_item_add_keyval_pair (struct gui_item *pgui_item, +void gui_item_add_keyval_pair (Lisp_Object, Lisp_Object key, Lisp_Object val, Error_behavior errb); -void gui_parse_item_keywords (Lisp_Object item, struct gui_item *pgui_item); -void gui_parse_item_keywords_no_errors (Lisp_Object item, struct gui_item *pgui_item); -int gui_item_active_p (CONST struct gui_item *pgui_item); -int gui_item_selected_p (CONST struct gui_item *pgui_item); -int gui_item_included_p (CONST struct gui_item *pgui_item, Lisp_Object into); -int gui_item_hash (Lisp_Object, struct gui_item*, int); -Lisp_Object mark_gui_item (struct gui_item* p, void (*markobj) (Lisp_Object)); -unsigned int gui_item_display_flush_left (CONST struct gui_item *pgui_item, +Lisp_Object gui_parse_item_keywords (Lisp_Object item); +Lisp_Object gui_parse_item_keywords_no_errors (Lisp_Object item); +void gui_add_item_keywords_to_plist (Lisp_Object plist, Lisp_Object gui_item); +int gui_item_active_p (Lisp_Object); +int gui_item_selected_p (Lisp_Object); +int gui_item_included_p (Lisp_Object, Lisp_Object into); +Lisp_Object gui_item_accelerator (Lisp_Object gui_item); +Lisp_Object gui_name_accelerator (Lisp_Object name); +int gui_item_id_hash (Lisp_Object, Lisp_Object gui_item, int); +unsigned int gui_item_display_flush_left (Lisp_Object pgui_item, char* buf, Bytecount buf_len); -unsigned int gui_item_display_flush_right (CONST struct gui_item *pgui_item, +unsigned int gui_item_display_flush_right (Lisp_Object gui_item, char* buf, Bytecount buf_len); +Lisp_Object allocate_gui_item (void); +void gui_item_init (Lisp_Object gui_item); +Lisp_Object parse_gui_item_tree_children (Lisp_Object list); + /* this is mswindows biased but reasonably safe I think */ #define GUI_ITEM_ID_SLOTS 8 #define GUI_ITEM_ID_MIN(s) (s * 0x2000) #define GUI_ITEM_ID_MAX(s) (0x1FFF + GUI_ITEM_ID_MIN (s)) #define GUI_ITEM_ID_BITS(x,s) (((x) & 0x1FFF) + GUI_ITEM_ID_MIN (s)) -#endif /* _XEMACS_GUI_H_ */ +#define MAX_MENUITEM_LENGTH 128 + +#endif /* INCLUDED_gui_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/gutter.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/gutter.c Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,1202 @@ +/* Gutter implementation. + Copyright (C) 1999 Andy Piper. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +/* written by Andy Piper <andy@xemacs.org> with specifiers partially + ripped-off from toolbar.c */ + +#include <config.h> +#include "lisp.h" + +#include "buffer.h" +#include "frame.h" +#include "device.h" +#include "faces.h" +#include "glyphs.h" +#include "redisplay.h" +#include "window.h" +#include "gutter.h" + +Lisp_Object Vgutter[4]; +Lisp_Object Vgutter_size[4]; +Lisp_Object Vgutter_visible_p[4]; +Lisp_Object Vgutter_border_width[4]; + +Lisp_Object Vdefault_gutter, Vdefault_gutter_visible_p; +Lisp_Object Vdefault_gutter_width, Vdefault_gutter_height; +Lisp_Object Vdefault_gutter_border_width; + +Lisp_Object Vdefault_gutter_position; + +Lisp_Object Qgutter_size; + +#define SET_GUTTER_WAS_VISIBLE_FLAG(frame, pos, flag) \ + do { \ + switch (pos) \ + { \ + case TOP_GUTTER: \ + (frame)->top_gutter_was_visible = flag; \ + break; \ + case BOTTOM_GUTTER: \ + (frame)->bottom_gutter_was_visible = flag; \ + break; \ + case LEFT_GUTTER: \ + (frame)->left_gutter_was_visible = flag; \ + break; \ + case RIGHT_GUTTER: \ + (frame)->right_gutter_was_visible = flag; \ + break; \ + default: \ + abort (); \ + } \ + } while (0) + +static int gutter_was_visible (struct frame* frame, enum gutter_pos pos) +{ + switch (pos) + { + case TOP_GUTTER: + return frame->top_gutter_was_visible; + case BOTTOM_GUTTER: + return frame->bottom_gutter_was_visible; + case LEFT_GUTTER: + return frame->left_gutter_was_visible; + case RIGHT_GUTTER: + return frame->right_gutter_was_visible; + default: + abort (); + } +} + +static Lisp_Object +frame_topmost_window (struct frame *f) +{ + Lisp_Object w = FRAME_ROOT_WINDOW (f); + + do { + while (!NILP (XWINDOW (w)->vchild)) + { + w = XWINDOW (w)->vchild; + } + } while (!NILP (XWINDOW (w)->hchild) && !NILP (w = XWINDOW (w)->hchild)); + + return w; +} + +static Lisp_Object +frame_bottommost_window (struct frame *f) +{ + Lisp_Object w = FRAME_ROOT_WINDOW (f); + + do { + while (!NILP (XWINDOW (w)->vchild)) + { + w = XWINDOW (w)->vchild; + while (!NILP (XWINDOW (w)->next)) + { + w = XWINDOW (w)->next; + } + } + } while (!NILP (XWINDOW (w)->hchild) && !NILP (w = XWINDOW (w)->hchild)); + + return w; +} + +#if 0 +static Lisp_Object +frame_leftmost_window (struct frame *f) +{ + Lisp_Object w = FRAME_ROOT_WINDOW (f); + + do { + while (!NILP (XWINDOW (w)->hchild)) + { + w = XWINDOW (w)->hchild; + } + } while (!NILP (XWINDOW (w)->vchild) && !NILP (w = XWINDOW (w)->vchild)); + + return w; +} + +static Lisp_Object +frame_rightmost_window (struct frame *f) +{ + Lisp_Object w = FRAME_ROOT_WINDOW (f); + + do { + while (!NILP (XWINDOW (w)->hchild)) + { + w = XWINDOW (w)->hchild; + while (!NILP (XWINDOW (w)->next)) + { + w = XWINDOW (w)->next; + } + } + } while (!NILP (XWINDOW (w)->vchild) && !NILP (w = XWINDOW (w)->vchild)); + return w; +} +#endif + +/* calculate the coordinates of a gutter for the current frame and + selected window. we have to be careful in calculating this as we + need to use *two* windows, the currently selected window will give + us the actual height, width and contents of the gutter, but if we + use this for calculating the gutter positions we run into trouble + if it is not the window nearest the gutter. Instead we predetermine + the nearest window and then use that.*/ +static void +get_gutter_coords (struct frame *f, enum gutter_pos pos, int *x, int *y, + int *width, int *height) +{ + struct window + * top = XWINDOW (frame_topmost_window (f)), + * bot = XWINDOW (frame_bottommost_window (f)); + /* The top and bottom gutters take precedence over the left and + right. */ + switch (pos) + { + case TOP_GUTTER: + *x = FRAME_LEFT_BORDER_END (f); + *y = FRAME_TOP_BORDER_END (f); + *width = FRAME_RIGHT_BORDER_START (f) + - FRAME_LEFT_BORDER_END (f); + *height = FRAME_TOP_GUTTER_BOUNDS (f); + break; + + case BOTTOM_GUTTER: + *x = FRAME_LEFT_BORDER_END (f); + *y = WINDOW_BOTTOM (bot) + - FRAME_BOTTOM_GUTTER_BOUNDS (f); + *width = FRAME_RIGHT_BORDER_START (f) + - FRAME_LEFT_BORDER_END (f); + *height = FRAME_BOTTOM_GUTTER_BOUNDS (f); + break; + + case LEFT_GUTTER: + *x = FRAME_LEFT_BORDER_END (f); + *y = WINDOW_TEXT_TOP (top); + *width = FRAME_LEFT_GUTTER_BOUNDS (f); + *height = WINDOW_BOTTOM (bot) + - (WINDOW_TEXT_TOP (top) + + FRAME_BOTTOM_GUTTER_BOUNDS (f)); + break; + + case RIGHT_GUTTER: + *x = FRAME_RIGHT_BORDER_START (f) + - FRAME_RIGHT_GUTTER_BOUNDS (f); + *y = WINDOW_TEXT_TOP (top); + *width = FRAME_RIGHT_GUTTER_BOUNDS (f); + *height = WINDOW_BOTTOM (bot) + - (WINDOW_TEXT_TOP (top) + + FRAME_BOTTOM_GUTTER_BOUNDS (f)); + break; + + default: + abort (); + } +} + +static void +output_gutter (struct frame *f, enum gutter_pos pos) +{ + Lisp_Object frame; + Lisp_Object window = FRAME_LAST_NONMINIBUF_WINDOW (f); + struct device *d = XDEVICE (f->device); + struct window* w = XWINDOW (window); + int x, y, width, height, ypos; + int line, border_width; + face_index findex; + display_line_dynarr* ddla, *cdla; + struct display_line *dl; + int cdla_len; + + if (!WINDOW_LIVE_P (w)) + return; + + border_width = FRAME_GUTTER_BORDER_WIDTH (f, pos); + findex = get_builtin_face_cache_index (w, Vgui_element_face); + + if (!f->current_display_lines) + f->current_display_lines = Dynarr_new (display_line); + if (!f->desired_display_lines) + f->desired_display_lines = Dynarr_new (display_line); + + ddla = f->desired_display_lines; + cdla = f->current_display_lines; + cdla_len = Dynarr_length (cdla); + + XSETFRAME (frame, f); + + get_gutter_coords (f, pos, &x, &y, &width, &height); + /* generate some display lines */ + generate_displayable_area (w, WINDOW_GUTTER (w, pos), + x + border_width, y + border_width, + width - 2 * border_width, + height - 2 * border_width, ddla, 0, findex); + /* Output each line. */ + for (line = 0; line < Dynarr_length (ddla); line++) + { + output_display_line (w, cdla, ddla, line, -1, -1); + } + + /* If the number of display lines has shrunk, adjust. */ + if (cdla_len > Dynarr_length (ddla)) + { + Dynarr_length (cdla) = Dynarr_length (ddla); + } + + /* grab coordinates of last line and blank after it. */ + dl = Dynarr_atp (ddla, Dynarr_length (ddla) - 1); + ypos = dl->ypos + dl->descent - dl->clip; + redisplay_clear_region (window, findex, x + border_width , ypos, + width - 2 * border_width, height - (ypos - y) - border_width); + /* bevel the gutter area if so desired */ + if (border_width != 0) + { + MAYBE_DEVMETH (d, bevel_area, + (w, findex, x, y, width, height, border_width, + EDGE_ALL, EDGE_BEVEL_OUT)); + } +} + +/* sizing gutters is a pain so we try and help the user by detemining + what height will accommodate all lines. This is useless on left and + right gutters as we always have a maximal number of lines. */ +static Lisp_Object +calculate_gutter_size (struct window *w, enum gutter_pos pos) +{ + struct frame* f = XFRAME (WINDOW_FRAME (w)); + int ypos; + display_line_dynarr* ddla; + struct display_line *dl; + + /* we cannot autodetect gutter sizes for the left and right as there + is no reasonable metric to use */ + assert (pos == TOP_GUTTER || pos == BOTTOM_GUTTER); + /* degenerate case */ + if (NILP (WINDOW_GUTTER (w, pos)) + || + !FRAME_VISIBLE_P (f) + || + NILP (w->buffer)) + return Qnil; + + ddla = Dynarr_new (display_line); + /* generate some display lines */ + generate_displayable_area (w, WINDOW_GUTTER (w, pos), + FRAME_LEFT_BORDER_END (f), + 0, + FRAME_RIGHT_BORDER_START (f) + - FRAME_LEFT_BORDER_END (f), + 200, + ddla, 0, 0); + /* grab coordinates of last line */ + if (Dynarr_length (ddla)) + { + dl = Dynarr_atp (ddla, Dynarr_length (ddla) - 1); + ypos = dl->ypos + dl->descent - dl->clip; + free_display_lines (ddla); + return make_int (ypos); + } + else + { + free_display_lines (ddla); + return Qnil; + } +} + +static void +clear_gutter (struct frame *f, enum gutter_pos pos) +{ + int x, y, width, height; + Lisp_Object window = FRAME_LAST_NONMINIBUF_WINDOW (f); + face_index findex = get_builtin_face_cache_index (XWINDOW (window), + Vgui_element_face); + get_gutter_coords (f, pos, &x, &y, &width, &height); + + SET_GUTTER_WAS_VISIBLE_FLAG (f, pos, 0); + + redisplay_clear_region (window, findex, x, y, width, height); +} + +void +update_frame_gutters (struct frame *f) +{ + if (f->gutter_changed || f->clear || + f->glyphs_changed || f->subwindows_changed || + f->windows_changed || f->windows_structure_changed || + f->extents_changed || f->faces_changed) + { + enum gutter_pos pos; + + /* We don't actually care about these when outputting the gutter + so locally disable them. */ + int local_clip_changed = f->clip_changed; + int local_buffers_changed = f->buffers_changed; + f->clip_changed = 0; + f->buffers_changed = 0; + + /* and output */ + GUTTER_POS_LOOP (pos) + { + if (FRAME_GUTTER_VISIBLE (f, pos)) + output_gutter (f, pos); + else if (gutter_was_visible (f, pos)) + clear_gutter (f, pos); + } + f->clip_changed = local_clip_changed; + f->buffers_changed = local_buffers_changed; + f->gutter_changed = 0; + } +} + +void +reset_gutter_display_lines (struct frame* f) +{ + if (f->current_display_lines) + Dynarr_reset (f->current_display_lines); +} + +static void +redraw_exposed_gutter (struct frame *f, enum gutter_pos pos, int x, int y, + int width, int height) +{ + int g_x, g_y, g_width, g_height; + + get_gutter_coords (f, pos, &g_x, &g_y, &g_width, &g_height); + + if (((y + height) < g_y) || (y > (g_y + g_height)) || !height || !width || !g_height || !g_width) + return; + if (((x + width) < g_x) || (x > (g_x + g_width))) + return; + + /* #### optimize this - redrawing the whole gutter for every expose + is very expensive. We reset the current display lines because if + they're being exposed they are no longer current. */ + reset_gutter_display_lines (f); + + /* Even if none of the gutter is in the area, the blank region at + the very least must be because the first thing we did is verify + that some portion of the gutter is in the exposed region. */ + output_gutter (f, pos); +} + +void +redraw_exposed_gutters (struct frame *f, int x, int y, int width, + int height) +{ + enum gutter_pos pos; + GUTTER_POS_LOOP (pos) + { + if (FRAME_GUTTER_VISIBLE (f, pos)) + redraw_exposed_gutter (f, pos, x, y, width, height); + } +} + +void +free_frame_gutters (struct frame *f) +{ + if (f->current_display_lines) + { + free_display_lines (f->current_display_lines); + f->current_display_lines = 0; + } + if (f->desired_display_lines) + { + free_display_lines (f->desired_display_lines); + f->desired_display_lines = 0; + } +} + +static enum gutter_pos +decode_gutter_position (Lisp_Object position) +{ + if (EQ (position, Qtop)) return TOP_GUTTER; + if (EQ (position, Qbottom)) return BOTTOM_GUTTER; + if (EQ (position, Qleft)) return LEFT_GUTTER; + if (EQ (position, Qright)) return RIGHT_GUTTER; + signal_simple_error ("Invalid gutter position", position); + + return TOP_GUTTER; /* not reached */ +} + +DEFUN ("set-default-gutter-position", Fset_default_gutter_position, 1, 1, 0, /* +Set the position that the `default-gutter' will be displayed at. +Valid positions are 'top, 'bottom, 'left and 'right. +See `default-gutter-position'. +*/ + (position)) +{ + enum gutter_pos cur = decode_gutter_position (Vdefault_gutter_position); + enum gutter_pos new = decode_gutter_position (position); + + if (cur != new) + { + /* The following calls will automatically cause the dirty + flags to be set; we delay frame size changes to avoid + lots of frame flickering. */ + /* #### I think this should be GC protected. -sb */ + hold_frame_size_changes (); + set_specifier_fallback (Vgutter[cur], list1 (Fcons (Qnil, Qnil))); + set_specifier_fallback (Vgutter[new], Vdefault_gutter); + set_specifier_fallback (Vgutter_size[cur], list1 (Fcons (Qnil, Qzero))); + set_specifier_fallback (Vgutter_size[new], + new == TOP_GUTTER || new == BOTTOM_GUTTER + ? Vdefault_gutter_height + : Vdefault_gutter_width); + set_specifier_fallback (Vgutter_border_width[cur], + list1 (Fcons (Qnil, Qzero))); + set_specifier_fallback (Vgutter_border_width[new], + Vdefault_gutter_border_width); + set_specifier_fallback (Vgutter_visible_p[cur], + list1 (Fcons (Qnil, Qt))); + set_specifier_fallback (Vgutter_visible_p[new], + Vdefault_gutter_visible_p); + Vdefault_gutter_position = position; + unhold_frame_size_changes (); + } + + return position; +} + +DEFUN ("default-gutter-position", Fdefault_gutter_position, 0, 0, 0, /* +Return the position that the `default-gutter' will be displayed at. +The `default-gutter' will only be displayed here if the corresponding +position-specific gutter specifier does not provide a value. +*/ + ()) +{ + return Vdefault_gutter_position; +} + +DEFUN ("gutter-pixel-width", Fgutter_pixel_width, 0, 2, 0, /* +Return the pixel width of the gutter at POS in LOCALE. +POS defaults to the default gutter position. LOCALE defaults to +the current window. +*/ + (pos, locale)) +{ + int x, y, width, height; + enum gutter_pos p = TOP_GUTTER; + struct frame *f = decode_frame (FW_FRAME (locale)); + + if (NILP (pos)) + pos = Vdefault_gutter_position; + p = decode_gutter_position (pos); + + get_gutter_coords (f, p, &x, &y, &width, &height); + width -= (FRAME_GUTTER_BORDER_WIDTH (f, p) * 2); + + return make_int (width); +} + +DEFUN ("gutter-pixel-height", Fgutter_pixel_height, 0, 2, 0, /* +Return the pixel height of the gutter at POS in LOCALE. +POS defaults to the default gutter position. LOCALE defaults to +the current window. +*/ + (pos, locale)) +{ + int x, y, width, height; + enum gutter_pos p = TOP_GUTTER; + struct frame *f = decode_frame (FW_FRAME (locale)); + + if (NILP (pos)) + pos = Vdefault_gutter_position; + p = decode_gutter_position (pos); + + get_gutter_coords (f, p, &x, &y, &width, &height); + height -= (FRAME_GUTTER_BORDER_WIDTH (f, p) * 2); + + return make_int (height); +} + +DEFINE_SPECIFIER_TYPE (gutter); + +static void +gutter_after_change (Lisp_Object specifier, Lisp_Object locale) +{ + MARK_GUTTER_CHANGED; +} + +static void +gutter_validate (Lisp_Object instantiator) +{ + if (NILP (instantiator)) + return; + + if (!STRINGP (instantiator)) + signal_simple_error ("Gutter spec must be string or nil", instantiator); +} + +DEFUN ("gutter-specifier-p", Fgutter_specifier_p, 1, 1, 0, /* +Return non-nil if OBJECT is a gutter specifier. +Gutter specifiers are used to specify the format of a gutter. +The values of the variables `default-gutter', `top-gutter', +`left-gutter', `right-gutter', and `bottom-gutter' are always +gutter specifiers. + +Valid gutter instantiators are called "gutter descriptors" +and are lists of vectors. See `default-gutter' for a description +of the exact format. +*/ + (object)) +{ + return GUTTER_SPECIFIERP (object) ? Qt : Qnil; +} + + +/* + Helper for invalidating the real specifier when default + specifier caching changes +*/ +static void +recompute_overlaying_specifier (Lisp_Object real_one[4]) +{ + enum gutter_pos pos = decode_gutter_position (Vdefault_gutter_position); + Fset_specifier_dirty_flag (real_one[pos]); +} + +static void +gutter_specs_changed (Lisp_Object specifier, struct window *w, + Lisp_Object oldval) +{ + enum gutter_pos pos; + GUTTER_POS_LOOP (pos) + { + w->real_gutter_size[pos] = w->gutter_size[pos]; + if (EQ (w->real_gutter_size[pos], Qautodetect) + && !NILP (w->gutter_visible_p[pos])) + { + w->real_gutter_size [pos] = calculate_gutter_size (w, pos); + } + } + MARK_GUTTER_CHANGED; + MARK_WINDOWS_CHANGED (w); +} + +static void +default_gutter_specs_changed (Lisp_Object specifier, struct window *w, + Lisp_Object oldval) +{ + recompute_overlaying_specifier (Vgutter); +} + +static void +gutter_geometry_changed_in_window (Lisp_Object specifier, struct window *w, + Lisp_Object oldval) +{ + enum gutter_pos pos; + GUTTER_POS_LOOP (pos) + { + w->real_gutter_size[pos] = w->gutter_size[pos]; + if (EQ (w->real_gutter_size[pos], Qautodetect) + && !NILP (w->gutter_visible_p[pos])) + { + w->real_gutter_size [pos] = calculate_gutter_size (w, pos); + } + } + + MARK_GUTTER_CHANGED; + MARK_WINDOWS_CHANGED (w); +} + +static void +default_gutter_size_changed_in_window (Lisp_Object specifier, struct window *w, + Lisp_Object oldval) +{ + recompute_overlaying_specifier (Vgutter_size); +} + +static void +default_gutter_border_width_changed_in_window (Lisp_Object specifier, + struct window *w, + Lisp_Object oldval) +{ + recompute_overlaying_specifier (Vgutter_border_width); +} + +static void +default_gutter_visible_p_changed_in_window (Lisp_Object specifier, + struct window *w, + Lisp_Object oldval) +{ + recompute_overlaying_specifier (Vgutter_visible_p); +} + + +DECLARE_SPECIFIER_TYPE (gutter_size); +#define GUTTER_SIZE_SPECIFIERP(x) SPECIFIER_TYPEP (x, gutter_size) +DEFINE_SPECIFIER_TYPE (gutter_size); + +static void +gutter_size_validate (Lisp_Object instantiator) +{ + if (NILP (instantiator)) + return; + + if (!INTP (instantiator) && !EQ (instantiator, Qautodetect)) + signal_simple_error ("Gutter size must be an integer or 'autodetect", instantiator); +} + +DEFUN ("gutter-size-specifier-p", Fgutter_size_specifier_p, 1, 1, 0, /* +Return non-nil if OBJECT is a gutter-size specifier. +*/ + (object)) +{ + return GUTTER_SIZE_SPECIFIERP (object) ? Qt : Qnil; +} + +DEFUN ("redisplay-gutter-area", Fredisplay_gutter_area, 0, 0, 0, /* +Ensure that all gutters are correctly showing their gutter specifier. +*/ + ()) +{ + Lisp_Object devcons, concons; + + DEVICE_LOOP_NO_BREAK (devcons, concons) + { + struct device *d = XDEVICE (XCAR (devcons)); + Lisp_Object frmcons; + + DEVICE_FRAME_LOOP (frmcons, d) + { + struct frame *f = XFRAME (XCAR (frmcons)); + + if (FRAME_REPAINT_P (f)) + { + update_frame_gutters (f); + } + } + + /* We now call the output_end routine for tty frames. We delay + doing so in order to avoid cursor flicker. So much for 100% + encapsulation. */ + if (DEVICE_TTY_P (d)) + DEVMETH (d, output_end, (d)); + } + + return Qnil; +} + +void +init_frame_gutters (struct frame *f) +{ + enum gutter_pos pos; + struct window* w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)); + /* We are here as far in frame creation so cached specifiers are + already recomputed, and possibly modified by resource + initialization. We need to recalculate autodetected gutters. */ + GUTTER_POS_LOOP (pos) + { + w->real_gutter_size[pos] = w->gutter_size[pos]; + if (EQ (w->gutter_size[pos], Qautodetect) + && !NILP (w->gutter_visible_p[pos])) + { + w->real_gutter_size [pos] = calculate_gutter_size (w, pos); + MARK_GUTTER_CHANGED; + MARK_WINDOWS_CHANGED (w); + } + } +} + +void +syms_of_gutter (void) +{ + DEFSUBR (Fgutter_specifier_p); + DEFSUBR (Fgutter_size_specifier_p); + DEFSUBR (Fset_default_gutter_position); + DEFSUBR (Fdefault_gutter_position); + DEFSUBR (Fgutter_pixel_height); + DEFSUBR (Fgutter_pixel_width); + DEFSUBR (Fredisplay_gutter_area); + + defsymbol (&Qgutter_size, "gutter-size"); +} + +void +vars_of_gutter (void) +{ + staticpro (&Vdefault_gutter_position); + Vdefault_gutter_position = Qtop; + + Fprovide (Qgutter); +} + +void +specifier_type_create_gutter (void) +{ + INITIALIZE_SPECIFIER_TYPE (gutter, "gutter", "gutter-specifier-p"); + + SPECIFIER_HAS_METHOD (gutter, validate); + SPECIFIER_HAS_METHOD (gutter, after_change); + + INITIALIZE_SPECIFIER_TYPE (gutter_size, "gutter-size", "gutter-size-specifier-p"); + + SPECIFIER_HAS_METHOD (gutter_size, validate); +} + +void +reinit_specifier_type_create_gutter (void) +{ + REINITIALIZE_SPECIFIER_TYPE (gutter); + REINITIALIZE_SPECIFIER_TYPE (gutter_size); +} + +void +specifier_vars_of_gutter (void) +{ + Lisp_Object fb; + + DEFVAR_SPECIFIER ("default-gutter", &Vdefault_gutter /* +Specifier for a fallback gutter. +Use `set-specifier' to change this. + +The position of this gutter is specified in the function +`default-gutter-position'. If the corresponding position-specific +gutter (e.g. `top-gutter' if `default-gutter-position' is 'top) +does not specify a gutter in a particular domain (usually a window), +then the value of `default-gutter' in that domain, if any, will be +used instead. + +Note that the gutter at any particular position will not be +displayed unless its visibility flag is true and its thickness +\(width or height, depending on orientation) is non-zero. The +visibility is controlled by the specifiers `top-gutter-visible-p', +`bottom-gutter-visible-p', `left-gutter-visible-p', and +`right-gutter-visible-p', and the thickness is controlled by the +specifiers `top-gutter-height', `bottom-gutter-height', +`left-gutter-width', and `right-gutter-width'. + +Note that one of the four visibility specifiers inherits from +`default-gutter-visibility' and one of the four thickness +specifiers inherits from either `default-gutter-width' or +`default-gutter-height' (depending on orientation), just +like for the gutter description specifiers (e.g. `top-gutter') +mentioned above. + +Therefore, if you are setting `default-gutter', you should control +the visibility and thickness using `default-gutter-visible-p', +`default-gutter-width', and `default-gutter-height', rather than +using position-specific specifiers. That way, you will get sane +behavior if the user changes the default gutter position. + +The gutter value should be a string or nil. You can attach extents and +glyphs to the string and hence display glyphs and text in other fonts +in the gutter area. + +*/ ); + + Vdefault_gutter = Fmake_specifier (Qgutter); + /* #### It would be even nicer if the specifier caching + automatically knew about specifier fallbacks, so we didn't + have to do it ourselves. */ + set_specifier_caching (Vdefault_gutter, + offsetof (struct window, default_gutter), + default_gutter_specs_changed, + 0, 0); + + DEFVAR_SPECIFIER ("top-gutter", + &Vgutter[TOP_GUTTER] /* +Specifier for the gutter at the top of the frame. +Use `set-specifier' to change this. +See `default-gutter' for a description of a valid gutter instantiator. +*/ ); + Vgutter[TOP_GUTTER] = Fmake_specifier (Qgutter); + set_specifier_caching (Vgutter[TOP_GUTTER], + offsetof (struct window, gutter[TOP_GUTTER]), + gutter_specs_changed, + 0, 0); + + DEFVAR_SPECIFIER ("bottom-gutter", + &Vgutter[BOTTOM_GUTTER] /* +Specifier for the gutter at the bottom of the frame. +Use `set-specifier' to change this. +See `default-gutter' for a description of a valid gutter instantiator. + +Note that, unless the `default-gutter-position' is `bottom', by +default the height of the bottom gutter (controlled by +`bottom-gutter-height') is 0; thus, a bottom gutter will not be +displayed even if you provide a value for `bottom-gutter'. +*/ ); + Vgutter[BOTTOM_GUTTER] = Fmake_specifier (Qgutter); + set_specifier_caching (Vgutter[BOTTOM_GUTTER], + offsetof (struct window, gutter[BOTTOM_GUTTER]), + gutter_specs_changed, + 0, 0); + + DEFVAR_SPECIFIER ("left-gutter", + &Vgutter[LEFT_GUTTER] /* +Specifier for the gutter at the left edge of the frame. +Use `set-specifier' to change this. +See `default-gutter' for a description of a valid gutter instantiator. + +Note that, unless the `default-gutter-position' is `left', by +default the height of the left gutter (controlled by +`left-gutter-width') is 0; thus, a left gutter will not be +displayed even if you provide a value for `left-gutter'. +*/ ); + Vgutter[LEFT_GUTTER] = Fmake_specifier (Qgutter); + set_specifier_caching (Vgutter[LEFT_GUTTER], + offsetof (struct window, gutter[LEFT_GUTTER]), + gutter_specs_changed, + 0, 0); + + DEFVAR_SPECIFIER ("right-gutter", + &Vgutter[RIGHT_GUTTER] /* +Specifier for the gutter at the right edge of the frame. +Use `set-specifier' to change this. +See `default-gutter' for a description of a valid gutter instantiator. + +Note that, unless the `default-gutter-position' is `right', by +default the height of the right gutter (controlled by +`right-gutter-width') is 0; thus, a right gutter will not be +displayed even if you provide a value for `right-gutter'. +*/ ); + Vgutter[RIGHT_GUTTER] = Fmake_specifier (Qgutter); + set_specifier_caching (Vgutter[RIGHT_GUTTER], + offsetof (struct window, gutter[RIGHT_GUTTER]), + gutter_specs_changed, + 0, 0); + + /* initially, top inherits from default; this can be + changed with `set-default-gutter-position'. */ + fb = list1 (Fcons (Qnil, Qnil)); + set_specifier_fallback (Vdefault_gutter, fb); + set_specifier_fallback (Vgutter[TOP_GUTTER], Vdefault_gutter); + set_specifier_fallback (Vgutter[BOTTOM_GUTTER], fb); + set_specifier_fallback (Vgutter[LEFT_GUTTER], fb); + set_specifier_fallback (Vgutter[RIGHT_GUTTER], fb); + + DEFVAR_SPECIFIER ("default-gutter-height", &Vdefault_gutter_height /* +*Height of the default gutter, if it's oriented horizontally. +This is a specifier; use `set-specifier' to change it. + +The position of the default gutter is specified by the function +`set-default-gutter-position'. If the corresponding position-specific +gutter thickness specifier (e.g. `top-gutter-height' if +`default-gutter-position' is 'top) does not specify a thickness in a +particular domain (a window or a frame), then the value of +`default-gutter-height' or `default-gutter-width' (depending on the +gutter orientation) in that domain, if any, will be used instead. + +Note that `default-gutter-height' is only used when +`default-gutter-position' is 'top or 'bottom, and `default-gutter-width' +is only used when `default-gutter-position' is 'left or 'right. + +Note that all of the position-specific gutter thickness specifiers +have a fallback value of zero when they do not correspond to the +default gutter. Therefore, you will have to set a non-zero thickness +value if you want a position-specific gutter to be displayed. + +If you set the height to 'autodetect the size of the gutter will be +calculated to be large enough to hold the contents of the gutter. This +is the default. +*/ ); + Vdefault_gutter_height = Fmake_specifier (Qgutter_size); + set_specifier_caching (Vdefault_gutter_height, + offsetof (struct window, default_gutter_height), + default_gutter_size_changed_in_window, + 0, 0); + + DEFVAR_SPECIFIER ("default-gutter-width", &Vdefault_gutter_width /* +*Width of the default gutter, if it's oriented vertically. +This is a specifier; use `set-specifier' to change it. + +See `default-gutter-height' for more information. +*/ ); + Vdefault_gutter_width = Fmake_specifier (Qnatnum); + set_specifier_caching (Vdefault_gutter_width, + offsetof (struct window, default_gutter_width), + default_gutter_size_changed_in_window, + 0, 0); + + DEFVAR_SPECIFIER ("top-gutter-height", + &Vgutter_size[TOP_GUTTER] /* +*Height of the top gutter. +This is a specifier; use `set-specifier' to change it. + +See `default-gutter-height' for more information. +*/ ); + Vgutter_size[TOP_GUTTER] = Fmake_specifier (Qgutter_size); + set_specifier_caching (Vgutter_size[TOP_GUTTER], + offsetof (struct window, gutter_size[TOP_GUTTER]), + gutter_geometry_changed_in_window, + 0, 0); + + DEFVAR_SPECIFIER ("bottom-gutter-height", + &Vgutter_size[BOTTOM_GUTTER] /* +*Height of the bottom gutter. +This is a specifier; use `set-specifier' to change it. + +See `default-gutter-height' for more information. +*/ ); + Vgutter_size[BOTTOM_GUTTER] = Fmake_specifier (Qgutter_size); + set_specifier_caching (Vgutter_size[BOTTOM_GUTTER], + offsetof (struct window, gutter_size[BOTTOM_GUTTER]), + gutter_geometry_changed_in_window, + 0, 0); + + DEFVAR_SPECIFIER ("left-gutter-width", + &Vgutter_size[LEFT_GUTTER] /* +*Width of left gutter. +This is a specifier; use `set-specifier' to change it. + +See `default-gutter-height' for more information. +*/ ); + Vgutter_size[LEFT_GUTTER] = Fmake_specifier (Qnatnum); + set_specifier_caching (Vgutter_size[LEFT_GUTTER], + offsetof (struct window, gutter_size[LEFT_GUTTER]), + gutter_geometry_changed_in_window, + 0, 0); + + DEFVAR_SPECIFIER ("right-gutter-width", + &Vgutter_size[RIGHT_GUTTER] /* +*Width of right gutter. +This is a specifier; use `set-specifier' to change it. + +See `default-gutter-height' for more information. +*/ ); + Vgutter_size[RIGHT_GUTTER] = Fmake_specifier (Qnatnum); + set_specifier_caching (Vgutter_size[RIGHT_GUTTER], + offsetof (struct window, gutter_size[RIGHT_GUTTER]), + gutter_geometry_changed_in_window, + 0, 0); + + fb = Qnil; +#ifdef HAVE_TTY + fb = Fcons (Fcons (list1 (Qtty), Qautodetect), fb); +#endif +#ifdef HAVE_X_WINDOWS + fb = Fcons (Fcons (list1 (Qx), Qautodetect), fb); +#endif +#ifdef HAVE_MS_WINDOWS + fb = Fcons (Fcons (list1 (Qmsprinter), Qautodetect), fb); + fb = Fcons (Fcons (list1 (Qmswindows), Qautodetect), fb); +#endif + if (!NILP (fb)) + set_specifier_fallback (Vdefault_gutter_height, fb); + + fb = Qnil; +#ifdef HAVE_TTY + fb = Fcons (Fcons (list1 (Qtty), Qzero), fb); +#endif +#ifdef HAVE_X_WINDOWS + fb = Fcons (Fcons (list1 (Qx), make_int (DEFAULT_GUTTER_WIDTH)), fb); +#endif +#ifdef HAVE_MS_WINDOWS + fb = Fcons (Fcons (list1 (Qmsprinter), Qzero), fb); + fb = Fcons (Fcons (list1 (Qmswindows), + make_int (DEFAULT_GUTTER_WIDTH)), fb); +#endif + if (!NILP (fb)) + set_specifier_fallback (Vdefault_gutter_width, fb); + + set_specifier_fallback (Vgutter_size[TOP_GUTTER], Vdefault_gutter_height); + fb = list1 (Fcons (Qnil, Qzero)); + set_specifier_fallback (Vgutter_size[BOTTOM_GUTTER], fb); + set_specifier_fallback (Vgutter_size[LEFT_GUTTER], fb); + set_specifier_fallback (Vgutter_size[RIGHT_GUTTER], fb); + + DEFVAR_SPECIFIER ("default-gutter-border-width", + &Vdefault_gutter_border_width /* +*Width of the border around the default gutter. +This is a specifier; use `set-specifier' to change it. + +The position of the default gutter is specified by the function +`set-default-gutter-position'. If the corresponding position-specific +gutter border width specifier (e.g. `top-gutter-border-width' if +`default-gutter-position' is 'top) does not specify a border width in a +particular domain (a window or a frame), then the value of +`default-gutter-border-width' in that domain, if any, will be used +instead. + +*/ ); + Vdefault_gutter_border_width = Fmake_specifier (Qnatnum); + set_specifier_caching (Vdefault_gutter_border_width, + offsetof (struct window, default_gutter_border_width), + default_gutter_border_width_changed_in_window, + 0, 0); + + DEFVAR_SPECIFIER ("top-gutter-border-width", + &Vgutter_border_width[TOP_GUTTER] /* +*Border width of the top gutter. +This is a specifier; use `set-specifier' to change it. + +See `default-gutter-height' for more information. +*/ ); + Vgutter_border_width[TOP_GUTTER] = Fmake_specifier (Qnatnum); + set_specifier_caching (Vgutter_border_width[TOP_GUTTER], + offsetof (struct window, + gutter_border_width[TOP_GUTTER]), + gutter_geometry_changed_in_window, + 0, 0); + + DEFVAR_SPECIFIER ("bottom-gutter-border-width", + &Vgutter_border_width[BOTTOM_GUTTER] /* +*Border width of the bottom gutter. +This is a specifier; use `set-specifier' to change it. + +See `default-gutter-height' for more information. +*/ ); + Vgutter_border_width[BOTTOM_GUTTER] = Fmake_specifier (Qnatnum); + set_specifier_caching (Vgutter_border_width[BOTTOM_GUTTER], + offsetof (struct window, + gutter_border_width[BOTTOM_GUTTER]), + gutter_geometry_changed_in_window, + 0, 0); + + DEFVAR_SPECIFIER ("left-gutter-border-width", + &Vgutter_border_width[LEFT_GUTTER] /* +*Border width of left gutter. +This is a specifier; use `set-specifier' to change it. + +See `default-gutter-height' for more information. +*/ ); + Vgutter_border_width[LEFT_GUTTER] = Fmake_specifier (Qnatnum); + set_specifier_caching (Vgutter_border_width[LEFT_GUTTER], + offsetof (struct window, + gutter_border_width[LEFT_GUTTER]), + gutter_geometry_changed_in_window, + 0, 0); + + DEFVAR_SPECIFIER ("right-gutter-border-width", + &Vgutter_border_width[RIGHT_GUTTER] /* +*Border width of right gutter. +This is a specifier; use `set-specifier' to change it. + +See `default-gutter-height' for more information. +*/ ); + Vgutter_border_width[RIGHT_GUTTER] = Fmake_specifier (Qnatnum); + set_specifier_caching (Vgutter_border_width[RIGHT_GUTTER], + offsetof (struct window, + gutter_border_width[RIGHT_GUTTER]), + gutter_geometry_changed_in_window, + 0, 0); + + fb = Qnil; +#ifdef HAVE_TTY + fb = Fcons (Fcons (list1 (Qtty), Qzero), fb); +#endif +#ifdef HAVE_X_WINDOWS + fb = Fcons (Fcons (list1 (Qx), make_int (DEFAULT_GUTTER_BORDER_WIDTH)), fb); +#endif +#ifdef HAVE_MS_WINDOWS + fb = Fcons (Fcons (list1 (Qmsprinter), Qzero), fb); + fb = Fcons (Fcons (list1 (Qmswindows), make_int (DEFAULT_GUTTER_BORDER_WIDTH)), fb); +#endif + if (!NILP (fb)) + set_specifier_fallback (Vdefault_gutter_border_width, fb); + + set_specifier_fallback (Vgutter_border_width[TOP_GUTTER], Vdefault_gutter_border_width); + fb = list1 (Fcons (Qnil, Qzero)); + set_specifier_fallback (Vgutter_border_width[BOTTOM_GUTTER], fb); + set_specifier_fallback (Vgutter_border_width[LEFT_GUTTER], fb); + set_specifier_fallback (Vgutter_border_width[RIGHT_GUTTER], fb); + + DEFVAR_SPECIFIER ("default-gutter-visible-p", &Vdefault_gutter_visible_p /* +*Whether the default gutter is visible. +This is a specifier; use `set-specifier' to change it. + +The position of the default gutter is specified by the function +`set-default-gutter-position'. If the corresponding position-specific +gutter visibility specifier (e.g. `top-gutter-visible-p' if +`default-gutter-position' is 'top) does not specify a visible-p value +in a particular domain (a window or a frame), then the value of +`default-gutter-visible-p' in that domain, if any, will be used +instead. + +`default-gutter-visible-p' and all of the position-specific gutter +visibility specifiers have a fallback value of true. +*/ ); + Vdefault_gutter_visible_p = Fmake_specifier (Qboolean); + set_specifier_caching (Vdefault_gutter_visible_p, + offsetof (struct window, + default_gutter_visible_p), + default_gutter_visible_p_changed_in_window, + 0, 0); + + DEFVAR_SPECIFIER ("top-gutter-visible-p", + &Vgutter_visible_p[TOP_GUTTER] /* +*Whether the top gutter is visible. +This is a specifier; use `set-specifier' to change it. + +See `default-gutter-visible-p' for more information. +*/ ); + Vgutter_visible_p[TOP_GUTTER] = Fmake_specifier (Qboolean); + set_specifier_caching (Vgutter_visible_p[TOP_GUTTER], + offsetof (struct window, + gutter_visible_p[TOP_GUTTER]), + gutter_geometry_changed_in_window, + 0, 0); + + DEFVAR_SPECIFIER ("bottom-gutter-visible-p", + &Vgutter_visible_p[BOTTOM_GUTTER] /* +*Whether the bottom gutter is visible. +This is a specifier; use `set-specifier' to change it. + +See `default-gutter-visible-p' for more information. +*/ ); + Vgutter_visible_p[BOTTOM_GUTTER] = Fmake_specifier (Qboolean); + set_specifier_caching (Vgutter_visible_p[BOTTOM_GUTTER], + offsetof (struct window, + gutter_visible_p[BOTTOM_GUTTER]), + gutter_geometry_changed_in_window, + 0, 0); + + DEFVAR_SPECIFIER ("left-gutter-visible-p", + &Vgutter_visible_p[LEFT_GUTTER] /* +*Whether the left gutter is visible. +This is a specifier; use `set-specifier' to change it. + +See `default-gutter-visible-p' for more information. +*/ ); + Vgutter_visible_p[LEFT_GUTTER] = Fmake_specifier (Qboolean); + set_specifier_caching (Vgutter_visible_p[LEFT_GUTTER], + offsetof (struct window, + gutter_visible_p[LEFT_GUTTER]), + gutter_geometry_changed_in_window, + 0, 0); + + DEFVAR_SPECIFIER ("right-gutter-visible-p", + &Vgutter_visible_p[RIGHT_GUTTER] /* +*Whether the right gutter is visible. +This is a specifier; use `set-specifier' to change it. + +See `default-gutter-visible-p' for more information. +*/ ); + Vgutter_visible_p[RIGHT_GUTTER] = Fmake_specifier (Qboolean); + set_specifier_caching (Vgutter_visible_p[RIGHT_GUTTER], + offsetof (struct window, + gutter_visible_p[RIGHT_GUTTER]), + gutter_geometry_changed_in_window, + 0, 0); + + /* initially, top inherits from default; this can be + changed with `set-default-gutter-position'. */ + fb = list1 (Fcons (Qnil, Qt)); + set_specifier_fallback (Vdefault_gutter_visible_p, fb); + set_specifier_fallback (Vgutter_visible_p[TOP_GUTTER], + Vdefault_gutter_visible_p); + set_specifier_fallback (Vgutter_visible_p[BOTTOM_GUTTER], fb); + set_specifier_fallback (Vgutter_visible_p[LEFT_GUTTER], fb); + set_specifier_fallback (Vgutter_visible_p[RIGHT_GUTTER], fb); +} diff -r f4aeb21a5bad -r 74fd4e045ea6 src/gutter.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/gutter.h Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,127 @@ +/* Define general gutter support. + Copyright (C) 1999 Andy Piper. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +#ifndef INCLUDED_gutter_h_ +#define INCLUDED_gutter_h_ + +#include "specifier.h" + +#define DEVICE_SUPPORTS_GUTTERS_P(d) HAS_DEVMETH_P (d, output_frame_gutters) + +DECLARE_SPECIFIER_TYPE (gutter); +#define XGUTTER_SPECIFIER(x) XSPECIFIER_TYPE (x, gutter) +#define XSETGUTTER_SPECIFIER(x, p) XSETSPECIFIER_TYPE (x, p, gutter) +#define GUTTER_SPECIFIERP(x) SPECIFIER_TYPEP (x, gutter) +#define CHECK_GUTTER_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, gutter) +#define CONCHECK_GUTTER_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, gutter) + +#define DEFAULT_GUTTER_WIDTH 40 +#define DEFAULT_GUTTER_BORDER_WIDTH 2 + +enum gutter_pos +{ + TOP_GUTTER = 0, + BOTTOM_GUTTER = 1, + LEFT_GUTTER = 2, + RIGHT_GUTTER = 3 +}; + +/* Iterate over all possible gutter positions */ +#define GUTTER_POS_LOOP(var) \ +for (var = (enum gutter_pos) 0; var < 4; var = (enum gutter_pos) (var + 1)) + +extern Lisp_Object Qgutter; + +extern Lisp_Object Vgutter_size[4]; +extern Lisp_Object Vgutter_border_width[4]; +void update_frame_gutters (struct frame *f); +void init_frame_gutters (struct frame *f); +void init_device_gutters (struct device *d); +void init_global_gutters (struct device *d); +void free_frame_gutters (struct frame *f); +void redraw_exposed_gutters (struct frame *f, int x, int y, int width, + int height); +void reset_gutter_display_lines (struct frame* f); + +#define WINDOW_GUTTER_BORDER_WIDTH(w, pos) \ +(NILP ((w)->gutter_border_width[pos]) ? 0 : XINT ((w)->gutter_border_width[pos])) +#define WINDOW_GUTTER_SIZE(w, pos) \ +(NILP ((w)->gutter_size[pos]) ? 0 : XINT ((w)->gutter_size[pos])) +#define WINDOW_GUTTER_SIZE_INTERNAL(w, pos) \ +(NILP ((w)->real_gutter_size[pos]) ? 0 : XINT ((w)->real_gutter_size[pos])) +#define WINDOW_GUTTER_VISIBLE(w, pos) \ +((w)->gutter_visible_p[pos]) +#define WINDOW_GUTTER(w, pos) \ +((w)->gutter[pos]) + +#define WINDOW_REAL_GUTTER_SIZE(w, pos) \ + (!NILP (WINDOW_GUTTER_VISIBLE (w, pos)) \ + ? WINDOW_GUTTER_SIZE_INTERNAL (w, pos) \ + : 0) +#define WINDOW_REAL_GUTTER_VISIBLE(f, pos) \ + (WINDOW_REAL_GUTTER_SIZE (f, pos) > 0) +#define WINDOW_REAL_GUTTER_BORDER_WIDTH(f, pos) \ + ((!NILP (WINDOW_GUTTER_VISIBLE (f, pos)) \ + && WINDOW_GUTTER_SIZE_INTERNAL (f,pos) > 0) \ + ? WINDOW_GUTTER_BORDER_WIDTH (f, pos) \ + : 0) +#define WINDOW_REAL_GUTTER_BOUNDS(f, pos) \ + (WINDOW_REAL_GUTTER_SIZE (f,pos) + \ + 2 * WINDOW_REAL_GUTTER_BORDER_WIDTH (f,pos)) + +/* these macros predicate size on position and type of window */ +#define WINDOW_REAL_TOP_GUTTER_BOUNDS(w) \ + ((!MINI_WINDOW_P (w) && window_is_highest (w)) ? \ + WINDOW_REAL_GUTTER_BOUNDS (w,TOP_GUTTER) : 0) +#define WINDOW_REAL_BOTTOM_GUTTER_BOUNDS(w) \ + ((!MINI_WINDOW_P (w) && window_is_lowest (w)) ? \ + WINDOW_REAL_GUTTER_BOUNDS (w,BOTTOM_GUTTER) : 0) +#define WINDOW_REAL_LEFT_GUTTER_BOUNDS(w) \ + ((!MINI_WINDOW_P (w) && window_is_leftmost (w)) ? \ + WINDOW_REAL_GUTTER_BOUNDS (w,LEFT_GUTTER) : 0) +#define WINDOW_REAL_RIGHT_GUTTER_BOUNDS(w) \ + ((!MINI_WINDOW_P (w) && window_is_rightmost (w)) ? \ + WINDOW_REAL_GUTTER_BOUNDS (w,RIGHT_GUTTER) : 0) + +#define FRAME_GUTTER_VISIBLE(f, pos) \ + WINDOW_REAL_GUTTER_VISIBLE (XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)), pos) +#define FRAME_GUTTER_SIZE(f, pos) \ + WINDOW_REAL_GUTTER_SIZE (XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)), pos) +#define FRAME_GUTTER_BOUNDS(f, pos) \ + WINDOW_REAL_GUTTER_BOUNDS (XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)), pos) +#define FRAME_GUTTER_BORDER_WIDTH(f, pos) \ + WINDOW_REAL_GUTTER_BORDER_WIDTH (XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)), pos) + +#define FRAME_GUTTER(f, pos) \ +WINDOW_GUTTER (XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)), pos) + +/* these macros predicate size on position and type of window */ +#define FRAME_TOP_GUTTER_BOUNDS(f) \ + WINDOW_REAL_GUTTER_BOUNDS (XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)), TOP_GUTTER) +#define FRAME_BOTTOM_GUTTER_BOUNDS(f) \ + WINDOW_REAL_GUTTER_BOUNDS (XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)), BOTTOM_GUTTER) +#define FRAME_LEFT_GUTTER_BOUNDS(f) \ + WINDOW_REAL_GUTTER_BOUNDS (XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)), LEFT_GUTTER) +#define FRAME_RIGHT_GUTTER_BOUNDS(f) \ + WINDOW_REAL_GUTTER_BOUNDS (XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)), RIGHT_GUTTER) + +#endif /* INCLUDED_gutter_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/hash.c --- a/src/hash.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/hash.c Mon Aug 13 11:13:30 2007 +0200 @@ -34,10 +34,10 @@ static void rehash (hentry *harray, struct hash_table *ht, hash_size_t size); unsigned long -memory_hash (CONST void *xv, size_t size) +memory_hash (const void *xv, size_t size) { unsigned int h = 0; - unsigned CONST char *x = (unsigned CONST char *) xv; + unsigned const char *x = (unsigned const char *) xv; if (!x) return 0; @@ -59,7 +59,7 @@ /* Return some prime near, but greater than or equal to, SIZE. Decades from the time of writing, someone will have a system large enough that the list below will be too short... */ - static CONST size_t primes [] = + static const size_t primes [] = { 19, 29, 41, 59, 79, 107, 149, 197, 263, 347, 457, 599, 787, 1031, 1361, 1777, 2333, 3037, 3967, 5167, 6719, 8737, 11369, 14783, @@ -85,8 +85,8 @@ return primes [high]; } -CONST void * -gethash (CONST void *key, struct hash_table *hash_table, CONST void **ret_value) +const void * +gethash (const void *key, struct hash_table *hash_table, const void **ret_value) { if (!key) { @@ -104,7 +104,7 @@ (unsigned long) key; unsigned int hcode = hcode_initial % size; hentry *e = &harray [hcode]; - CONST void *e_key = e->key; + const void *e_key = e->key; if (e_key ? KEYS_DIFFER_P (e_key, key, test_function) : @@ -188,7 +188,7 @@ } void -puthash (CONST void *key, void *contents, struct hash_table *hash_table) +puthash (const void *key, void *contents, struct hash_table *hash_table) { if (!key) { @@ -207,8 +207,8 @@ unsigned int hcode = hcode_initial % size; size_t h2 = size - 2; unsigned int incr = 1 + (hcode_initial % h2); - CONST void *e_key = harray [hcode].key; - CONST void *oldcontents; + const void *e_key = harray [hcode].key; + const void *oldcontents; if (e_key && KEYS_DIFFER_P (e_key, key, test_function)) { @@ -269,7 +269,7 @@ } void -remhash (CONST void *key, struct hash_table *hash_table) +remhash (const void *key, struct hash_table *hash_table) { if (!key) { @@ -287,7 +287,7 @@ ((unsigned long) key); unsigned int hcode = hcode_initial % size; hentry *e = &harray [hcode]; - CONST void *e_key = e->key; + const void *e_key = e->key; if (e_key ? KEYS_DIFFER_P (e_key, key, test_function) : diff -r f4aeb21a5bad -r 74fd4e045ea6 src/hash.h --- a/src/hash.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/hash.h Mon Aug 13 11:13:30 2007 +0200 @@ -17,17 +17,17 @@ /* Synched up with: Not in FSF. */ -#ifndef _HASH_H_ -#define _HASH_H_ +#ifndef INCLUDED_hash_h_ +#define INCLUDED_hash_h_ typedef struct { - CONST void *key; + const void *key; void *contents; } hentry; -typedef int (*hash_table_test_function) (CONST void *, CONST void *); -typedef unsigned long (*hash_table_hash_function) (CONST void *); +typedef int (*hash_table_test_function) (const void *, const void *); +typedef unsigned long (*hash_table_hash_function) (const void *); typedef size_t hash_size_t; struct hash_table @@ -57,18 +57,18 @@ void free_hash_table (struct hash_table *hash_table); /* Returns a hentry whose key is 0 if the entry does not exist in HASH-TABLE */ -CONST void *gethash (CONST void *key, struct hash_table *hash_table, - CONST void **ret_value); +const void *gethash (const void *key, struct hash_table *hash_table, + const void **ret_value); /* KEY should be different from 0 */ -void puthash (CONST void *key, void *contents, struct hash_table *hash_table); +void puthash (const void *key, void *contents, struct hash_table *hash_table); /* delete the entry with key KEY */ -void remhash (CONST void *key, struct hash_table *hash_table); +void remhash (const void *key, struct hash_table *hash_table); -typedef int (*maphash_function) (CONST void* key, void* contents, void* arg); +typedef int (*maphash_function) (const void* key, void* contents, void* arg); -typedef int (*remhash_predicate) (CONST void* key, CONST void* contents, +typedef int (*remhash_predicate) (const void* key, const void* contents, void* arg); /* Call MF (key, contents, arg) for every entry in HASH-TABLE */ @@ -78,4 +78,4 @@ void map_remhash (remhash_predicate predicate, struct hash_table *hash_table, void *arg); -#endif /* _HASH_H_ */ +#endif /* INCLUDED_hash_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/imgproc.h --- a/src/imgproc.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/imgproc.h Mon Aug 13 11:13:30 2007 +0200 @@ -18,6 +18,9 @@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ +#ifndef INCLUDED_imgproc_h_ +#define INCLUDED_imgproc_h_ + /* Synched up with: Not in FSF. */ /* Original author: Jareth Hein */ @@ -60,3 +63,5 @@ #define QUANT_GET_COLOR(qt,r,g,b) (qt->histogram[r>>COLOR_SHIFT][g>>COLOR_SHIFT][b>>COLOR_SHIFT]) quant_table *build_EImage_quantable(unsigned char *eimage, int width, int height, int num_colors); + +#endif /* INCLUDED_imgproc_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/indent.c --- a/src/indent.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/indent.c Mon Aug 13 11:13:30 2007 +0200 @@ -40,6 +40,8 @@ #endif #include "window.h" +Lisp_Object Qcoerce; + /* Indentation can insert tabs if this is non-zero; otherwise always uses spaces */ int indent_tabs_mode; @@ -193,6 +195,53 @@ } int +string_column_at_point (Lisp_String* s, Bufpos init_pos, int tab_width) +{ + int col; + int tab_seen; + int post_tab; + Bufpos pos = init_pos; + Emchar c; + + if (tab_width <= 0 || tab_width > 1000) tab_width = 8; + col = tab_seen = post_tab = 0; + + while (1) + { + if (pos <= 0) + break; + + pos--; + c = string_char (s, pos); + if (c == '\t') + { + if (tab_seen) + col = ((col + tab_width) / tab_width) * tab_width; + + post_tab += col; + col = 0; + tab_seen = 1; + } + else if (c == '\n') + break; + else +#ifdef MULE + col += XCHARSET_COLUMNS (CHAR_CHARSET (c)); +#else + col ++; +#endif /* MULE */ + } + + if (tab_seen) + { + col = ((col + tab_width) / tab_width) * tab_width; + col += post_tab; + } + + return col; +} + +int current_column (struct buffer *buf) { if (buf == last_known_column_buffer @@ -342,9 +391,11 @@ If specified column is within a character, point goes after that character. If it's past end of line, point goes to end of line. -A non-nil second (optional) argument FORCE means, if the line -is too short to reach column COLUMN then add spaces/tabs to get there, -and if COLUMN is in the middle of a tab character, change it to spaces. +A value of 'coerce for the second (optional) argument FORCE means if +COLUMN is in the middle of a tab character, change it to spaces. +Any other non-nil value means the same, plus if the line is too short to +reach column COLUMN, then add spaces/tabs to get there. + Returns the actual column that it moved to. */ (column, force, buffer)) @@ -428,7 +479,7 @@ } /* If line ends prematurely, add space to the end. */ - if (col < goal && !NILP (force)) + if (col < goal && !NILP (force) && !EQ (force, Qcoerce)) { col = goal; Findent_to (make_int (col), Qzero, buffer); @@ -541,7 +592,7 @@ assert (start <= end); assert (start >= 0); assert (end < Dynarr_length (cache)); - + vpix = 0; for (i = start; i <= end; i++) vpix += Dynarr_atp (cache, i)->height; @@ -665,7 +716,7 @@ if (NILP (window)) window = Fselected_window (Qnil); - CHECK_WINDOW (window); + CHECK_LIVE_WINDOW (window); CHECK_INT (lines); selected = (EQ (window, Fselected_window (Qnil))); @@ -681,7 +732,7 @@ bufpos = vmotion_1 (w, orig, XINT (lines), vpos, vpix); /* Note that the buffer's point is set, not the window's point. */ - if (selected) + if (selected) BUF_SET_PT (XBUFFER (w->buffer), bufpos); else set_marker_restricted (w->pointm[CURRENT_DISP], @@ -739,7 +790,7 @@ if (NILP (window)) window = Fselected_window (Qnil); - CHECK_WINDOW (window); + CHECK_LIVE_WINDOW (window); w = XWINDOW (window); eobuf = BUF_ZV (XBUFFER (w->buffer)); @@ -842,7 +893,7 @@ if (NILP (window)) window = Fselected_window (Qnil); - CHECK_WINDOW (window); + CHECK_LIVE_WINDOW (window); CHECK_INT (pixels); selected = (EQ (window, Fselected_window (Qnil))); @@ -856,7 +907,7 @@ bufpos = vmotion_pixels (window, orig, XINT (pixels), howto, &motion); - if (selected) + if (selected) BUF_SET_PT (XBUFFER (w->buffer), bufpos); else set_marker_restricted (w->pointm[CURRENT_DISP], @@ -879,6 +930,8 @@ #endif DEFSUBR (Fvertical_motion); DEFSUBR (Fvertical_motion_pixels); + + defsymbol (&Qcoerce, "coerce"); } void diff -r f4aeb21a5bad -r 74fd4e045ea6 src/input-method-motif.c --- a/src/input-method-motif.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/input-method-motif.c Mon Aug 13 11:13:30 2007 +0200 @@ -41,7 +41,7 @@ { char *locale; - /* dverna - Nov. 98: ### DON'T DO THIS !!! The default XtLanguageProc + /* dverna - Nov. 98: #### DON'T DO THIS !!! The default XtLanguageProc routine calls setlocale(LC_ALL, lang) which fucks up our lower-level locale management, and especially the value of LC_NUMERIC. Anyway, since at this point, we don't know yet whether we're gonna need an X11 frame, @@ -115,9 +115,10 @@ default face, rather than foreground and background resources, or that the user can use set-frame-parameters to set xic attributes */ -#define res(name, class, representation, field, default_value) \ - { name, class, representation, sizeof(xim_resources.field), \ - XtOffsetOf(xim_resources_t, field), XtRString, default_value } +#define res(name, class, representation, field, default_value) \ + { name, class, representation, sizeof(xim_resources.field), \ + XtOffsetOf(xim_resources_t, field), \ + XtRString, (XtPointer) (default_value) } static XtResource resources[] = { @@ -161,7 +162,7 @@ void XIM_SetSpotLocation (struct frame *f, int x, int y) { - /* ### FIX: Must make sure spot fits within Preedit Area */ + /* #### FIX: Must make sure spot fits within Preedit Area */ XPoint *spot = &(FRAME_X_XIC_SPOT (f)); if (spot->x == (short) x && spot->y == (short) y) diff -r f4aeb21a5bad -r 74fd4e045ea6 src/input-method-xfs.c --- a/src/input-method-xfs.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/input-method-xfs.c Mon Aug 13 11:13:30 2007 +0200 @@ -42,7 +42,7 @@ { char *locale; - /* dverna - Nov. 98: ### DON'T DO THIS !!! The default XtLanguageProc + /* dverna - Nov. 98: #### DON'T DO THIS !!! The default XtLanguageProc routine calls setlocale(LC_ALL, lang) which fucks up our lower-level locale management, and especially the value of LC_NUMERIC. Anyway, since at this point, we don't know yet whether we're gonna need an X11 frame, diff -r f4aeb21a5bad -r 74fd4e045ea6 src/input-method-xlib.c --- a/src/input-method-xlib.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/input-method-xlib.c Mon Aug 13 11:13:30 2007 +0200 @@ -27,6 +27,47 @@ and X11 R6 release guide chapters on internationalized input, for further details */ +/* + Policy: + + The XIM is of the device, by the device, for the device. + The XIC is of each frame, by each frame, for each frame. + The exceptions are: + 1. Activate XICs on poor frames when the XIM is back. + 2. Deactivate all the XICs when the XIM go down. + + Methods: + + - Register a callback for an XIM when the X device is being initialized. + XIM_init_device (d) { XRegisterIMInstantiateCallback (); } + The "XRegisterIMInstantiateCallback" is called when an XIM become + available on the X display. + + - Catch the XIC when the frame is being initialized if XIM was available. + XIM_init_frame (f) { ... XCreateIC (); ... } + + - Release the XIC when the frame is being closed. + XIM_delete_frame (f) { ... FRAME_X_XIC (f) = NULL; ... } + "XIM_delete_frame" is a "DestroyCallback" function declared in + XIM_init_frame (); + + - Release all the XICs when the XIM was down accidentally. + In IMDestroyCallback: + DEVICE_FRAME_LOOP (...) { FRAME_X_XIC (f) = NULL; } + + - Re-enable XIC for all the frames which doesn't have XIC when the XIM + is back. + In IMInstantiateCallback: + DEVICE_FRAME_LOOP (...) { XIM_init_frame (f); } + + + Note: + + - Currently, we don't use XDestroyIC because of _XimProtoCloseIM + (internally registered as im->methods->close) does "Xfree (ic)". + + */ + #include <config.h> #include "lisp.h" #include <X11/Xlocale.h> /* More portable than <locale.h> ? */ @@ -38,10 +79,19 @@ #include "EmacsFrame.h" #include "events.h" +#ifdef THIS_IS_X11R6 +#include <X11/IntrinsicP.h> +#endif + #ifndef XIM_XLIB #error XIM_XLIB is not defined?? #endif +Lisp_Object Qxim_xlib; +#define xim_warn(str) warn_when_safe (Qxim_xlib, Qwarning, str); +#define xim_warn1(fmt, str) warn_when_safe (Qxim_xlib, Qwarning, fmt, str); +#define xim_info(str) warn_when_safe (Qxim_xlib, Qinfo, str); + /* Get/Set IC values for just one attribute */ #ifdef DEBUG_XEMACS #define XIC_Value(Get_Set, xic, name, attr, value) \ @@ -72,6 +122,8 @@ "XIMPreeditNone|XIMStatusNothing\n" "XIMPreeditNone|XIMStatusNone"; +static Boolean xim_initted = False; + static XIMStyle best_style (XIMStyles *user, XIMStyles *xim); void @@ -79,7 +131,7 @@ { char *locale; - /* dverna - Nov. 98: ### DON'T DO THIS !!! The default XtLanguageProc + /* dverna - Nov. 98: #### DON'T DO THIS !!! The default XtLanguageProc routine calls setlocale(LC_ALL, lang) which fucks up our lower-level locale management, and especially the value of LC_NUMERIC. Anyway, since at this point, we don't know yet whether we're gonna need an X11 frame, @@ -87,31 +139,31 @@ /*XtSetLanguageProc (NULL, (XtLanguageProc) NULL, NULL);*/ if ((locale = setlocale (LC_ALL, "")) == NULL) { - stderr_out ("Can't set locale.\n"); - stderr_out ("Using C locale instead.\n"); + xim_warn ("Can't set locale.\n" + "Using C locale instead.\n"); putenv ("LANG=C"); putenv ("LC_ALL=C"); if ((locale = setlocale (LC_ALL, "C")) == NULL) { - stderr_out ("Can't even set locale to `C'!\n"); + xim_warn ("Can't even set locale to `C'!\n"); return; } } if (!XSupportsLocale ()) { - stderr_out ("X Windows does not support locale `%s'\n", locale); - stderr_out ("Using C Locale instead\n"); + xim_warn1 ("X Windows does not support locale `%s'\n" + "Using C Locale instead\n", locale); putenv ("LANG=C"); putenv ("LC_ALL=C"); if ((locale = setlocale (LC_ALL, "C")) == NULL) { - stderr_out ("Can't even set locale to `C'!\n"); + xim_warn ("Can't even set locale to `C'!\n"); return; } if (!XSupportsLocale ()) { - stderr_out ("X Windows does not even support locale `C'!\n"); + xim_warn ("X Windows does not even support locale `C'!\n"); return; } } @@ -120,65 +172,148 @@ if (XSetLocaleModifiers ("") == NULL) { - stderr_out ("XSetLocaleModifiers(\"\") failed\n"); - stderr_out ("Check the value of the XMODIFIERS environment variable.\n"); + xim_warn ("XSetLocaleModifiers(\"\") failed\n" + "Check the value of the XMODIFIERS environment variable.\n"); } } -/* Create X input method for device */ +#ifdef THIS_IS_X11R6 /* Callbacks for IM are supported from X11R6 or later. */ +/* Called from when XIM is destroying. + Clear all the XIC when the XIM was destroying... */ +static void +IMDestroyCallback (XIM im, XPointer client_data, XPointer call_data) +{ + struct device *d = (struct device *)client_data; + Lisp_Object tail; + + DEVICE_FRAME_LOOP (tail, d) + { + struct frame *target_frame = XFRAME (XCAR (tail)); + if (FRAME_X_P (target_frame) && FRAME_X_XIC (target_frame)) + { + /* XDestroyIC (FRAME_X_XIC (target_frame)); */ + FRAME_X_XIC (target_frame) = NULL; + } + } + + DEVICE_X_XIM (d) = NULL; + xim_initted = False; + return; +} + +/* This is registered in XIM_init_device (when DEVICE is initializing). + This activates XIM when XIM becomes available. */ +static void +IMInstantiateCallback (Display *dpy, XPointer client_data, XPointer call_data) +{ + struct device *d = (struct device *)client_data; + XIM xim; + char *name, *class; + XIMCallback ximcallback; + Lisp_Object tail; + + /* if no xim is presented, initialize xim ... */ + if ( xim_initted == False ) + { + xim_initted = True; + XtGetApplicationNameAndClass (dpy, &name, &class); + DEVICE_X_XIM (d) = xim = XOpenIM (dpy, XtDatabase (dpy), name, class); + + /* destroy callback for im */ + ximcallback.callback = IMDestroyCallback; + ximcallback.client_data = (XPointer) d; + XSetIMValues (xim, XNDestroyCallback, &ximcallback, NULL); + } + + /* activate XIC on all the X frames... */ + DEVICE_FRAME_LOOP (tail, d) + { + struct frame *target_frame = XFRAME (XCAR (tail)); + if (FRAME_X_P (target_frame) && !FRAME_X_XIC (target_frame)) + { + XIM_init_frame (target_frame); + } + } + return; +} +#endif /* if THIS_IS_X11R6 */ + +/* Initialize XIM for X device. + Register the use of XIM using XRegisterIMInstantiateCallback. */ void XIM_init_device (struct device *d) { +#ifdef THIS_IS_X11R6 + DEVICE_X_XIM (d) = NULL; + XRegisterIMInstantiateCallback (DEVICE_X_DISPLAY (d), NULL, NULL, NULL, + IMInstantiateCallback, (XPointer) d); + return; +#else Display *dpy = DEVICE_X_DISPLAY (d); char *name, *class; XIM xim; XtGetApplicationNameAndClass (dpy, &name, &class); - DEVICE_X_XIM (d) = xim = XOpenIM (dpy, XtDatabase (dpy), name, class); - if (xim == NULL) { - stderr_out ("Warning: XOpenIM() failed...no input server available\n"); + xim_warn ("XOpenIM() failed...no input server available\n"); return; } else { - /* Get supported styles */ XGetIMValues (xim, XNQueryInputStyle, &DEVICE_X_XIM_STYLES (d), NULL); -#ifdef DEBUG_XIM - describe_XIM (xim); + return; + } #endif - } } -/* Create an X input context for this frame. */ + +/* + * For the frames + */ + +/* Callback for the deleting frame. */ +static void +XIM_delete_frame (Widget w, XtPointer client_data, XtPointer call_data) +{ + struct frame *f = (struct frame *) client_data; + struct device *d = XDEVICE (FRAME_DEVICE (f)); + + if (DEVICE_X_XIM (d)) + { + if (FRAME_X_XIC (f)) + { + XDestroyIC (FRAME_X_XIC (f)); + FRAME_X_XIC (f) = NULL; + } + } + return; +} + +/* Initialize XIC for new frame. + Create an X input context (XIC) for this frame. */ void XIM_init_frame (struct frame *f) { struct device *d = XDEVICE (FRAME_DEVICE (f)); - XIM xim = DEVICE_X_XIM (d); - XIC xic; + XIM xim; Widget w = FRAME_X_TEXT_WIDGET (f); Window win = XtWindow (w); - XRectangle p_area = {0,0,1,1}, s_area={0,0,1,1}; + XRectangle p_area = {0,0,1,1}, s_area = {0,0,1,1}; XPoint spot = {0,0}; XIMStyle style; XVaNestedList p_list, s_list; - typedef struct { XIMStyles styles; XFontSet fontset; Pixel fg; Pixel bg; + char *inputmethod; } xic_vars_t; - xic_vars_t xic_vars; - - /* mrb: #### Fix so that background and foreground is set from - default face, rather than foreground and background resources, or - that the user can use set-frame-parameters to set xic attributes */ + XIC xic; #define res(name, class, representation, field, default_value) \ { name, class, representation, sizeof(xic_vars.field), \ @@ -193,64 +328,71 @@ res(XtNximBackground, XtCBackground, XtRPixel, bg, (XtPointer) XtDefaultBackground) }; - assert (win != 0 && w != NULL && d != NULL); + + xim = DEVICE_X_XIM (d); if (!xim) - { /* No input method? */ - FRAME_X_XIC (f) = NULL; + { + xim_info ("X Input Method open failed. Waiting for an XIM to be enabled.\n"); return; } + w = FRAME_X_TEXT_WIDGET (f); + + /* + * initialize XIC + */ + if (FRAME_X_XIC (f)) return; XtGetApplicationResources (w, &xic_vars, resources, XtNumber (resources), NULL, 0); - if (!xic_vars.fontset) { - stderr_out ("Can't get fontset resource for Input Method\n"); + xim_warn ("Can't get fontset resource for Input Method\n"); FRAME_X_XIC (f) = NULL; return; } + /* construct xic */ + XGetIMValues (xim, XNQueryInputStyle, &DEVICE_X_XIM_STYLES(d), NULL); FRAME_X_XIC_STYLE (f) = style = - best_style (&xic_vars.styles, DEVICE_X_XIM_STYLES (d)); + best_style (&xic_vars.styles, (XIMStyles *)DEVICE_X_XIM_STYLES(d)); - /* Hopefully we don't have to conditionalize the following based on - style; the IM should ignore values it doesn't use */ p_list = XVaCreateNestedList (0, - XNArea, &p_area, - XNSpotLocation, &spot, - XNForeground, xic_vars.fg, - XNBackground, xic_vars.bg, - XNFontSet, xic_vars.fontset, - NULL); + XNArea, &p_area, + XNSpotLocation, &spot, + XNForeground, xic_vars.fg, + XNBackground, xic_vars.bg, + XNFontSet, xic_vars.fontset, + NULL); s_list = XVaCreateNestedList (0, - XNArea, &s_area, - XNForeground, xic_vars.fg, - XNBackground, xic_vars.bg, - XNFontSet, xic_vars.fontset, - NULL); + XNArea, &s_area, + XNForeground, xic_vars.fg, + XNBackground, xic_vars.bg, + XNFontSet, xic_vars.fontset, + NULL); + FRAME_X_XIC (f) = xic = XCreateIC (xim, - XNInputStyle, style, - XNClientWindow, win, - XNFocusWindow, win, - XNPreeditAttributes, p_list, - XNStatusAttributes, s_list, - NULL); + XNInputStyle, style, + XNClientWindow, win, + XNFocusWindow, win, + XNPreeditAttributes, p_list, + XNStatusAttributes, s_list, + NULL); XFree (p_list); XFree (s_list); if (!xic) { - stderr_out ("Warning: XCreateIC failed\n"); + xim_warn ("Warning: XCreateIC failed.\n"); return; } if (style & XIMPreeditPosition) - { /* Init spot to invalid values */ - XPoint *frame_spot = &(FRAME_X_XIC_SPOT (f)); + { + XPoint *frame_spot = &(FRAME_X_XIC_SPOT(f)); frame_spot->x = frame_spot->y = -1; } @@ -258,11 +400,14 @@ XSetICFocus (xic); -#ifdef DEBUG_XIM - describe_XIC (xic); +#ifdef THIS_IS_X11R6 + /* when frame is going to be destroyed (closed) */ + XtAddCallback (FRAME_X_TEXT_WIDGET(f), XNDestroyCallback, + XIM_delete_frame, (XtPointer)f); #endif } + void XIM_SetGeometry (struct frame *f) { @@ -336,7 +481,7 @@ spot->x = (short) x; spot->y = (short) y; - /* ### FIX: Must make sure spot fits within Preedit Area */ + /* #### FIX: Must make sure spot fits within Preedit Area */ XIC_Value (Set, xic, XNPreeditAttributes, XNSpotLocation, spot); #ifdef DEBUG_XIM stderr_out ("Spot: %d %d\n", spot->x, spot->y); @@ -346,7 +491,7 @@ void XIM_focus_event (struct frame *f, int in_p) { - if (FRAME_X_XIC (f)) + if (FRAME_X_XIC (f) /* && FRAME_X_XIM_REGISTERED(f) */) (in_p ? XSetICFocus : XUnsetICFocus) (FRAME_X_XIC (f)); } @@ -464,9 +609,9 @@ #define STYLE_INFO(style) { style, #style, sizeof(#style) } static struct XIMStyleInfo { - CONST XIMStyle style; - CONST char * CONST name; - CONST int namelen; + const XIMStyle style; + const char * const name; + const int namelen; } emacs_XIMStyleInfo[] = { STYLE_INFO (XIMPreeditPosition|XIMStatusArea), STYLE_INFO (XIMPreeditPosition|XIMStatusNothing), @@ -482,9 +627,9 @@ char *s = (char *) fromVal->addr; char *end = s + fromVal->size; - XIMStyles * CONST p = (XIMStyles *) toVal->addr; - CONST char * CONST delimiter = " \t\n\r:;," ; - CONST int max_styles = XtNumber(emacs_XIMStyleInfo); + XIMStyles * const p = (XIMStyles *) toVal->addr; + const char * const delimiter = " \t\n\r:;," ; + const int max_styles = XtNumber(emacs_XIMStyleInfo); int i; char *c; @@ -637,6 +782,65 @@ return DEFAULTStyle; /* Default Style */ } +/* These lisp-callable functions will be sealed until xim-leim is needed. + Oct 22 1999 - kazz */ +#if 0 +/* + * External callable function for XIM + */ +DEFUN ("x-open-xim", Fx_open_xim, 1, 1, 0, /* +Open the XIC on the frame if XIM is available. +Commonly, use this as \(x-open-xim \(selected-frame)). +If the frame is not on X device, return signal. +If XIC is created successfully return t. If not return nil. +*/ + (frame)) +{ + struct frame *f; + + CHECK_LIVE_FRAME (frame); + f = XFRAME (frame); + if (!FRAME_X_P (f)) + return signal_simple_error ("This frame is not on X device", frame); + + XIM_init_frame (f); + return FRAME_X_XIC (f) ? Qt : Qnil; +} + +DEFUN ("x-close-xim", Fx_close_xim, 1, 1, 0, /* +Close the XIC on the frame if it exists. +Commonly, use this as \(x-close-xim \(selected-frame)). +If the frame is not on X device, return signal. +Otherwise, it destroys the XIC if it exists, then returns t anyway. +*/ + (frame)) +{ + struct frame *f; + struct device *d; + + CHECK_LIVE_FRAME (frame); + f = XFRAME (frame); + if (!FRAME_X_P (f)) + return signal_simple_error ("This frame is not on X device", frame); + + d = XDEVICE (FRAME_DEVICE (f)); + if (DEVICE_X_XIM (d)) { + /* XDestroyIC (FRAME_X_XIC (XFRAME (f))); */ + FRAME_X_XIC (XFRAME (f)) = NULL; + } + return Qt; +} +#endif /* if 0 */ + +void +syms_of_input_method_xlib (void) +{ + defsymbol (&Qxim_xlib, "xim-xlib"); +#if 0 /* see above */ + DEFSUBR (Fx_open_xim); + DEFSUBR (Fx_close_xim); +#endif +} void vars_of_input_method_xlib (void) diff -r f4aeb21a5bad -r 74fd4e045ea6 src/insdel.c --- a/src/insdel.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/insdel.c Mon Aug 13 11:13:30 2007 +0200 @@ -304,10 +304,10 @@ the equivalent length in characters. */ Charcount -bytecount_to_charcount (CONST Bufbyte *ptr, Bytecount len) +bytecount_to_charcount (const Bufbyte *ptr, Bytecount len) { Charcount count = 0; - CONST Bufbyte *end = ptr + len; + const Bufbyte *end = ptr + len; #if (LONGBITS == 32 || LONGBITS == 64) @@ -331,11 +331,11 @@ /* Determine the section in the middle of the string that's amenable to this treatment. Everything has to be aligned on CPU word boundaries. */ - CONST Bufbyte *aligned_ptr = - (CONST Bufbyte *) (((unsigned long) (ptr + LONG_BYTES - 1)) & + const Bufbyte *aligned_ptr = + (const Bufbyte *) (((unsigned long) (ptr + LONG_BYTES - 1)) & ALIGN_MASK); - CONST Bufbyte *aligned_end = - (CONST Bufbyte *) (((unsigned long) end) & ALIGN_MASK); + const Bufbyte *aligned_end = + (const Bufbyte *) (((unsigned long) end) & ALIGN_MASK); /* Handle unaligned stuff at the beginning. */ while (ptr < aligned_ptr) @@ -378,9 +378,9 @@ the equivalent length in bytes. */ Bytecount -charcount_to_bytecount (CONST Bufbyte *ptr, Charcount len) +charcount_to_bytecount (const Bufbyte *ptr, Charcount len) { - CONST Bufbyte *newptr = ptr; + const Bufbyte *newptr = ptr; while (len > 0) { @@ -1605,7 +1605,7 @@ adjust_markers (struct buffer *buf, Memind from, Memind to, Bytecount amount) { - struct Lisp_Marker *m; + Lisp_Marker *m; for (m = BUF_MARKERS (buf); m; m = marker_next (m)) m->memind = do_marker_adjustment (m->memind, from, to, amount); @@ -1617,7 +1617,7 @@ static void adjust_markers_for_insert (struct buffer *buf, Memind ind, Bytecount amount) { - struct Lisp_Marker *m; + Lisp_Marker *m; for (m = BUF_MARKERS (buf); m; m = marker_next (m)) { @@ -1631,18 +1631,6 @@ /* Routines for dealing with the gap */ /************************************************************************/ -/* XEmacs requires an ANSI C compiler, and it damn well better have a - working memmove() */ -#define GAP_USE_BCOPY -#ifdef BCOPY_UPWARD_SAFE -# undef BCOPY_UPWARD_SAFE -#endif -#ifdef BCOPY_DOWNWARD_SAFE -# undef BCOPY_DOWNWARD_SAFE -#endif -#define BCOPY_UPWARD_SAFE 1 -#define BCOPY_DOWNWARD_SAFE 1 - /* maximum amount of memory moved in a single chunk. Increasing this value improves gap-motion efficiency but decreases QUIT responsiveness time. Was 32000 but today's processors are faster and files are @@ -1683,23 +1671,15 @@ /* Move at most GAP_MOVE_CHUNK chars before checking again for a quit. */ if (i > GAP_MOVE_CHUNK) i = GAP_MOVE_CHUNK; -#ifdef GAP_USE_BCOPY - if (i >= 128 - /* bcopy is safe if the two areas of memory do not overlap - or on systems where bcopy is always safe for moving upward. */ - && (BCOPY_UPWARD_SAFE - || to - from >= 128)) + + if (i >= 128) { - /* If overlap is not safe, avoid it by not moving too many - characters at once. */ - if (!BCOPY_UPWARD_SAFE && i > to - from) - i = to - from; new_s1 -= i; - from -= i, to -= i; + from -= i; + to -= i; memmove (to, from, i); } else -#endif { new_s1 -= i; while (--i >= 0) @@ -1762,23 +1742,15 @@ /* Move at most GAP_MOVE_CHUNK chars before checking again for a quit. */ if (i > GAP_MOVE_CHUNK) i = GAP_MOVE_CHUNK; -#ifdef GAP_USE_BCOPY - if (i >= 128 - /* bcopy is safe if the two areas of memory do not overlap - or on systems where bcopy is always safe for moving downward. */ - && (BCOPY_DOWNWARD_SAFE - || from - to >= 128)) + + if (i >= 128) { - /* If overlap is not safe, avoid it by not moving too many - characters at once. */ - if (!BCOPY_DOWNWARD_SAFE && i > from - to) - i = from - to; new_s1 += i; memmove (to, from, i); - from += i, to += i; + from += i; + to += i; } else -#endif { new_s1 += i; while (--i >= 0) @@ -2057,7 +2029,12 @@ of the specified region, that will also be handled correctly. begin_multiple_change() returns a number (actually a specpdl depth) - that you must pass to end_multiple_change() when you are done. */ + that you must pass to end_multiple_change() when you are done. + + FSF Emacs 20 implements a similar feature, accessible from Lisp + through a `combine-after-change-calls' special form, which is + essentially equivalent to this function. We should consider + whether we want to introduce a similar Lisp form. */ int begin_multiple_change (struct buffer *buf, Bufpos start, Bufpos end) @@ -2105,7 +2082,8 @@ /* We should first reset the variable and then change the buffer, because Fset_buffer() can throw. */ inside_change_hook = 0; - Fset_buffer (buffer); + if (XBUFFER (buffer) != current_buffer) + Fset_buffer (buffer); return Qnil; } @@ -2155,6 +2133,7 @@ if (!inside_change_hook) { Lisp_Object buffer; + int speccount; /* Are we in a multiple-change session? */ if (buf->text->changes->in_multiple_change && @@ -2192,6 +2171,9 @@ } /* Now in any case run the before-change-functions if any. */ + speccount = specpdl_depth (); + record_unwind_protect (change_function_restore, Fcurrent_buffer ()); + inside_change_hook = 1; MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) { @@ -2200,25 +2182,28 @@ /* Obsolete, for compatibility */ || !NILP (symbol_value_in_buffer (Qbefore_change_function, buffer))) { - int speccount = specpdl_depth (); - record_unwind_protect (change_function_restore, Fcurrent_buffer ()); set_buffer_internal (buf); - inside_change_hook = 1; va_run_hook_with_args (Qbefore_change_functions, 2, make_int (start), make_int (end)); /* Obsolete, for compatibility */ va_run_hook_with_args (Qbefore_change_function, 2, make_int (start), make_int (end)); - unbind_to (speccount, Qnil); } } + /* Make sure endpoints remain valid. before-change-functions + might have modified the buffer. */ + if (start < BUF_BEGV (buf)) start = BUF_BEGV (buf); + if (start > BUF_ZV (buf)) start = BUF_ZV (buf); + if (end < BUF_BEGV (buf)) end = BUF_BEGV (buf); + if (end > BUF_ZV (buf)) end = BUF_ZV (buf); + MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) { XSETBUFFER (buffer, mbuf); - report_extent_modification (buffer, start, end, - &inside_change_hook, 0); + report_extent_modification (buffer, start, end, 0); } + unbind_to (speccount, Qnil); /* Only now do we indicate that the before-change-functions have been called, in case some function throws out. */ @@ -2255,6 +2240,7 @@ if (!inside_change_hook) { Lisp_Object buffer; + int speccount; if (buf->text->changes->in_multiple_change && buf->text->changes->mc_begin != 0) @@ -2267,6 +2253,9 @@ return; /* after-change-functions signalled when all changes done */ } + speccount = specpdl_depth (); + record_unwind_protect (change_function_restore, Fcurrent_buffer ()); + inside_change_hook = 1; MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) { XSETBUFFER (buffer, mbuf); @@ -2275,10 +2264,7 @@ /* Obsolete, for compatibility */ || !NILP (symbol_value_in_buffer (Qafter_change_function, buffer))) { - int speccount = specpdl_depth (); - record_unwind_protect (change_function_restore, Fcurrent_buffer ()); set_buffer_internal (buf); - inside_change_hook = 1; /* The actual after-change functions take slightly different arguments than what we were passed. */ va_run_hook_with_args (Qafter_change_functions, 3, @@ -2288,16 +2274,24 @@ va_run_hook_with_args (Qafter_change_function, 3, make_int (start), make_int (new_end), make_int (orig_end - start)); - unbind_to (speccount, Qnil); } } + /* Make sure endpoints remain valid. after-change-functions + might have modified the buffer. */ + if (start < BUF_BEGV (buf)) start = BUF_BEGV (buf); + if (start > BUF_ZV (buf)) start = BUF_ZV (buf); + if (new_end < BUF_BEGV (buf)) new_end = BUF_BEGV (buf); + if (new_end > BUF_ZV (buf)) new_end = BUF_ZV (buf); + if (orig_end < BUF_BEGV (buf)) orig_end = BUF_BEGV (buf); + if (orig_end > BUF_ZV (buf)) orig_end = BUF_ZV (buf); + MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) { XSETBUFFER (buffer, mbuf); - report_extent_modification (buffer, start, new_end, - &inside_change_hook, 1); + report_extent_modification (buffer, start, new_end, 1); } + unbind_to (speccount, Qnil); /* sets inside_change_hook back to 0 */ } } @@ -2377,7 +2371,7 @@ /************************************************************************/ void -fixup_internal_substring (CONST Bufbyte *nonreloc, Lisp_Object reloc, +fixup_internal_substring (const Bufbyte *nonreloc, Lisp_Object reloc, Bytecount offset, Bytecount *len) { assert ((nonreloc && NILP (reloc)) || (!nonreloc && STRINGP (reloc))); @@ -2385,7 +2379,7 @@ if (*len < 0) { if (nonreloc) - *len = strlen ((CONST char *) nonreloc) - offset; + *len = strlen ((const char *) nonreloc) - offset; else *len = XSTRING_LENGTH (reloc) - offset; } @@ -2419,7 +2413,7 @@ Charcount buffer_insert_string_1 (struct buffer *buf, Bufpos pos, - CONST Bufbyte *nonreloc, Lisp_Object reloc, + const Bufbyte *nonreloc, Lisp_Object reloc, Bytecount offset, Bytecount length, int flags) { @@ -2584,7 +2578,7 @@ Charcount buffer_insert_raw_string_1 (struct buffer *buf, Bufpos pos, - CONST Bufbyte *nonreloc, Bytecount length, + const Bufbyte *nonreloc, Bytecount length, int flags) { /* This function can GC */ @@ -2608,12 +2602,12 @@ /* Insert the null-terminated string S (in external format). */ Charcount -buffer_insert_c_string_1 (struct buffer *buf, Bufpos pos, CONST char *s, +buffer_insert_c_string_1 (struct buffer *buf, Bufpos pos, const char *s, int flags) { /* This function can GC */ - CONST char *translated = GETTEXT (s); - return buffer_insert_string_1 (buf, pos, (CONST Bufbyte *) translated, Qnil, + const char *translated = GETTEXT (s); + return buffer_insert_string_1 (buf, pos, (const Bufbyte *) translated, Qnil, 0, strlen (translated), flags); } @@ -3079,14 +3073,14 @@ } void -find_charsets_in_bufbyte_string (unsigned char *charsets, CONST Bufbyte *str, +find_charsets_in_bufbyte_string (unsigned char *charsets, const Bufbyte *str, Bytecount len) { #ifndef MULE /* Telescope this. */ charsets[0] = 1; #else - CONST Bufbyte *strend = str + len; + const Bufbyte *strend = str + len; memset (charsets, 0, NUM_LEADING_BYTES); while (str < strend) @@ -3098,7 +3092,7 @@ } void -find_charsets_in_emchar_string (unsigned char *charsets, CONST Emchar *str, +find_charsets_in_emchar_string (unsigned char *charsets, const Emchar *str, Charcount len) { #ifndef MULE @@ -3116,10 +3110,10 @@ } int -bufbyte_string_displayed_columns (CONST Bufbyte *str, Bytecount len) +bufbyte_string_displayed_columns (const Bufbyte *str, Bytecount len) { int cols = 0; - CONST Bufbyte *end = str + len; + const Bufbyte *end = str + len; while (str < end) { @@ -3136,7 +3130,7 @@ } int -emchar_string_displayed_columns (CONST Emchar *str, Charcount len) +emchar_string_displayed_columns (const Emchar *str, Charcount len) { #ifdef MULE int cols = 0; @@ -3154,10 +3148,10 @@ /* NOTE: Does not reset the Dynarr. */ void -convert_bufbyte_string_into_emchar_dynarr (CONST Bufbyte *str, Bytecount len, +convert_bufbyte_string_into_emchar_dynarr (const Bufbyte *str, Bytecount len, Emchar_dynarr *dyn) { - CONST Bufbyte *strend = str + len; + const Bufbyte *strend = str + len; while (str < strend) { @@ -3168,10 +3162,10 @@ } Charcount -convert_bufbyte_string_into_emchar_string (CONST Bufbyte *str, Bytecount len, +convert_bufbyte_string_into_emchar_string (const Bufbyte *str, Bytecount len, Emchar *arr) { - CONST Bufbyte *strend = str + len; + const Bufbyte *strend = str + len; Charcount newlen = 0; while (str < strend) { @@ -3234,7 +3228,7 @@ /************************************************************************/ void -vars_of_insdel (void) +reinit_vars_of_insdel (void) { int i; @@ -3246,6 +3240,12 @@ } void +vars_of_insdel (void) +{ + reinit_vars_of_insdel (); +} + +void init_buffer_text (struct buffer *b) { if (!b->base_buffer) diff -r f4aeb21a5bad -r 74fd4e045ea6 src/insdel.h --- a/src/insdel.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/insdel.h Mon Aug 13 11:13:30 2007 +0200 @@ -22,8 +22,8 @@ /* Mostly rewritten by Ben Wing. */ -#ifndef _XEMACS_INSDEL_H_ -#define _XEMACS_INSDEL_H_ +#ifndef INCLUDED_insdel_h_ +#define INCLUDED_insdel_h_ /************************************************************************/ /* changing a buffer's text */ @@ -38,16 +38,16 @@ #define INSDEL_NO_LOCKING 2 Charcount buffer_insert_string_1 (struct buffer *buf, Bufpos pos, - CONST Bufbyte *nonreloc, Lisp_Object reloc, + const Bufbyte *nonreloc, Lisp_Object reloc, Bytecount offset, Bytecount length, int flags); Charcount buffer_insert_raw_string_1 (struct buffer *buf, Bufpos pos, - CONST Bufbyte *nonreloc, + const Bufbyte *nonreloc, Bytecount length, int flags); Charcount buffer_insert_lisp_string_1 (struct buffer *buf, Bufpos pos, Lisp_Object str, int flags); Charcount buffer_insert_c_string_1 (struct buffer *buf, Bufpos pos, - CONST char *s, int flags); + const char *s, int flags); Charcount buffer_insert_emacs_char_1 (struct buffer *buf, Bufpos pos, Emchar ch, int flags); Charcount buffer_insert_c_char_1 (struct buffer *buf, Bufpos pos, char c, @@ -140,11 +140,11 @@ /************************************************************************/ Memind do_marker_adjustment (Memind mpos, Memind from, - Memind to, int amount); + Memind to, Bytecount amount); -void fixup_internal_substring (CONST Bufbyte *nonreloc, +void fixup_internal_substring (const Bufbyte *nonreloc, Lisp_Object reloc, - int offset, int *len); + Bytecount offset, Bytecount *len); /* In font-lock.c */ void font_lock_maybe_update_syntactic_caches (struct buffer *buf, @@ -159,4 +159,4 @@ void init_buffer_text (struct buffer *b); void uninit_buffer_text (struct buffer *b); -#endif /* _XEMACS_INSDEL_H_ */ +#endif /* INCLUDED_insdel_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/intl.c --- a/src/intl.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/intl.c Mon Aug 13 11:13:30 2007 +0200 @@ -45,7 +45,7 @@ /* init_input -- Set things up for i18n level 4 input. */ void -init_input (CONST char *res_name, CONST char *res_class, Display *display) +init_input (const char *res_name, const char *res_class, Display *display) { XIMStyles *styles; unsigned short i; @@ -165,7 +165,6 @@ #endif /* I18N4 */ -Lisp_Object Qdomain; Lisp_Object Qdefer_gettext; DEFUN ("ignore-defer-gettext", Fignore_defer_gettext, 1, 1, 0, /* @@ -274,14 +273,7 @@ { CHECK_STRING (domain_name); if (load_in_progress) - { -#ifdef I18N3 - Vfile_domain = Fpurecopy (domain_name); - return Vfile_domain; -#else - return (domain_name); -#endif - } + return (domain_name); else return Qnil; } @@ -307,8 +299,6 @@ void syms_of_intl (void) { - defsymbol (&Qdomain, "domain"); - /* defer-gettext is defined as a symbol because when it is used in menu specification strings, it is not evaluated as a function by menu_item_descriptor_to_widget_value(). */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/iso-wide.h --- a/src/iso-wide.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/iso-wide.h Mon Aug 13 11:13:30 2007 +0200 @@ -17,8 +17,8 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_ISO_WIDE_H -#define _XEMACS_ISO_WIDE_H +#ifndef INCLUDED_iso_wide_h_ +#define INCLUDED_iso_wide_h_ /* The following macros are designed for SunOS 5.0 wide characters, in which the single byte ISO Latin-1 character 1xxxxxxx are represented @@ -46,4 +46,4 @@ #define WIDE_TO_BYTE(c) (IS_ISO_WIDE (c) ? ISO_WIDE_TO_BYTE (c) : (c)) #define BYTE_TO_WIDE(c) (IS_ISO_BYTE (c) ? ISO_BYTE_TO_WIDE (c) : (c)) -#endif /* _XEMACS_ISO_WIDE_H */ +#endif /* INCLUDED_iso_wide_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/keymap.c --- a/src/keymap.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/keymap.c Mon Aug 13 11:13:30 2007 +0200 @@ -141,7 +141,7 @@ Since keymaps are opaque, the only way to extract information from them is with the functions lookup-key, key-binding, local-key-binding, and global-key-binding, which work just as before, and the new function - map-keymap, which is roughly analagous to maphash. + map-keymap, which is roughly analogous to maphash. Note that map-keymap perpetuates the illusion that the "bucky" submaps don't exist: if you map over a keymap with bucky submaps, it will also @@ -156,33 +156,25 @@ */ -typedef struct Lisp_Keymap +struct Lisp_Keymap { struct lcrecord_header header; - Lisp_Object parents; /* Keymaps to be searched after this one - * An ordered list */ + Lisp_Object parents; /* Keymaps to be searched after this one. + An ordered list */ Lisp_Object prompt; /* Qnil or a string to print in the minibuffer - * when reading from this keymap */ - + when reading from this keymap */ Lisp_Object table; /* The contents of this keymap */ Lisp_Object inverse_table; /* The inverse mapping of the above */ - Lisp_Object default_binding; /* Use this if no other binding is found - * (this overrides parent maps and the - * normal global-map lookup). */ - - + (this overrides parent maps and the + normal global-map lookup). */ Lisp_Object sub_maps_cache; /* Cache of directly inferior keymaps; This holds an alist, of the key and the maps, or the modifier bit and the map. If this is the symbol t, then the cache - needs to be recomputed. - */ - int fullness; /* How many entries there are in this table. - This should be the same as the fullness - of the `table', but hash.c is broken. */ + needs to be recomputed. */ Lisp_Object name; /* Just for debugging convenience */ -} Lisp_Keymap; +}; #define MAKE_MODIFIER_HASH_KEY(modifier) make_int (modifier) #define MODIFIER_HASH_KEY_BITS(x) (INTP (x) ? XINT (x) : 0) @@ -191,7 +183,7 @@ /* Actually allocate storage for these variables */ -static Lisp_Object Vcurrent_global_map; /* Always a keymap */ +Lisp_Object Vcurrent_global_map; /* Always a keymap */ static Lisp_Object Vmouse_grabbed_buffer; @@ -230,6 +222,7 @@ Lisp_Object shadow, int mice_only_p, Lisp_Object buffer); +static Lisp_Object keymap_submaps (Lisp_Object keymap); Lisp_Object Qcontrol, Qctrl, Qmeta, Qsuper, Qhyper, Qalt, Qshift; Lisp_Object Qbutton0, Qbutton1, Qbutton2, Qbutton3; @@ -252,15 +245,15 @@ /************************************************************************/ static Lisp_Object -mark_keymap (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_keymap (Lisp_Object obj) { Lisp_Keymap *keymap = XKEYMAP (obj); - markobj (keymap->parents); - markobj (keymap->prompt); - markobj (keymap->inverse_table); - markobj (keymap->sub_maps_cache); - markobj (keymap->default_binding); - markobj (keymap->name); + mark_object (keymap->parents); + mark_object (keymap->prompt); + mark_object (keymap->inverse_table); + mark_object (keymap->sub_maps_cache); + mark_object (keymap->default_binding); + mark_object (keymap->name); return keymap->table; } @@ -270,24 +263,34 @@ /* This function can GC */ Lisp_Keymap *keymap = XKEYMAP (obj); char buf[200]; - int size = XINT (Fkeymap_fullness (obj)); if (print_readably) error ("printing unreadable object #<keymap 0x%x>", keymap->header.uid); write_c_string ("#<keymap ", printcharfun); if (!NILP (keymap->name)) - print_internal (keymap->name, printcharfun, 1); - /* #### Yuck! This is no way to form plural! --hniksic */ - sprintf (buf, "%s%d entr%s 0x%x>", - ((NILP (keymap->name)) ? "" : " "), - size, - ((size == 1) ? "y" : "ies"), - keymap->header.uid); + { + print_internal (keymap->name, printcharfun, 1); + write_c_string (" ", printcharfun); + } + sprintf (buf, "size %ld 0x%x>", + (long) XINT (Fkeymap_fullness (obj)), keymap->header.uid); write_c_string (buf, printcharfun); } +static const struct lrecord_description keymap_description[] = { + { XD_LISP_OBJECT, offsetof (Lisp_Keymap, parents) }, + { XD_LISP_OBJECT, offsetof (Lisp_Keymap, prompt) }, + { XD_LISP_OBJECT, offsetof (Lisp_Keymap, table) }, + { XD_LISP_OBJECT, offsetof (Lisp_Keymap, inverse_table) }, + { XD_LISP_OBJECT, offsetof (Lisp_Keymap, default_binding) }, + { XD_LISP_OBJECT, offsetof (Lisp_Keymap, sub_maps_cache) }, + { XD_LISP_OBJECT, offsetof (Lisp_Keymap, name) }, + { XD_END } +}; + /* No need for keymap_equal #### Why not? */ DEFINE_LRECORD_IMPLEMENTATION ("keymap", keymap, mark_keymap, print_keymap, 0, 0, 0, + keymap_description, Lisp_Keymap); /************************************************************************/ @@ -312,19 +315,19 @@ start_keymap = get_keymap (start_keymap, 1, 1); keymap = start_keymap; /* Hack special-case parents at top-level */ - tail = ((!NILP (tail)) ? tail : XKEYMAP (keymap)->parents); + tail = !NILP (tail) ? tail : XKEYMAP (keymap)->parents; for (;;) { Lisp_Object result; QUIT; - result = ((mapper) (keymap, mapper_arg)); + result = mapper (keymap, mapper_arg); if (!NILP (result)) { while (CONSP (malloc_bites)) { - struct Lisp_Cons *victim = XCONS (malloc_bites); + Lisp_Cons *victim = XCONS (malloc_bites); malloc_bites = victim->cdr; free_cons (victim); } @@ -341,7 +344,7 @@ stack_depth--; if (CONSP (malloc_bites)) { - struct Lisp_Cons *victim = XCONS (malloc_bites); + Lisp_Cons *victim = XCONS (malloc_bites); tail = victim->car; malloc_bites = victim->cdr; free_cons (victim); @@ -433,7 +436,7 @@ } static Lisp_Object -make_key_description (CONST struct key_data *key, int prettify) +make_key_description (const struct key_data *key, int prettify) { Lisp_Object keysym = key->keysym; unsigned int modifiers = key->modifiers; @@ -461,7 +464,7 @@ static Lisp_Object raw_lookup_key (Lisp_Object keymap, - CONST struct key_data *raw_keys, int raw_keys_count, + const struct key_data *raw_keys, int raw_keys_count, int keys_so_far, int accept_default); /* Relies on caller to gc-protect args */ @@ -576,31 +579,50 @@ */ } +/* Prevent luser from shooting herself in the foot using something like + (define-key ctl-x-4-map "p" global-map) */ +static void +check_keymap_definition_loop (Lisp_Object def, Lisp_Keymap *to_keymap) +{ + def = get_keymap (def, 0, 0); + + if (KEYMAPP (def)) + { + Lisp_Object maps; + + if (XKEYMAP (def) == to_keymap) + signal_simple_error ("Cyclic keymap definition", def); + + for (maps = keymap_submaps (def); + CONSP (maps); + maps = XCDR (maps)) + check_keymap_definition_loop (XCDR (XCAR (maps)), to_keymap); + } +} static void keymap_store_internal (Lisp_Object keysym, Lisp_Keymap *keymap, - Lisp_Object value) + Lisp_Object def) { - Lisp_Object prev_value = Fgethash (keysym, keymap->table, Qnil); - - if (EQ (prev_value, value)) + Lisp_Object prev_def = Fgethash (keysym, keymap->table, Qnil); + + if (EQ (prev_def, def)) return; - if (!NILP (prev_value)) + + check_keymap_definition_loop (def, keymap); + + if (!NILP (prev_def)) keymap_delete_inverse_internal (keymap->inverse_table, - keysym, prev_value); - if (NILP (value)) + keysym, prev_def); + if (NILP (def)) { - keymap->fullness--; - if (keymap->fullness < 0) abort (); Fremhash (keysym, keymap->table); } else { - if (NILP (prev_value)) - keymap->fullness++; - Fputhash (keysym, value, keymap->table); + Fputhash (keysym, def, keymap->table); keymap_store_inverse_internal (keymap->inverse_table, - keysym, value); + keysym, def); } keymap_tick++; } @@ -623,26 +645,19 @@ /* Relies on caller to gc-protect keymap, keysym, value */ static void -keymap_store (Lisp_Object keymap, CONST struct key_data *key, +keymap_store (Lisp_Object keymap, const struct key_data *key, Lisp_Object value) { Lisp_Object keysym = key->keysym; unsigned int modifiers = key->modifiers; - Lisp_Keymap *k; - - if ((modifiers & ~(MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER - | MOD_ALT | MOD_SHIFT)) != 0) - abort (); - - k = XKEYMAP (keymap); + Lisp_Keymap *k = XKEYMAP (keymap); + + assert ((modifiers & ~(MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER + | MOD_ALT | MOD_SHIFT)) == 0); /* If the keysym is a one-character symbol, use the char code instead. */ if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1) - { - Lisp_Object run_the_gcc_developers_over_with_a_steamroller = - make_char (string_char (XSYMBOL (keysym)->name, 0)); - keysym = run_the_gcc_developers_over_with_a_steamroller; - } + keysym = make_char (string_char (XSYMBOL (keysym)->name, 0)); if (modifiers & MOD_META) /* Utterly hateful ESC lossage */ { @@ -742,7 +757,7 @@ make_keymap (size_t size) { Lisp_Object result; - Lisp_Keymap *keymap = alloc_lcrecord_type (Lisp_Keymap, lrecord_keymap); + Lisp_Keymap *keymap = alloc_lcrecord_type (Lisp_Keymap, &lrecord_keymap); XSETKEYMAP (result, keymap); @@ -752,7 +767,6 @@ keymap->inverse_table = Qnil; keymap->default_binding = Qnil; keymap->sub_maps_cache = Qnil; /* No possible submaps */ - keymap->fullness = 0; keymap->name = Qnil; if (size != 0) /* hack for copy-keymap */ @@ -1044,7 +1058,7 @@ struct key_data indirection; if (CHARP (idx)) { - struct Lisp_Event event; + Lisp_Event event; event.event_type = empty_event; character_to_event (XCHAR (idx), &event, XCONSOLE (Vselected_console), 0, 0); @@ -1086,7 +1100,7 @@ } static Lisp_Object -keymap_lookup_1 (Lisp_Object keymap, CONST struct key_data *key, +keymap_lookup_1 (Lisp_Object keymap, const struct key_data *key, int accept_default) { /* This function can GC */ @@ -1130,10 +1144,10 @@ copy_keymap_inverse_closure.inverse_table = keymap->inverse_table; new_keymap->parents = Fcopy_sequence (keymap->parents); - new_keymap->fullness = keymap->fullness; new_keymap->sub_maps_cache = Qnil; /* No submaps */ new_keymap->table = Fcopy_hash_table (keymap->table); new_keymap->inverse_table = Fcopy_hash_table (keymap->inverse_table); + new_keymap->default_binding = keymap->default_binding; /* After copying the inverse map, we need to copy the conses which are its values, lest they be shared by the copy, and mangled. */ @@ -1207,16 +1221,17 @@ struct gcpro gcpro1, gcpro2; keymap = get_keymap (keymap, 1, 1); - fullness = XKEYMAP (keymap)->fullness; - sub_maps = keymap_submaps (keymap); + fullness = XINT (Fhash_table_count (XKEYMAP (keymap)->table)); GCPRO2 (keymap, sub_maps); - for (; !NILP (sub_maps); sub_maps = XCDR (sub_maps)) + for (sub_maps = keymap_submaps (keymap); + !NILP (sub_maps); + sub_maps = XCDR (sub_maps)) { if (MODIFIER_HASH_KEY_BITS (XCAR (XCAR (sub_maps))) != 0) { - Lisp_Object sub_map = XCDR (XCAR (sub_maps)); - fullness--; /* don't count bucky maps */ - fullness += keymap_fullness (sub_map); + Lisp_Object bucky_map = XCDR (XCAR (sub_maps)); + fullness--; /* don't count bucky maps themselves. */ + fullness += keymap_fullness (bucky_map); } } UNGCPRO; @@ -1273,14 +1288,12 @@ } else { - signal_simple_error ("Unknown keysym specifier", - *keysym); + signal_simple_error ("Unknown keysym specifier", *keysym); } if (SYMBOLP (*keysym)) { - char *name = (char *) - string_data (XSYMBOL (*keysym)->name); + char *name = (char *) string_data (XSYMBOL (*keysym)->name); /* FSFmacs uses symbols with the printed representation of keysyms in their names, like 'M-x, and we use the syntax '(meta x). So, to avoid @@ -1343,6 +1356,8 @@ *keysym = QKescape; else if (EQ (*keysym, QDEL)) *keysym = QKdelete; + else if (EQ (*keysym, QSPC)) + *keysym = QKspace; else if (EQ (*keysym, QBS)) *keysym = QKbackspace; /* Emacs compatibility */ @@ -1382,7 +1397,7 @@ { if (CHAR_OR_CHAR_INTP (spec)) { - struct Lisp_Event event; + Lisp_Event event; event.event_type = empty_event; character_to_event (XCHAR_OR_CHAR_INT (spec), &event, XCONSOLE (Vselected_console), 0, 0); @@ -1530,8 +1545,7 @@ int -event_matches_key_specifier_p (struct Lisp_Event *event, - Lisp_Object key_specifier) +event_matches_key_specifier_p (Lisp_Event *event, Lisp_Object key_specifier) { Lisp_Object event2; int retval; @@ -1582,9 +1596,9 @@ } static int -meta_prefix_char_p (CONST struct key_data *key) +meta_prefix_char_p (const struct key_data *key) { - struct Lisp_Event event; + Lisp_Event event; event.event_type = key_press_event; event.channel = Vselected_console; @@ -1890,20 +1904,17 @@ (defvar my-escape-map (lookup-key my-map "\e")) if the luser really wants the map in a variable. */ - Lisp_Object mmap; + Lisp_Object meta_map; struct gcpro ngcpro1; NGCPRO1 (c); - mmap = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META), - XKEYMAP (keymap)->table, Qnil); - if (!NILP (mmap) - && keymap_fullness (mmap) != 0) - { - Lisp_Object desc - = Fsingle_key_description (Vmeta_prefix_char); - signal_simple_error_2 - ("Map contains meta-bindings, can't bind", desc, keymap); - } + meta_map = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META), + XKEYMAP (keymap)->table, Qnil); + if (!NILP (meta_map) + && keymap_fullness (meta_map) != 0) + signal_simple_error_2 + ("Map contains meta-bindings, can't bind", + Fsingle_key_description (Vmeta_prefix_char), keymap); NUNGCPRO; } else @@ -1924,7 +1935,7 @@ if (metized) { - raw_key1.modifiers |= MOD_META; + raw_key1.modifiers |= MOD_META; raw_key2.modifiers |= MOD_META; metized = 0; } @@ -1981,7 +1992,7 @@ struct raw_lookup_key_mapper_closure { int remaining; - CONST struct key_data *raw_keys; + const struct key_data *raw_keys; int raw_keys_count; int keys_so_far; int accept_default; @@ -1992,7 +2003,7 @@ /* Caller should gc-protect args (keymaps may autoload) */ static Lisp_Object raw_lookup_key (Lisp_Object keymap, - CONST struct key_data *raw_keys, int raw_keys_count, + const struct key_data *raw_keys, int raw_keys_count, int keys_so_far, int accept_default) { /* This function can GC */ @@ -2015,7 +2026,7 @@ int accept_default = c->accept_default; int remaining = c->remaining; int keys_so_far = c->keys_so_far; - CONST struct key_data *raw_keys = c->raw_keys; + const struct key_data *raw_keys = c->raw_keys; Lisp_Object cmd; if (! meta_prefix_char_p (&(raw_keys[0]))) @@ -2106,7 +2117,7 @@ if (nkeys == 0) return Qnil; - if (nkeys < (countof (kkk))) + if (nkeys < countof (kkk)) raw_keys = kkk; else raw_keys = alloca_array (struct key_data, nkeys); @@ -2136,7 +2147,7 @@ nkeys = event_chain_count (event_head); - if (nkeys < (countof (kkk))) + if (nkeys < countof (kkk)) raw_keys = kkk; else raw_keys = alloca_array (struct key_data, nkeys); @@ -2362,8 +2373,7 @@ get_relevant_extent_keymaps (Fevent_modeline_position (terminal), XBUFFER (buffer)->generated_modeline_string, - /* #### third arg should maybe be a glyph. */ - Qnil, &closure); + Fevent_glyph_extent (terminal), &closure); if (!UNBOUNDP (map) && !NILP (map)) relevant_map_push (get_keymap (map, 1, 1), &closure); @@ -2731,7 +2741,7 @@ struct map_keymap_unsorted_closure { - void (*fn) (CONST struct key_data *, Lisp_Object binding, void *arg); + void (*fn) (const struct key_data *, Lisp_Object binding, void *arg); void *arg; unsigned int modifiers; }; @@ -2870,7 +2880,7 @@ static void map_keymap_sorted (Lisp_Object keymap_table, unsigned int modifiers, - void (*function) (CONST struct key_data *key, + void (*function) (const struct key_data *key, Lisp_Object binding, void *map_keymap_sorted_closure), void *map_keymap_sorted_closure) @@ -2915,7 +2925,7 @@ /* used by Fmap_keymap() */ static void -map_keymap_mapper (CONST struct key_data *key, +map_keymap_mapper (const struct key_data *key, Lisp_Object binding, void *function) { @@ -2928,7 +2938,7 @@ static void map_keymap (Lisp_Object keymap_table, int sort_first, - void (*function) (CONST struct key_data *key, + void (*function) (const struct key_data *key, Lisp_Object binding, void *fn_arg), void *fn_arg) @@ -3084,23 +3094,28 @@ c.tail = Qnil; GCPRO4 (accessible_keymaps, c.tail, prefix, keymap); + keymap = get_keymap (keymap, 1, 1); + retry: - keymap = get_keymap (keymap, 1, 1); if (NILP (prefix)) - prefix = make_vector (0, Qnil); - else if (!VECTORP (prefix) || STRINGP (prefix)) { - prefix = wrong_type_argument (Qarrayp, prefix); - goto retry; + prefix = make_vector (0, Qnil); } - else + else if (VECTORP (prefix) || STRINGP (prefix)) { int len = XINT (Flength (prefix)); - Lisp_Object def = Flookup_key (keymap, prefix, Qnil); + Lisp_Object def; Lisp_Object p; int iii; struct gcpro ngcpro1; + if (len == 0) + { + prefix = Qnil; + goto retry; + } + + def = Flookup_key (keymap, prefix, Qnil); def = get_keymap (def, 0, 1); if (!KEYMAPP (def)) goto RETURN; @@ -3117,12 +3132,16 @@ NUNGCPRO; prefix = p; } + else + { + prefix = wrong_type_argument (Qarrayp, prefix); + goto retry; + } accessible_keymaps = list1 (Fcons (prefix, keymap)); - /* For each map in the list maps, - look at any other maps it points to - and stick them at the end if they are not already in the list */ + /* For each map in the list maps, look at any other maps it points + to and stick them at the end if they are not already in the list */ for (c.tail = accessible_keymaps; !NILP (c.tail); @@ -3167,9 +3186,9 @@ for (i = 0; i < size; i++) { Lisp_Object s2 = Fsingle_key_description - (((STRINGP (keys)) - ? make_char (string_char (XSTRING (keys), i)) - : XVECTOR_DATA (keys)[i])); + (STRINGP (keys) + ? make_char (string_char (XSTRING (keys), i)) + : XVECTOR_DATA (keys)[i]); if (i == 0) string = s2; @@ -3200,7 +3219,7 @@ char buf [255]; if (!EVENTP (key)) { - struct Lisp_Event event; + Lisp_Event event; event.event_type = empty_event; CHECK_CHAR_COERCE_INT (key); character_to_event (XCHAR (key), &event, @@ -3449,7 +3468,7 @@ format_raw_keys (struct key_data *keys, int count, char *buf) { int i; - struct Lisp_Event event; + Lisp_Event event; event.event_type = key_press_event; event.channel = Vselected_console; for (i = 0; i < count; i++) @@ -3506,9 +3525,9 @@ /* This function can GC */ struct where_is_closure *c = (struct where_is_closure *) arg; Lisp_Object definition = c->definition; - CONST int firstonly = c->firstonly; - CONST unsigned int keys_count = c->keys_count; - CONST unsigned int modifiers_so_far = c->modifiers_so_far; + const int firstonly = c->firstonly; + const unsigned int keys_count = c->keys_count; + const unsigned int modifiers_so_far = c->modifiers_so_far; char *target_buffer = c->target_buffer; Lisp_Object keys = Fgethash (definition, XKEYMAP (map)->inverse_table, @@ -3526,7 +3545,7 @@ for (;;) /* loop over all keys that match */ { - Lisp_Object k = ((CONSP (keys)) ? XCAR (keys) : keys); + Lisp_Object k = CONSP (keys) ? XCAR (keys) : keys; int i; so_far [keys_count].keysym = k; @@ -3624,7 +3643,7 @@ if (! c->keys_so_far_malloced) { struct key_data *new = xnew_array (struct key_data, size); - memcpy ((void *)new, (CONST void *)c->keys_so_far, + memcpy ((void *)new, (const void *)c->keys_so_far, c->keys_so_far_total_size * sizeof (struct key_data)); } else @@ -3877,7 +3896,7 @@ struct describe_map_shadow_closure { - CONST struct key_data *raw_key; + const struct key_data *raw_key; Lisp_Object self; }; @@ -3906,7 +3925,7 @@ static void -describe_map_mapper (CONST struct key_data *key, +describe_map_mapper (const struct key_data *key, Lisp_Object binding, void *describe_map_closure) { @@ -4266,6 +4285,7 @@ defsymbol (&QRET, "RET"); defsymbol (&QESC, "ESC"); defsymbol (&QDEL, "DEL"); + defsymbol (&QSPC, "SPC"); defsymbol (&QBS, "BS"); } @@ -4319,7 +4339,7 @@ staticpro (&Vcurrent_global_map); - Vsingle_space_string = make_pure_string ((CONST Bufbyte *) " ", 1, Qnil, 1); + Vsingle_space_string = make_string ((const Bufbyte *) " ", 1); staticpro (&Vsingle_space_string); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/keymap.h --- a/src/keymap.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/keymap.h Mon Aug 13 11:13:30 2007 +0200 @@ -21,14 +21,15 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_KEYMAP_H_ -#define _XEMACS_KEYMAP_H_ +#ifndef INCLUDED_keymap_h_ +#define INCLUDED_keymap_h_ -DECLARE_LRECORD (keymap, struct Lisp_Keymap); -#define XKEYMAP(x) XRECORD (x, keymap, struct Lisp_Keymap) +typedef struct Lisp_Keymap Lisp_Keymap; + +DECLARE_LRECORD (keymap, Lisp_Keymap); +#define XKEYMAP(x) XRECORD (x, keymap, Lisp_Keymap) #define XSETKEYMAP(x, p) XSETRECORD (x, p, keymap) #define KEYMAPP(x) RECORDP (x, keymap) -#define GC_KEYMAPP(x) GC_RECORDP (x, keymap) #define CHECK_KEYMAP(x) CHECK_RECORD (x, keymap) #define CONCHECK_KEYMAP(x) CONCHECK_RECORD (x, keymap) @@ -56,7 +57,7 @@ void key_desc_list_to_event (Lisp_Object list, Lisp_Object event, int allow_menu_events); -int event_matches_key_specifier_p (struct Lisp_Event *event, +int event_matches_key_specifier_p (Lisp_Event *event, Lisp_Object key_specifier); -#endif /* _XEMACS_KEYMAP_H_ */ +#endif /* INCLUDED_keymap_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/libsst.c --- a/src/libsst.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/libsst.c Mon Aug 13 11:13:30 2007 +0200 @@ -20,29 +20,25 @@ #include "lisp.h" #endif -#ifdef STDC_HEADERS #include <stdlib.h> -#endif +#include <stdio.h> +#include <fcntl.h> #ifdef HAVE_UNISTD_H #include <unistd.h> #endif -#include <stdio.h> -#include <fcntl.h> #include "libsst.h" #define AUDBUF 1024 -extern void usleep(); - int sst_open(play_level, record_level) int play_level, record_level; { int fd, i, gr, ger, gx; struct audio_ioctl ai; - char *getenv(), *ep; + char *ep; fd = open( "/dev/audio", O_RDWR ); if ( fd < 0 ) diff -r f4aeb21a5bad -r 74fd4e045ea6 src/libsst.h --- a/src/libsst.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/libsst.h Mon Aug 13 11:13:30 2007 +0200 @@ -12,6 +12,9 @@ /* Synched up with: Not in FSF. */ +#ifndef INCLUDED_libsst_h_ +#define INCLUDED_libsst_h_ + #include <sys/ioctl.h> #ifndef SUNOS4_0_3 #define AUDIO_4_0_3_COMPAT @@ -46,3 +49,5 @@ #else /* !emacs */ # define warn(str) fprintf (stderr, "%s\n", (str)) #endif /* emacs */ + +#endif /* INCLUDED_libsst_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/libst.h --- a/src/libst.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/libst.h Mon Aug 13 11:13:30 2007 +0200 @@ -12,6 +12,9 @@ /* Synched up with: Not in FSF. */ +#ifndef INCLUDED_libst_h_ +#define INCLUDED_libst_h_ + #define SAMPLES_PER_SECOND 8192 #define MINLIN -32768 @@ -65,3 +68,5 @@ 244, 228, 212, 196, 180, 164, 148, 132, 120, 112, 104, 96, 88, 80, 72, 64, 56, 48, 40, 32, 24, 16, 8, 0 }; + +#endif /* INCLUDED_libst_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/line-number.c --- a/src/line-number.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/line-number.c Mon Aug 13 11:13:30 2007 +0200 @@ -158,7 +158,7 @@ This will do nothing if the cache is uninitialized. */ void insert_invalidate_line_number_cache (struct buffer *b, Bufpos pos, - CONST Bufbyte *nonreloc, Bytecount length) + const Bufbyte *nonreloc, Bytecount length) { if (NILP (b->text->line_number_cache)) return; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/line-number.h --- a/src/line-number.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/line-number.h Mon Aug 13 11:13:30 2007 +0200 @@ -17,11 +17,16 @@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ +#ifndef INCLUDED_line_number_h_ +#define INCLUDED_line_number_h_ + /* Synched up with: Not in FSF. */ void narrow_line_number_cache (struct buffer *); void insert_invalidate_line_number_cache (struct buffer *, Bufpos, - CONST Bufbyte *, Bytecount); + const Bufbyte *, Bytecount); void delete_invalidate_line_number_cache (struct buffer *, Bufpos, Bufpos); EMACS_INT buffer_line_number (struct buffer *, Bufpos, int); + +#endif /* INCLUDED_line_number_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/linuxplay.c --- a/src/linuxplay.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/linuxplay.c Mon Aug 13 11:13:30 2007 +0200 @@ -1,7 +1,8 @@ /* linuxplay.c - play a sound file on the speaker ** ** Copyright (C) 1995,96 by Markus Gutschke (gutschk@math.uni-muenster.de) - ** This is version 1.3 of linuxplay.c + ** This is version 1.3 of linuxplay.c, with platform-independent functions + ** moved to a different file by Robert Bihlmeyer <robbe@orcus.priv.at>. ** ** Parts of this code were inspired by sunplay.c, which is copyright 1989 by ** Jef Poskanzer and 1991,92 by Jamie Zawinski; c.f. sunplay.c for further @@ -45,9 +46,6 @@ /* Synched up with: Not in FSF. */ -#define HEADERSZ 256 /* has to be at least as big as the biggest header */ -#define SNDBUFSZ 2048 /* has to be at least as big as HEADERSZ */ - /* XEmacs beta testers say: undef this by default. */ #undef NOVOLUMECTRLFORMULAW /* Changing the volume for uLaw-encoded samples sounds very poor; possibly, @@ -59,6 +57,8 @@ #include <config.h> #endif +#include "miscplay.h" + #include <errno.h> #include <fcntl.h> #include SOUNDCARD_H_PATH /* Path computed by configure */ @@ -82,62 +82,19 @@ #define warn(str) message("audio: %s ",GETTEXT(str)) #endif -#ifdef __GNUC__ -#define UNUSED(x) ((void)(x)) -#else -#define UNUSED(x) -#define __inline__ -#endif - -static void (*sighup_handler)(int); -static void (*sigint_handler)(int); - -/* Maintain global variable for keeping parser state information; this struct - is set to zero before the first invocation of the parser. The use of a - global variable prevents multiple concurrent executions of this code, but - this does not happen anyways... */ -enum wvState -{ wvMain, - wvSubchunk, - wvOutOfBlock, - wvSkipChunk, - wvSoundChunk, - wvFatal, - wvFatalNotify -}; - -static union { - struct { - int align; - enum wvState state; - size_t left; - unsigned char leftover[HEADERSZ]; - signed long chunklength; - } wave; - struct { - int align; - int isdata; - int skipping; - size_t left; - unsigned char leftover[HEADERSZ]; - } audio; -} parsestate; - -/* Use a global buffer as scratch-pad for possible conversions of the - sampling format */ -unsigned char linuxplay_sndbuf[SNDBUFSZ]; +static SIGTYPE (*sighup_handler) (int); +static SIGTYPE (*sigint_handler) (int); static int mix_fd; static int audio_vol; static int audio_fd; static char *audio_dev = "/dev/dsp"; -typedef enum {fmtIllegal,fmtRaw,fmtVoc,fmtWave,fmtSunAudio} fmtType; - /* Intercept SIGINT and SIGHUP in order to close the audio and mixer devices before terminating sound output; this requires reliable signals as provided by "syssignal.h" */ -static void sighandler(int sig) +static SIGTYPE +sighandler (int sig) { if (mix_fd > 0) { if (audio_vol >= 0) { @@ -156,649 +113,6 @@ else exit(1); } -/* There is no special treatment required for parsing raw data files; we - assume that these files contain data in 8bit unsigned format that - has been sampled at 8kHz; there is no extra header */ -static size_t parseraw(void **data,size_t *sz,void **outbuf) -{ - int rc = *sz; - - *outbuf = *data; - *sz = 0; - return(rc); -} - -/* Currently we cannot cope with files in VOC format; if you really need - to play these files, they should be converted by using SOX */ -static size_t parsevoc(void **data,size_t *sz,void **outbuf) -{ - UNUSED(data); - UNUSED(sz); - UNUSED(outbuf); - return(0); -} - -/* We need to perform some look-ahead in order to parse files in WAVE format; - this might require re-partioning of the data segments if headers cross the - boundaries between two read operations. This is done in a two-step way: - first we request a certain amount of bytes... */ -static __inline__ int waverequire(void **data,size_t *sz,size_t rq) -{ - int rc = 1; - - if (rq > HEADERSZ) { - warn("Header size exceeded while parsing WAVE file"); - parsestate.wave.state = wvFatal; - *sz = 0; - return(0); } - if ((rq -= parsestate.wave.left) <= 0) - return(rc); - if (rq > *sz) {rq = *sz; rc = 0;} - memcpy(parsestate.wave.leftover+parsestate.wave.left, - *data,rq); - parsestate.wave.left += rq; - (*(unsigned char **)data) += rq; - *sz -= rq; - return(rc); -} - -/* ...and next we remove this many bytes from the buffer */ -static __inline__ void waveremove(size_t rq) -{ - if (parsestate.wave.left <= rq) - parsestate.wave.left = 0; - else { - parsestate.wave.left -= rq; - memmove(parsestate.wave.leftover, - parsestate.wave.leftover+rq, - parsestate.wave.left); } - return; -} - -/* Sound files in WAVE format can contain an arbitrary amount of tagged - chunks; this requires quite some effort for parsing the data */ -static size_t parsewave(void **data,size_t *sz,void **outbuf) -{ - for (;;) - switch (parsestate.wave.state) { - case wvMain: - if (!waverequire(data,sz,20)) - return(0); - /* Keep compatibility with Linux 68k, etc. by not relying on byte-sex */ - parsestate.wave.chunklength = parsestate.wave.leftover[16] + - 256*(parsestate.wave.leftover[17] + - 256*(parsestate.wave.leftover[18] + - 256*parsestate.wave.leftover[19])); - waveremove(20); - parsestate.wave.state = wvSubchunk; - break; - case wvSubchunk: - if (!waverequire(data,sz,parsestate.wave.chunklength)) - return(0); - parsestate.wave.align = parsestate.wave.chunklength < 14 ? 1 - : parsestate.wave.leftover[12]; - if (parsestate.wave.align != 1 && - parsestate.wave.align != 2 && - parsestate.wave.align != 4) { - warn("Illegal datawidth detected while parsing WAVE file"); - parsestate.wave.state = wvFatal; } - else - parsestate.wave.state = wvOutOfBlock; - waveremove(parsestate.wave.chunklength); - break; - case wvOutOfBlock: - if (!waverequire(data,sz,8)) - return(0); - /* Keep compatibility with Linux 68k, etc. by not relying on byte-sex */ - parsestate.wave.chunklength = parsestate.wave.leftover[4] + - 256*(parsestate.wave.leftover[5] + - 256*(parsestate.wave.leftover[6] + - 256*(parsestate.wave.leftover[7] & 0x7F))); - if (memcmp(parsestate.wave.leftover,"data",4)) - parsestate.wave.state = wvSkipChunk; - else - parsestate.wave.state = wvSoundChunk; - waveremove(8); - break; - case wvSkipChunk: - if (parsestate.wave.chunklength > 0 && *sz > 0 && - (signed long)*sz < (signed long)parsestate.wave.chunklength) { - parsestate.wave.chunklength -= *sz; - *sz = 0; } - else { - if (parsestate.wave.chunklength > 0 && *sz > 0) { - *sz -= parsestate.wave.chunklength; - (*(unsigned char **)data) += parsestate.wave.chunklength; } - parsestate.wave.state = wvOutOfBlock; } - break; - case wvSoundChunk: { - size_t count,rq; - if (parsestate.wave.left) { /* handle leftover bytes from last - alignment operation */ - count = parsestate.wave.left; - rq = HEADERSZ-count; - if (rq > (size_t) parsestate.wave.chunklength) - rq = parsestate.wave.chunklength; - if (!waverequire(data,sz,rq)) { - parsestate.wave.chunklength -= parsestate.wave.left - count; - return(0); } - parsestate.wave.chunklength -= rq; - *outbuf = parsestate.wave.leftover; - parsestate.wave.left = 0; - return(rq); } - if (*sz >= (size_t) parsestate.wave.chunklength) { - count = parsestate.wave.chunklength; - rq = 0; } - else { - count = *sz; - count -= rq = count % parsestate.wave.align; } - *outbuf = *data; - (*(unsigned char **)data) += count; - *sz -= count; - if ((parsestate.wave.chunklength -= count) < parsestate.wave.align) { - parsestate.wave.state = wvOutOfBlock; - /* Some broken software (e.g. SOX) attaches junk to the end of a sound - chunk; so, let's ignore this... */ - if (parsestate.wave.chunklength) - parsestate.wave.state = wvSkipChunk; } - else if (rq) - /* align data length to a multiple of datasize; keep additional data - in "leftover" buffer --- this is necessary to ensure proper - functioning of the sndcnv... routines */ - waverequire(data,sz,rq); - return(count); } - case wvFatalNotify: - warn("Irrecoverable error while parsing WAVE file"); - parsestate.wave.state = wvFatal; - break; - case wvFatal: - default: - *sz = 0; - return(0); } -} - -/* Strip the header from files in Sun/DEC audio format; this requires some - extra processing as the header can be an arbitrary size and it might - result in alignment errors for subsequent conversions --- thus we do - some buffering, where needed */ -static size_t parsesundecaudio(void **data,size_t *sz,void **outbuf) -{ - /* There is data left over from the last invocation of this function; join - it with the new data and return a sound chunk that is as big as a - single entry */ - if (parsestate.audio.left) { - if (parsestate.audio.left + *sz > (size_t) parsestate.audio.align) { - int count; - memmove(parsestate.audio.leftover + parsestate.audio.left, - *data, - count = parsestate.audio.align - parsestate.audio.left); - *outbuf = parsestate.audio.leftover; - *sz -= count; - *data = (*(char **)data) + count; - parsestate.audio.left = 0; - return(parsestate.audio.align); } - else { - /* We need even more data in order to get one complete single entry! */ - memmove(parsestate.audio.leftover + parsestate.audio.left, - *data, - *sz); - *data = (*(char **)data) + *sz; - parsestate.audio.left += *sz; - *sz = 0; - return(0); } } - - /* This is the main sound chunk, strip of any extra data that does not fit - the alignment requirements and move these bytes into the leftover buffer*/ - if (parsestate.audio.isdata) { - int rc = *sz; - *outbuf = *data; - if ((parsestate.audio.left = rc % parsestate.audio.align) != 0) { - memmove(parsestate.audio.leftover, - (char *)*outbuf + rc - parsestate.audio.left, - parsestate.audio.left); - rc -= parsestate.audio.left; } - *sz = 0; - return(rc); } - - /* This is the first invocation of this function; we need to parse the - header information and determine how many bytes we need to skip until - the start of the sound chunk */ - if (!parsestate.audio.skipping) { - unsigned char *header = (unsigned char *) *data; - if (*sz < 8) { - warn("Irrecoverable error while parsing Sun/DEC audio file"); - return(0); } - /* Keep compatibility with Linux 68k, etc. by not relying on byte-sex */ - if (header[3]) { /* Sun audio (big endian) */ - parsestate.audio.align = ((header[15] > 2)+1)*header[23]; - parsestate.audio.skipping = header[7]+256*(header[6]+256* - (header[5]+256*header[4])); } - else { /* DEC audio (little endian) */ - parsestate.audio.align = ((header[12] > 2)+1)*header[20]; - parsestate.audio.skipping = header[4]+256*(header[5]+256* - (header[6]+256*header[7])); }} - - /* We are skipping extra data that has been attached to header; most usually - this will be just a comment, such as the original filename and/or the - creation date. Make sure that we do not return less than one single sound - sample entry to the caller; if this happens, rather decide to move those - few bytes into the leftover buffer and deal with it later */ - if (*sz >= (size_t) parsestate.audio.skipping) { - /* Skip just the header information and return the sound chunk */ - int rc = *sz - parsestate.audio.skipping; - *outbuf = (char *)*data + parsestate.audio.skipping; - if ((parsestate.audio.left = rc % parsestate.audio.align) != 0) { - memmove(parsestate.audio.leftover, - (char *)*outbuf + rc - parsestate.audio.left, - parsestate.audio.left); - rc -= parsestate.audio.left; } - *sz = 0; - parsestate.audio.skipping = 0; - parsestate.audio.isdata++; - return(rc); } - else { - /* Skip everything */ - parsestate.audio.skipping -= *sz; - return(0); } -} - -/* If the soundcard could not be set to natively support the data format, we - try to do some limited on-the-fly conversion to a different format; if - no conversion is needed, though, we can output directly */ -static size_t sndcnvnop(void **data,size_t *sz,void **outbuf) -{ - int rc = *sz; - - *outbuf = *data; - *sz = 0; - return(rc); -} - -/* Convert 8 bit unsigned stereo data to 8 bit unsigned mono data */ -static size_t sndcnv8U_2mono(void **data,size_t *sz,void **outbuf) -{ - REGISTER unsigned char *src; - REGISTER unsigned char *dest; - int rc,count; - - count = *sz / 2; - if (count > SNDBUFSZ) { *sz -= 2*SNDBUFSZ; count = SNDBUFSZ; } - else *sz = 0; - rc = count; - src = (unsigned char *) *data; - *outbuf = - dest = linuxplay_sndbuf; - while (count--) - *dest++ = (unsigned char)(((int)*(src)++ + - (int)*(src)++) / 2); - *data = src; - return(rc); -} - -/* Convert 8 bit signed stereo data to 8 bit signed mono data */ -static size_t sndcnv8S_2mono(void **data,size_t *sz,void **outbuf) -{ - REGISTER unsigned char *src; - REGISTER unsigned char *dest; - int rc, count; - - count = *sz / 2; - if (count > SNDBUFSZ) { *sz -= 2*SNDBUFSZ; count = SNDBUFSZ; } - else *sz = 0; - rc = count; - src = (unsigned char *) *data; - *outbuf = - dest = linuxplay_sndbuf; - while (count--) - *dest++ = (unsigned char)(((int)*((signed char *)(src++)) + - (int)*((signed char *)(src++))) / 2); - *data = src; - return(rc); -} - -/* Convert 8 bit signed stereo data to 8 bit unsigned mono data */ -static size_t sndcnv2monounsigned(void **data,size_t *sz,void **outbuf) -{ - REGISTER unsigned char *src; - REGISTER unsigned char *dest; - int rc,count; - - count = *sz / 2; - if (count > SNDBUFSZ) { *sz -= 2*SNDBUFSZ; count = SNDBUFSZ; } - else *sz = 0; - rc = count; - src = (unsigned char *) *data; - *outbuf = - dest = linuxplay_sndbuf; - while (count--) - *dest++ = (unsigned char)(((int)*((signed char *)(src++)) + - (int)*((signed char *)(src++))) / 2) ^ 0x80; - *data = src; - return(rc); -} - -/* Convert 8 bit signed mono data to 8 bit unsigned mono data */ -static size_t sndcnv2unsigned(void **data,size_t *sz,void **outbuf) -{ - REGISTER unsigned char *src; - REGISTER unsigned char *dest; - int rc,count; - - count = *sz; - if (count > SNDBUFSZ) { *sz -= SNDBUFSZ; count = SNDBUFSZ; } - else *sz = 0; - rc = count; - src = (unsigned char *) *data; - *outbuf = - dest = linuxplay_sndbuf; - while (count--) - *dest++ = *(src)++ ^ 0x80; - *data = src; - return(rc); -} - -/* Convert a number in the range -32768..32767 to an 8 bit ulaw encoded - number --- I hope, I got this conversion right :-) */ -static __inline__ signed char int2ulaw(int i) -{ - /* Lookup table for fast calculation of number of bits that need shifting*/ - static short int t_bits[128] = { - 0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, - 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6, - 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, - 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7}; - REGISTER int bits,logi; - - /* unrolling this condition (hopefully) improves execution speed */ - if (i < 0) { - if ((i = (132-i)) > 0x7FFF) i = 0x7FFF; - logi = (i >> ((bits = t_bits[i/256])+4)); - return((bits << 4 | logi) ^ 0x7F); } - else { - if ((i = 132+i) > 0x7FFF) i = 0x7FFF; - logi = (i >> ((bits = t_bits[i/256])+4)); - return(~(bits << 4 | logi)); } -} - -/* Convert 8 bit ulaw stereo data to 8 bit ulaw mono data */ -static size_t sndcnvULaw_2mono(void **data,size_t *sz,void **outbuf) -{ - - static short int ulaw2int[256] = { - /* Precomputed lookup table for conversion from ulaw to 15 bit signed */ - -16062,-15550,-15038,-14526,-14014,-13502,-12990,-12478, - -11966,-11454,-10942,-10430, -9918, -9406, -8894, -8382, - -7998, -7742, -7486, -7230, -6974, -6718, -6462, -6206, - -5950, -5694, -5438, -5182, -4926, -4670, -4414, -4158, - -3966, -3838, -3710, -3582, -3454, -3326, -3198, -3070, - -2942, -2814, -2686, -2558, -2430, -2302, -2174, -2046, - -1950, -1886, -1822, -1758, -1694, -1630, -1566, -1502, - -1438, -1374, -1310, -1246, -1182, -1118, -1054, -990, - -942, -910, -878, -846, -814, -782, -750, -718, - -686, -654, -622, -590, -558, -526, -494, -462, - -438, -422, -406, -390, -374, -358, -342, -326, - -310, -294, -278, -262, -246, -230, -214, -198, - -186, -178, -170, -162, -154, -146, -138, -130, - -122, -114, -106, -98, -90, -82, -74, -66, - -60, -56, -52, -48, -44, -40, -36, -32, - -28, -24, -20, -16, -12, -8, -4, +0, - +16062,+15550,+15038,+14526,+14014,+13502,+12990,+12478, - +11966,+11454,+10942,+10430, +9918, +9406, +8894, +8382, - +7998, +7742, +7486, +7230, +6974, +6718, +6462, +6206, - +5950, +5694, +5438, +5182, +4926, +4670, +4414, +4158, - +3966, +3838, +3710, +3582, +3454, +3326, +3198, +3070, - +2942, +2814, +2686, +2558, +2430, +2302, +2174, +2046, - +1950, +1886, +1822, +1758, +1694, +1630, +1566, +1502, - +1438, +1374, +1310, +1246, +1182, +1118, +1054, +990, - +942, +910, +878, +846, +814, +782, +750, +718, - +686, +654, +622, +590, +558, +526, +494, +462, - +438, +422, +406, +390, +374, +358, +342, +326, - +310, +294, +278, +262, +246, +230, +214, +198, - +186, +178, +170, +162, +154, +146, +138, +130, - +122, +114, +106, +98, +90, +82, +74, +66, - +60, +56, +52, +48, +44, +40, +36, +32, - +28, +24, +20, +16, +12, +8, +4, +0}; - - REGISTER unsigned char *src; - REGISTER unsigned char *dest; - int rc,count; - - count = *sz / 2; - if (count > SNDBUFSZ) { *sz -= 2*SNDBUFSZ; count = SNDBUFSZ; } - else *sz = 0; - rc = count; - src = (unsigned char *) *data; - *outbuf = - dest = linuxplay_sndbuf; - while (count--) - /* it is not possible to directly interpolate between two ulaw encoded - data bytes, thus we need to convert to linear format first and later - we convert back to ulaw format */ - *dest++ = int2ulaw(ulaw2int[*(src)++] + - ulaw2int[*(src)++]); - *data = src; - return(rc); -} - -/* Convert 16 bit little endian signed stereo data to 16 bit little endian - signed mono data */ -static size_t sndcnv16_2monoLE(void **data,size_t *sz,void **outbuf) -{ - REGISTER unsigned char *src; - REGISTER unsigned char *dest; - int rc,count; - signed short i; - - count = *sz / 2; - if (count > SNDBUFSZ) { *sz -= 2*SNDBUFSZ; count = SNDBUFSZ; } - else *sz = 0; - rc = count; - src = (unsigned char *) *data; - *outbuf = - dest = linuxplay_sndbuf; - for (count /= 2; count--; ) { - i = ((int)(src[0]) + - 256*(int)(src[1]) + - (int)(src[2]) + - 256*(int)(src[3])) / 2; - src += 4; - *dest++ = (unsigned char)(i & 0xFF); - *dest++ = (unsigned char)((i / 256) & 0xFF); } - *data = src; - return(rc); -} - -/* Convert 16 bit big endian signed stereo data to 16 bit big endian - signed mono data */ -static size_t sndcnv16_2monoBE(void **data,size_t *sz,void **outbuf) -{ - REGISTER unsigned char *src; - REGISTER unsigned char *dest; - int rc,count; - signed short i; - - count = *sz / 2; - if (count > SNDBUFSZ) { *sz -= 2*SNDBUFSZ; count = SNDBUFSZ; } - else *sz = 0; - rc = count; - src = (unsigned char *) *data; - *outbuf = - dest = linuxplay_sndbuf; - for (count /= 2; count--; ) { - i = ((int)(src[1]) + - 256*(int)(src[0]) + - (int)(src[3]) + - 256*(int)(src[2])) / 2; - src += 4; - *dest++ = (unsigned char)((i / 256) & 0xFF); - *dest++ = (unsigned char)(i & 0xFF); } - *data = src; - return(rc); -} - -/* Convert 16 bit little endian signed data to 8 bit unsigned data */ -static size_t sndcnv2byteLE(void **data,size_t *sz,void **outbuf) -{ - REGISTER unsigned char *src; - REGISTER unsigned char *dest; - int rc,count; - - count = *sz / 2; - if (count > SNDBUFSZ) { *sz -= 2*SNDBUFSZ; count = SNDBUFSZ; } - else *sz = 0; - rc = count; - src = (unsigned char *) *data; - *outbuf = - dest = linuxplay_sndbuf; - while (count--) { - *dest++ = (unsigned char)(((signed char *)src)[1] ^ (signed char)0x80); - src += 2; - } - *data = src; - return(rc); -} - -/* Convert 16 bit big endian signed data to 8 bit unsigned data */ -static size_t sndcnv2byteBE(void **data,size_t *sz,void **outbuf) -{ - REGISTER unsigned char *src; - REGISTER unsigned char *dest; - int rc,count; - - count = *sz / 2; - if (count > SNDBUFSZ) { *sz -= 2*SNDBUFSZ; count = SNDBUFSZ; } - else *sz = 0; - rc = count; - src = (unsigned char *) *data; - *outbuf = - dest = linuxplay_sndbuf; - while (count--) { - *dest++ = (unsigned char)(((signed char *)src)[0] ^ (signed char)0x80); - src += 2; - } - *data = src; - return(rc); -} - -/* Convert 16 bit little endian signed stereo data to 8 bit unsigned - mono data */ -static size_t sndcnv2monobyteLE(void **data,size_t *sz,void **outbuf) -{ - REGISTER unsigned char *src; - REGISTER unsigned char *dest; - int rc,count; - - count = *sz / 4; - if (count > SNDBUFSZ) { *sz -= 4*SNDBUFSZ; count = SNDBUFSZ; } - else *sz = 0; - rc = count; - src = (unsigned char *) *data; - *outbuf = - dest = linuxplay_sndbuf; - while (count--) { - *dest++ = (unsigned char)(((int)((signed char *)src)[1] + - (int)((signed char *)src)[3]) / 2 ^ 0x80); - src += 4; - } - *data = src; - return(rc); -} - -/* Convert 16 bit big endian signed stereo data to 8 bit unsigned - mono data */ -static size_t sndcnv2monobyteBE(void **data,size_t *sz,void **outbuf) -{ - REGISTER unsigned char *src; - REGISTER unsigned char *dest; - int rc,count; - - count = *sz / 4; - if (count > SNDBUFSZ) { *sz -= 4*SNDBUFSZ; count = SNDBUFSZ; } - else *sz = 0; - rc = count; - src = (unsigned char *) *data; - *outbuf = - dest = linuxplay_sndbuf; - while (count--) { - *dest++ = (unsigned char)(((int)((signed char *)src)[0] + - (int)((signed char *)src)[2]) / 2 ^ 0x80); - src += 4; - } - *data = src; - return(rc); -} - -/* Look at the header of the sound file and try to determine the format; - we can recognize files in VOC, WAVE, and, Sun/DEC-audio format--- everything - else is assumed to be raw 8 bit unsigned data sampled at 8kHz */ -static fmtType analyze_format(unsigned char *format,int *fmt,int *speed, - int *tracks, - size_t (**parsesndfile)(void **,size_t *sz, - void **)) -{ - /* Keep compatibility with Linux 68k, etc. by not relying on byte-sex */ - if (!memcmp(format,"Creative Voice File\x1A\x1A\x00",22) && - (format[22]+256*format[23]) == - ((0x1233-format[24]-256*format[25])&0xFFFF)) { /* VOC */ - *fmt = AFMT_U8; - *speed = 8000; - *tracks = 2; - *parsesndfile = parsevoc; - return(fmtVoc); } - else if (!memcmp(format,"RIFF",4) && - !memcmp(format+8,"WAVEfmt ",8)) { /* WAVE */ - if (memcmp(format+20,"\001\000\001"/* PCM mono */,4) && - memcmp(format+20,"\001\000\002"/* PCM stereo */,4)) - return(fmtIllegal); - *fmt = (format[32]/(*tracks = format[22])) == 1 ? - AFMT_U8 : AFMT_S16_LE; - /* Keep compatibility with Linux 68k, etc. by not relying on byte-sex */ - *speed = format[24]+256*(format[25]+256* - (format[26]+256*format[27])); - *parsesndfile = parsewave; - return(fmtWave); } - else if (!memcmp(format,".snd",4)) { /* Sun Audio (big endian) */ - if (format[7]+256*(format[6]+256*(format[5]+256*format[4])) < 24) { - *fmt = AFMT_MU_LAW; - *speed = 8000; - *tracks = 1; - *parsesndfile = parsesundecaudio; - return(fmtSunAudio); } - if (!memcmp(format+12,"\000\000\000\001",4)) *fmt = AFMT_MU_LAW; - else if (!memcmp(format+12,"\000\000\000\002",4)) *fmt = AFMT_S8; - else if (!memcmp(format+12,"\000\000\000\003",4)) *fmt = AFMT_S16_BE; - else return(fmtIllegal); - /* Keep compatibility with Linux 68k, etc. by not relying on byte-sex */ - *speed = format[19]+256*(format[18]+256* - (format[17]+256*format[16])); - *tracks = format[23]; - *parsesndfile = parsesundecaudio; - return(fmtSunAudio); } - else if (!memcmp(format,".sd",4)) { /* DEC Audio (little endian) */ - if (format[4]+256*(format[5]+256*(format[6]+256*format[7])) < 24) { - *fmt = AFMT_MU_LAW; - *speed = 8000; - *tracks = 1; - *parsesndfile = parsesundecaudio; - return(fmtSunAudio); } - if (!memcmp(format+12,"\001\000\000",4)) *fmt = AFMT_MU_LAW; - else if (!memcmp(format+12,"\002\000\000",4)) *fmt = AFMT_S8; - else if (!memcmp(format+12,"\003\000\000",4)) *fmt = AFMT_S16_LE; - else return(fmtIllegal); - /* Keep compatibility with Linux 68k, etc. by not relying on byte-sex */ - *speed = format[16]+256*(format[17]+256* - (format[18]+256*format[19])); - *tracks = format[20]; - *parsesndfile = parsesundecaudio; - return(fmtSunAudio); } - else { - *fmt = AFMT_U8; - *speed = 8000; - *tracks = 1; - *parsesndfile = parseraw; - return(fmtRaw); } -} - /* Initialize the soundcard and mixer device with the parameters that we found in the header of the sound file. If the soundcard is not capable of natively supporting the required parameters, then try to set up conversion @@ -973,16 +287,17 @@ int fmt,speed,tracks; unsigned char *pptr,*optr,*cptr,*sptr; int wrtn,rrtn,crtn,prtn; + unsigned char sndbuf[SNDBUFSZ]; /* We need to read at least the header information before we can start doing anything */ if (!data || length < HEADERSZ) { if (fd < 0) return; else { - length = read(fd,linuxplay_sndbuf,SNDBUFSZ); + length = read(fd,sndbuf,SNDBUFSZ); if (length < HEADERSZ) return; - data = linuxplay_sndbuf; + data = sndbuf; length = SNDBUFSZ; } } @@ -1010,8 +325,7 @@ goto END_OF_PLAY; audio_vol = volume; - /* Initialize global parser state information to zero */ - memset(&parsestate,0,sizeof(parsestate)); + reset_parsestate(); /* Mainloop: read a block of data, parse its contents, perform all the necessary conversions and output it to the sound @@ -1034,17 +348,15 @@ warn(buf); goto END_OF_PLAY; } } if (fd >= 0) { - if ((rrtn = read(fd,linuxplay_sndbuf,SNDBUFSZ)) < 0) { + if ((rrtn = read(fd,sndbuf,SNDBUFSZ)) < 0) { perror("read"); goto END_OF_PLAY; } } else break; } while (rrtn > 0); - /* Verify that we could fully parse the entire soundfile; this is needed - only for files in WAVE format */ - if (ffmt == fmtWave && parsestate.wave.state != wvOutOfBlock && - parsestate.wave.state != wvFatal) - warn("Unexpected end of WAVE file"); + if (ffmt == fmtWave) + parse_wave_complete(); + END_OF_PLAY: /* Now cleanup all used resources */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/lisp-disunion.h --- a/src/lisp-disunion.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/lisp-disunion.h Mon Aug 13 11:13:30 2007 +0200 @@ -25,8 +25,6 @@ /* Format of a non-union-type Lisp Object - For the USE_MINIMAL_TAGBITS implementation: - 3 2 1 0 bit 10987654321098765432109876543210 -------------------------------- @@ -39,61 +37,32 @@ -------------------------------- VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVT - For the non-USE_MINIMAL_TAGBITS implementation: - - 3 2 1 0 - bit 10987654321098765432109876543210 - -------------------------------- - TTTMVVVVVVVVVVVVVVVVVVVVVVVVVVVV - - V = value bits - T = type bits - M = mark bits - For integral Lisp types, i.e. integers and characters, the value bits are the Lisp object. - The object is obtained by masking off the type and mark - bits. In the USE_MINIMAL_TAGBITS implementation, bit 1 is - used as a value bit by splitting the Lisp integer type into - two subtypes, Lisp_Type_Int_Even and Lisp_Type_Int_Odd. By + The object is obtained by masking off the type and mark bits. + Bit 1 is used as a value bit by splitting the Lisp integer type + into two subtypes, Lisp_Type_Int_Even and Lisp_Type_Int_Odd. By this trickery we get 31 bits for integers instead of 30. - In the non-USE_MINIMAL_TAGBITS world, Lisp integers are 28 bits, - or more properly (BITS_PER_EMACS_INT - GCTYPEBITS - 1) bits. - For non-integral types, the value bits of a Lisp_Object contain a pointer to a structure containing the object. The pointer is obtained by masking off the type and mark bits. - In the USE_MINIMAL_TAGBITS implementation, all - pointer-based types are coalesced under a single type called + All pointer-based types are coalesced under a single type called Lisp_Type_Record. The type bits for this type are required by the implementation to be 00, just like the least significant bits of word-aligned struct pointers on 32-bit hardware. Because of this, Lisp_Object pointers don't have to be masked and are full-sized. - In the non-USE_MINIMAL_TAGBITS implementation, the type and - mark bits must be masked off and pointers are limited to 28 - bits (really BITS_PER_EMACS_INT - GCTYPEBITS - 1 bits). - - There are no mark bits in the USE_MINIMAL_TAGBITS implementation. + There are no mark bits. Integers and characters don't need to be marked. All other types are lrecord-based, which means they get marked by incrementing their ->implementation pointer. - In the non-USE_MINIMAL_TAGBITS implementation, the markbit is stored - in the Lisp_Object itself. It is stored in the middle so that the - type bits can be obtained by simply shifting them. - - Outside of garbage collection, all mark bits are always zero. - Here is a brief description of the following macros: - XMARKBIT Extract the mark bit (non-USE_MINIMAL_TAGBITS) - XMARK Set the mark bit of this Lisp_Object (non-USE_MINIMAL_TAGBITS) - XUNMARK Clear the mark bit of this Lisp_Object (non-USE_MINIMAL_TAGBITS) XTYPE The type bits of a Lisp_Object XPNTRVAL The value bits of a Lisp_Object storing a pointer XCHARVAL The value bits of a Lisp_Object storing a Emchar @@ -101,53 +70,29 @@ XUINT The value bits of a Lisp_Object storing an integer, unsigned INTP Non-zero if this Lisp_Object an integer? Qzero Lisp Integer 0 - EQ Non-zero if two Lisp_Objects are identical - GC_EQ Version of EQ used during garbage collection -*/ + EQ Non-zero if two Lisp_Objects are identical */ + typedef EMACS_INT Lisp_Object; -#ifdef USE_MINIMAL_TAGBITS - -# define Lisp_Type_Int_Bit (Lisp_Type_Int_Even & Lisp_Type_Int_Odd) -# define XUNMARK(x) DO_NOTHING -# define make_obj(vartype, x) ((Lisp_Object) (x)) -# define make_int(x) ((Lisp_Object) (((x) << INT_GCBITS) | Lisp_Type_Int_Bit)) -# define make_char(x) ((Lisp_Object) (((x) << GCBITS) | Lisp_Type_Char)) -# define VALMASK (((1UL << VALBITS) - 1UL) << GCTYPEBITS) -# define XTYPE(x) ((enum Lisp_Type) (((EMACS_UINT)(x)) & ~VALMASK)) -# define XPNTRVAL(x) (x) /* This depends on Lisp_Type_Record == 0 */ -# define XCHARVAL(x) ((x) >> GCBITS) -# define GC_EQ(x,y) EQ (x,y) -# define XREALINT(x) ((x) >> INT_GCBITS) -# define XUINT(x) ((EMACS_UINT)(x) >> INT_GCBITS) -# define INTP(x) ((EMACS_UINT)(x) & Lisp_Type_Int_Bit) - -#else /* !USE_MINIMAL_TAGBITS */ - -# define MARKBIT (1UL << VALBITS) -# define XMARKBIT(x) (((x) & MARKBIT) != 0) -# define XMARK(x) ((void) ((x) |= MARKBIT)) -# define XUNMARK(x) ((void) ((x) &= ~MARKBIT)) -# define make_obj(vartype, value) \ - ((Lisp_Object) (((EMACS_UINT) (vartype) << (VALBITS + GCMARKBITS)) \ - + ((EMACS_UINT) (value) & VALMASK))) -# define make_int(value) make_obj (Lisp_Type_Int, value) -# define make_char(value) make_obj (Lisp_Type_Char, value) -# define VALMASK ((1UL << VALBITS) - 1UL) -# define XTYPE(x) ((enum Lisp_Type) (((EMACS_UINT)(x)) >> (VALBITS + GCMARKBITS))) -# define XPNTRVAL(x) ((x) & VALMASK) -# define XCHARVAL(x) XPNTRVAL(x) -# define GC_EQ(x,y) (((x) & ~MARKBIT) == ((y) & ~MARKBIT)) -# define XREALINT(x) (((x) << INT_GCBITS) >> INT_GCBITS) -# define XUINT(x) ((EMACS_UINT) ((x) & VALMASK)) -# define INTP(x) (XTYPE (x) == Lisp_Type_Int) - -#endif /* !USE_MINIMAL_TAGBITS */ +#define Lisp_Type_Int_Bit (Lisp_Type_Int_Even & Lisp_Type_Int_Odd) +#define make_obj(vartype, x) ((Lisp_Object) (x)) +#define make_int(x) ((Lisp_Object) (((x) << INT_GCBITS) | Lisp_Type_Int_Bit)) +#define make_char(x) ((Lisp_Object) (((x) << GCBITS) | Lisp_Type_Char)) +#define VALMASK (((1UL << VALBITS) - 1UL) << GCTYPEBITS) +#define XTYPE(x) ((enum Lisp_Type) (((EMACS_UINT)(x)) & ~VALMASK)) +#define XPNTRVAL(x) (x) /* This depends on Lisp_Type_Record == 0 */ +#define XCHARVAL(x) ((x) >> GCBITS) +#define XREALINT(x) ((x) >> INT_GCBITS) +#define XUINT(x) ((EMACS_UINT)(x) >> INT_GCBITS) +#define INTP(x) ((EMACS_UINT)(x) & Lisp_Type_Int_Bit) +#define INT_PLUS(x,y) ((x)+(y)-Lisp_Type_Int_Bit) +#define INT_MINUS(x,y) ((x)-(y)+Lisp_Type_Int_Bit) +#define INT_PLUS1(x) INT_PLUS (x, make_int (1)) +#define INT_MINUS1(x) INT_MINUS (x, make_int (1)) #define Qzero make_int (0) #define Qnull_pointer ((Lisp_Object) 0) -#define XGCTYPE(x) XTYPE(x) #define EQ(x,y) ((x) == (y)) #define XSETINT(var, value) ((void) ((var) = make_int (value))) #define XSETCHAR(var, value) ((void) ((var) = make_char (value))) @@ -158,7 +103,7 @@ #define VOID_TO_LISP(larg,varg) ((void) ((larg) = ((Lisp_Object) (varg)))) #define CVOID_TO_LISP VOID_TO_LISP #define LISP_TO_VOID(larg) ((void *) (larg)) -#define LISP_TO_CVOID(varg) ((CONST void *) (larg)) +#define LISP_TO_CVOID(varg) ((const void *) (larg)) /* Convert a Lisp_Object into something that can't be used as an lvalue. Useful for type-checking. */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/lisp-union.h --- a/src/lisp-union.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/lisp-union.h Mon Aug 13 11:13:30 2007 +0200 @@ -23,20 +23,17 @@ /* Definition of Lisp_Object type as a union. The declaration order of the objects within the struct members - of the union is dependent on ENDIAN-ness and USE_MINIMAL_TAGBITS. + of the union is dependent on ENDIAN-ness. See lisp-disunion.h for more details. */ typedef union Lisp_Object { /* if non-valbits are at lower addresses */ -#if defined(WORDS_BIGENDIAN) == defined(USE_MINIMAL_TAGBITS) +#if defined(WORDS_BIGENDIAN) struct { EMACS_UINT val : VALBITS; -#if GCMARKBITS > 0 - unsigned int markbit: GCMARKBITS; -#endif enum_field (Lisp_Type) type : GCTYPEBITS; } gu; @@ -55,9 +52,6 @@ struct { enum_field (Lisp_Type) type : GCTYPEBITS; -#if GCMARKBITS > 0 - unsigned int markbit: GCMARKBITS; -#endif EMACS_UINT val : VALBITS; } gu; @@ -82,14 +76,12 @@ GCC to accept any (yes, any) pointer as the argument of a function declared to accept a Lisp_Object. */ struct nosuchstruct *v; - CONST struct nosuchstruct *cv; + const struct nosuchstruct *cv; } Lisp_Object; #define XCHARVAL(x) ((x).gu.val) -#ifdef USE_MINIMAL_TAGBITS - # define XSETINT(var, value) do { \ EMACS_INT xset_value = (value); \ Lisp_Object *xset_var = &(var); \ @@ -108,21 +100,6 @@ } while (0) # define XPNTRVAL(x) ((x).ui) -#else /* ! USE_MINIMAL_TAGBITS */ - -# define XSETOBJ(var, vartype, value) do { \ - EMACS_UINT xset_value = (EMACS_UINT) (value); \ - Lisp_Object *xset_var = &(var); \ - xset_var->gu.type = (vartype); \ - xset_var->gu.markbit = 0; \ - xset_var->gu.val = xset_value; \ -} while (0) -# define XSETINT(var, value) XSETOBJ (var, Lisp_Type_Int, value) -# define XSETCHAR(var, value) XSETOBJ (var, Lisp_Type_Char, value) -# define XPNTRVAL(x) ((x).gu.val) - -#endif /* ! USE_MINIMAL_TAGBITS */ - INLINE Lisp_Object make_int (EMACS_INT val); INLINE Lisp_Object make_int (EMACS_INT val) @@ -146,37 +123,22 @@ #define XREALINT(x) ((x).s.val) #define XUINT(x) ((x).u.val) #define XTYPE(x) ((x).gu.type) -#define XGCTYPE(x) XTYPE (x) #define EQ(x,y) ((x).v == (y).v) -#ifdef USE_MINIMAL_TAGBITS #define INTP(x) ((x).s.bits) -#define GC_EQ(x,y) EQ (x, y) -#else -#define INTP(x) (XTYPE(x) == Lisp_Type_Int) -#define GC_EQ(x,y) ((x).gu.val == (y).gu.val && XTYPE (x) == XTYPE (y)) -#endif - -#if GCMARKBITS > 0 -/* XMARKBIT accesses the markbit. Markbits are used only in - particular slots of particular structure types. Other markbits are - always zero. Outside of garbage collection, all mark bits are - always zero. */ -# define XMARKBIT(x) ((x).gu.markbit) -# define XMARK(x) ((void) (XMARKBIT (x) = 1)) -# define XUNMARK(x) ((void) (XMARKBIT (x) = 0)) -#else -# define XUNMARK(x) DO_NOTHING -#endif +#define INT_PLUS(x,y) make_int (XINT (x) + XINT (y)) +#define INT_MINUS(x,y) make_int (XINT (x) - XINT (y)) +#define INT_PLUS1(x) make_int (XINT (x) + 1) +#define INT_MINUS1(x) make_int (XINT (x) - 1) /* Convert between a (void *) and a Lisp_Object, as when the Lisp_Object is passed to a toolkit callback function */ #define VOID_TO_LISP(larg,varg) \ ((void) ((larg).v = (struct nosuchstruct *) (varg))) #define CVOID_TO_LISP(larg,varg) \ - ((void) ((larg).cv = (CONST struct nosuchstruct *) (varg))) + ((void) ((larg).cv = (const struct nosuchstruct *) (varg))) #define LISP_TO_VOID(larg) ((void *) ((larg).v)) -#define LISP_TO_CVOID(larg) ((CONST void *) ((larg).cv)) +#define LISP_TO_CVOID(larg) ((const void *) ((larg).cv)) /* Convert a Lisp_Object into something that can't be used as an lvalue. Useful for type-checking. */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/lisp.h --- a/src/lisp.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/lisp.h Mon Aug 13 11:13:30 2007 +0200 @@ -22,8 +22,8 @@ /* Synched up with: FSF 19.30. */ -#ifndef _XEMACS_LISP_H_ -#define _XEMACS_LISP_H_ +#ifndef INCLUDED_lisp_h_ +#define INCLUDED_lisp_h_ /************************************************************************/ /* general definitions */ @@ -39,10 +39,8 @@ #include <stdio.h> /* NULL, etc. */ #include <ctype.h> #include <stdarg.h> - -#ifdef __lucid -# include <sysent.h> -#endif +#include <stddef.h> /* offsetof */ +#include <sys/types.h> /* ---- Dynamic arrays ---- */ @@ -60,11 +58,11 @@ void *Dynarr_newf (int elsize); void Dynarr_resize (void *dy, int size); -void Dynarr_insert_many (void *d, CONST void *el, int len, int start); +void Dynarr_insert_many (void *d, const void *el, int len, int start); void Dynarr_delete_many (void *d, int start, int len); void Dynarr_free (void *d); -#define Dynarr_new(type) ((type##_dynarr *) Dynarr_newf (sizeof(type))) +#define Dynarr_new(type) ((type##_dynarr *) Dynarr_newf (sizeof (type))) #define Dynarr_at(d, pos) ((d)->base[pos]) #define Dynarr_atp(d, pos) (&Dynarr_at (d, pos)) #define Dynarr_length(d) ((d)->cur) @@ -73,9 +71,9 @@ #define Dynarr_add_many(d, el, len) Dynarr_insert_many (d, el, len, (d)->cur) #define Dynarr_insert_many_at_start(d, el, len) \ Dynarr_insert_many (d, el, len, 0) -#define Dynarr_add_literal_string(d, s) Dynarr_add_many (d, s, sizeof(s) - 1) +#define Dynarr_add_literal_string(d, s) Dynarr_add_many (d, s, sizeof (s) - 1) #define Dynarr_add_lisp_string(d, s) do { \ - struct Lisp_String *dyna_ls_s = XSTRING (s); \ + Lisp_String *dyna_ls_s = XSTRING (s); \ Dynarr_add_many (d, (char *) string_data (dyna_ls_s), \ string_length (dyna_ls_s)); \ } while (0) @@ -90,9 +88,6 @@ #define Dynarr_increment(d) ((d)->cur++) #define Dynarr_set_size(d, n) ((d)->cur = n) -/* Minimum size in elements for dynamic array when resized; default is 32 */ -extern int Dynarr_min_size; - #ifdef MEMORY_USAGE_STATS struct overhead_stats; size_t Dynarr_memory_usage (void *d, struct overhead_stats *stats); @@ -112,19 +107,17 @@ #endif /* Memory allocation */ -void malloc_warning (CONST char *); +void malloc_warning (const char *); void *xmalloc (size_t size); void *xmalloc_and_zero (size_t size); void *xrealloc (void *, size_t size); -char *xstrdup (CONST char *); +char *xstrdup (const char *); /* generally useful */ -#define countof(x) ((int) (sizeof(x)/sizeof(x[0]))) -#define slot_offset(type, slot_name) \ - ((unsigned) (((char *) (&(((type *)0)->slot_name))) - ((char *)0))) +#define countof(x) ((int) (sizeof(x)/sizeof((x)[0]))) #define xnew(type) ((type *) xmalloc (sizeof (type))) #define xnew_array(type, len) ((type *) xmalloc ((len) * sizeof (type))) #define xnew_and_zero(type) ((type *) xmalloc_and_zero (sizeof (type))) -#define xzero(lvalue) ((void) memset (&(lvalue), 0, sizeof (lvalue))) +#define xzero(lvalue) ((void) memset (&(lvalue), '\0', sizeof (lvalue))) #define xnew_array_and_zero(type, len) ((type *) xmalloc_and_zero ((len) * sizeof (type))) #define XREALLOC_ARRAY(ptr, type, len) ((void) (ptr = (type *) xrealloc (ptr, (len) * sizeof (type)))) #define alloca_array(type, len) ((type *) alloca ((len) * sizeof (type))) @@ -136,21 +129,16 @@ macro will realloc BASEVAR as necessary so that it can hold at least NEEDED_SIZE objects. The reallocing is done by doubling, which ensures constant amortized time per element. */ -#define DO_REALLOC(basevar, sizevar, needed_size, type) do \ -{ \ - /* Avoid side-effectualness. */ \ - /* Dammit! Macros suffer from dynamic scope! */ \ - /* We demand inline functions! */ \ +#define DO_REALLOC(basevar, sizevar, needed_size, type) do { \ size_t do_realloc_needed_size = (needed_size); \ - size_t do_realloc_newsize = 0; \ - while ((sizevar) < (do_realloc_needed_size)) { \ - do_realloc_newsize = 2*(sizevar); \ - if (do_realloc_newsize < 32) \ - do_realloc_newsize = 32; \ - (sizevar) = do_realloc_newsize; \ - } \ - if (do_realloc_newsize) \ - XREALLOC_ARRAY (basevar, type, do_realloc_newsize); \ + if ((sizevar) < do_realloc_needed_size) \ + { \ + if ((sizevar) < 32) \ + (sizevar) = 32; \ + while ((sizevar) < do_realloc_needed_size) \ + (sizevar) *= 2; \ + XREALLOC_ARRAY (basevar, type, (sizevar)); \ + } \ } while (0) #ifdef ERROR_CHECK_MALLOC @@ -163,7 +151,6 @@ } while (0) #else void xfree (void *); -#define xfree_1 xfree #endif /* ERROR_CHECK_MALLOC */ #ifndef PRINTF_ARGS @@ -202,7 +189,7 @@ #ifndef ALIGNOF # if defined (__GNUC__) && (__GNUC__ >= 2) -# define ALIGNOF(x) __alignof (x) +# define ALIGNOF(x) __alignof__ (x) # else # define ALIGNOF(x) sizeof (x) # endif @@ -231,7 +218,7 @@ #ifdef USE_ASSERTIONS /* Highly dubious kludge */ /* (thanks, Jamie, I feel better now -- ben) */ -DECLARE_DOESNT_RETURN (assert_failed (CONST char *, int, CONST char *)); +DECLARE_DOESNT_RETURN (assert_failed (const char *, int, const char *)); # define abort() (assert_failed (__FILE__, __LINE__, "abort()")) # define assert(x) ((x) ? (void) 0 : assert_failed (__FILE__, __LINE__, #x)) #else @@ -249,6 +236,33 @@ /*#define REGISTER register*/ /*#endif*/ + +/* EMACS_INT is the underlying integral type into which a Lisp_Object must fit. + In particular, it must be large enough to contain a pointer. + config.h can override this, e.g. to use `long long' for bigger lisp ints. */ + +#ifndef SIZEOF_EMACS_INT +# define SIZEOF_EMACS_INT SIZEOF_VOID_P +#endif + +#ifndef EMACS_INT +# if SIZEOF_EMACS_INT == SIZEOF_LONG +# define EMACS_INT long +# elif SIZEOF_EMACS_INT == SIZEOF_INT +# define EMACS_INT int +# elif SIZEOF_EMACS_INT == SIZEOF_LONG_LONG +# define EMACS_INT long long +# else +# error Unable to determine suitable type for EMACS_INT +# endif +#endif + +#ifndef EMACS_UINT +# define EMACS_UINT unsigned EMACS_INT +#endif + +#define BITS_PER_EMACS_INT (SIZEOF_EMACS_INT * BITS_PER_CHAR) + /************************************************************************/ /* typedefs */ @@ -283,17 +297,17 @@ buffer.h (where they rightfully belong) to avoid syntax errors in function prototypes. */ -typedef int Bufpos; -typedef int Bytind; -typedef int Memind; +typedef EMACS_INT Bufpos; +typedef EMACS_INT Bytind; +typedef EMACS_INT Memind; /* Counts of bytes or chars */ -typedef int Bytecount; -typedef int Charcount; +typedef EMACS_INT Bytecount; +typedef EMACS_INT Charcount; /* Length in bytes of a string in external format */ -typedef int Extcount; +typedef EMACS_INT Extcount; typedef struct lstream Lstream; @@ -323,20 +337,17 @@ typedef struct extent *EXTENT; struct frame; /* "frame.h" */ struct window; /* "window.h" */ -struct Lisp_Event; /* "events.h" */ -typedef struct Lisp_Event Lisp_Event; -struct Lisp_Face; -typedef struct Lisp_Face Lisp_Face; -struct Lisp_Process; /* "process.c" */ -typedef struct Lisp_Process Lisp_Process; +typedef struct Lisp_Event Lisp_Event; /* "events.h" */ +typedef struct Lisp_Face Lisp_Face; /* "faces.h" */ +typedef struct Lisp_Process Lisp_Process; /* "procimpl.h" */ struct stat; /* <sys/stat.h> */ -struct Lisp_Color_Instance; typedef struct Lisp_Color_Instance Lisp_Color_Instance; -struct Lisp_Font_Instance; typedef struct Lisp_Font_Instance Lisp_Font_Instance; -struct Lisp_Image_Instance; typedef struct Lisp_Image_Instance Lisp_Image_Instance; +typedef struct Lisp_Gui_Item Lisp_Gui_Item; struct display_line; +struct display_glyph_area; +struct display_box; struct redisplay_info; struct window_mirror; struct scrollbar_instance; @@ -406,47 +417,6 @@ Dynarr_declare (struct console_type_entry); } console_type_entry_dynarr; -/* Need to declare this here. */ -enum external_data_format -{ - /* Binary format. This is the simplest format and is what we - use in the absence of a more appropriate format. This converts - according to the `binary' coding system: - - a) On input, bytes 0 - 255 are converted into characters 0 - 255. - b) On output, characters 0 - 255 are converted into bytes 0 - 255 - and other characters are converted into `X'. - */ - FORMAT_BINARY, - - /* Format used for filenames. In the original Mule, this is - user-definable with the `pathname-coding-system' variable. - For the moment, we just use the `binary' coding system. */ - FORMAT_FILENAME, - - /* Format used for output to the terminal. This should be controlled - by the `terminal-coding-system' variable. Under kterm, this will - be some ISO2022 system. On some DOS machines, this is Shift-JIS. */ - FORMAT_TERMINAL, - - /* Format used for input from the terminal. This should be controlled - by the `keyboard-coding-system' variable. */ - FORMAT_KEYBOARD, - - /* Format used for the external Unix environment -- argv[], stuff - from getenv(), stuff from the /etc/passwd file, etc. - - Perhaps should be the same as FORMAT_FILENAME. */ - FORMAT_OS, - - /* Compound-text format. This is the standard X format used for - data stored in properties, selections, and the like. This is - an 8-bit no-lock-shift ISO2022 coding system. */ - FORMAT_CTEXT -}; - -#define FORMAT_NATIVE FORMAT_FILENAME - enum run_hooks_condition { RUN_HOOKS_TO_COMPLETION, @@ -464,6 +434,14 @@ }; #endif +enum edge_style +{ + EDGE_ETCHED_IN, + EDGE_ETCHED_OUT, + EDGE_BEVEL_IN, + EDGE_BEVEL_OUT +}; + #ifndef ERROR_CHECK_TYPECHECK typedef enum error_behavior @@ -506,59 +484,10 @@ /* Definition of Lisp_Object data type */ /************************************************************************/ -#ifdef USE_MINIMAL_TAGBITS -# define LRECORD_CONS -# define LRECORD_VECTOR -# define LRECORD_SYMBOL -# define LRECORD_STRING -#endif - /* Define the fundamental Lisp data structures */ /* This is the set of Lisp data types */ -#ifndef USE_MINIMAL_TAGBITS - -enum Lisp_Type -{ - /* XRECORD_LHEADER (object) points to a struct lrecord_header - lheader->implementation determines the type (and GC behavior) - of the object. */ - Lisp_Type_Record, - - /* Integer. XINT(obj) is the integer value. */ - Lisp_Type_Int, - -#ifndef LRECORD_CONS - /* Cons. XCONS (object) points to a struct Lisp_Cons. */ - Lisp_Type_Cons, -#endif - -#ifndef LRECORD_STRING - /* String. XSTRING (object) points to a struct Lisp_String. - The length of the string, and its contents, are stored therein. */ - Lisp_Type_String, -#endif - -#ifndef LRECORD_VECTOR - /* Vector of Lisp objects. XVECTOR(object) points to a struct Lisp_Vector. - The length of the vector, and its contents, are stored therein. */ - Lisp_Type_Vector, -#endif /* !LRECORD_VECTOR */ - -#ifndef LRECORD_SYMBOL - /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */ - Lisp_Type_Symbol, -#endif /* !LRECORD_SYMBOL */ - - Lisp_Type_Char -}; - -# define POINTER_TYPE_P(type) \ - ((type) != Lisp_Type_Int && (type) != Lisp_Type_Char) - -#else /* USE_MINIMAL_TAGBITS */ - enum Lisp_Type { Lisp_Type_Record, @@ -569,50 +498,15 @@ #define POINTER_TYPE_P(type) ((type) == Lisp_Type_Record) -#endif /* USE_MINIMAL_TAGBITS */ - -/* EMACS_INT is the underlying integral type into which a Lisp_Object must fit. - In particular, it must be large enough to contain a pointer. - config.h can override this, e.g. to use `long long' for bigger lisp ints. */ - -#ifndef SIZEOF_EMACS_INT -# define SIZEOF_EMACS_INT SIZEOF_VOID_P -#endif - -#ifndef EMACS_INT -# if SIZEOF_EMACS_INT == SIZEOF_LONG -# define EMACS_INT long -# elif SIZEOF_EMACS_INT == SIZEOF_INT -# define EMACS_INT int -# elif SIZEOF_EMACS_INT == SIZEOF_LONG_LONG -# define EMACS_INT long long -# else -# error Unable to determine suitable type for EMACS_INT -# endif -#endif - -#ifndef EMACS_UINT -# define EMACS_UINT unsigned EMACS_INT -#endif - -#define BITS_PER_EMACS_INT (SIZEOF_EMACS_INT * BITS_PER_CHAR) - /* Overridden by m/next.h */ #ifndef ASSERT_VALID_POINTER # define ASSERT_VALID_POINTER(pnt) (assert ((((EMACS_UINT) pnt) & 3) == 0)) #endif -#ifdef USE_MINIMAL_TAGBITS -# define GCMARKBITS 0 -# define GCTYPEBITS 2 -# define GCBITS 2 -# define INT_GCBITS 1 -#else -# define GCMARKBITS 1 -# define GCTYPEBITS 3 -# define GCBITS 4 -# define INT_GCBITS GCBITS -#endif +#define GCMARKBITS 0 +#define GCTYPEBITS 2 +#define GCBITS 2 +#define INT_GCBITS 1 #define INT_VALBITS (BITS_PER_EMACS_INT - INT_GCBITS) #define VALBITS (BITS_PER_EMACS_INT - GCBITS) @@ -624,25 +518,7 @@ # include "lisp-disunion.h" #endif /* !USE_UNION_TYPE */ -#ifdef HAVE_SHM -/* In this representation, data is found in two widely separated segments. */ -extern int pure_size; -# define XPNTR(x) \ - ((void *)(XPNTRVAL(x)) | (XPNTRVAL(x) > pure_size ? DATA_SEG_BITS : PURE_SEG_BITS))) -#else /* not HAVE_SHM */ -# ifdef DATA_SEG_BITS -/* This case is used for the rt-pc and hp-pa. - In the diffs I was given, it checked for ptr = 0 - and did not adjust it in that case. - But I don't think that zero should ever be found - in a Lisp object whose data type says it points to something. - */ -# define XPNTR(x) ((void *)((XPNTRVAL(x)) | DATA_SEG_BITS)) -# else /* not DATA_SEG_BITS */ -# define XPNTR(x) ((void *) (XPNTRVAL(x))) -# endif /* not DATA_SEG_BITS */ -#endif /* not HAVE_SHM */ - +#define XPNTR(x) ((void *) XPNTRVAL(x)) /* WARNING WARNING WARNING. You must ensure on your own that proper GC protection is provided for the elements in this array. */ @@ -654,8 +530,8 @@ /* Close your eyes now lest you vomit or spontaneously combust ... */ #define HACKEQ_UNSAFE(obj1, obj2) \ - (EQ (obj1, obj2) || (!POINTER_TYPE_P (XGCTYPE (obj1)) \ - && !POINTER_TYPE_P (XGCTYPE (obj2)) \ + (EQ (obj1, obj2) || (!POINTER_TYPE_P (XTYPE (obj1)) \ + && !POINTER_TYPE_P (XTYPE (obj2)) \ && XCHAR_OR_INT (obj1) == XCHAR_OR_INT (obj2))) #ifdef DEBUG_XEMACS @@ -685,7 +561,6 @@ to mean "no such value". */ #define UNBOUNDP(val) EQ (val, Qunbound) -#define GC_UNBOUNDP(val) GC_EQ (val, Qunbound) /*********** cons ***********/ @@ -693,9 +568,7 @@ struct Lisp_Cons { -#ifdef LRECORD_CONS struct lrecord_header lheader; -#endif Lisp_Object car, cdr; }; typedef struct Lisp_Cons Lisp_Cons; @@ -712,40 +585,19 @@ }; #endif -#ifdef LRECORD_CONS - DECLARE_LRECORD (cons, Lisp_Cons); #define XCONS(x) XRECORD (x, cons, Lisp_Cons) #define XSETCONS(x, p) XSETRECORD (x, p, cons) #define CONSP(x) RECORDP (x, cons) -#define GC_CONSP(x) GC_RECORDP (x, cons) #define CHECK_CONS(x) CHECK_RECORD (x, cons) #define CONCHECK_CONS(x) CONCHECK_RECORD (x, cons) #define CONS_MARKED_P(c) MARKED_RECORD_HEADER_P(&((c)->lheader)) #define MARK_CONS(c) MARK_RECORD_HEADER (&((c)->lheader)) -#else /* ! LRECORD_CONS */ - -DECLARE_NONRECORD (cons, Lisp_Type_Cons, Lisp_Cons); -#define XCONS(a) XNONRECORD (a, cons, Lisp_Type_Cons, Lisp_Cons) -#define XSETCONS(c, p) XSETOBJ (c, Lisp_Type_Cons, p) -#define CONSP(x) (XTYPE (x) == Lisp_Type_Cons) -#define GC_CONSP(x) (XGCTYPE (x) == Lisp_Type_Cons) -#define CHECK_CONS(x) CHECK_NONRECORD (x, Lisp_Type_Cons, Qconsp) -#define CONCHECK_CONS(x) CONCHECK_NONRECORD (x, Lisp_Type_Cons, Qconsp) - -/* Define these because they're used in a few places, inside and - out of alloc.c */ -#define CONS_MARKED_P(c) XMARKBIT (c->car) -#define MARK_CONS(c) XMARK (c->car) - -#endif /* ! LRECORD_CONS */ - extern Lisp_Object Qnil; #define NILP(x) EQ (x, Qnil) -#define GC_NILP(x) GC_EQ (x, Qnil) #define XCAR(a) (XCONS (a)->car) #define XCDR(a) (XCONS (a)->cdr) #define LISTP(x) (CONSP(x) || NILP(x)) @@ -805,7 +657,7 @@ #define EXTERNAL_LIST_LOOP_DELETE_IF(elt, list, condition) do { \ Lisp_Object prev_tail_##list = Qnil; \ Lisp_Object tail_##list; \ - int len_##list; \ + EMACS_INT len_##list; \ EXTERNAL_LIST_LOOP_4 (elt, list, tail_##list, len_##list) \ { \ if (condition) \ @@ -862,26 +714,26 @@ #define EXTERNAL_LIST_LOOP_1(list) \ Lisp_Object ELL1_elt, ELL1_hare, ELL1_tortoise; \ -int ELL1_len; \ -EXTERNAL_LIST_LOOP_6(ELL1_elt, list, ELL1_len, ELL1_hare, \ - ELL1_tortoise, CIRCULAR_LIST_SUSPICION_LENGTH) +EMACS_INT ELL1_len; \ +EXTERNAL_LIST_LOOP_6 (ELL1_elt, list, ELL1_len, ELL1_hare, \ + ELL1_tortoise, CIRCULAR_LIST_SUSPICION_LENGTH) #define EXTERNAL_LIST_LOOP_2(elt, list) \ Lisp_Object hare_##elt, tortoise_##elt; \ -int len_##elt; \ -EXTERNAL_LIST_LOOP_6(elt, list, len_##elt, hare_##elt, \ - tortoise_##elt, CIRCULAR_LIST_SUSPICION_LENGTH) +EMACS_INT len_##elt; \ +EXTERNAL_LIST_LOOP_6 (elt, list, len_##elt, hare_##elt, \ + tortoise_##elt, CIRCULAR_LIST_SUSPICION_LENGTH) #define EXTERNAL_LIST_LOOP_3(elt, list, tail) \ Lisp_Object tortoise_##elt; \ -int len_##elt; \ -EXTERNAL_LIST_LOOP_6(elt, list, len_##elt, tail, \ - tortoise_##elt, CIRCULAR_LIST_SUSPICION_LENGTH) +EMACS_INT len_##elt; \ +EXTERNAL_LIST_LOOP_6 (elt, list, len_##elt, tail, \ + tortoise_##elt, CIRCULAR_LIST_SUSPICION_LENGTH) #define EXTERNAL_LIST_LOOP_4(elt, list, tail, len) \ Lisp_Object tortoise_##elt; \ -EXTERNAL_LIST_LOOP_6(elt, list, len, tail, \ - tortoise_##elt, CIRCULAR_LIST_SUSPICION_LENGTH) +EXTERNAL_LIST_LOOP_6 (elt, list, len, tail, \ + tortoise_##elt, CIRCULAR_LIST_SUSPICION_LENGTH) #define EXTERNAL_LIST_LOOP_6(elt, list, len, hare, \ @@ -906,30 +758,30 @@ /* Optimized and safe macros for looping over external alists. */ -#define EXTERNAL_ALIST_LOOP_4(elt, elt_car, elt_cdr, list) \ -Lisp_Object hare_##elt, tortoise_##elt; \ -int len_##elt; \ -EXTERNAL_ALIST_LOOP_8 (elt, elt_car, elt_cdr, list, \ - len_##elt, hare_##elt, tortoise_##elt, \ +#define EXTERNAL_ALIST_LOOP_4(elt, elt_car, elt_cdr, list) \ +Lisp_Object hare_##elt, tortoise_##elt; \ +EMACS_INT len_##elt; \ +EXTERNAL_ALIST_LOOP_8 (elt, elt_car, elt_cdr, list, \ + len_##elt, hare_##elt, tortoise_##elt, \ CIRCULAR_LIST_SUSPICION_LENGTH) #define EXTERNAL_ALIST_LOOP_5(elt, elt_car, elt_cdr, list, tail) \ Lisp_Object tortoise_##elt; \ -int len_##elt; \ -EXTERNAL_ALIST_LOOP_8(elt, elt_car, elt_cdr, list, \ - len_##elt, tail, tortoise_##elt, \ - CIRCULAR_LIST_SUSPICION_LENGTH) +EMACS_INT len_##elt; \ +EXTERNAL_ALIST_LOOP_8 (elt, elt_car, elt_cdr, list, \ + len_##elt, tail, tortoise_##elt, \ + CIRCULAR_LIST_SUSPICION_LENGTH) \ #define EXTERNAL_ALIST_LOOP_6(elt, elt_car, elt_cdr, list, tail, len) \ Lisp_Object tortoise_##elt; \ -EXTERNAL_ALIST_LOOP_8(elt, elt_car, elt_cdr, list, \ - len, tail, tortoise_##elt, \ - CIRCULAR_LIST_SUSPICION_LENGTH) +EXTERNAL_ALIST_LOOP_8 (elt, elt_car, elt_cdr, list, \ + len, tail, tortoise_##elt, \ + CIRCULAR_LIST_SUSPICION_LENGTH) #define EXTERNAL_ALIST_LOOP_8(elt, elt_car, elt_cdr, list, len, hare, \ tortoise, suspicion_length) \ -EXTERNAL_LIST_LOOP_6(elt, list, len, hare, tortoise, suspicion_length) \ +EXTERNAL_LIST_LOOP_6 (elt, list, len, hare, tortoise, suspicion_length) \ if (CONSP (elt) ? (elt_car = XCAR (elt), elt_cdr = XCDR (elt), 0) :1) \ continue; \ else @@ -938,20 +790,20 @@ /* Optimized and safe macros for looping over external property lists. */ #define EXTERNAL_PROPERTY_LIST_LOOP_3(key, value, list) \ Lisp_Object key, value, hare_##key, tortoise_##key; \ -int len_##key; \ -EXTERNAL_PROPERTY_LIST_LOOP_7(key, value, list, len_##key, hare_##key,\ +EMACS_INT len_##key; \ +EXTERNAL_PROPERTY_LIST_LOOP_7 (key, value, list, len_##key, hare_##key, \ tortoise_##key, CIRCULAR_LIST_SUSPICION_LENGTH) #define EXTERNAL_PROPERTY_LIST_LOOP_4(key, value, list, tail) \ Lisp_Object key, value, tail, tortoise_##key; \ -int len_##key; \ -EXTERNAL_PROPERTY_LIST_LOOP_7(key, value, list, len_##key, tail, \ +EMACS_INT len_##key; \ +EXTERNAL_PROPERTY_LIST_LOOP_7 (key, value, list, len_##key, tail, \ tortoise_##key, CIRCULAR_LIST_SUSPICION_LENGTH) #define EXTERNAL_PROPERTY_LIST_LOOP_5(key, value, list, tail, len) \ Lisp_Object key, value, tail, tortoise_##key; \ -int len; \ -EXTERNAL_PROPERTY_LIST_LOOP_7(key, value, list, len, tail, \ +EMACS_INT len; \ +EXTERNAL_PROPERTY_LIST_LOOP_7 (key, value, list, len, tail, \ tortoise_##key, CIRCULAR_LIST_SUSPICION_LENGTH) @@ -1008,7 +860,7 @@ TRUE_LIST_P (Lisp_Object object) { Lisp_Object hare, tortoise; - int len; + EMACS_INT len; for (hare = tortoise = object, len = 0; CONSP (hare); @@ -1030,7 +882,7 @@ #define CHECK_TRUE_LIST(list) do { \ Lisp_Object CTL_list = (list); \ Lisp_Object CTL_hare, CTL_tortoise; \ - int CTL_len; \ + EMACS_INT CTL_len; \ \ for (CTL_hare = CTL_tortoise = CTL_list, CTL_len = 0; \ CONSP (CTL_hare); \ @@ -1051,45 +903,26 @@ /*********** string ***********/ -/* In a string, the markbit of the plist is used as the gc mark bit */ - struct Lisp_String { -#ifdef LRECORD_STRING struct lrecord_header lheader; -#endif Bytecount size; Bufbyte *data; Lisp_Object plist; }; typedef struct Lisp_String Lisp_String; -#ifdef LRECORD_STRING - DECLARE_LRECORD (string, Lisp_String); #define XSTRING(x) XRECORD (x, string, Lisp_String) #define XSETSTRING(x, p) XSETRECORD (x, p, string) #define STRINGP(x) RECORDP (x, string) -#define GC_STRINGP(x) GC_RECORDP (x, string) #define CHECK_STRING(x) CHECK_RECORD (x, string) #define CONCHECK_STRING(x) CONCHECK_RECORD (x, string) -#else /* ! LRECORD_STRING */ - -DECLARE_NONRECORD (string, Lisp_Type_String, Lisp_String); -#define XSTRING(x) XNONRECORD (x, string, Lisp_Type_String, Lisp_String) -#define XSETSTRING(x, p) XSETOBJ (x, Lisp_Type_String, p) -#define STRINGP(x) (XTYPE (x) == Lisp_Type_String) -#define GC_STRINGP(x) (XGCTYPE (x) == Lisp_Type_String) -#define CHECK_STRING(x) CHECK_NONRECORD (x, Lisp_Type_String, Qstringp) -#define CONCHECK_STRING(x) CONCHECK_NONRECORD (x, Lisp_Type_String, Qstringp) - -#endif /* ! LRECORD_STRING */ - #ifdef MULE -Charcount bytecount_to_charcount (CONST Bufbyte *ptr, Bytecount len); -Bytecount charcount_to_bytecount (CONST Bufbyte *ptr, Charcount len); +Charcount bytecount_to_charcount (const Bufbyte *ptr, Bytecount len); +Bytecount charcount_to_bytecount (const Bufbyte *ptr, Charcount len); #else /* not MULE */ @@ -1138,9 +971,7 @@ struct Lisp_Vector { -#ifdef LRECORD_VECTOR struct lcrecord_header header; -#endif long size; /* next is now chained through v->contents[size], terminated by Qzero. This means that pure vectors don't need a "next" */ @@ -1149,35 +980,17 @@ }; typedef struct Lisp_Vector Lisp_Vector; -#ifdef LRECORD_VECTOR - DECLARE_LRECORD (vector, Lisp_Vector); #define XVECTOR(x) XRECORD (x, vector, Lisp_Vector) #define XSETVECTOR(x, p) XSETRECORD (x, p, vector) #define VECTORP(x) RECORDP (x, vector) -#define GC_VECTORP(x) GC_RECORDP (x, vector) #define CHECK_VECTOR(x) CHECK_RECORD (x, vector) #define CONCHECK_VECTOR(x) CONCHECK_RECORD (x, vector) -#else - -DECLARE_NONRECORD (vector, Lisp_Type_Vector, Lisp_Vector); -#define XVECTOR(x) XNONRECORD (x, vector, Lisp_Type_Vector, Lisp_Vector) -#define XSETVECTOR(x, p) XSETOBJ (x, Lisp_Type_Vector, p) -#define VECTORP(x) (XTYPE (x) == Lisp_Type_Vector) -#define GC_VECTORP(x) (XGCTYPE (x) == Lisp_Type_Vector) -#define CHECK_VECTOR(x) CHECK_NONRECORD (x, Lisp_Type_Vector, Qvectorp) -#define CONCHECK_VECTOR(x) CONCHECK_NONRECORD (x, Lisp_Type_Vector, Qvectorp) - -#endif - #define vector_length(v) ((v)->size) #define XVECTOR_LENGTH(s) vector_length (XVECTOR (s)) #define vector_data(v) ((v)->contents) #define XVECTOR_DATA(s) vector_data (XVECTOR (s)) -#ifndef LRECORD_VECTOR -# define vector_next(v) ((v)->contents[(v)->size]) -#endif /*********** bit vector ***********/ @@ -1209,12 +1022,10 @@ #define XBIT_VECTOR(x) XRECORD (x, bit_vector, Lisp_Bit_Vector) #define XSETBIT_VECTOR(x, p) XSETRECORD (x, p, bit_vector) #define BIT_VECTORP(x) RECORDP (x, bit_vector) -#define GC_BIT_VECTORP(x) GC_RECORDP (x, bit_vector) #define CHECK_BIT_VECTOR(x) CHECK_RECORD (x, bit_vector) #define CONCHECK_BIT_VECTOR(x) CONCHECK_RECORD (x, bit_vector) #define BITP(x) (INTP (x) && (XINT (x) == 0 || XINT (x) == 1)) -#define GC_BITP(x) (GC_INTP (x) && (XINT (x) == 0 || XINT (x) == 1)) #define CHECK_BIT(x) do { \ if (!BITP (x)) \ @@ -1229,77 +1040,57 @@ #define bit_vector_length(v) ((v)->size) #define bit_vector_next(v) ((v)->next) -INLINE int bit_vector_bit (Lisp_Bit_Vector *v, int i); +INLINE int bit_vector_bit (Lisp_Bit_Vector *v, size_t n); INLINE int -bit_vector_bit (Lisp_Bit_Vector *v, int i) +bit_vector_bit (Lisp_Bit_Vector *v, size_t n) { - unsigned int ui = (unsigned int) i; - - return (((v)->bits[ui >> LONGBITS_LOG2] >> (ui & (LONGBITS_POWER_OF_2 - 1))) + return ((v->bits[n >> LONGBITS_LOG2] >> (n & (LONGBITS_POWER_OF_2 - 1))) & 1); } -INLINE void set_bit_vector_bit (Lisp_Bit_Vector *v, int i, int value); +INLINE void set_bit_vector_bit (Lisp_Bit_Vector *v, size_t n, int value); INLINE void -set_bit_vector_bit (Lisp_Bit_Vector *v, int i, int value) +set_bit_vector_bit (Lisp_Bit_Vector *v, size_t n, int value) { - unsigned int ui = (unsigned int) i; if (value) - (v)->bits[ui >> LONGBITS_LOG2] |= (1U << (ui & (LONGBITS_POWER_OF_2 - 1))); + v->bits[n >> LONGBITS_LOG2] |= (1UL << (n & (LONGBITS_POWER_OF_2 - 1))); else - (v)->bits[ui >> LONGBITS_LOG2] &= ~(1U << (ui & (LONGBITS_POWER_OF_2 - 1))); + v->bits[n >> LONGBITS_LOG2] &= ~(1UL << (n & (LONGBITS_POWER_OF_2 - 1))); } /* Number of longs required to hold LEN bits */ #define BIT_VECTOR_LONG_STORAGE(len) \ - ((len + LONGBITS_POWER_OF_2 - 1) >> LONGBITS_LOG2) + (((len) + LONGBITS_POWER_OF_2 - 1) >> LONGBITS_LOG2) /*********** symbol ***********/ -/* In a symbol, the markbit of the plist is used as the gc mark bit */ - +typedef struct Lisp_Symbol Lisp_Symbol; struct Lisp_Symbol { -#ifdef LRECORD_SYMBOL struct lrecord_header lheader; -#endif /* next symbol in this obarray bucket */ - struct Lisp_Symbol *next; - struct Lisp_String *name; + Lisp_Symbol *next; + Lisp_String *name; Lisp_Object value; Lisp_Object function; - /* non-nil if the symbol is interned in Vobarray */ - Lisp_Object obarray; Lisp_Object plist; }; -typedef struct Lisp_Symbol Lisp_Symbol; - -#define SYMBOL_IS_KEYWORD(sym) (string_byte (XSYMBOL(sym)->name, 0) == ':') + +#define SYMBOL_IS_KEYWORD(sym) \ + ((string_byte (symbol_name (XSYMBOL (sym)), 0) == ':') \ + && EQ (sym, oblookup (Vobarray, \ + string_data (symbol_name (XSYMBOL (sym))), \ + string_length (symbol_name (XSYMBOL (sym)))))) #define KEYWORDP(obj) (SYMBOLP (obj) && SYMBOL_IS_KEYWORD (obj)) -#ifdef LRECORD_SYMBOL - DECLARE_LRECORD (symbol, Lisp_Symbol); #define XSYMBOL(x) XRECORD (x, symbol, Lisp_Symbol) #define XSETSYMBOL(x, p) XSETRECORD (x, p, symbol) #define SYMBOLP(x) RECORDP (x, symbol) -#define GC_SYMBOLP(x) GC_RECORDP (x, symbol) #define CHECK_SYMBOL(x) CHECK_RECORD (x, symbol) #define CONCHECK_SYMBOL(x) CONCHECK_RECORD (x, symbol) -#else - -DECLARE_NONRECORD (symbol, Lisp_Type_Symbol, Lisp_Symbol); -#define XSYMBOL(x) XNONRECORD (x, symbol, Lisp_Type_Symbol, Lisp_Symbol) -#define XSETSYMBOL(s, p) XSETOBJ ((s), Lisp_Type_Symbol, (p)) -#define SYMBOLP(x) (XTYPE (x) == Lisp_Type_Symbol) -#define GC_SYMBOLP(x) (XGCTYPE (x) == Lisp_Type_Symbol) -#define CHECK_SYMBOL(x) CHECK_NONRECORD (x, Lisp_Type_Symbol, Qsymbolp) -#define CONCHECK_SYMBOL(x) CONCHECK_NONRECORD (x, Lisp_Type_Symbol, Qsymbolp) - -#endif - #define symbol_next(s) ((s)->next) #define symbol_name(s) ((s)->name) #define symbol_value(s) ((s)->value) @@ -1314,9 +1105,9 @@ { struct lrecord_header lheader; short min_args, max_args; - CONST char *prompt; - CONST char *doc; - CONST char *name; + const char *prompt; + const char *doc; + const char *name; lisp_fn_t subr_fn; }; typedef struct Lisp_Subr Lisp_Subr; @@ -1325,30 +1116,31 @@ #define XSUBR(x) XRECORD (x, subr, Lisp_Subr) #define XSETSUBR(x, p) XSETRECORD (x, p, subr) #define SUBRP(x) RECORDP (x, subr) -#define GC_SUBRP(x) GC_RECORDP (x, subr) #define CHECK_SUBR(x) CHECK_RECORD (x, subr) #define CONCHECK_SUBR(x) CONCHECK_RECORD (x, subr) -#define subr_function(subr) (subr)->subr_fn -#define subr_name(subr) (subr)->name +#define subr_function(subr) ((subr)->subr_fn) +#define SUBR_FUNCTION(subr,max_args) \ + ((Lisp_Object (*) (EXFUN_##max_args)) (subr)->subr_fn) +#define subr_name(subr) ((subr)->name) /*********** marker ***********/ +typedef struct Lisp_Marker Lisp_Marker; struct Lisp_Marker { struct lrecord_header lheader; - struct Lisp_Marker *next, *prev; + Lisp_Marker *next; + Lisp_Marker *prev; struct buffer *buffer; Memind memind; char insertion_type; }; -typedef struct Lisp_Marker Lisp_Marker; DECLARE_LRECORD (marker, Lisp_Marker); #define XMARKER(x) XRECORD (x, marker, Lisp_Marker) #define XSETMARKER(x, p) XSETRECORD (x, p, marker) #define MARKERP(x) RECORDP (x, marker) -#define GC_MARKERP(x) GC_RECORDP (x, marker) #define CHECK_MARKER(x) CHECK_RECORD (x, marker) #define CONCHECK_MARKER(x) CONCHECK_RECORD (x, marker) @@ -1361,7 +1153,6 @@ /*********** char ***********/ #define CHARP(x) (XTYPE (x) == Lisp_Type_Char) -#define GC_CHARP(x) (XGCTYPE (x) == Lisp_Type_Char) #ifdef ERROR_CHECK_TYPECHECK @@ -1403,7 +1194,6 @@ #define XFLOAT(x) XRECORD (x, float, Lisp_Float) #define XSETFLOAT(x, p) XSETRECORD (x, p, float) #define FLOATP(x) RECORDP (x, float) -#define GC_FLOATP(x) GC_RECORDP (x, float) #define CHECK_FLOAT(x) CHECK_RECORD (x, float) #define CONCHECK_FLOAT(x) CONCHECK_RECORD (x, float) @@ -1423,31 +1213,25 @@ } while (0) # define INT_OR_FLOATP(x) (INTP (x) || FLOATP (x)) -# define GC_INT_OR_FLOATP(x) (GC_INTP (x) || GC_FLOATP (x)) #else /* not LISP_FLOAT_TYPE */ #define XFLOAT(x) --- error! No float support. --- #define XSETFLOAT(x, p) --- error! No float support. --- #define FLOATP(x) 0 -#define GC_FLOATP(x) 0 #define CHECK_FLOAT(x) --- error! No float support. --- #define CONCHECK_FLOAT(x) --- error! No float support. --- #define XFLOATINT(n) XINT(n) #define CHECK_INT_OR_FLOAT CHECK_INT #define CONCHECK_INT_OR_FLOAT CONCHECK_INT -#define INT_OR_FLOATP(x) (INTP (x)) -# define GC_INT_OR_FLOATP(x) (GC_INTP (x)) +#define INT_OR_FLOATP(x) INTP (x) #endif /* not LISP_FLOAT_TYPE */ /*********** int ***********/ -#define GC_INTP(x) INTP (x) - #define ZEROP(x) EQ (x, Qzero) -#define GC_ZEROP(x) GC_EQ (x, Qzero) #ifdef ERROR_CHECK_TYPECHECK @@ -1485,7 +1269,6 @@ } while (0) #define NATNUMP(x) (INTP (x) && XINT (x) >= 0) -#define GC_NATNUMP(x) (GC_INTP (x) && XINT (x) >= 0) #define CHECK_NATNUM(x) do { \ if (!NATNUMP (x)) \ @@ -1528,10 +1311,16 @@ } while (0) -/*********** pure space ***********/ - -#define CHECK_IMPURE(obj) \ - do { if (purified (obj)) pure_write_error (obj); } while (0) +/*********** readonly objects ***********/ + +#define CHECK_C_WRITEABLE(obj) \ + do { if (c_readonly (obj)) c_write_error (obj); } while (0) + +#define CHECK_LISP_WRITEABLE(obj) \ + do { if (lisp_readonly (obj)) lisp_write_error (obj); } while (0) + +#define C_READONLY(obj) (C_READONLY_RECORD_HEADER_P(XRECORD_LHEADER (obj))) +#define LISP_READONLY(obj) (LISP_READONLY_RECORD_HEADER_P(XRECORD_LHEADER (obj))) /*********** structures ***********/ @@ -1601,7 +1390,6 @@ #define XWEAK_LIST(x) XRECORD (x, weak_list, struct weak_list) #define XSETWEAK_LIST(x, p) XSETRECORD (x, p, weak_list) #define WEAK_LISTP(x) RECORDP (x, weak_list) -#define GC_WEAK_LISTP(x) GC_RECORDP (x, weak_list) #define CHECK_WEAK_LIST(x) CHECK_RECORD (x, weak_list) #define CONCHECK_WEAK_LIST(x) CONCHECK_RECORD (x, weak_list) @@ -1610,9 +1398,8 @@ Lisp_Object make_weak_list (enum weak_list_type type); /* The following two are only called by the garbage collector */ -int finish_marking_weak_lists (int (*obj_marked_p) (Lisp_Object), - void (*markobj) (Lisp_Object)); -void prune_weak_lists (int (*obj_marked_p) (Lisp_Object)); +int finish_marking_weak_lists (void); +void prune_weak_lists (void); /*********** lcrecord lists ***********/ @@ -1621,20 +1408,19 @@ struct lcrecord_header header; Lisp_Object free; size_t size; - CONST struct lrecord_implementation *implementation; + const struct lrecord_implementation *implementation; }; DECLARE_LRECORD (lcrecord_list, struct lcrecord_list); #define XLCRECORD_LIST(x) XRECORD (x, lcrecord_list, struct lcrecord_list) #define XSETLCRECORD_LIST(x, p) XSETRECORD (x, p, lcrecord_list) #define LCRECORD_LISTP(x) RECORDP (x, lcrecord_list) -#define GC_LCRECORD_LISTP(x) GC_RECORDP (x, lcrecord_list) /* #define CHECK_LCRECORD_LIST(x) CHECK_RECORD (x, lcrecord_list) Lcrecord lists should never escape to the Lisp level, so functions should not be doing this. */ Lisp_Object make_lcrecord_list (size_t size, - CONST struct lrecord_implementation + const struct lrecord_implementation *implementation); Lisp_Object allocate_managed_lcrecord (Lisp_Object lcrecord_list); void free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord); @@ -1693,11 +1479,7 @@ /* Can't be const, because then subr->doc is read-only and Snarf_documentation chokes */ -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION -# define subr_lheader_initializer { 0, 0, 0 } -#else -# define subr_lheader_initializer { lrecord_subr } -#endif +#define subr_lheader_initializer { 0, 0, 0, 0 } #define DEFUN(lname, Fname, min_args, max_args, prompt, arglist) \ Lisp_Object Fname (EXFUN_##max_args); \ @@ -1800,8 +1582,8 @@ #define HASH9(a,b,c,d,e,f,g,h,i) (GOOD_HASH * HASH8 (a,b,c,d,e,f,g,h) + (i)) #define LISP_HASH(obj) ((unsigned long) LISP_TO_VOID (obj)) -unsigned long string_hash (CONST void *xv); -unsigned long memory_hash (CONST void *xv, size_t size); +unsigned long string_hash (const void *xv); +unsigned long memory_hash (const void *xv, size_t size); unsigned long internal_hash (Lisp_Object obj, int depth); unsigned long internal_array_hash (Lisp_Object *arr, int size, int depth); @@ -1814,10 +1596,10 @@ #ifdef HAVE_LIBINTL_H #include <libintl.h> #else -char *dgettext (CONST char *, CONST char *); -char *gettext (CONST char *); -char *textdomain (CONST char *); -char *bindtextdomain (CONST char *, CONST char *); +char *dgettext (const char *, const char *); +char *gettext (const char *); +char *textdomain (const char *); +char *bindtextdomain (const char *, const char *); #endif /* HAVE_LIBINTL_H */ #define GETTEXT(x) gettext(x) @@ -1932,7 +1714,7 @@ #define NNGCPRO5(v1,v2,v3,v4,v5) \ debug_gcpro5 (__FILE__, __LINE__,&nngcpro1,&nngcpro2,&nngcpro3,&nngcpro4,\ &nngcpro5,&v1,&v2,&v3,&v4,&v5) -#define NUNNGCPRO \ +#define NNUNGCPRO \ debug_ungcpro(__FILE__, __LINE__,&nngcpro1) #else /* ! DEBUG_GCPRO */ @@ -1959,8 +1741,7 @@ gcpro4.next = &gcpro3, gcpro4.var = &var4, gcpro4.nvars = 1, \ gcprolist = &gcpro4 )) -#define GCPRO5(var1, var2, var3, var4, var5) \ - ((void) ( \ +#define GCPRO5(var1, var2, var3, var4, var5) ((void) ( \ gcpro1.next = gcprolist, gcpro1.var = &var1, gcpro1.nvars = 1, \ gcpro2.next = &gcpro1, gcpro2.var = &var2, gcpro2.nvars = 1, \ gcpro3.next = &gcpro2, gcpro3.var = &var3, gcpro3.nvars = 1, \ @@ -1992,8 +1773,7 @@ ngcpro4.next = &ngcpro3, ngcpro4.var = &var4, ngcpro4.nvars = 1, \ gcprolist = &ngcpro4 )) -#define NGCPRO5(var1, var2, var3, var4, var5) \ - ((void) ( \ +#define NGCPRO5(var1, var2, var3, var4, var5) ((void) ( \ ngcpro1.next = gcprolist, ngcpro1.var = &var1, ngcpro1.nvars = 1, \ ngcpro2.next = &ngcpro1, ngcpro2.var = &var2, ngcpro2.nvars = 1, \ ngcpro3.next = &ngcpro2, ngcpro3.var = &var3, ngcpro3.nvars = 1, \ @@ -2025,8 +1805,7 @@ nngcpro4.next = &nngcpro3, nngcpro4.var = &var4, nngcpro4.nvars = 1, \ gcprolist = &nngcpro4 )) -#define NNGCPRO5(var1, var2, var3, var4, var5) \ - ((void) ( \ +#define NNGCPRO5(var1, var2, var3, var4, var5) ((void) ( \ nngcpro1.next = gcprolist, nngcpro1.var = &var1, nngcpro1.nvars = 1, \ nngcpro2.next = &nngcpro1, nngcpro2.var = &var2, nngcpro2.nvars = 1, \ nngcpro3.next = &nngcpro2, nngcpro3.var = &var3, nngcpro3.nvars = 1, \ @@ -2088,6 +1867,24 @@ /* Call staticpro (&var) to protect static variable `var'. */ void staticpro (Lisp_Object *); +/* Call staticpro_nodump (&var) to protect static variable `var'. */ +/* var will not be saved at dump time */ +void staticpro_nodump (Lisp_Object *); + +/* Call dumpstruct(&var, &desc) to dump the structure pointed to by `var'. */ +void dumpstruct (void *, const struct struct_description *); + +/* Call dumpopaque(&var, size) to dump the opaque static structure `var'. */ +void dumpopaque (void *, size_t); + +/* Call pdump_wire(&var) to ensure that var is properly updated after pdump. */ +void pdump_wire (Lisp_Object *); + +/* Call pdump_wire(&var) to ensure that var is properly updated after + pdump. var must point to a linked list of objects out of which + some may not be dumped */ +void pdump_wire_list (Lisp_Object *); + /* Nonzero means Emacs has already been initialized. Used during startup to detect startup of dumped Emacs. */ extern int initialized; @@ -2137,7 +1934,7 @@ #endif #endif #ifndef IS_ANY_SEP -#define IS_ANY_SEP(c) (IS_DIRECTORY_SEP (c)) +#define IS_ANY_SEP(c) IS_DIRECTORY_SEP (c) #endif #ifdef HAVE_INTTYPES_H @@ -2184,33 +1981,38 @@ extern int gc_currently_forbidden; Lisp_Object restore_gc_inhibit (Lisp_Object); extern EMACS_INT gc_generation_number[1]; -int purified (Lisp_Object); -Lisp_Object build_string (CONST char *); -Lisp_Object build_ext_string (CONST char *, enum external_data_format); -Lisp_Object build_translated_string (CONST char *); -Lisp_Object make_string (CONST Bufbyte *, Bytecount); -Lisp_Object make_ext_string (CONST Extbyte *, EMACS_INT, - enum external_data_format); +int c_readonly (Lisp_Object); +int lisp_readonly (Lisp_Object); +Lisp_Object build_string (const char *); +Lisp_Object build_ext_string (const char *, Lisp_Object); +Lisp_Object build_translated_string (const char *); +Lisp_Object make_string (const Bufbyte *, Bytecount); +Lisp_Object make_ext_string (const Extbyte *, EMACS_INT, Lisp_Object); Lisp_Object make_uninit_string (Bytecount); Lisp_Object make_float (double); -size_t purespace_usage (void); -void report_pure_usage (int, int); -Lisp_Object make_pure_string (CONST Bufbyte *, Bytecount, Lisp_Object, int); -Lisp_Object make_pure_pname (CONST Bufbyte *, Bytecount, int); -Lisp_Object pure_cons (Lisp_Object, Lisp_Object); -Lisp_Object pure_list (int, Lisp_Object *); -Lisp_Object make_pure_vector (size_t, Lisp_Object); +Lisp_Object make_string_nocopy (const Bufbyte *, Bytecount); void free_cons (Lisp_Cons *); void free_list (Lisp_Object); void free_alist (Lisp_Object); void mark_conses_in_list (Lisp_Object); void free_marker (Lisp_Marker *); int object_dead_p (Lisp_Object); +void mark_object (Lisp_Object obj); +int marked_p (Lisp_Object obj); #ifdef MEMORY_USAGE_STATS size_t malloced_storage_size (void *, size_t, struct overhead_stats *); size_t fixed_type_block_overhead (size_t); #endif +#ifdef PDUMP +void pdump (void); +int pdump_load (void); + +extern char *pdump_start, *pdump_end; +#define DUMPEDP(adr) ((((char *)(adr)) < pdump_end) && (((char *)(adr)) >= pdump_start)) +#else +#define DUMPEDP(adr) 0 +#endif /* Defined in buffer.c */ Lisp_Object make_buffer (struct buffer *); @@ -2220,19 +2022,20 @@ extern int find_file_use_truenames; /* Defined in callproc.c */ -char *egetenv (CONST char *); +char *egetenv (const char *); /* Defined in console.c */ void stuff_buffered_input (Lisp_Object); /* Defined in data.c */ -DECLARE_DOESNT_RETURN (pure_write_error (Lisp_Object)); +DECLARE_DOESNT_RETURN (c_write_error (Lisp_Object)); +DECLARE_DOESNT_RETURN (lisp_write_error (Lisp_Object)); DECLARE_DOESNT_RETURN (args_out_of_range (Lisp_Object, Lisp_Object)); DECLARE_DOESNT_RETURN (args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object)); Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); DECLARE_DOESNT_RETURN (dead_wrong_type_argument (Lisp_Object, Lisp_Object)); -void check_int_range (int, int, int); +void check_int_range (EMACS_INT, EMACS_INT, EMACS_INT); enum arith_comparison { arith_equal, @@ -2247,7 +2050,7 @@ unsigned int lisp_to_word (Lisp_Object); /* Defined in dired.c */ -Lisp_Object make_directory_hash_table (CONST char *); +Lisp_Object make_directory_hash_table (const char *); Lisp_Object wasteful_word_to_lisp (unsigned int); /* Defined in doc.c */ @@ -2255,32 +2058,32 @@ Lisp_Object read_doc_string (Lisp_Object); /* Defined in doprnt.c */ -Bytecount emacs_doprnt_c (Lisp_Object, CONST Bufbyte *, Lisp_Object, +Bytecount emacs_doprnt_c (Lisp_Object, const Bufbyte *, Lisp_Object, Bytecount, ...); -Bytecount emacs_doprnt_va (Lisp_Object, CONST Bufbyte *, Lisp_Object, +Bytecount emacs_doprnt_va (Lisp_Object, const Bufbyte *, Lisp_Object, Bytecount, va_list); -Bytecount emacs_doprnt_lisp (Lisp_Object, CONST Bufbyte *, Lisp_Object, - Bytecount, int, CONST Lisp_Object *); -Bytecount emacs_doprnt_lisp_2 (Lisp_Object, CONST Bufbyte *, Lisp_Object, +Bytecount emacs_doprnt_lisp (Lisp_Object, const Bufbyte *, Lisp_Object, + Bytecount, int, const Lisp_Object *); +Bytecount emacs_doprnt_lisp_2 (Lisp_Object, const Bufbyte *, Lisp_Object, Bytecount, int, ...); -Lisp_Object emacs_doprnt_string_c (CONST Bufbyte *, Lisp_Object, +Lisp_Object emacs_doprnt_string_c (const Bufbyte *, Lisp_Object, Bytecount, ...); -Lisp_Object emacs_doprnt_string_va (CONST Bufbyte *, Lisp_Object, +Lisp_Object emacs_doprnt_string_va (const Bufbyte *, Lisp_Object, Bytecount, va_list); -Lisp_Object emacs_doprnt_string_lisp (CONST Bufbyte *, Lisp_Object, - Bytecount, int, CONST Lisp_Object *); -Lisp_Object emacs_doprnt_string_lisp_2 (CONST Bufbyte *, Lisp_Object, +Lisp_Object emacs_doprnt_string_lisp (const Bufbyte *, Lisp_Object, + Bytecount, int, const Lisp_Object *); +Lisp_Object emacs_doprnt_string_lisp_2 (const Bufbyte *, Lisp_Object, Bytecount, int, ...); /* Defined in editfns.c */ void uncache_home_directory (void); -char *get_home_directory (void); -char *user_login_name (int *); +Extbyte *get_home_directory (void); +char *user_login_name (uid_t *); Bufpos bufpos_clip_to_bounds (Bufpos, Bufpos, Bufpos); Bytind bytind_clip_to_bounds (Bytind, Bytind, Bytind); void buffer_insert1 (struct buffer *, Lisp_Object); -Lisp_Object make_string_from_buffer (struct buffer *, int, int); -Lisp_Object make_string_from_buffer_no_extents (struct buffer *, int, int); +Lisp_Object make_string_from_buffer (struct buffer *, Bufpos, Charcount); +Lisp_Object make_string_from_buffer_no_extents (struct buffer *, Bufpos, Charcount); Lisp_Object save_excursion_save (void); Lisp_Object save_restriction_save (void); Lisp_Object save_excursion_restore (Lisp_Object); @@ -2290,18 +2093,18 @@ Lisp_Object save_current_buffer_restore (Lisp_Object); /* Defined in emacs.c */ -DECLARE_DOESNT_RETURN_GCC_ATTRIBUTE_SYNTAX_SUCKS (fatal (CONST char *, +DECLARE_DOESNT_RETURN_GCC_ATTRIBUTE_SYNTAX_SUCKS (fatal (const char *, ...), 1, 2); -int stderr_out (CONST char *, ...) PRINTF_ARGS (1, 2); -int stdout_out (CONST char *, ...) PRINTF_ARGS (1, 2); +int stderr_out (const char *, ...) PRINTF_ARGS (1, 2); +int stdout_out (const char *, ...) PRINTF_ARGS (1, 2); SIGTYPE fatal_error_signal (int); Lisp_Object make_arg_list (int, char **); void make_argc_argv (Lisp_Object, int *, char ***); void free_argc_argv (char **); -Lisp_Object decode_env_path (CONST char *, CONST char *); -Lisp_Object decode_path (CONST char *); +Lisp_Object decode_env_path (const char *, const char *); +Lisp_Object decode_path (const char *); /* Nonzero means don't do interactive redisplay and don't change tty modes */ -extern int noninteractive; +extern int noninteractive, noninteractive1; extern int preparing_for_armageddon; extern int emacs_priority; extern int running_asynch_code; @@ -2312,42 +2115,46 @@ void maybe_signal_error (Lisp_Object, Lisp_Object, Lisp_Object, Error_behavior); Lisp_Object maybe_signal_continuable_error (Lisp_Object, Lisp_Object, Lisp_Object, Error_behavior); -DECLARE_DOESNT_RETURN_GCC_ATTRIBUTE_SYNTAX_SUCKS (error (CONST char *, +DECLARE_DOESNT_RETURN_GCC_ATTRIBUTE_SYNTAX_SUCKS (error (const char *, ...), 1, 2); -void maybe_error (Lisp_Object, Error_behavior, CONST char *, +void maybe_error (Lisp_Object, Error_behavior, const char *, ...) PRINTF_ARGS (3, 4); -Lisp_Object continuable_error (CONST char *, ...) PRINTF_ARGS (1, 2); +Lisp_Object continuable_error (const char *, ...) PRINTF_ARGS (1, 2); Lisp_Object maybe_continuable_error (Lisp_Object, Error_behavior, - CONST char *, ...) PRINTF_ARGS (3, 4); -DECLARE_DOESNT_RETURN (signal_simple_error (CONST char *, Lisp_Object)); -void maybe_signal_simple_error (CONST char *, Lisp_Object, + const char *, ...) PRINTF_ARGS (3, 4); +DECLARE_DOESNT_RETURN (signal_simple_error (const char *, Lisp_Object)); +void maybe_signal_simple_error (const char *, Lisp_Object, Lisp_Object, Error_behavior); -Lisp_Object signal_simple_continuable_error (CONST char *, Lisp_Object); -Lisp_Object maybe_signal_simple_continuable_error (CONST char *, Lisp_Object, +Lisp_Object signal_simple_continuable_error (const char *, Lisp_Object); +Lisp_Object maybe_signal_simple_continuable_error (const char *, Lisp_Object, Lisp_Object, Error_behavior); DECLARE_DOESNT_RETURN_GCC_ATTRIBUTE_SYNTAX_SUCKS (error_with_frob - (Lisp_Object, CONST char *, + (Lisp_Object, const char *, ...), 2, 3); void maybe_error_with_frob (Lisp_Object, Lisp_Object, Error_behavior, - CONST char *, ...) PRINTF_ARGS (4, 5); -Lisp_Object continuable_error_with_frob (Lisp_Object, CONST char *, + const char *, ...) PRINTF_ARGS (4, 5); +Lisp_Object continuable_error_with_frob (Lisp_Object, const char *, ...) PRINTF_ARGS (2, 3); Lisp_Object maybe_continuable_error_with_frob -(Lisp_Object, Lisp_Object, Error_behavior, CONST char *, ...) PRINTF_ARGS (4, 5); -DECLARE_DOESNT_RETURN (signal_simple_error_2 (CONST char *, +(Lisp_Object, Lisp_Object, Error_behavior, const char *, ...) PRINTF_ARGS (4, 5); +DECLARE_DOESNT_RETURN (signal_simple_error_2 (const char *, Lisp_Object, Lisp_Object)); -void maybe_signal_simple_error_2 (CONST char *, Lisp_Object, Lisp_Object, +void maybe_signal_simple_error_2 (const char *, Lisp_Object, Lisp_Object, Lisp_Object, Error_behavior); -Lisp_Object signal_simple_continuable_error_2 (CONST char *, +Lisp_Object signal_simple_continuable_error_2 (const char *, Lisp_Object, Lisp_Object); -Lisp_Object maybe_signal_simple_continuable_error_2 (CONST char *, Lisp_Object, +Lisp_Object maybe_signal_simple_continuable_error_2 (const char *, Lisp_Object, Lisp_Object, Lisp_Object, Error_behavior); -void signal_malformed_list_error (Lisp_Object); -void signal_malformed_property_list_error (Lisp_Object); -void signal_circular_list_error (Lisp_Object); -void signal_circular_property_list_error (Lisp_Object); -void signal_void_function_error (Lisp_Object); +DECLARE_DOESNT_RETURN (signal_malformed_list_error (Lisp_Object)); +DECLARE_DOESNT_RETURN (signal_malformed_property_list_error (Lisp_Object)); +DECLARE_DOESNT_RETURN (signal_circular_list_error (Lisp_Object)); +DECLARE_DOESNT_RETURN (signal_circular_property_list_error (Lisp_Object)); + +Lisp_Object signal_void_function_error (Lisp_Object); +Lisp_Object signal_invalid_function_error (Lisp_Object); +Lisp_Object signal_wrong_number_of_arguments_error (Lisp_Object, int); + Lisp_Object run_hook_with_args_in_buffer (struct buffer *, int, Lisp_Object *, enum run_hooks_condition); Lisp_Object run_hook_with_args (int, Lisp_Object *, enum run_hooks_condition); @@ -2387,13 +2194,13 @@ Lisp_Object eval_in_buffer (struct buffer *, Lisp_Object); Lisp_Object call0_with_handler (Lisp_Object, Lisp_Object); Lisp_Object call1_with_handler (Lisp_Object, Lisp_Object, Lisp_Object); -Lisp_Object eval_in_buffer_trapping_errors (CONST char *, struct buffer *, +Lisp_Object eval_in_buffer_trapping_errors (const char *, struct buffer *, Lisp_Object); -Lisp_Object run_hook_trapping_errors (CONST char *, Lisp_Object); -Lisp_Object safe_run_hook_trapping_errors (CONST char *, Lisp_Object, int); -Lisp_Object call0_trapping_errors (CONST char *, Lisp_Object); -Lisp_Object call1_trapping_errors (CONST char *, Lisp_Object, Lisp_Object); -Lisp_Object call2_trapping_errors (CONST char *, +Lisp_Object run_hook_trapping_errors (const char *, Lisp_Object); +Lisp_Object safe_run_hook_trapping_errors (const char *, Lisp_Object, int); +Lisp_Object call0_trapping_errors (const char *, Lisp_Object); +Lisp_Object call1_trapping_errors (const char *, Lisp_Object, Lisp_Object); +Lisp_Object call2_trapping_errors (const char *, Lisp_Object, Lisp_Object, Lisp_Object); Lisp_Object call_with_suspended_errors (lisp_fn_t, volatile Lisp_Object, Lisp_Object, Error_behavior, int, ...); @@ -2412,7 +2219,7 @@ void do_autoload (Lisp_Object, Lisp_Object); Lisp_Object un_autoload (Lisp_Object); void warn_when_safe_lispobj (Lisp_Object, Lisp_Object, Lisp_Object); -void warn_when_safe (Lisp_Object, Lisp_Object, CONST char *, +void warn_when_safe (Lisp_Object, Lisp_Object, const char *, ...) PRINTF_ARGS (3, 4); @@ -2431,30 +2238,29 @@ /* Defined in events.c */ void clear_event_resource (void); Lisp_Object allocate_event (void); -int event_to_character (Lisp_Event *, int, int, int); /* Defined in fileio.c */ void record_auto_save (void); void force_auto_save_soon (void); -DECLARE_DOESNT_RETURN (report_file_error (CONST char *, Lisp_Object)); -void maybe_report_file_error (CONST char *, Lisp_Object, +DECLARE_DOESNT_RETURN (report_file_error (const char *, Lisp_Object)); +void maybe_report_file_error (const char *, Lisp_Object, Lisp_Object, Error_behavior); -DECLARE_DOESNT_RETURN (signal_file_error (CONST char *, Lisp_Object)); -void maybe_signal_file_error (CONST char *, Lisp_Object, +DECLARE_DOESNT_RETURN (signal_file_error (const char *, Lisp_Object)); +void maybe_signal_file_error (const char *, Lisp_Object, Lisp_Object, Error_behavior); -DECLARE_DOESNT_RETURN (signal_double_file_error (CONST char *, CONST char *, +DECLARE_DOESNT_RETURN (signal_double_file_error (const char *, const char *, Lisp_Object)); -void maybe_signal_double_file_error (CONST char *, CONST char *, +void maybe_signal_double_file_error (const char *, const char *, Lisp_Object, Lisp_Object, Error_behavior); -DECLARE_DOESNT_RETURN (signal_double_file_error_2 (CONST char *, CONST char *, +DECLARE_DOESNT_RETURN (signal_double_file_error_2 (const char *, const char *, Lisp_Object, Lisp_Object)); -void maybe_signal_double_file_error_2 (CONST char *, CONST char *, +void maybe_signal_double_file_error_2 (const char *, const char *, Lisp_Object, Lisp_Object, Lisp_Object, Error_behavior); Lisp_Object lisp_strerror (int); Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object); -int read_allowing_quit (int, void *, size_t); -int write_allowing_quit (int, CONST void *, size_t); +ssize_t read_allowing_quit (int, void *, size_t); +ssize_t write_allowing_quit (int, const void *, size_t); int internal_delete_file (Lisp_Object); /* Defined in filelock.c */ @@ -2485,7 +2291,6 @@ Lisp_Object remassq_no_quit (Lisp_Object, Lisp_Object); Lisp_Object remrassq_no_quit (Lisp_Object, Lisp_Object); -void pure_put (Lisp_Object, Lisp_Object, Lisp_Object); int plists_differ (Lisp_Object, Lisp_Object, int, int, int); Lisp_Object internal_plist_get (Lisp_Object, Lisp_Object); void internal_plist_put (Lisp_Object *, Lisp_Object, Lisp_Object); @@ -2502,7 +2307,7 @@ Lisp_Object vconcat3 (Lisp_Object, Lisp_Object, Lisp_Object); Lisp_Object nconc2 (Lisp_Object, Lisp_Object); Lisp_Object bytecode_nconc2 (Lisp_Object *); -void check_losing_bytecode (CONST char *, Lisp_Object); +void check_losing_bytecode (const char *, Lisp_Object); /* Defined in getloadavg.c */ int getloadavg (double[], int); @@ -2514,6 +2319,7 @@ /* Defined in indent.c */ int bi_spaces_at_point (struct buffer *, Bytind); int column_at_point (struct buffer *, Bufpos, int); +int string_column_at_point (Lisp_String *, Bufpos, int); int current_column (struct buffer *); void invalidate_current_column (void); Bufpos vmotion (struct window *, Bufpos, int, int *); @@ -2525,8 +2331,9 @@ /* Defined in lread.c */ void ebolify_bytecode_constants (Lisp_Object); void close_load_descs (void); -int locate_file (Lisp_Object, Lisp_Object, CONST char *, Lisp_Object *, int); -int isfloat_string (CONST char *); +int locate_file (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object *, int); +EXFUN (Flocate_file_clear_hashing, 1); +int isfloat_string (const char *); /* Well, I've decided to enable this. -- ben */ /* And I've decided to make it work right. -- sb */ @@ -2563,32 +2370,32 @@ /* Defined in minibuf.c */ extern int minibuf_level; -Charcount scmp_1 (CONST Bufbyte *, CONST Bufbyte *, Charcount, int); +Charcount scmp_1 (const Bufbyte *, const Bufbyte *, Charcount, int); #define scmp(s1, s2, len) scmp_1 (s1, s2, len, completion_ignore_case) extern int completion_ignore_case; -int regexp_ignore_completion_p (CONST Bufbyte *, Lisp_Object, +int regexp_ignore_completion_p (const Bufbyte *, Lisp_Object, Bytecount, Bytecount); Lisp_Object clear_echo_area (struct frame *, Lisp_Object, int); Lisp_Object clear_echo_area_from_print (struct frame *, Lisp_Object, int); -void echo_area_append (struct frame *, CONST Bufbyte *, Lisp_Object, +void echo_area_append (struct frame *, const Bufbyte *, Lisp_Object, Bytecount, Bytecount, Lisp_Object); -void echo_area_message (struct frame *, CONST Bufbyte *, Lisp_Object, +void echo_area_message (struct frame *, const Bufbyte *, Lisp_Object, Bytecount, Bytecount, Lisp_Object); Lisp_Object echo_area_status (struct frame *); int echo_area_active (struct frame *); Lisp_Object echo_area_contents (struct frame *); -void message_internal (CONST Bufbyte *, Lisp_Object, Bytecount, Bytecount); -void message_append_internal (CONST Bufbyte *, Lisp_Object, +void message_internal (const Bufbyte *, Lisp_Object, Bytecount, Bytecount); +void message_append_internal (const Bufbyte *, Lisp_Object, Bytecount, Bytecount); -void message (CONST char *, ...) PRINTF_ARGS (1, 2); -void message_append (CONST char *, ...) PRINTF_ARGS (1, 2); -void message_no_translate (CONST char *, ...) PRINTF_ARGS (1, 2); +void message (const char *, ...) PRINTF_ARGS (1, 2); +void message_append (const char *, ...) PRINTF_ARGS (1, 2); +void message_no_translate (const char *, ...) PRINTF_ARGS (1, 2); void clear_message (void); /* Defined in print.c */ void write_string_to_stdio_stream (FILE *, struct console *, - CONST Bufbyte *, Bytecount, Bytecount, - enum external_data_format); + const Bufbyte *, Bytecount, Bytecount, + Lisp_Object); void debug_print (Lisp_Object); void debug_short_backtrace (int); void temp_output_buffer_setup (Lisp_Object); @@ -2596,9 +2403,9 @@ /* NOTE: Do not call this with the data of a Lisp_String. Use princ. * Note: stream should be defaulted before calling * (eg Qnil means stdout, not Vstandard_output, etc) */ -void write_c_string (CONST char *, Lisp_Object); +void write_c_string (const char *, Lisp_Object); /* Same goes for this function. */ -void write_string_1 (CONST Bufbyte *, Bytecount, Lisp_Object); +void write_string_1 (const Bufbyte *, Bytecount, Lisp_Object); void print_cons (Lisp_Object, Lisp_Object, int); void print_vector (Lisp_Object, Lisp_Object, int); void print_string (Lisp_Object, Lisp_Object, int); @@ -2615,7 +2422,7 @@ void internal_object_printer (Lisp_Object, Lisp_Object, int); /* Defined in profile.c */ -void mark_profiling_info (void (*) (Lisp_Object)); +void mark_profiling_info (void); void profile_increase_call_count (Lisp_Object); extern int profiling_active; extern int profiling_redisplay_flag; @@ -2637,10 +2444,11 @@ Bufpos find_next_newline (struct buffer *, Bufpos, int); Bufpos find_next_newline_no_quit (struct buffer *, Bufpos, int); Bytind bi_find_next_newline_no_quit (struct buffer *, Bytind, int); +Bytind bi_find_next_emchar_in_string (Lisp_String*, Emchar, Bytind, EMACS_INT); Bufpos find_before_next_newline (struct buffer *, Bufpos, Bufpos, int); struct re_pattern_buffer *compile_pattern (Lisp_Object, struct re_registers *, char *, int, Error_behavior); -Bytecount fast_string_match (Lisp_Object, CONST Bufbyte *, +Bytecount fast_string_match (Lisp_Object, const Bufbyte *, Lisp_Object, Bytecount, Bytecount, int, Error_behavior, int); Bytecount fast_lisp_string_match (Lisp_Object, Lisp_Object); @@ -2662,9 +2470,9 @@ Error_behavior, int, Lisp_Object); /* Defined in symbols.c */ -int hash_string (CONST Bufbyte *, Bytecount); -Lisp_Object intern (CONST char *); -Lisp_Object oblookup (Lisp_Object, CONST Bufbyte *, Bytecount); +int hash_string (const Bufbyte *, Bytecount); +Lisp_Object intern (const char *); +Lisp_Object oblookup (Lisp_Object, const Bufbyte *, Bytecount); void map_obarray (Lisp_Object, int (*) (Lisp_Object, void *), void *); Lisp_Object indirect_function (Lisp_Object, int); Lisp_Object symbol_value_in_buffer (Lisp_Object, Lisp_Object); @@ -2678,7 +2486,7 @@ Lisp_Object follow_past_lisp_magic); /* Defined in syntax.c */ -int scan_words (struct buffer *, int, int); +Bufpos scan_words (struct buffer *, Bufpos, int); /* Defined in undo.c */ Lisp_Object truncate_undo_list (Lisp_Object, int, int); @@ -2694,7 +2502,7 @@ #endif /* Defined in vm-limit.c */ -void memory_warnings (void *, void (*) (CONST char *)); +void memory_warnings (void *, void (*) (const char *)); /* Defined in window.c */ Lisp_Object save_window_excursion_unwind (Lisp_Object); @@ -2760,6 +2568,7 @@ EXFUN (Fdefault_value, 1); EXFUN (Fdefine_key, 3); EXFUN (Fdelete_region, 3); +EXFUN (Fdelete_process, 1); EXFUN (Fdelq, 2); EXFUN (Fdestructive_alist_to_plist, 1); EXFUN (Fdetect_coding_region, 3); @@ -2836,10 +2645,9 @@ EXFUN (Fleq, MANY); EXFUN (Flist, MANY); EXFUN (Flistp, 1); -#ifdef HAVE_SHLIB EXFUN (Flist_modules, 0); EXFUN (Fload_module, 3); -#endif +EXFUN (Flookup_key, 3); EXFUN (Flss, MANY); EXFUN (Fmake_byte_code, MANY); EXFUN (Fmake_coding_system, 4); @@ -2888,7 +2696,6 @@ EXFUN (Fprocess_status, 1); EXFUN (Fprogn, UNEVALLED); EXFUN (Fprovide, 1); -EXFUN (Fpurecopy, 1); EXFUN (Fput, 3); EXFUN (Fput_range_table, 4); EXFUN (Fput_text_property, 5); @@ -2952,78 +2759,89 @@ extern Lisp_Object Qafter, Qall, Qand; extern Lisp_Object Qarith_error, Qarrayp, Qassoc, Qat, Qautodetect, Qautoload; extern Lisp_Object Qbackground, Qbackground_pixmap, Qbad_variable, Qbefore; -extern Lisp_Object Qbeginning_of_buffer, Qbig5, Qbinary, Qbitmap, Qbitp, Qblinking; -extern Lisp_Object Qboolean, Qbottom, Qbuffer, Qbuffer_file_coding_system; +extern Lisp_Object Qbeginning_of_buffer, Qbig5, Qbinary; +extern Lisp_Object Qbitmap, Qbitp, Qblinking; +extern Lisp_Object Qboolean, Qbottom, Qbottom_margin, Qbuffer; extern Lisp_Object Qbuffer_glyph_p, Qbuffer_live_p, Qbuffer_read_only, Qbutton; extern Lisp_Object Qbyte_code, Qcall_interactively, Qcategory; extern Lisp_Object Qcategory_designator_p, Qcategory_table_value_p, Qccl, Qcdr; extern Lisp_Object Qchannel, Qchar, Qchar_or_string_p, Qcharacter, Qcharacterp; extern Lisp_Object Qchars, Qcharset_g0, Qcharset_g1, Qcharset_g2, Qcharset_g3; -extern Lisp_Object Qcircular_list, Qcircular_property_list; -extern Lisp_Object Qcoding_system_error, Qcoding_system_p; +extern Lisp_Object Qcenter, Qcircular_list, Qcircular_property_list; +extern Lisp_Object Qcoding_system_error; extern Lisp_Object Qcolor, Qcolor_pixmap_image_instance_p; extern Lisp_Object Qcolumns, Qcommand, Qcommandp, Qcompletion_ignore_case; extern Lisp_Object Qconsole, Qconsole_live_p, Qconst_specifier, Qcr, Qcritical; -extern Lisp_Object Qcrlf, Qctext, Qcurrent_menubar, Qcursor; +extern Lisp_Object Qcrlf, Qctext, Qcurrent_menubar, Qctext, Qcursor; extern Lisp_Object Qcyclic_variable_indirection, Qdata, Qdead, Qdecode; extern Lisp_Object Qdefault, Qdefun, Qdelete, Qdelq, Qdevice, Qdevice_live_p; extern Lisp_Object Qdim, Qdimension, Qdisabled, Qdisplay, Qdisplay_table; -extern Lisp_Object Qdoc_string, Qdomain_error, Qdynarr_overhead; +extern Lisp_Object Qdoc_string, Qdomain_error, Qduplex, Qdynarr_overhead; extern Lisp_Object Qempty, Qencode, Qend_of_buffer, Qend_of_file, Qend_open; extern Lisp_Object Qeol_cr, Qeol_crlf, Qeol_lf, Qeol_type, Qeq, Qeql, Qequal; extern Lisp_Object Qerror, Qerror_conditions, Qerror_message, Qescape_quoted; extern Lisp_Object Qeval, Qevent_live_p, Qexit, Qextent_live_p, Qextents; -extern Lisp_Object Qexternal_debugging_output, Qface, Qfeaturep, Qfile_error; +extern Lisp_Object Qexternal_debugging_output, Qface, Qfeaturep; +extern Lisp_Object Qfile_name, Qfile_error; extern Lisp_Object Qfont, Qforce_g0_on_output, Qforce_g1_on_output; extern Lisp_Object Qforce_g2_on_output, Qforce_g3_on_output, Qforeground; extern Lisp_Object Qformat, Qframe, Qframe_live_p, Qfunction, Qgap_overhead; -extern Lisp_Object Qgeneric, Qgeometry, Qglobal, Qheight, Qhighlight, Qicon; +extern Lisp_Object Qgeneric, Qgeometry, Qglobal, Qheight; +extern Lisp_Object Qhighlight, Qhorizontal, Qicon; extern Lisp_Object Qicon_glyph_p, Qid, Qidentity, Qimage, Qinfo, Qinherit; extern Lisp_Object Qinhibit_quit, Qinhibit_read_only; extern Lisp_Object Qinput_charset_conversion, Qinteger; extern Lisp_Object Qinteger_char_or_marker_p, Qinteger_or_char_p; extern Lisp_Object Qinteger_or_marker_p, Qintegerp, Qinteractive, Qinternal; extern Lisp_Object Qinvalid_function, Qinvalid_read_syntax, Qio_error; -extern Lisp_Object Qiso2022, Qkey, Qkey_assoc, Qkeymap, Qlambda, Qleft, Qlf; +extern Lisp_Object Qiso2022, Qkey, Qkey_assoc, Qkeyboard, Qkeymap; +extern Lisp_Object Qlambda, Qlayout, Qlandscape, Qleft, Qleft_margin, Qlf; extern Lisp_Object Qlist, Qlistp, Qload, Qlock_shift, Qmacro, Qmagic; -extern Lisp_Object Qmalformed_list, Qmalformed_property_list; +extern Lisp_Object Qmakunbound, Qmalformed_list, Qmalformed_property_list; extern Lisp_Object Qmalloc_overhead, Qmark, Qmarkers; extern Lisp_Object Qmax, Qmemory, Qmessage, Qminus, Qmnemonic, Qmodifiers; extern Lisp_Object Qmono_pixmap_image_instance_p, Qmotion; -extern Lisp_Object Qmouse_leave_buffer_hook, Qmswindows, Qname, Qnas, Qnatnump; +extern Lisp_Object Qmouse_leave_buffer_hook, Qmsprinter, Qmswindows; +extern Lisp_Object Qname, Qnas, Qnatnump; extern Lisp_Object Qno_ascii_cntl, Qno_ascii_eol, Qno_catch; extern Lisp_Object Qno_conversion, Qno_iso6429, Qnone, Qnot, Qnothing; extern Lisp_Object Qnothing_image_instance_p, Qnotice; -extern Lisp_Object Qnumber_char_or_marker_p, Qnumber_or_marker_p, Qnumberp; +extern Lisp_Object Qnumber_char_or_marker_p, Qnumberp; extern Lisp_Object Qobject, Qold_assoc, Qold_delete, Qold_delq, Qold_rassoc; -extern Lisp_Object Qold_rassq, Qonly, Qor, Qother, Qoutput_charset_conversion; -extern Lisp_Object Qoverflow_error, Qpath, Qpoint, Qpointer, Qpointer_glyph_p; -extern Lisp_Object Qpointer_image_instance_p, Qpost_read_conversion; -extern Lisp_Object Qpre_write_conversion, Qprint, Qprint_length; +extern Lisp_Object Qold_rassq, Qonly, Qor, Qother; +extern Lisp_Object Qorientation, Qoutput_charset_conversion; +extern Lisp_Object Qoverflow_error, Qpoint, Qpointer, Qpointer_glyph_p; +extern Lisp_Object Qpointer_image_instance_p, Qportrait, Qpost_read_conversion; +extern Lisp_Object Qpre_write_conversion, Qprint, Qprinter, Qprint_length; extern Lisp_Object Qprint_string_length, Qprocess, Qprogn, Qprovide, Qquit; extern Lisp_Object Qquote, Qrange_error, Qrassoc, Qrassq, Qread_char; extern Lisp_Object Qread_from_minibuffer, Qreally_early_error_handler; extern Lisp_Object Qregion_beginning, Qregion_end, Qrequire, Qresource; -extern Lisp_Object Qreturn, Qreverse, Qright, Qrun_hooks, Qsans_modifiers; -extern Lisp_Object Qsave_buffers_kill_emacs, Qsearch, Qselected, Qself_insert_command; -extern Lisp_Object Qsequencep, Qsetting_constant, Qseven, Qshift_jis, Qshort; +extern Lisp_Object Qreturn, Qreverse, Qright, Qright_margin; +extern Lisp_Object Qrun_hooks, Qsans_modifiers; +extern Lisp_Object Qsave_buffers_kill_emacs, Qsearch, Qselected; +extern Lisp_Object Qself_insert_command, Qself_insert_defer_undo; +extern Lisp_Object Qsequencep, Qset, Qsetting_constant; +extern Lisp_Object Qseven, Qshift_jis, Qshort; extern Lisp_Object Qsignal, Qsimple, Qsingularity_error, Qsize, Qspace; extern Lisp_Object Qspecifier, Qstandard_input, Qstandard_output, Qstart_open; extern Lisp_Object Qstream, Qstring, Qstring_lessp, Qsubwindow; -extern Lisp_Object Qsubwindow_image_instance_p, Qsymbol, Qsyntax, Qt, Qtest; +extern Lisp_Object Qsubwindow_image_instance_p; +extern Lisp_Object Qsymbol, Qsyntax, Qt, Qterminal, Qtest; extern Lisp_Object Qtext, Qtext_image_instance_p, Qtimeout, Qtimestamp; -extern Lisp_Object Qtoolbar, Qtop, Qtop_level, Qtrue_list_p, Qtty, Qtype; +extern Lisp_Object Qtoolbar, Qtop, Qtop_margin, Qtop_level; +extern Lisp_Object Qtrue_list_p, Qtty, Qtype; extern Lisp_Object Qunbound, Qundecided, Qundefined, Qunderflow_error; extern Lisp_Object Qunderline, Qunimplemented, Quser_files_and_directories; extern Lisp_Object Qvalue_assoc, Qvalues; -extern Lisp_Object Qvariable_documentation, Qvariable_domain, Qvector; -extern Lisp_Object Qvoid_function, Qvoid_variable, Qwarning, Qwidth, Qwidget, Qwindow; +extern Lisp_Object Qvariable_documentation, Qvariable_domain, Qvertical; +extern Lisp_Object Qvoid_function, Qvoid_variable, Qwarning; +extern Lisp_Object Qwidth, Qwidget, Qwindow; extern Lisp_Object Qwindow_live_p, Qwindow_system, Qwrong_number_of_arguments; extern Lisp_Object Qwrong_type_argument, Qx, Qy, Qyes_or_no_p; extern Lisp_Object Vactivate_menubar_hook, Vascii_canon_table; extern Lisp_Object Vascii_downcase_table, Vascii_eqv_table; -extern Lisp_Object Vascii_upcase_table, Vautoload_queue, Vbinary_process_input; -extern Lisp_Object Vbinary_process_output, Vblank_menubar; +extern Lisp_Object Vascii_upcase_table, Vautoload_queue, Vblank_menubar; extern Lisp_Object Vcharset_ascii, Vcharset_composite, Vcharset_control_1; extern Lisp_Object Vcoding_system_for_read, Vcoding_system_for_write; extern Lisp_Object Vcoding_system_hash_table, Vcommand_history; @@ -3032,7 +2850,8 @@ extern Lisp_Object Vconsole_list, Vcontrolling_terminal; extern Lisp_Object Vcurrent_compiled_function_annotation, Vcurrent_load_list; extern Lisp_Object Vcurrent_mouse_event, Vcurrent_prefix_arg, Vdata_directory; -extern Lisp_Object Vdisabled_command_hook, Vdoc_directory, Vinternal_doc_file_name; +extern Lisp_Object Vdirectory_sep_char, Vdisabled_command_hook; +extern Lisp_Object Vdoc_directory, Vinternal_doc_file_name; extern Lisp_Object Vecho_area_buffer, Vemacs_major_version; extern Lisp_Object Vemacs_minor_version, Vexec_directory, Vexec_path; extern Lisp_Object Vexecuting_macro, Vfeatures, Vfile_domain; @@ -3049,15 +2868,12 @@ extern Lisp_Object Vmodule_directory, Vmswindows_downcase_file_names; extern Lisp_Object Vmswindows_get_true_file_attributes, Vobarray; extern Lisp_Object Vprint_length, Vprint_level, Vprocess_environment; -extern Lisp_Object Vpure_uninterned_symbol_table, Vquit_flag; +extern Lisp_Object Vquit_flag; extern Lisp_Object Vrecent_keys_ring, Vshell_file_name, Vsite_directory; extern Lisp_Object Vsite_module_directory; extern Lisp_Object Vstandard_input, Vstandard_output, Vstdio_str; extern Lisp_Object Vsynchronous_sounds, Vsystem_name, Vterminal_coding_system; extern Lisp_Object Vthis_command_keys, Vunread_command_event; -extern Lisp_Object Vwin32_generate_fake_inodes, Vwin32_pipe_read_delay; extern Lisp_Object Vx_initial_argv_list; -extern Lisp_Object Qmakunbound, Qset; - -#endif /* _XEMACS_LISP_H_ */ +#endif /* INCLUDED_lisp_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/lread.c --- a/src/lread.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/lread.c Mon Aug 13 11:13:30 2007 +0200 @@ -63,9 +63,13 @@ Lisp_Object Vvalues, Vstandard_input, Vafter_load_alist; Lisp_Object Qcurrent_load_list; Lisp_Object Qload, Qload_file_name; -Lisp_Object Qlocate_file_hash_table; Lisp_Object Qfset; +/* Hash-table that maps directory names to hashes of their contents. */ +static Lisp_Object Vlocate_file_hash_table; + +Lisp_Object Qexists, Qreadable, Qwritable, Qexecutable; + /* See read_escape() for an explanation of this. */ #if 0 int fail_on_bucky_bit_character_escapes; @@ -118,7 +122,7 @@ Each member of the list has the form (n . object), and is used to look up the object for the corresponding #n# construct. It must be set to nil before all top-level calls to read0. */ -Lisp_Object read_objects; +Lisp_Object Vread_objects; /* Nonzero means load should forcibly load all dynamic doc strings. */ /* Note that this always happens (with some special behavior) when @@ -214,14 +218,14 @@ static DOESNT_RETURN -syntax_error (CONST char *string) +syntax_error (const char *string) { signal_error (Qinvalid_read_syntax, list1 (build_translated_string (string))); } static Lisp_Object -continuable_syntax_error (CONST char *string) +continuable_syntax_error (const char *string) { return Fsignal (Qinvalid_read_syntax, list1 (build_translated_string (string))); @@ -439,12 +443,6 @@ Lisp_Object list = Vload_force_doc_string_list; Lisp_Object tail; int fd = XINT (XCAR (Vload_descriptor_list)); - /* NOTE: If purify_flag is true, we're in-place modifying objects that - may be in purespace (and if not, they will be). Therefore, we have - to be VERY careful to make sure that all objects that we create - are purecopied -- objects in purespace are not marked for GC, and - if we leave any impure objects inside of pure ones, we're really - screwed. */ GCPRO1 (list); /* restore the old value first just in case an error occurs. */ @@ -475,13 +473,12 @@ ivan = Fread (juan); if (!CONSP (ivan)) signal_simple_error ("invalid lazy-loaded byte code", ivan); - /* Remember to purecopy; see above. */ - XCOMPILED_FUNCTION (john)->instructions = Fpurecopy (XCAR (ivan)); + XCOMPILED_FUNCTION (john)->instructions = XCAR (ivan); /* v18 or v19 bytecode file. Need to Ebolify. */ if (XCOMPILED_FUNCTION (john)->flags.ebolified && VECTORP (XCDR (ivan))) ebolify_bytecode_constants (XCDR (ivan)); - XCOMPILED_FUNCTION (john)->constants = Fpurecopy (XCDR (ivan)); + XCOMPILED_FUNCTION (john)->constants = XCDR (ivan); NUNGCPRO; } doc = compiled_function_documentation (XCOMPILED_FUNCTION (john)); @@ -553,7 +550,6 @@ int message_p = NILP (nomessage); /*#ifdef DEBUG_XEMACS*/ static Lisp_Object last_file_loaded; - size_t pure_usage = 0; /*#endif*/ struct stat s1, s2; GCPRO3 (file, newer, found); @@ -565,7 +561,6 @@ { message_p = 1; last_file_loaded = file; - pure_usage = purespace_usage (); } /*#endif / * DEBUG_XEMACS */ @@ -593,9 +588,9 @@ int foundlen; fd = locate_file (Vload_path, file, - ((!NILP (nosuffix)) ? "" : - load_ignore_elc_files ? ".el:" : - ".elc:.el:"), + ((!NILP (nosuffix)) ? Qnil : + build_string (load_ignore_elc_files ? ".el:" : + ".elc:.el:")), &found, -1); @@ -681,7 +676,7 @@ { /* Lisp_Object's must be malloc'ed, not stack-allocated */ Lisp_Object lispstream = Qnil; - CONST int block_size = 8192; + const int block_size = 8192; struct gcpro ngcpro1; NGCPRO1 (lispstream); @@ -786,12 +781,8 @@ /*#ifdef DEBUG_XEMACS*/ if (purify_flag && noninteractive) { - if (EQ (last_file_loaded, file)) - message_append (" (%ld)", - (unsigned long) (purespace_usage() - pure_usage)); - else - message ("Loading %s ...done (%ld)", XSTRING_DATA (file), - (unsigned long) (purespace_usage() - pure_usage)); + if (!EQ (last_file_loaded, file)) + message ("Loading %s ...done", XSTRING_DATA (file)); } /*#endif / * DEBUG_XEMACS */ @@ -803,26 +794,57 @@ } -#if 0 /* FSFmacs */ -/* not used */ +/* ------------------------------- */ +/* locate_file */ +/* ------------------------------- */ + static int -complete_filename_p (Lisp_Object pathname) +decode_mode_1 (Lisp_Object mode) { - REGISTER unsigned char *s = XSTRING_DATA (pathname); - return (IS_DIRECTORY_SEP (s[0]) - || (XSTRING_LENGTH (pathname) > 2 - && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2])) -#ifdef ALTOS - || *s == '@' -#endif - ); + if (EQ (mode, Qexists)) + return F_OK; + else if (EQ (mode, Qexecutable)) + return X_OK; + else if (EQ (mode, Qwritable)) + return W_OK; + else if (EQ (mode, Qreadable)) + return R_OK; + else if (INTP (mode)) + { + check_int_range (XINT (mode), 0, 7); + return XINT (mode); + } + else + signal_simple_error ("Invalid value", mode); + return 0; /* unreached */ } -#endif /* 0 */ + +static int +decode_mode (Lisp_Object mode) +{ + if (NILP (mode)) + return R_OK; + else if (CONSP (mode)) + { + Lisp_Object tail; + int mask = 0; + EXTERNAL_LIST_LOOP (tail, mode) + mask |= decode_mode_1 (XCAR (tail)); + return mask; + } + else + return decode_mode_1 (mode); +} DEFUN ("locate-file", Flocate_file, 2, 4, 0, /* -Search for FILENAME through PATH-LIST, expanded by one of the optional -SUFFIXES (string of suffixes separated by ":"s), checking for access -MODE (0|1|2|4 = exists|executable|writeable|readable), default readable. +Search for FILENAME through PATH-LIST. + +If SUFFIXES is non-nil, it should be a list of suffixes to append to +file name when searching. + +If MODE is non-nil, it should be a symbol or a list of symbol representing +requirements. Allowed symbols are `exists', `executable', `writable', and +`readable'. If MODE is nil, it defaults to `readable'. `locate-file' keeps hash tables of the directories it searches through, in order to speed things up. It tries valiantly to not get confused in @@ -837,61 +859,208 @@ Lisp_Object tp; CHECK_STRING (filename); - if (!NILP (suffixes)) + + if (LISTP (suffixes)) + { + Lisp_Object tail; + EXTERNAL_LIST_LOOP (tail, suffixes) + CHECK_STRING (XCAR (tail)); + } + else CHECK_STRING (suffixes); - if (!NILP (mode)) - CHECK_NATNUM (mode); - - locate_file (path_list, - filename, - NILP (suffixes) ? "" : (char *) XSTRING_DATA (suffixes), - &tp, - NILP (mode) ? R_OK : XINT (mode)); + + locate_file (path_list, filename, suffixes, &tp, decode_mode (mode)); return tp; } -/* recalculate the hash table for the given string */ +/* Recalculate the hash table for the given string. DIRECTORY should + better have been through Fexpand_file_name() by now. */ + +static Lisp_Object +locate_file_refresh_hashing (Lisp_Object directory) +{ + Lisp_Object hash = + make_directory_hash_table ((char *) XSTRING_DATA (directory)); + + if (!NILP (hash)) + Fputhash (directory, hash, Vlocate_file_hash_table); + return hash; +} + +/* find the hash table for the given directory, recalculating if necessary */ static Lisp_Object -locate_file_refresh_hashing (Lisp_Object str) +locate_file_find_directory_hash_table (Lisp_Object directory) { - Lisp_Object hash = make_directory_hash_table ((char *) XSTRING_DATA (str)); - Fput (str, Qlocate_file_hash_table, hash); - return hash; + Lisp_Object hash = Fgethash (directory, Vlocate_file_hash_table, Qnil); + if (NILP (hash)) + return locate_file_refresh_hashing (directory); + else + return hash; } -/* find the hash table for the given string, recalculating if necessary */ - -static Lisp_Object -locate_file_find_directory_hash_table (Lisp_Object str) +/* The SUFFIXES argument in any of the locate_file* functions can be + nil, a list, or a string (for backward compatibility), with the + following semantics: + + a) nil - no suffix, just search for file name intact + (semantically different from "empty suffix list", which + would be meaningless.) + b) list - list of suffixes to append to file name. Each of these + must be a string. + c) string - colon-separated suffixes to append to file name (backward + compatibility). + + All of this got hairy, so I decided to use a mapper. Calling a + function for each suffix shouldn't slow things down, since + locate_file is rarely called with enough suffixes for funcalls to + make any difference. */ + +/* Map FUN over SUFFIXES, as described above. FUN will be called with a + char * containing the current file name, and ARG. Mapping stops when + FUN returns non-zero. */ +static void +locate_file_map_suffixes (Lisp_Object filename, Lisp_Object suffixes, + int (*fun) (char *, void *), + void *arg) { - Lisp_Object hash = Fget (str, Qlocate_file_hash_table, Qnil); - if (! HASH_TABLEP (hash)) - return locate_file_refresh_hashing (str); - return hash; + /* This function can GC */ + char *fn; + int fn_len, max; + + /* Calculate maximum size of any filename made from + this path element/specified file name and any possible suffix. */ + if (CONSP (suffixes)) + { + /* We must traverse the list, so why not do it right. */ + Lisp_Object tail; + max = 0; + LIST_LOOP (tail, suffixes) + { + if (XSTRING_LENGTH (XCAR (tail)) > max) + max = XSTRING_LENGTH (XCAR (tail)); + } + } + else if (NILP (suffixes)) + max = 0; + else + /* Just take the easy way out */ + max = XSTRING_LENGTH (suffixes); + + fn_len = XSTRING_LENGTH (filename); + fn = (char *) alloca (max + fn_len + 1); + memcpy (fn, (char *) XSTRING_DATA (filename), fn_len); + + /* Loop over suffixes. */ + if (!STRINGP (suffixes)) + { + if (NILP (suffixes)) + { + /* Case a) discussed in the comment above. */ + fn[fn_len] = 0; + if ((*fun) (fn, arg)) + return; + } + else + { + /* Case b) */ + Lisp_Object tail; + LIST_LOOP (tail, suffixes) + { + memcpy (fn + fn_len, XSTRING_DATA (XCAR (tail)), + XSTRING_LENGTH (XCAR (tail))); + fn[fn_len + XSTRING_LENGTH (XCAR (tail))] = 0; + if ((*fun) (fn, arg)) + return; + } + } + } + else + { + /* Case c) */ + const char *nsuffix = (const char *) XSTRING_DATA (suffixes); + + while (1) + { + char *esuffix = (char *) strchr (nsuffix, ':'); + int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix)); + + /* Concatenate path element/specified name with the suffix. */ + strncpy (fn + fn_len, nsuffix, lsuffix); + fn[fn_len + lsuffix] = 0; + + if ((*fun) (fn, arg)) + return; + + /* Advance to next suffix. */ + if (esuffix == 0) + break; + nsuffix += lsuffix + 1; + } + } } -/* look for STR in PATH, optionally adding suffixes in SUFFIX */ +struct locate_file_in_directory_mapper_closure { + int fd; + Lisp_Object *storeptr; + int mode; +}; static int -locate_file_in_directory (Lisp_Object path, Lisp_Object str, - CONST char *suffix, Lisp_Object *storeptr, +locate_file_in_directory_mapper (char *fn, void *arg) +{ + struct locate_file_in_directory_mapper_closure *closure = + (struct locate_file_in_directory_mapper_closure *)arg; + struct stat st; + + /* Ignore file if it's a directory. */ + if (stat (fn, &st) >= 0 + && (st.st_mode & S_IFMT) != S_IFDIR) + { + /* Check that we can access or open it. */ + if (closure->mode >= 0) + closure->fd = access (fn, closure->mode); + else + closure->fd = open (fn, O_RDONLY | OPEN_BINARY, 0); + + if (closure->fd >= 0) + { + /* We succeeded; return this descriptor and filename. */ + if (closure->storeptr) + *closure->storeptr = build_string (fn); + +#ifndef WINDOWSNT + /* If we actually opened the file, set close-on-exec flag + on the new descriptor so that subprocesses can't whack + at it. */ + if (closure->mode < 0) + (void) fcntl (closure->fd, F_SETFD, FD_CLOEXEC); +#endif + + return 1; + } + } + /* Keep mapping. */ + return 0; +} + + +/* look for STR in PATH, optionally adding SUFFIXES. DIRECTORY need + not have been expanded. */ + +static int +locate_file_in_directory (Lisp_Object directory, Lisp_Object str, + Lisp_Object suffixes, Lisp_Object *storeptr, int mode) { /* This function can GC */ - int fd; - int fn_size = 100; - char buf[100]; - char *fn = buf; - int want_size; - struct stat st; + struct locate_file_in_directory_mapper_closure closure; Lisp_Object filename = Qnil; struct gcpro gcpro1, gcpro2, gcpro3; - CONST char *nsuffix; - - GCPRO3 (path, str, filename); - - filename = Fexpand_file_name (str, path); + + GCPRO3 (directory, str, filename); + + filename = Fexpand_file_name (str, directory); if (NILP (filename) || NILP (Ffile_name_absolute_p (filename))) /* If there are non-absolute elts in PATH (eg ".") */ /* Of course, this could conceivably lose if luser sets @@ -905,142 +1074,73 @@ current_buffer->directory); if (NILP (Ffile_name_absolute_p (filename))) { - /* Give up on this path element! */ + /* Give up on this directory! */ UNGCPRO; return -1; } } - /* Calculate maximum size of any filename made from - this path element/specified file name and any possible suffix. */ - want_size = strlen (suffix) + XSTRING_LENGTH (filename) + 1; - if (fn_size < want_size) - fn = (char *) alloca (fn_size = 100 + want_size); - - nsuffix = suffix; - - /* Loop over suffixes. */ - while (1) - { - char *esuffix = (char *) strchr (nsuffix, ':'); - int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix)); - - /* Concatenate path element/specified name with the suffix. */ - strncpy (fn, (char *) XSTRING_DATA (filename), - XSTRING_LENGTH (filename)); - fn[XSTRING_LENGTH (filename)] = 0; - if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */ - strncat (fn, nsuffix, lsuffix); - - /* Ignore file if it's a directory. */ - if (stat (fn, &st) >= 0 - && (st.st_mode & S_IFMT) != S_IFDIR) - { - /* Check that we can access or open it. */ - if (mode >= 0) - fd = access (fn, mode); - else - fd = open (fn, O_RDONLY | OPEN_BINARY, 0); - - if (fd >= 0) - { - /* We succeeded; return this descriptor and filename. */ - if (storeptr) - *storeptr = build_string (fn); - UNGCPRO; - -#ifndef WINDOWSNT - /* If we actually opened the file, set close-on-exec flag - on the new descriptor so that subprocesses can't whack - at it. */ - if (mode < 0) - (void) fcntl (fd, F_SETFD, FD_CLOEXEC); -#endif - - return fd; - } - } - - /* Advance to next suffix. */ - if (esuffix == 0) - break; - nsuffix += lsuffix + 1; - } + + closure.fd = -1; + closure.storeptr = storeptr; + closure.mode = mode; + + locate_file_map_suffixes (filename, suffixes, locate_file_in_directory_mapper, + &closure); UNGCPRO; - return -1; + return closure.fd; } /* do the same as locate_file() but don't use any hash tables. */ static int locate_file_without_hash (Lisp_Object path, Lisp_Object str, - CONST char *suffix, Lisp_Object *storeptr, + Lisp_Object suffixes, Lisp_Object *storeptr, int mode) { /* This function can GC */ - int absolute; - struct gcpro gcpro1; - - /* is this necessary? */ - GCPRO1 (path); - - absolute = !NILP (Ffile_name_absolute_p (str)); - - for (; !NILP (path); path = Fcdr (path)) + int absolute = !NILP (Ffile_name_absolute_p (str)); + + EXTERNAL_LIST_LOOP (path, path) { - int val = locate_file_in_directory (Fcar (path), str, suffix, - storeptr, mode); + int val = locate_file_in_directory (XCAR (path), str, suffixes, storeptr, + mode); if (val >= 0) - { - UNGCPRO; - return val; - } + return val; if (absolute) break; } - - UNGCPRO; return -1; } -/* Construct a list of all files to search for. */ +static int +locate_file_construct_suffixed_files_mapper (char *fn, void *arg) +{ + Lisp_Object *tail = (Lisp_Object *)arg; + *tail = Fcons (build_string (fn), *tail); + return 0; +} + +/* Construct a list of all files to search for. + It makes sense to have this despite locate_file_map_suffixes() + because we need Lisp strings to access the hash-table, and it would + be inefficient to create them on the fly, again and again for each + path component. See locate_file(). */ static Lisp_Object -locate_file_construct_suffixed_files (Lisp_Object str, CONST char *suffix) +locate_file_construct_suffixed_files (Lisp_Object filename, + Lisp_Object suffixes) { - int want_size; - int fn_size = 100; - char buf[100]; - char *fn = buf; - CONST char *nsuffix; - Lisp_Object suffixtab = Qnil; - - /* Calculate maximum size of any filename made from - this path element/specified file name and any possible suffix. */ - want_size = strlen (suffix) + XSTRING_LENGTH (str) + 1; - if (fn_size < want_size) - fn = (char *) alloca (fn_size = 100 + want_size); - - nsuffix = suffix; - - while (1) - { - char *esuffix = (char *) strchr (nsuffix, ':'); - int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix)); - - /* Concatenate path element/specified name with the suffix. */ - strncpy (fn, (char *) XSTRING_DATA (str), XSTRING_LENGTH (str)); - fn[XSTRING_LENGTH (str)] = 0; - if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */ - strncat (fn, nsuffix, lsuffix); - - suffixtab = Fcons (build_string (fn), suffixtab); - /* Advance to next suffix. */ - if (esuffix == 0) - break; - nsuffix += lsuffix + 1; - } - return Fnreverse (suffixtab); + Lisp_Object tail = Qnil; + struct gcpro gcpro1; + GCPRO1 (tail); + + locate_file_map_suffixes (filename, suffixes, + locate_file_construct_suffixed_files_mapper, + &tail); + + UNGCPRO; + return Fnreverse (tail); } DEFUN ("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /* @@ -1056,23 +1156,31 @@ `locate-file' will primarily get confused if you add a file that shadows \(i.e. has the same name as) another file further down in the directory list. In this case, you must call `locate-file-clear-hashing'. + +If PATH is t, it means to fully clear all the accumulated hashes. This +can be used if the internal tables grow too large, or when dumping. */ (path)) { - Lisp_Object pathtail; - - for (pathtail = path; !NILP (pathtail); pathtail = Fcdr (pathtail)) + if (EQ (path, Qt)) + Fclrhash (Vlocate_file_hash_table); + else { - Lisp_Object pathel = Fcar (pathtail); - if (!purified (pathel)) - Fput (pathel, Qlocate_file_hash_table, Qnil); + Lisp_Object pathtail; + EXTERNAL_LIST_LOOP (pathtail, path) + { + Lisp_Object pathel = Fexpand_file_name (XCAR (pathtail), Qnil); + Fremhash (pathel, Vlocate_file_hash_table); + } } return Qnil; } /* Search for a file whose name is STR, looking in directories - in the Lisp list PATH, and trying suffixes from SUFFIX. - SUFFIX is a string containing possible suffixes separated by colons. + in the Lisp list PATH, and trying suffixes from SUFFIXES. + SUFFIXES is a list of possible suffixes, or (for backward + compatibility) a string containing possible suffixes separated by + colons. On success, returns a file descriptor. On failure, returns -1. MODE nonnegative means don't open the files, @@ -1086,43 +1194,45 @@ Called openp() in FSFmacs. */ int -locate_file (Lisp_Object path, Lisp_Object str, CONST char *suffix, +locate_file (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *storeptr, int mode) { /* This function can GC */ Lisp_Object suffixtab = Qnil; - Lisp_Object pathtail; + Lisp_Object pathtail, pathel_expanded; int val; - struct gcpro gcpro1, gcpro2, gcpro3; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; if (storeptr) *storeptr = Qnil; + /* Is it really necessary to gcpro path and str? It shouldn't be + unless some caller has fucked up. There are known instances that + call us with build_string("foo:bar") as SUFFIXES, though. */ + GCPRO4 (path, str, suffixes, suffixtab); + /* if this filename has directory components, it's too complicated to try and use the hash tables. */ if (!NILP (Ffile_name_directory (str))) - return locate_file_without_hash (path, str, suffix, storeptr, - mode); - - /* Is it really necessary to gcpro path and str? It shouldn't be - unless some caller has fucked up. */ - GCPRO3 (path, str, suffixtab); - - suffixtab = locate_file_construct_suffixed_files (str, suffix); - - for (pathtail = path; !NILP (pathtail); pathtail = Fcdr (pathtail)) { - Lisp_Object pathel = Fcar (pathtail); + val = locate_file_without_hash (path, str, suffixes, storeptr, mode); + UNGCPRO; + return val; + } + + suffixtab = locate_file_construct_suffixed_files (str, suffixes); + + EXTERNAL_LIST_LOOP (pathtail, path) + { + Lisp_Object pathel = XCAR (pathtail); Lisp_Object hash_table; Lisp_Object tail; - int found; - - /* If this path element is relative, we have to look by hand. - Can't set string property in a pure string. */ - if (NILP (pathel) || NILP (Ffile_name_absolute_p (pathel)) || - purified (pathel)) + int found = 0; + + /* If this path element is relative, we have to look by hand. */ + if (NILP (Ffile_name_absolute_p (pathel))) { - val = locate_file_in_directory (pathel, str, suffix, storeptr, + val = locate_file_in_directory (pathel, str, suffixes, storeptr, mode); if (val >= 0) { @@ -1132,21 +1242,25 @@ continue; } - hash_table = locate_file_find_directory_hash_table (pathel); - - /* Loop over suffixes. */ - for (tail = suffixtab, found = 0; !found && CONSP (tail); - tail = XCDR (tail)) + pathel_expanded = Fexpand_file_name (pathel, Qnil); + hash_table = locate_file_find_directory_hash_table (pathel_expanded); + + if (!NILP (hash_table)) { - if (!NILP (Fgethash (XCAR (tail), hash_table, Qnil))) - found = 1; + /* Loop over suffixes. */ + LIST_LOOP (tail, suffixtab) + if (!NILP (Fgethash (XCAR (tail), hash_table, Qnil))) + { + found = 1; + break; + } } if (found) { /* This is a likely candidate. Look by hand in this directory so we don't get thrown off if someone byte-compiles a file. */ - val = locate_file_in_directory (pathel, str, suffix, storeptr, + val = locate_file_in_directory (pathel, str, suffixes, storeptr, mode); if (val >= 0) { @@ -1156,13 +1270,12 @@ /* Hmm ... the file isn't actually there. (Or possibly it's a directory ...) So refresh our hashing. */ - locate_file_refresh_hashing (pathel); + locate_file_refresh_hashing (pathel_expanded); } } /* File is probably not there, but check the hard way just in case. */ - val = locate_file_without_hash (path, str, suffix, storeptr, - mode); + val = locate_file_without_hash (path, str, suffixes, storeptr, mode); if (val >= 0) { /* Sneaky user added a file without telling us. */ @@ -1325,7 +1438,7 @@ #else /* No "defun hack" -- Emacs 19 uses read-time syntax for bytecodes */ { unreadchar (readcharfun, c); - read_objects = Qnil; + Vread_objects = Qnil; if (NILP (Vload_read_function)) val = read0 (readcharfun); else @@ -1463,7 +1576,7 @@ if (EQ (stream, Qt)) stream = Qread_char; - read_objects = Qnil; + Vread_objects = Qnil; #ifdef COMPILED_FUNCTION_ANNOTATION_HACK Vcurrent_compiled_function_annotation = Qnil; @@ -1504,7 +1617,7 @@ lispstream = make_lisp_string_input_stream (string, startval, endval - startval); - read_objects = Qnil; + Vread_objects = Qnil; tem = read0 (lispstream); /* Yeah, it's ugly. Gonna make something of it? @@ -1539,9 +1652,8 @@ static Lisp_Object read0 (Lisp_Object readcharfun) { - Lisp_Object val; - - val = read1 (readcharfun); + Lisp_Object val = read1 (readcharfun); + if (CONSP (val) && UNBOUNDP (XCAR (val))) { Emchar c = XCHAR (XCDR (val)); @@ -1681,10 +1793,14 @@ } case 'x': - /* A hex escape, as in ANSI C. */ + /* A hex escape, as in ANSI C, except that we only allow latin-1 + characters to be read this way. What is "\x4e03" supposed to + mean, anyways, if the internal representation is hidden? + This is also consistent with the treatment of octal escapes. */ { REGISTER Emchar i = 0; - while (1) + REGISTER int count = 0; + while (++count <= 2) { c = readchar (readcharfun); /* Remember, can't use isdigit(), isalpha() etc. on Emchars */ @@ -1754,7 +1870,7 @@ return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1; } -static Lisp_Object parse_integer (CONST Bufbyte *buf, Bytecount len, int base); +static Lisp_Object parse_integer (const Bufbyte *buf, Bytecount len, int base); static Lisp_Object read_atom (Lisp_Object readcharfun, @@ -1822,23 +1938,11 @@ { Lisp_Object sym; if (uninterned_symbol) - sym = (Fmake_symbol ((purify_flag) - ? make_pure_pname ((Bufbyte *) read_ptr, len, 0) - : make_string ((Bufbyte *) read_ptr, len))); + sym = Fmake_symbol ( make_string ((Bufbyte *) read_ptr, len)); else { - /* intern will purecopy pname if necessary */ Lisp_Object name = make_string ((Bufbyte *) read_ptr, len); sym = Fintern (name, Qnil); - - if (SYMBOL_IS_KEYWORD (sym)) - { - /* the LISP way is to put keywords in their own package, - but we don't have packages, so we do something simpler. - Someday, maybe we'll have packages and then this will - be reworked. --Stig. */ - XSYMBOL (sym)->value = sym; - } } return sym; } @@ -1846,10 +1950,10 @@ static Lisp_Object -parse_integer (CONST Bufbyte *buf, Bytecount len, int base) +parse_integer (const Bufbyte *buf, Bytecount len, int base) { - CONST Bufbyte *lim = buf + len; - CONST Bufbyte *p = buf; + const Bufbyte *lim = buf + len; + const Bufbyte *p = buf; EMACS_UINT num = 0; int negativland = 0; @@ -1932,6 +2036,7 @@ { unsigned_char_dynarr *dyn = Dynarr_new (unsigned_char); Emchar c; + Lisp_Object val; while (1) { @@ -1944,8 +2049,12 @@ if (c >= 0) unreadchar (readcharfun, c); - return make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0), - Dynarr_length (dyn)); + val = make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0), + Dynarr_length (dyn)); + + Dynarr_free (dyn); + + return val; } @@ -2421,7 +2530,7 @@ n += c - '0'; c = readchar (readcharfun); } - found = assq_no_quit (make_int (n), read_objects); + found = assq_no_quit (make_int (n), Vread_objects); if (c == '=') { /* #n=object returns object, but associates it with @@ -2433,7 +2542,8 @@ ("Multiply defined symbol label"), make_int (n))); obj = read0 (readcharfun); - read_objects = Fcons (Fcons (make_int (n), obj), read_objects); + Vread_objects = Fcons (Fcons (make_int (n), obj), + Vread_objects); return obj; } else if (c == '#') @@ -2559,18 +2669,10 @@ return Qzero; Lstream_flush (XLSTREAM (Vread_buffer_stream)); -#if 0 /* FSFmacs defun hack */ - if (read_pure) - return - make_pure_string - (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)), - Lstream_byte_count (XLSTREAM (Vread_buffer_stream))); - else -#endif - return - make_string - (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)), - Lstream_byte_count (XLSTREAM (Vread_buffer_stream))); + return + make_string + (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)), + Lstream_byte_count (XLSTREAM (Vread_buffer_stream))); } default: @@ -2594,10 +2696,10 @@ #define EXP_INT 16 int -isfloat_string (CONST char *cp) +isfloat_string (const char *cp) { int state = 0; - CONST Bufbyte *ucp = (CONST Bufbyte *) cp; + const Bufbyte *ucp = (const Bufbyte *) cp; if (*ucp == '+' || *ucp == '-') ucp++; @@ -2900,13 +3002,8 @@ i < len; i++, p++) { - struct Lisp_Cons *otem = XCONS (tem); -#if 0 /* FSFmacs defun hack */ - if (read_pure) - tem = Fpurecopy (Fcar (tem)); - else -#endif - tem = Fcar (tem); + Lisp_Cons *otem = XCONS (tem); + tem = Fcar (tem); *p = tem; tem = otem->cdr; free_cons (otem); @@ -2937,7 +3034,7 @@ for (iii = 0; CONSP (stuff); iii++) { - struct Lisp_Cons *victim = XCONS (stuff); + Lisp_Cons *victim = XCONS (stuff); make_byte_code_args[iii] = Fcar (stuff); if ((purify_flag || load_force_doc_strings) && CONSP (make_byte_code_args[iii]) @@ -3022,7 +3119,6 @@ defsymbol (&Qcurrent_load_list, "current-load-list"); defsymbol (&Qload, "load"); defsymbol (&Qload_file_name, "load-file-name"); - defsymbol (&Qlocate_file_hash_table, "locate-file-hash-table"); defsymbol (&Qfset, "fset"); #ifdef LISP_BACKQUOTES @@ -3032,6 +3128,11 @@ defsymbol (&Qcomma_at, ",@"); defsymbol (&Qcomma_dot, ",."); #endif + + defsymbol (&Qexists, "exists"); + defsymbol (&Qreadable, "readable"); + defsymbol (&Qwritable, "writable"); + defsymbol (&Qexecutable, "executable"); } void @@ -3041,8 +3142,17 @@ } void +reinit_vars_of_lread (void) +{ + Vread_buffer_stream = Qnil; + staticpro_nodump (&Vread_buffer_stream); +} + +void vars_of_lread (void) { + reinit_vars_of_lread (); + DEFVAR_LISP ("values", &Vvalues /* List of values of all expressions which were read, evaluated and printed. Order is reverse chronological. @@ -3160,9 +3270,6 @@ with values saved when the image is dumped. */ staticpro (&Vload_descriptor_list); - Vread_buffer_stream = Qnil; - staticpro (&Vread_buffer_stream); - /* Initialized in init_lread. */ staticpro (&Vload_force_doc_string_list); @@ -3196,6 +3303,15 @@ Vfile_domain = Qnil; #endif - read_objects = Qnil; - staticpro (&read_objects); + Vread_objects = Qnil; + staticpro (&Vread_objects); + + Vlocate_file_hash_table = make_lisp_hash_table (200, + HASH_TABLE_NON_WEAK, + HASH_TABLE_EQUAL); + staticpro (&Vlocate_file_hash_table); +#ifdef DEBUG_XEMACS + symbol_value (XSYMBOL (intern ("Vlocate-file-hash-table"))) + = Vlocate_file_hash_table; +#endif } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/lrecord.h --- a/src/lrecord.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/lrecord.h Mon Aug 13 11:13:30 2007 +0200 @@ -21,18 +21,18 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_LRECORD_H_ -#define _XEMACS_LRECORD_H_ +#ifndef INCLUDED_lrecord_h_ +#define INCLUDED_lrecord_h_ /* The "lrecord" type of Lisp object is used for all object types other than a few simple ones. This allows many types to be - implemented but only a few bits required in a Lisp object for - type information. (The tradeoff is that each object has its - type marked in it, thereby increasing its size.) The first - four bytes of all lrecords is either a pointer to a struct - lrecord_implementation, which contains methods describing how - to process this object, or an index into an array of pointers - to struct lrecord_implementations plus some other data bits. + implemented but only a few bits required in a Lisp object for type + information. (The tradeoff is that each object has its type marked + in it, thereby increasing its size.) All lrecords begin with a + `struct lrecord_header', which identifies the lisp object type, by + providing an index into a table of `struct lrecord_implementation', + which describes the behavior of the lisp object. It also contains + some other data bits. Lrecords are of two types: straight lrecords, and lcrecords. Straight lrecords are used for those types of objects that have @@ -42,12 +42,12 @@ the lrecord_implementation for the object. There are special routines in alloc.c to deal with each such object type. - Lcrecords are used for less common sorts of objects that don't - do their own allocation. Each such object is malloc()ed - individually, and the objects are chained together through - a `next' pointer. Lcrecords have a `struct lcrecord_header' - at the top, which contains a `struct lrecord_header' and - a `next' pointer, and are allocated using alloc_lcrecord(). + Lcrecords are used for less common sorts of objects that don't do + their own allocation. Each such object is malloc()ed individually, + and the objects are chained together through a `next' pointer. + Lcrecords have a `struct lcrecord_header' at the top, which + contains a `struct lrecord_header' and a `next' pointer, and are + allocated using alloc_lcrecord(). Creating a new lcrecord type is fairly easy; just follow the lead of some existing type (e.g. hash tables). Note that you @@ -59,68 +59,34 @@ struct lrecord_header { - /* It would be better to put the mark-bit together with the - following datatype identification field in an 8- or 16-bit - integer rather than playing funny games with changing - header->implementation and "wasting" 32 bits on the below - pointer. The type-id would then be a 7 or 15 bit index into a - table of lrecord-implementations rather than a direct pointer. - There would be 24 (or 16) bits left over for datatype-specific - per-instance flags. - - The below is the simplest thing to do for the present, - and doesn't incur that much overhead as most Emacs records - are of such a size that the overhead isn't too bad. - (The marker datatype is the worst case.) - - It also has the very very very slight advantage that type-checking - involves one memory read (of the "implementation" slot) and a - comparison against a link-time constant address rather than a - read and a comparison against a variable value. (Variable since - it is a very good idea to assign the indices into the hypothetical - type-code table dynamically rather that pre-defining them.) - I think I remember that Elk Lisp does something like this. - Gee, I wonder if some cretin has patented it? */ - - /* - * If USE_INDEXED_LRECORD_IMPLEMENTATION is defined, we are - * implementing the scheme described in the 'It would be better - * ...' paragraph above. - */ -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION /* index into lrecord_implementations_table[] */ - unsigned char type; - /* 1 if the object is marked during GC, 0 otherwise. */ - char mark; - /* 1 if the object resides in pure (read-only) space */ - char pure; -#else - CONST struct lrecord_implementation *implementation; -#endif + unsigned int type :8; + /* 1 if the object is marked during GC. */ + unsigned int mark :1; + /* 1 if the object resides in read-only space */ + unsigned int c_readonly :1; + /* 1 if the object is readonly from lisp */ + unsigned int lisp_readonly :1; }; struct lrecord_implementation; -int lrecord_type_index (CONST struct lrecord_implementation *implementation); +int lrecord_type_index (const struct lrecord_implementation *implementation); -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION -# define set_lheader_implementation(header,imp) do { \ +#define set_lheader_implementation(header,imp) do { \ struct lrecord_header* SLI_header = (header); \ - (SLI_header)->type = lrecord_type_index (imp); \ - (SLI_header)->mark = 0; \ - (SLI_header)->pure = 0; \ + SLI_header->type = lrecord_type_index (imp); \ + SLI_header->mark = 0; \ + SLI_header->c_readonly = 0; \ + SLI_header->lisp_readonly = 0; \ } while (0) -#else -# define set_lheader_implementation(header,imp) \ - ((void) ((header)->implementation = (imp))) -#endif struct lcrecord_header { struct lrecord_header lheader; - /* The `next' field is normally used to chain all lrecords together + /* The `next' field is normally used to chain all lcrecords together so that the GC can find (and free) all of them. - `alloc_lcrecord' threads records together. + `alloc_lcrecord' threads lcrecords together. The `next' field may be used for other purposes as long as some other mechanism is provided for letting the GC do its work. @@ -152,18 +118,14 @@ Lisp_Object chain; }; -/* This as the value of lheader->implementation->finalizer - means that this record is already marked */ -void this_marks_a_marked_record (void *, int); - /* see alloc.c for an explanation */ -Lisp_Object this_one_is_unmarkable (Lisp_Object obj, - void (*markobj) (Lisp_Object)); +Lisp_Object this_one_is_unmarkable (Lisp_Object obj); struct lrecord_implementation { - CONST char *name; - /* This function is called at GC time, to make sure that all Lisp_Objects + const char *name; + + /* `marker' is called at GC time, to make sure that all Lisp_Objects pointed to by this object get properly marked. It should call the mark_object function on all Lisp_Objects in the object. If the return value is non-nil, it should be a Lisp_Object to be @@ -172,86 +134,219 @@ recursion, so the object returned should preferably be the one with the deepest level of Lisp_Object pointers. This function can be NULL, meaning no GC marking is necessary. */ - Lisp_Object (*marker) (Lisp_Object, void (*mark_object) (Lisp_Object)); - /* This can be NULL if the object is an lcrecord; the - default_object_printer() in print.c will be used. */ + Lisp_Object (*marker) (Lisp_Object); + + /* `printer' converts the object to a printed representation. + This can be NULL; in this case default_object_printer() will be + used instead. */ void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag); - /* This function is called at GC time when the object is about to + + /* `finalizer' is called at GC time when the object is about to be freed, and at dump time (FOR_DISKSAVE will be non-zero in this case). It should perform any necessary cleanup (e.g. freeing - malloc()ed memory. This can be NULL, meaning no special + malloc()ed memory). This can be NULL, meaning no special finalization is necessary. - WARNING: remember that the finalizer is called at dump time even + WARNING: remember that `finalizer' is called at dump time even though the object is not being freed. */ void (*finalizer) (void *header, int for_disksave); + /* This can be NULL, meaning compare objects with EQ(). */ int (*equal) (Lisp_Object obj1, Lisp_Object obj2, int depth); - /* This can be NULL, meaning use the Lisp_Object itself as the hash; - but *only* if the `equal' function is EQ (if two objects are - `equal', they *must* hash to the same value or the hashing won't - work). */ + + /* `hash' generates hash values for use with hash tables that have + `equal' as their test function. This can be NULL, meaning use + the Lisp_Object itself as the hash. But, you must still satisfy + the constraint that if two objects are `equal', then they *must* + hash to the same value in order for hash tables to work properly. + This means that `hash' can be NULL only if the `equal' method is + also NULL. */ unsigned long (*hash) (Lisp_Object, int); + + /* External data layout description */ + const struct lrecord_description *description; + + /* These functions allow any object type to have builtin property + lists that can be manipulated from the lisp level with + `get', `put', `remprop', and `object-plist'. */ Lisp_Object (*getprop) (Lisp_Object obj, Lisp_Object prop); int (*putprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object val); int (*remprop) (Lisp_Object obj, Lisp_Object prop); Lisp_Object (*plist) (Lisp_Object obj); - /* Only one of these is non-0. If both are 0, it means that this type - is not instantiable by alloc_lcrecord(). */ + /* Only one of `static_size' and `size_in_bytes_method' is non-0. + If both are 0, this type is not instantiable by alloc_lcrecord(). */ size_t static_size; - size_t (*size_in_bytes_method) (CONST void *header); + size_t (*size_in_bytes_method) (const void *header); + /* A unique subtag-code (dynamically) assigned to this datatype. */ /* (This is a pointer so the rest of this structure can be read-only.) */ int *lrecord_type_index; + /* A "basic" lrecord is any lrecord that's not an lcrecord, i.e. one that does not have an lcrecord_header at the front and which is (usually) allocated in frob blocks. We only use this flag for some consistency checking, and that only when error-checking is enabled. */ - int basic_p; + unsigned int basic_p :1; }; -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION -extern CONST struct lrecord_implementation *lrecord_implementations_table[]; +extern const struct lrecord_implementation *lrecord_implementations_table[]; -# define XRECORD_LHEADER_IMPLEMENTATION(obj) \ +#define XRECORD_LHEADER_IMPLEMENTATION(obj) \ (lrecord_implementations_table[XRECORD_LHEADER (obj)->type]) -# define LHEADER_IMPLEMENTATION(lh) (lrecord_implementations_table[(lh)->type]) -#else -# define XRECORD_LHEADER_IMPLEMENTATION(obj) \ - (XRECORD_LHEADER (obj)->implementation) -# define LHEADER_IMPLEMENTATION(lh) ((lh)->implementation) -#endif +#define LHEADER_IMPLEMENTATION(lh) (lrecord_implementations_table[(lh)->type]) extern int gc_in_progress; -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION -# define MARKED_RECORD_P(obj) (gc_in_progress && XRECORD_LHEADER (obj)->mark) -#else -# define MARKED_RECORD_P(obj) (gc_in_progress && \ - XRECORD_LHEADER (obj)->implementation->finalizer == \ - this_marks_a_marked_record) -#endif - -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION - -# define MARKED_RECORD_HEADER_P(lheader) ((lheader)->mark) -# define MARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 1)) -# define UNMARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 0)) - -#else /* ! USE_INDEXED_LRECORD_IMPLEMENTATION */ - -# define MARKED_RECORD_HEADER_P(lheader) \ - ((lheader)->implementation->finalizer == this_marks_a_marked_record) -# define MARK_RECORD_HEADER(lheader) ((void) (((lheader)->implementation)++)) -# define UNMARK_RECORD_HEADER(lheader) ((void) (((lheader)->implementation)--)) - -#endif /* ! USE_INDEXED_LRECORD_IMPLEMENTATION */ +#define MARKED_RECORD_P(obj) (gc_in_progress && XRECORD_LHEADER (obj)->mark) +#define MARKED_RECORD_HEADER_P(lheader) ((lheader)->mark) +#define MARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 1)) +#define UNMARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 0)) #define UNMARKABLE_RECORD_HEADER_P(lheader) \ (LHEADER_IMPLEMENTATION (lheader)->marker == this_one_is_unmarkable) +#define C_READONLY_RECORD_HEADER_P(lheader) ((lheader)->c_readonly) +#define LISP_READONLY_RECORD_HEADER_P(lheader) ((lheader)->lisp_readonly) +#define SET_C_READONLY_RECORD_HEADER(lheader) \ + ((void) ((lheader)->c_readonly = (lheader)->lisp_readonly = 1)) +#define SET_LISP_READONLY_RECORD_HEADER(lheader) \ + ((void) ((lheader)->lisp_readonly = 1)) + +/* External description stuff + + A lrecord external description is an array of values. The first + value of each line is a type, the second the offset in the lrecord + structure. Following values are parameters, their presence, type + and number is type-dependant. + + The description ends with a "XD_END" or "XD_SPECIFIER_END" record. + + Some example descriptions : + + static const struct lrecord_description cons_description[] = { + { XD_LISP_OBJECT, offsetof (Lisp_Cons, car) }, + { XD_LISP_OBJECT, offsetof (Lisp_Cons, cdr) }, + { XD_END } + }; + + Which means "two lisp objects starting at the 'car' and 'cdr' elements" + + static const struct lrecord_description string_description[] = { + { XD_BYTECOUNT, offsetof (Lisp_String, size) }, + { XD_OPAQUE_DATA_PTR, offsetof (Lisp_String, data), XD_INDIRECT(0, 1) }, + { XD_LISP_OBJECT, offsetof (Lisp_String, plist) }, + { XD_END } + }; + "A pointer to string data at 'data', the size of the pointed array being the value + of the size variable plus 1, and one lisp object at 'plist'" + + The existing types : + XD_LISP_OBJECT + A Lisp object. This is also the type to use for pointers to other lrecords. + + XD_LISP_OBJECT_ARRAY + An array of Lisp objects or pointers to lrecords. + The third element is the count. + + XD_LO_RESET_NIL + Lisp objects which will be reset to Qnil when dumping. Useful for cleaning + up caches. + + XD_LO_LINK + Link in a linked list of objects of the same type. + + XD_OPAQUE_PTR + Pointer to undumpable data. Must be NULL when dumping. + + XD_STRUCT_PTR + Pointer to described struct. Parameters are number of structures and + struct_description. + + XD_OPAQUE_DATA_PTR + Pointer to dumpable opaque data. Parameter is the size of the data. + Pointed data must be relocatable without changes. + + XD_C_STRING + Pointer to a C string. + + XD_DOC_STRING + Pointer to a doc string (C string if positive, opaque value if negative) + + XD_INT_RESET + An integer which will be reset to a given value in the dump file. + + + XD_SIZE_T + size_t value. Used for counts. + + XD_INT + int value. Used for counts. + + XD_LONG + long value. Used for counts. + + XD_BYTECOUNT + bytecount value. Used for counts. + + XD_END + Special type indicating the end of the array. + + XD_SPECIFIER_END + Special type indicating the end of the array for a specifier. Extra + description is going to be fetched from the specifier methods. + + + Special macros: + XD_INDIRECT(line, delta) + Usable where a "count" or "size" is requested. Gives the value of + the element which is at line number 'line' in the description (count + starts at zero) and adds delta to it. +*/ + +enum lrecord_description_type { + XD_LISP_OBJECT_ARRAY, + XD_LISP_OBJECT, + XD_LO_RESET_NIL, + XD_LO_LINK, + XD_OPAQUE_PTR, + XD_STRUCT_PTR, + XD_OPAQUE_DATA_PTR, + XD_C_STRING, + XD_DOC_STRING, + XD_INT_RESET, + XD_SIZE_T, + XD_INT, + XD_LONG, + XD_BYTECOUNT, + XD_END, + XD_SPECIFIER_END +}; + +struct lrecord_description { + enum lrecord_description_type type; + int offset; + EMACS_INT data1; + const struct struct_description *data2; +}; + +struct struct_description { + size_t size; + const struct lrecord_description *description; +}; + +#define XD_INDIRECT(val, delta) (-1-((val)|(delta<<8))) + +#define XD_IS_INDIRECT(code) (code<0) +#define XD_INDIRECT_VAL(code) ((-1-code) & 255) +#define XD_INDIRECT_DELTA(code) (((-1-code)>>8) & 255) + +#define XD_DYNARR_DESC(base_type, sub_desc) \ + { XD_STRUCT_PTR, offsetof (base_type, base), XD_INDIRECT(1, 0), sub_desc }, \ + { XD_INT, offsetof (base_type, cur) }, \ + { XD_INT_RESET, offsetof (base_type, max), XD_INDIRECT(1, 0) } + /* Declaring the following structures as const puts them in the text (read-only) segment, which makes debugging inconvenient because this segment is not mapped when processing a core- @@ -260,7 +355,7 @@ #ifdef DEBUG_XEMACS #define CONST_IF_NOT_DEBUG #else -#define CONST_IF_NOT_DEBUG CONST +#define CONST_IF_NOT_DEBUG const #endif /* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size. @@ -273,44 +368,41 @@ # define DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) #endif -#define DEFINE_BASIC_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,structtype) \ -DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,0,0,0,0,structtype) +#define DEFINE_BASIC_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \ +DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) -#define DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,structtype) \ -MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,sizeof(structtype),0,1,structtype) +#define DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \ +MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof(structtype),0,1,structtype) -#define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,structtype) \ -DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,0,0,0,0,structtype) +#define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \ +DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) -#define DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,structtype) \ -MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,sizeof (structtype),0,0,structtype) +#define DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \ +MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype) + +#define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ +DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype) -#define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,sizer,structtype) \ -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,0,0,0,0,sizer,structtype) +#define DEFINE_BASIC_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ +MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,1,structtype) -#define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,sizer,structtype) \ -MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,0,sizer,0,structtype) \ +#define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \ +MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) \ -#define MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,size,sizer,basic_p,structtype) \ +#define MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) \ static int lrecord_##c_name##_lrecord_type_index; \ -CONST_IF_NOT_DEBUG struct lrecord_implementation lrecord_##c_name[2] = \ - { { name, marker, printer, nuker, equal, hash, \ - getprop, putprop, remprop, props, size, sizer, \ - &(lrecord_##c_name##_lrecord_type_index), basic_p }, \ - { 0, 0, 0, this_marks_a_marked_record, 0, 0, 0, 0, 0, 0, 0, 0, 0, basic_p } } +CONST_IF_NOT_DEBUG struct lrecord_implementation lrecord_##c_name = \ + { name, marker, printer, nuker, equal, hash, desc, \ + getprop, putprop, remprop, plist, size, sizer, \ + &(lrecord_##c_name##_lrecord_type_index), basic_p } \ -#define LRECORDP(a) (XTYPE ((a)) == Lisp_Type_Record) +#define LRECORDP(a) (XTYPE (a) == Lisp_Type_Record) #define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a)) -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION -# define RECORD_TYPEP(x, ty) \ +#define RECORD_TYPEP(x, ty) \ (LRECORDP (x) && \ lrecord_implementations_table[XRECORD_LHEADER (x)->type] == (ty)) -#else -# define RECORD_TYPEP(x, ty) \ - (LRECORDP (x) && XRECORD_LHEADER (x)->implementation == (ty)) -#endif /* NOTE: the DECLARE_LRECORD() must come before the associated DEFINE_LRECORD_*() or you will get compile errors. @@ -325,14 +417,12 @@ # define DECLARE_LRECORD(c_name, structtype) \ extern CONST_IF_NOT_DEBUG struct lrecord_implementation \ - lrecord_##c_name[]; \ + lrecord_##c_name; \ INLINE structtype *error_check_##c_name (Lisp_Object obj); \ INLINE structtype * \ error_check_##c_name (Lisp_Object obj) \ { \ - XUNMARK (obj); \ - assert (RECORD_TYPEP (obj, lrecord_##c_name) || \ - MARKED_RECORD_P (obj)); \ + assert (RECORD_TYPEP (obj, &lrecord_##c_name)); \ return (structtype *) XPNTR (obj); \ } \ extern Lisp_Object Q##c_name##p @@ -342,8 +432,7 @@ INLINE structtype * \ error_check_##c_name (Lisp_Object obj) \ { \ - XUNMARK (obj); \ - assert (XGCTYPE (obj) == type_enum); \ + assert (XTYPE (obj) == type_enum); \ return (structtype *) XPNTR (obj); \ } \ extern Lisp_Object Q##c_name##p @@ -354,8 +443,7 @@ # define XSETRECORD(var, p, c_name) do \ { \ XSETOBJ (var, Lisp_Type_Record, p); \ - assert (RECORD_TYPEP (var, lrecord_##c_name) || \ - MARKED_RECORD_P (var)); \ + assert (RECORD_TYPEP (var, &lrecord_##c_name)); \ } while (0) #else /* not ERROR_CHECK_TYPECHECK */ @@ -363,7 +451,7 @@ # define DECLARE_LRECORD(c_name, structtype) \ extern Lisp_Object Q##c_name##p; \ extern CONST_IF_NOT_DEBUG struct lrecord_implementation \ - lrecord_##c_name[] + lrecord_##c_name # define DECLARE_NONRECORD(c_name, type_enum, structtype) \ extern Lisp_Object Q##c_name##p # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x)) @@ -373,8 +461,7 @@ #endif /* not ERROR_CHECK_TYPECHECK */ -#define RECORDP(x, c_name) RECORD_TYPEP (x, lrecord_##c_name) -#define GC_RECORDP(x, c_name) gc_record_type_p (x, lrecord_##c_name) +#define RECORDP(x, c_name) RECORD_TYPEP (x, &lrecord_##c_name) /* Note: we now have two different kinds of type-checking macros. The "old" kind has now been renamed CONCHECK_foo. The reason for @@ -400,7 +487,7 @@ way out and disabled returning from a signal entirely. */ #define CONCHECK_RECORD(x, c_name) do { \ - if (!RECORD_TYPEP (x, lrecord_##c_name)) \ + if (!RECORD_TYPEP (x, &lrecord_##c_name)) \ x = wrong_type_argument (Q##c_name##p, x); \ } while (0) #define CONCHECK_NONRECORD(x, lisp_enum, predicate) do {\ @@ -408,7 +495,7 @@ x = wrong_type_argument (predicate, x); \ } while (0) #define CHECK_RECORD(x, c_name) do { \ - if (!RECORD_TYPEP (x, lrecord_##c_name)) \ + if (!RECORD_TYPEP (x, &lrecord_##c_name)) \ dead_wrong_type_argument (Q##c_name##p, x); \ } while (0) #define CHECK_NONRECORD(x, lisp_enum, predicate) do { \ @@ -416,24 +503,21 @@ dead_wrong_type_argument (predicate, x); \ } while (0) -void *alloc_lcrecord (size_t size, CONST struct lrecord_implementation *); +void *alloc_lcrecord (size_t size, const struct lrecord_implementation *); #define alloc_lcrecord_type(type, lrecord_implementation) \ ((type *) alloc_lcrecord (sizeof (type), lrecord_implementation)) -int gc_record_type_p (Lisp_Object frob, - CONST struct lrecord_implementation *type); - /* Copy the data from one lcrecord structure into another, but don't overwrite the header information. */ #define copy_lcrecord(dst, src) \ - memcpy ((char *) dst + sizeof (struct lcrecord_header), \ - (char *) src + sizeof (struct lcrecord_header), \ - sizeof (*dst) - sizeof (struct lcrecord_header)) + memcpy ((char *) (dst) + sizeof (struct lcrecord_header), \ + (char *) (src) + sizeof (struct lcrecord_header), \ + sizeof (*(dst)) - sizeof (struct lcrecord_header)) #define zero_lcrecord(lcr) \ - memset ((char *) lcr + sizeof (struct lcrecord_header), 0, \ - sizeof (*lcr) - sizeof (struct lcrecord_header)) + memset ((char *) (lcr) + sizeof (struct lcrecord_header), 0, \ + sizeof (*(lcr)) - sizeof (struct lcrecord_header)) -#endif /* _XEMACS_LRECORD_H_ */ +#endif /* INCLUDED_lrecord_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/lstream.c --- a/src/lstream.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/lstream.c Mon Aug 13 11:13:30 2007 +0200 @@ -52,7 +52,7 @@ /* Functions are as follows: -Lstream *Lstream_new (Lstream_implementation *imp, CONST char *mode) +Lstream *Lstream_new (Lstream_implementation *imp, const char *mode) Allocate and return a new Lstream. This function is not really meant to be called directly; rather, each stream type should provide its own stream creation function, which @@ -95,12 +95,12 @@ void Lstream_fungetc (Lstream *stream, int c) Function equivalents of the above macros. -int Lstream_read (Lstream *stream, void *data, size_t size) +ssize_t Lstream_read (Lstream *stream, void *data, size_t size) Read SIZE bytes of DATA from the stream. Return the number of bytes read. 0 means EOF. -1 means an error occurred and no bytes were read. -int Lstream_write (Lstream *stream, void *data, size_t size) +ssize_t Lstream_write (Lstream *stream, void *data, size_t size) Write SIZE bytes of DATA to the stream. Return the number of bytes written. -1 means an error occurred and no bytes were written. @@ -134,10 +134,10 @@ #define MAX_READ_SIZE 512 static Lisp_Object -mark_lstream (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_lstream (Lisp_Object obj) { Lstream *lstr = XLSTREAM (obj); - return lstr->imp->marker ? (lstr->imp->marker) (obj, markobj) : Qnil; + return lstr->imp->marker ? (lstr->imp->marker) (obj) : Qnil; } static void @@ -180,15 +180,15 @@ } static size_t -sizeof_lstream (CONST void *header) +sizeof_lstream (const void *header) { - CONST Lstream *lstr = (CONST Lstream *) header; + const Lstream *lstr = (const Lstream *) header; return sizeof (*lstr) + lstr->imp->size - 1; } DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("stream", lstream, mark_lstream, print_lstream, - finalize_lstream, 0, 0, + finalize_lstream, 0, 0, 0, sizeof_lstream, Lstream); void @@ -210,12 +210,12 @@ } } -static CONST Lstream_implementation *lstream_types[32]; +static const Lstream_implementation *lstream_types[32]; static Lisp_Object Vlstream_free_list[32]; static int lstream_type_count; Lstream * -Lstream_new (CONST Lstream_implementation *imp, CONST char *mode) +Lstream_new (const Lstream_implementation *imp, const char *mode) { Lstream *p; int i; @@ -232,7 +232,7 @@ lstream_types[lstream_type_count] = imp; Vlstream_free_list[lstream_type_count] = make_lcrecord_list (sizeof (*p) + imp->size - 1, - lrecord_lstream); + &lrecord_lstream); lstream_type_count++; } @@ -282,7 +282,7 @@ #define Lstream_internal_error(reason, lstr) \ Lstream_signal_simple_error ("Internal error: " reason, lstr) -static void Lstream_signal_simple_error (CONST char *reason, Lstream *lstr) +static void Lstream_signal_simple_error (const char *reason, Lstream *lstr) { Lisp_Object obj; XSETLSTREAM (obj, lstr); @@ -302,11 +302,11 @@ int Lstream_flush_out (Lstream *lstr) { - int num_written; + ssize_t num_written; while (lstr->out_buffer_ind > 0) { - int size = lstr->out_buffer_ind; + size_t size = lstr->out_buffer_ind; if (! (lstr->flags & LSTREAM_FL_IS_OPEN)) Lstream_internal_error ("lstream not open", lstr); if (! (lstr->flags & LSTREAM_FL_WRITE)) @@ -319,8 +319,8 @@ character at the end. We need to spit back that incomplete character. */ { - CONST unsigned char *data = lstr->out_buffer; - CONST unsigned char *dataend = data + size - 1; + const unsigned char *data = lstr->out_buffer; + const unsigned char *dataend = data + size - 1; assert (size > 0); /* safety check ... */ /* Optimize the most common case. */ if (!BYTE_ASCII_P (*dataend)) @@ -347,7 +347,7 @@ the attempt to write the data might have resulted in an EWOULDBLOCK error. */ return 0; - else if (num_written >= (int) lstr->out_buffer_ind) + else if (num_written >= lstr->out_buffer_ind) lstr->out_buffer_ind = 0; else if (num_written > 0) { @@ -389,31 +389,36 @@ if it's getting EWOULDBLOCK errors. We have to keep stocking them up until they can be written, so as to avoid losing data. */ -static int +static size_t Lstream_adding (Lstream *lstr, size_t num, int force) { - /* Compute the size that the outbuffer needs to be after the - chars are added. */ - size_t size_needed = max (lstr->out_buffer_size, - num + lstr->out_buffer_ind); + size_t size = num + lstr->out_buffer_ind; + + if (size <= lstr->out_buffer_size) + return num; + /* Maybe chop it down so that we don't buffer more characters than our advertised buffering size. */ - if (!force) - size_needed = min (lstr->buffering_size, size_needed); - DO_REALLOC (lstr->out_buffer, lstr->out_buffer_size, - size_needed, unsigned char); - /* There might be more data buffered than the buffering size, - so make sure we don't return a negative number here. */ - return max (0, min (num, size_needed - lstr->out_buffer_ind)); + if ((size > lstr->buffering_size) && !force) + { + size = lstr->buffering_size; + /* There might be more data buffered than the buffering size. */ + if (size <= lstr->out_buffer_ind) + return 0; + } + + DO_REALLOC (lstr->out_buffer, lstr->out_buffer_size, size, unsigned char); + + return size - lstr->out_buffer_ind; } /* Like Lstream_write(), but does not handle line-buffering correctly. */ -static int -Lstream_write_1 (Lstream *lstr, CONST void *data, size_t size) +static ssize_t +Lstream_write_1 (Lstream *lstr, const void *data, size_t size) { - CONST unsigned char *p = (CONST unsigned char *) data; - int off = 0; + const unsigned char *p = (const unsigned char *) data; + ssize_t off = 0; if (! (lstr->flags & LSTREAM_FL_IS_OPEN)) Lstream_internal_error ("lstream not open", lstr); if (! (lstr->flags & LSTREAM_FL_WRITE)) @@ -424,7 +429,7 @@ while (1) { /* Figure out how much we can add to the buffer */ - int chunk = Lstream_adding (lstr, size, 0); + size_t chunk = Lstream_adding (lstr, size, 0); if (chunk == 0) { if (couldnt_write_last_time) @@ -467,33 +472,30 @@ /* If the stream is not line-buffered, then we can just call Lstream_write_1(), which writes in chunks. Otherwise, we repeatedly call Lstream_putc(), which knows how to handle - line buffering. */ + line buffering. Returns number of bytes written. */ -int -Lstream_write (Lstream *lstr, CONST void *data, size_t size) +ssize_t +Lstream_write (Lstream *lstr, const void *data, size_t size) { - int i; - CONST unsigned char *p = (CONST unsigned char *) data; + size_t i; + const unsigned char *p = (const unsigned char *) data; if (size == 0) return size; if (lstr->buffering != LSTREAM_LINE_BUFFERED) return Lstream_write_1 (lstr, data, size); - for (i = 0; i < (int) size; i++) + for (i = 0; i < size; i++) { if (Lstream_putc (lstr, p[i]) < 0) break; } - return i == 0 ? -1 : 0; + return i == 0 ? -1 : (ssize_t) i; } int Lstream_was_blocked_p (Lstream *lstr) { - if (lstr->imp->was_blocked_p) - return (lstr->imp->was_blocked_p) (lstr); - else - return 0; + return lstr->imp->was_blocked_p ? lstr->imp->was_blocked_p (lstr) : 0; } static int @@ -511,16 +513,16 @@ /* Assuming the buffer is empty, fill it up again. */ -static int +static ssize_t Lstream_read_more (Lstream *lstr) { #if 0 - int size_needed = max (1, min (MAX_READ_SIZE, lstr->buffering_size)); + ssize_t size_needed = max (1, min (MAX_READ_SIZE, lstr->buffering_size)); #else /* If someone requested a larger buffer size, so be it! */ - int size_needed = max (1, lstr->buffering_size); + ssize_t size_needed = max (1, lstr->buffering_size); #endif - int size_gotten; + ssize_t size_gotten; DO_REALLOC (lstr->in_buffer, lstr->in_buffer_size, size_needed, unsigned char); @@ -530,11 +532,11 @@ return size_gotten < 0 ? -1 : size_gotten; } -int +ssize_t Lstream_read (Lstream *lstr, void *data, size_t size) { unsigned char *p = (unsigned char *) data; - int off = 0; + size_t off = 0; size_t chunk; int error_occurred = 0; @@ -546,7 +548,7 @@ if (chunk > 0) { /* The bytes come back in reverse order. */ - for (; off < (int) chunk; off++) + for (; off < chunk; off++) p[off] = lstr->unget_buffer[--lstr->unget_buffer_ind]; lstr->byte_count += chunk; size -= chunk; @@ -568,7 +570,7 @@ /* If we need some more, try to get some more from the stream's end */ if (size > 0) { - int retval = Lstream_read_more (lstr); + ssize_t retval = Lstream_read_more (lstr); if (retval < 0) error_occurred = 1; if (retval <= 0) @@ -582,7 +584,7 @@ /* It's quite possible for us to get passed an incomplete character at the end. We need to spit back that incomplete character. */ - CONST unsigned char *dataend = p + off - 1; + const unsigned char *dataend = p + off - 1; /* Optimize the most common case. */ if (!BYTE_ASCII_P (*dataend)) { @@ -592,7 +594,7 @@ VALIDATE_CHARPTR_BACKWARD (dataend); if (dataend + REP_BYTES_BY_FIRST_BYTE (*dataend) != p + off) { - int newoff = dataend - p; + size_t newoff = dataend - p; /* If not, chop the size down to ignore the last char and stash it away for next time. */ Lstream_unread (lstr, dataend, off - newoff); @@ -601,25 +603,24 @@ } } - return ((off == 0 && error_occurred) ? -1 : off); + return off == 0 && error_occurred ? -1 : (ssize_t) off; } void -Lstream_unread (Lstream *lstr, CONST void *data, size_t size) +Lstream_unread (Lstream *lstr, const void *data, size_t size) { - int i; - unsigned char *p = (unsigned char *) data; + const unsigned char *p = (const unsigned char *) data; /* Make sure buffer is big enough */ - DO_REALLOC (lstr->unget_buffer, lstr->unget_buffer_size, lstr->unget_buffer_ind + size, unsigned char); + lstr->byte_count -= size; + /* Bytes have to go on in reverse order -- they are reversed again when read back. */ - for (i = size - 1; i >= 0; i--) - lstr->unget_buffer[lstr->unget_buffer_ind++] = p[i]; - lstr->byte_count -= size; + while (size--) + lstr->unget_buffer[lstr->unget_buffer_ind++] = p[size]; } int @@ -646,15 +647,11 @@ static int Lstream_pseudo_close (Lstream *lstr) { - int rc; - if (!lstr->flags & LSTREAM_FL_IS_OPEN) Lstream_internal_error ("lstream is not open", lstr); /* don't check errors here -- best not to risk file descriptor loss */ - rc = Lstream_flush (lstr); - - return rc; + return Lstream_flush (lstr); } int @@ -729,7 +726,7 @@ Lstream_fputc (Lstream *lstr, int c) { unsigned char ch = (unsigned char) c; - int retval = Lstream_write_1 (lstr, &ch, 1); + ssize_t retval = Lstream_write_1 (lstr, &ch, 1); if (retval >= 0 && lstr->buffering == LSTREAM_LINE_BUFFERED && ch == '\n') return Lstream_flush_out (lstr); return retval < 0 ? -1 : 0; @@ -768,7 +765,7 @@ sizeof (struct stdio_stream)); static Lisp_Object -make_stdio_stream_1 (FILE *stream, int flags, CONST char *mode) +make_stdio_stream_1 (FILE *stream, int flags, const char *mode) { Lisp_Object obj; Lstream *lstr = Lstream_new (lstream_stdio, mode); @@ -792,24 +789,42 @@ return make_stdio_stream_1 (stream, flags, "w"); } -static int +/* #### From reading the Unix 98 specification, it appears that if we + want stdio_reader() to be completely correct, we should check for + 0 < val < size and if so, check to see if an error has occurred. + If an error has occurred, but val is non-zero, we should go ahead + and act as if the read was successful, but remember in some fashion + or other, that an error has occurred, and report that on the next + call to stdio_reader instead of calling fread() again. + + Currently, in such a case, we end up calling fread() twice and we + assume that + + 1) this is not harmful, and + 2) the error will still be reported on the second read. + + This is probably reasonable, so I don't think we should change this + code (it could even be argued that the error might have fixed + itself, so we should do the fread() again. */ + +static ssize_t stdio_reader (Lstream *stream, unsigned char *data, size_t size) { struct stdio_stream *str = STDIO_STREAM_DATA (stream); - size_t val = fread (data, 1, (size_t) size, str->file); + size_t val = fread (data, 1, size, str->file); if (!val && ferror (str->file)) return -1; - return (int) val; + return val; } -static int -stdio_writer (Lstream *stream, CONST unsigned char *data, size_t size) +static ssize_t +stdio_writer (Lstream *stream, const unsigned char *data, size_t size) { struct stdio_stream *str = STDIO_STREAM_DATA (stream); size_t val = fwrite (data, 1, size, str->file); if (!val && ferror (str->file)) return -1; - return (int) val; + return val; } static int @@ -837,9 +852,6 @@ if (stream->flags & LSTREAM_FL_WRITE) return fflush (str->file); else - /* call fpurge? Only exists on some systems. #### Why not add a - configure check for HAVE_FPURGE and utilize it on systems that - support it? --hniksic */ return 0; } @@ -853,7 +865,6 @@ if (stream->flags & LSTREAM_FL_WRITE) return fflush (str->file); else - /* call fpurge? Only exists on some systems. */ return 0; } @@ -886,7 +897,7 @@ ignored when writing); -1 for unlimited. */ static Lisp_Object make_filedesc_stream_1 (int filedesc, int offset, int count, int flags, - CONST char *mode) + const char *mode) { Lisp_Object obj; Lstream *lstr = Lstream_new (lstream_filedesc, mode); @@ -921,14 +932,16 @@ return make_filedesc_stream_1 (filedesc, offset, count, flags, "w"); } -static int +static ssize_t filedesc_reader (Lstream *stream, unsigned char *data, size_t size) { - int nread; + ssize_t nread; struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream); if (str->end_pos >= 0) size = min (size, (size_t) (str->end_pos - str->current_pos)); - nread = (str->allow_quit ? read_allowing_quit : read) (str->fd, data, size); + nread = str->allow_quit ? + read_allowing_quit (str->fd, data, size) : + read (str->fd, data, size); if (nread > 0) str->current_pos += nread; return nread; @@ -948,11 +961,11 @@ return 0; } -static int -filedesc_writer (Lstream *stream, CONST unsigned char *data, size_t size) +static ssize_t +filedesc_writer (Lstream *stream, const unsigned char *data, size_t size) { struct filedesc_stream *str = FILEDESC_STREAM_DATA (stream); - int retval; + ssize_t retval; int need_newline = 0; /* This function would be simple if it were not for the blasted @@ -964,9 +977,9 @@ if (str->pty_flushing) { /* To make life easy, only send out one line at the most. */ - CONST unsigned char *ptr; + const unsigned char *ptr; - ptr = (CONST unsigned char *) memchr (data, '\n', size); + ptr = (const unsigned char *) memchr (data, '\n', size); if (ptr) need_newline = 1; else @@ -981,8 +994,9 @@ /**** start of non-PTY-crap ****/ if (size > 0) - retval = ((str->allow_quit ? write_allowing_quit : write) - (str->fd, data, size)); + retval = str->allow_quit ? + write_allowing_quit (str->fd, data, size) : + write (str->fd, data, size); else retval = 0; if (retval < 0 && errno_would_block_p (errno) && str->blocked_ok) @@ -1005,8 +1019,10 @@ out for EWOULDBLOCK. */ if (str->chars_sans_newline >= str->pty_max_bytes) { - int retval2 = ((str->allow_quit ? write_allowing_quit : write) - (str->fd, &str->eof_char, 1)); + ssize_t retval2 = str->allow_quit ? + write_allowing_quit (str->fd, &str->eof_char, 1) : + write (str->fd, &str->eof_char, 1); + if (retval2 > 0) str->chars_sans_newline = 0; else if (retval2 < 0) @@ -1036,8 +1052,10 @@ if (need_newline) { Bufbyte nl = '\n'; - int retval2 = ((str->allow_quit ? write_allowing_quit : write) - (str->fd, &nl, 1)); + ssize_t retval2 = str->allow_quit ? + write_allowing_quit (str->fd, &nl, 1) : + write (str->fd, &nl, 1); + if (retval2 > 0) { str->chars_sans_newline = 0; @@ -1170,7 +1188,7 @@ return obj; } -static int +static ssize_t lisp_string_reader (Lstream *stream, unsigned char *data, size_t size) { struct lisp_string_stream *str = LISP_STRING_STREAM_DATA (stream); @@ -1214,7 +1232,7 @@ } static Lisp_Object -lisp_string_marker (Lisp_Object stream, void (*markobj) (Lisp_Object)) +lisp_string_marker (Lisp_Object stream) { struct lisp_string_stream *str = LISP_STRING_STREAM_DATA (XLSTREAM (stream)); return str->obj; @@ -1227,7 +1245,7 @@ struct fixed_buffer_stream { - CONST unsigned char *inbuf; + const unsigned char *inbuf; unsigned char *outbuf; size_t size; size_t offset; @@ -1237,30 +1255,30 @@ sizeof (struct fixed_buffer_stream)); Lisp_Object -make_fixed_buffer_input_stream (CONST unsigned char *buf, size_t size) +make_fixed_buffer_input_stream (const void *buf, size_t size) { Lisp_Object obj; Lstream *lstr = Lstream_new (lstream_fixed_buffer, "r"); struct fixed_buffer_stream *str = FIXED_BUFFER_STREAM_DATA (lstr); - str->inbuf = buf; + str->inbuf = (const unsigned char *) buf; str->size = size; XSETLSTREAM (obj, lstr); return obj; } Lisp_Object -make_fixed_buffer_output_stream (unsigned char *buf, size_t size) +make_fixed_buffer_output_stream (void *buf, size_t size) { Lisp_Object obj; Lstream *lstr = Lstream_new (lstream_fixed_buffer, "w"); struct fixed_buffer_stream *str = FIXED_BUFFER_STREAM_DATA (lstr); - str->outbuf = buf; + str->outbuf = (unsigned char *) buf; str->size = size; XSETLSTREAM (obj, lstr); return obj; } -static int +static ssize_t fixed_buffer_reader (Lstream *stream, unsigned char *data, size_t size) { struct fixed_buffer_stream *str = FIXED_BUFFER_STREAM_DATA (stream); @@ -1270,8 +1288,8 @@ return size; } -static int -fixed_buffer_writer (Lstream *stream, CONST unsigned char *data, size_t size) +static ssize_t +fixed_buffer_writer (Lstream *stream, const unsigned char *data, size_t size) { struct fixed_buffer_stream *str = FIXED_BUFFER_STREAM_DATA (stream); if (str->offset == str->size) @@ -1294,7 +1312,7 @@ return 0; } -CONST unsigned char * +const unsigned char * fixed_buffer_input_stream_ptr (Lstream *stream) { assert (stream->imp == lstream_fixed_buffer); @@ -1332,8 +1350,8 @@ return obj; } -static int -resizing_buffer_writer (Lstream *stream, CONST unsigned char *data, size_t size) +static ssize_t +resizing_buffer_writer (Lstream *stream, const unsigned char *data, size_t size) { struct resizing_buffer_stream *str = RESIZING_BUFFER_STREAM_DATA (stream); DO_REALLOC (str->buf, str->allocked, str->stored + size, unsigned char); @@ -1394,8 +1412,8 @@ return obj; } -static int -dynarr_writer (Lstream *stream, CONST unsigned char *data, size_t size) +static ssize_t +dynarr_writer (Lstream *stream, const unsigned char *data, size_t size) { struct dynarr_stream *str = DYNARR_STREAM_DATA (stream); Dynarr_add_many (str->dyn, data, size); @@ -1438,7 +1456,7 @@ static Lisp_Object make_lisp_buffer_stream_1 (struct buffer *buf, Bufpos start, Bufpos end, - int flags, CONST char *mode) + int flags, const char *mode) { Lisp_Object obj; Lstream *lstr; @@ -1518,7 +1536,7 @@ return lstr; } -static int +static ssize_t lisp_buffer_reader (Lstream *stream, unsigned char *data, size_t size) { struct lisp_buffer_stream *str = LISP_BUFFER_STREAM_DATA (stream); @@ -1576,8 +1594,8 @@ return data - orig_data; } -static int -lisp_buffer_writer (Lstream *stream, CONST unsigned char *data, size_t size) +static ssize_t +lisp_buffer_writer (Lstream *stream, const unsigned char *data, size_t size) { struct lisp_buffer_stream *str = LISP_BUFFER_STREAM_DATA (stream); Bufpos pos; @@ -1612,13 +1630,13 @@ } static Lisp_Object -lisp_buffer_marker (Lisp_Object stream, void (*markobj) (Lisp_Object)) +lisp_buffer_marker (Lisp_Object stream) { struct lisp_buffer_stream *str = LISP_BUFFER_STREAM_DATA (XLSTREAM (stream)); - markobj (str->start); - markobj (str->end); + mark_object (str->start); + mark_object (str->end); return str->buffer; } @@ -1673,13 +1691,19 @@ } void -vars_of_lstream (void) +reinit_vars_of_lstream (void) { int i; for (i = 0; i < countof (Vlstream_free_list); i++) { Vlstream_free_list[i] = Qnil; - staticpro (&Vlstream_free_list[i]); + staticpro_nodump (&Vlstream_free_list[i]); } } + +void +vars_of_lstream (void) +{ + reinit_vars_of_lstream (); +} diff -r f4aeb21a5bad -r 74fd4e045ea6 src/lstream.h --- a/src/lstream.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/lstream.h Mon Aug 13 11:13:30 2007 +0200 @@ -23,8 +23,8 @@ /* Written by Ben Wing. */ -#ifndef _XEMACS_LSTREAM_H_ -#define _XEMACS_LSTREAM_H_ +#ifndef INCLUDED_lstream_h_ +#define INCLUDED_lstream_h_ /************************************************************************/ /* definition of Lstream object */ @@ -74,7 +74,7 @@ typedef struct lstream_implementation { - CONST char *name; + const char *name; size_t size; /* Number of additional bytes to be allocated with this stream. Access this data using Lstream_data(). */ /* Read some data from the stream's end and store it into DATA, which @@ -95,7 +95,7 @@ /* The omniscient mly, blinded by the irresistable thrall of Common Lisp, thinks that it is bogus that the types and implementations of input and output streams are the same. */ - int (*reader) (Lstream *stream, unsigned char *data, size_t size); + ssize_t (*reader) (Lstream *stream, unsigned char *data, size_t size); /* Send some data to the stream's end. Data to be sent is in DATA and is SIZE bytes. Return the number of bytes sent. This function can send and return fewer bytes than is passed in; in @@ -106,7 +106,7 @@ data. (This is useful, e.g., of you're dealing with a non-blocking file descriptor and are getting EWOULDBLOCK errors.) This function can be NULL if the stream is input-only. */ - int (*writer) (Lstream *stream, CONST unsigned char *data, size_t size); + ssize_t (*writer) (Lstream *stream, const unsigned char *data, size_t size); /* Return non-zero if the last write operation on the stream resulted in an attempt to block (EWOULDBLOCK). If this method does not exists, the implementation returns 0 */ @@ -129,7 +129,7 @@ int (*closer) (Lstream *stream); /* Mark this object for garbage collection. Same semantics as a standard Lisp_Object marker. This function can be NULL. */ - Lisp_Object (*marker) (Lisp_Object lstream, void (*markfun) (Lisp_Object)); + Lisp_Object (*marker) (Lisp_Object lstream); } Lstream_implementation; #define DEFINE_LSTREAM_IMPLEMENTATION(name,c_name,size) \ @@ -145,7 +145,7 @@ struct lstream { struct lcrecord_header header; - CONST Lstream_implementation *imp; /* methods for this stream */ + const Lstream_implementation *imp; /* methods for this stream */ Lstream_buffering buffering; /* type of buffering in use */ size_t buffering_size; /* number of bytes buffered */ @@ -177,10 +177,10 @@ #ifdef ERROR_CHECK_TYPECHECK INLINE struct lstream * error_check_lstream_type (struct lstream *stream, - CONST Lstream_implementation *imp); + const Lstream_implementation *imp); INLINE struct lstream * error_check_lstream_type (struct lstream *stream, - CONST Lstream_implementation *imp) + const Lstream_implementation *imp) { assert (stream->imp == imp); return stream; @@ -199,8 +199,8 @@ (lstream_##type->m = type##_##m) -Lstream *Lstream_new (CONST Lstream_implementation *imp, - CONST char *mode); +Lstream *Lstream_new (const Lstream_implementation *imp, + const char *mode); void Lstream_reopen (Lstream *lstr); void Lstream_set_buffering (Lstream *lstr, Lstream_buffering buffering, int buffering_size); @@ -209,10 +209,10 @@ int Lstream_fputc (Lstream *lstr, int c); int Lstream_fgetc (Lstream *lstr); void Lstream_fungetc (Lstream *lstr, int c); -int Lstream_read (Lstream *lstr, void *data, size_t size); -int Lstream_write (Lstream *lstr, CONST void *data, size_t size); +ssize_t Lstream_read (Lstream *lstr, void *data, size_t size); +ssize_t Lstream_write (Lstream *lstr, const void *data, size_t size); int Lstream_was_blocked_p (Lstream *lstr); -void Lstream_unread (Lstream *lstr, CONST void *data, size_t size); +void Lstream_unread (Lstream *lstr, const void *data, size_t size); int Lstream_rewind (Lstream *lstr); int Lstream_seekable_p (Lstream *lstr); int Lstream_close (Lstream *lstr); @@ -339,11 +339,9 @@ Lisp_Object make_lisp_string_input_stream (Lisp_Object string, Bytecount offset, Bytecount len); -Lisp_Object make_fixed_buffer_input_stream (CONST unsigned char *buf, - size_t size); -Lisp_Object make_fixed_buffer_output_stream (unsigned char *buf, - size_t size); -CONST unsigned char *fixed_buffer_input_stream_ptr (Lstream *stream); +Lisp_Object make_fixed_buffer_input_stream (const void *buf, size_t size); +Lisp_Object make_fixed_buffer_output_stream (void *buf, size_t size); +const unsigned char *fixed_buffer_input_stream_ptr (Lstream *stream); unsigned char *fixed_buffer_output_stream_ptr (Lstream *stream); Lisp_Object make_resizing_buffer_output_stream (void); unsigned char *resizing_buffer_stream_ptr (Lstream *stream); @@ -356,4 +354,4 @@ int flags); Bufpos lisp_buffer_stream_startpos (Lstream *stream); -#endif /* _XEMACS_LSTREAM_H_ */ +#endif /* INCLUDED_lstream_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/m/alpha.h --- a/src/m/alpha.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/m/alpha.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,7 +20,7 @@ #ifdef LINUX - # define SYSTEM_MALLOC +# define SYSTEM_MALLOC #endif #ifdef OSF1 diff -r f4aeb21a5bad -r 74fd4e045ea6 src/m/intel386.h --- a/src/m/intel386.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/m/intel386.h Mon Aug 13 11:13:30 2007 +0200 @@ -168,13 +168,6 @@ #define NO_REMAP #endif -#ifdef WINDOWSNT -#define VIRT_ADDR_VARIES -#define DATA_END get_data_end () -#define DATA_START get_data_start () -#define HAVE_ALLOCA -#endif - #ifdef linux /* libc-linux/sysdeps/linux/i386/ulimit.c says that due to shared library, */ /* we cannot get the maximum address for brk */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/m/iris4d.h --- a/src/m/iris4d.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/m/iris4d.h Mon Aug 13 11:13:30 2007 +0200 @@ -99,8 +99,7 @@ #ifdef USG5_4 #undef UNEXEC -/* FSF renames this file to unexsgi.o */ -#define UNEXEC "unexelfsgi.o" +#define UNEXEC "unexelf.o" #else #define UNEXEC "unexmips.o" #endif diff -r f4aeb21a5bad -r 74fd4e045ea6 src/m/iris5d.h --- a/src/m/iris5d.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/m/iris5d.h Mon Aug 13 11:13:30 2007 +0200 @@ -101,8 +101,7 @@ #ifdef UNEXEC #undef UNEXEC #endif -/* FSF renames this file to unexsgi.o */ -#define UNEXEC "unexelfsgi.o" +#define UNEXEC "unexelf.o" #define TEXT_START 0x400000 diff -r f4aeb21a5bad -r 74fd4e045ea6 src/m/iris6d.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/m/iris6d.h Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,152 @@ +/* machine description file for Iris-4D machines. Use with s/irix*.h. + Copyright (C) 1987 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: FSF 19.31. */ + +/* Define WORD_MACHINE if addresses and such have + * to be corrected before they can be used as byte counts. */ + +#undef WORD_MACHINE + +/* Now define a symbol for the cpu type, if your compiler + does not define it automatically: + Ones defined so far include vax, m68000, ns16000, pyramid, + orion, tahoe, APOLLO and many others */ + +#ifndef mips +#define mips +#endif + +#ifndef IRIS_4D +#define IRIS_4D +#endif + +/* Define EXPLICIT_SIGN_EXTEND if XINT must explicitly sign-extend + the bit field into an int. In other words, if bit fields + are always unsigned. + + If you use NO_UNION_TYPE, this flag does not matter. */ + +#define EXPLICIT_SIGN_EXTEND + +/* jg@genmagic.genmagic.com (John Giannandrea) says this is unnecessary. */ +#if 0 +/* Data type of load average, as read out of kmem. */ + +#define LOAD_AVE_TYPE long /* This doesn't quite work on the 4D */ + +/* Convert that into an integer that is 100 for a load average of 1.0 */ + +#define LOAD_AVE_CVT(x) (int)(((double)(x)*100)/1024.0) + +/* s-iris3-6.h uses /vmunix */ + +#undef KERNEL_FILE +#define KERNEL_FILE "/unix" +#endif + +/* Define CANNOT_DUMP on machines where unexec does not work. + Then the function dump-emacs will not be defined + and temacs will do (load "loadup") automatically unless told otherwise. */ + +#undef CANNOT_DUMP + +/* Define VIRT_ADDR_VARIES if the virtual addresses of + pure and impure space as loaded can vary, and even their + relative order cannot be relied on. + + Otherwise Emacs assumes that text space precedes data space, + numerically. */ + +/* #define VIRT_ADDR_VARIES */ + +/* Define C_ALLOCA if this machine does not support a true alloca + and the one written in C should be used instead. + Define HAVE_ALLOCA to say that the system provides a properly + working alloca function and it should be used. + Define neither one if an assembler-language alloca + in the file alloca.s should be used. */ + +/* #define C_ALLOCA */ /* Sjoerd.Mullender@cwi.nl says no need. */ +/* #define HAVE_ALLOCA */ + +/* Define NO_REMAP if memory segmentation makes it not work well + to change the boundary between the text section and data section + when Emacs is dumped. If you define this, the preloaded Lisp + code will not be sharable; but that's better than failing completely. */ + +#define NO_REMAP + +/* This machine requires completely different unexec code + which lives in a separate file. Specify the file name. */ + +#ifdef USG5_4 +#undef UNEXEC +#define UNEXEC "unexelfsgi.o" +#else +#define UNEXEC "unexmips.o" +#endif + +#define TEXT_START 0x400000 + +/* + * DATA_SEG_BITS forces extra bits to be or'd in with any pointers which + * were stored in a Lisp_Object (as Emacs uses fewer than 32 bits for + * the value field of a LISP_OBJECT). + */ + +#define DATA_START 0x10000000 +#define DATA_SEG_BITS 0x10000000 + +#undef LIBS_MACHINE +/* -lsun in case using Yellow Pages for passwords. */ +#define LIBS_DEBUG + +/* Define this if you have a fairly recent system, + in which crt1.o and crt1.n should be used. */ +#define HAVE_CRTN + +#ifndef USG5_4 +#ifdef HAVE_CRTN +/* Must define START-FILES so that the linker can find /usr/lib/crt0.o. */ +#define START_FILES "pre-crt0.o /usr/lib/crt1.o" +#define LIB_STANDARD "-lc /usr/lib/crtn.o" +#else +#define START_FILES "pre-crt0.o /usr/lib/crt0.o" +/* The entry-point label (start of text segment) is `start', not `__start'. */ +#define DEFAULT_ENTRY_ADDRESS start +#define LIB_STANDARD "-lc" +#endif +#endif + +/* Use terminfo instead of termcap. */ + +#define TERMINFO + +/* Letter to use in finding device name of first pty, + if system supports pty's. 'a' means it is /dev/ptya0 */ + +#undef FIRST_PTY_LETTER +#define FIRST_PTY_LETTER 'q' + +/* Define STACK_DIRECTION for alloca.c */ + +#undef STACK_DIRECTION +#define STACK_DIRECTION -1 diff -r f4aeb21a5bad -r 74fd4e045ea6 src/m/mips.h --- a/src/m/mips.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/m/mips.h Mon Aug 13 11:13:30 2007 +0200 @@ -63,10 +63,12 @@ #define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / 256.0) +#ifndef linux /* CDC EP/IX 1.4.3 uses /unix */ #undef KERNEL_FILE #define KERNEL_FILE "/unix" +#endif /* ! linux */ /* Define CANNOT_DUMP on machines where unexec does not work. Then the function dump-emacs will not be defined @@ -106,16 +108,23 @@ /* This machine requires completely different unexec code which lives in a separate file. Specify the file name. */ +#ifndef linux #define UNEXEC "unexmips.o" - +#endif /* !linux */ /* Describe layout of the address space in an executing process. */ +#ifdef linux +#define TEXT_START 0x00400000 +#define DATA_START 0x10000000 +#define DATA_SEG_BITS 0x10000000 +#else /* !linux */ #define TEXT_START 0x400000 #define DATA_START 0x800000 +#endif /* linux */ /* Alter some of the options used when linking. */ -#ifndef NEWSOS5 +#if !defined(NEWSOS5) && !defined(linux) #ifdef BSD /* DECstations don't have this library. */ @@ -138,9 +147,9 @@ #define C_DEBUG_SWITCH "-O -g3" #endif /* not BSD */ -#endif /* not NEWSOS5 */ +#endif /* !NEWSOS5 && !linux */ -#ifndef NEWSOS5 +#if !defined(NEWSOS5) && !defined(linux) #ifdef USG /* Don't try to use SIGIO even though it is defined. */ @@ -167,4 +176,4 @@ #define TERMINFO #undef MAIL_USE_FLOCK /* Someone should check this. */ #endif /* BSD */ -#endif /* not NEWSOS5 */ +#endif /* !NEWSOS5 && !linux */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/macros.h --- a/src/macros.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/macros.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,8 +20,8 @@ /* Synched up with: FSF 19.30. */ -#ifndef _XEMACS_MACROS_H_ -#define _XEMACS_MACROS_H_ +#ifndef INCLUDED_macros_h_ +#define INCLUDED_macros_h_ /* Index of next character to fetch from that macro */ @@ -35,4 +35,4 @@ extern Lisp_Object Vexecuting_macro; -#endif /* _XEMACS_MACROS_H_ */ +#endif /* INCLUDED_macros_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/make-src-depend --- a/src/make-src-depend Mon Aug 13 11:12:06 2007 +0200 +++ b/src/make-src-depend Mon Aug 13 11:13:30 2007 +0200 @@ -29,8 +29,7 @@ Usage: $myName Generates Makefile dependencies for the XEmacs src directory. -The dependencies are written to stdout. -"; +The dependencies are written to stdout.\n"; die $usage if @ARGV; @@ -42,7 +41,7 @@ for (grep (/\.[ch]$/, readdir (SRCDIR))) { $exists{$_} = 1; } closedir SRCDIR; -for (qw (config.h puresize-adjust.h sheap-adjust.h paths.h Emacs.ad.h)) { +for (qw (config.h sheap-adjust.h paths.h Emacs.ad.h)) { $generated_header{$_} = 1; } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/marker.c --- a/src/marker.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/marker.c Mon Aug 13 11:13:30 2007 +0200 @@ -36,9 +36,9 @@ #include "buffer.h" static Lisp_Object -mark_marker (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_marker (Lisp_Object obj) { - struct Lisp_Marker *marker = XMARKER (obj); + Lisp_Marker *marker = XMARKER (obj); Lisp_Object buf; /* DO NOT mark through the marker's chain. The buffer's markers chain does not preserve markers from gc; @@ -55,7 +55,7 @@ static void print_marker (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { - struct Lisp_Marker *marker = XMARKER (obj); + Lisp_Marker *marker = XMARKER (obj); char buf[200]; if (print_readably) @@ -66,7 +66,7 @@ write_c_string (GETTEXT ("in no buffer"), printcharfun); else { - sprintf (buf, "at %d in ", marker_position (obj)); + sprintf (buf, "at %ld in ", (long) marker_position (obj)); write_c_string (buf, printcharfun); print_internal (marker->buffer->name, printcharfun, 0); } @@ -77,8 +77,8 @@ static int marker_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { - struct Lisp_Marker *marker1 = XMARKER (obj1); - struct Lisp_Marker *marker2 = XMARKER (obj2); + Lisp_Marker *marker1 = XMARKER (obj1); + Lisp_Marker *marker2 = XMARKER (obj2); return ((marker1->buffer == marker2->buffer) && (marker1->memind == marker2->memind || @@ -95,10 +95,17 @@ return hash; } +static const struct lrecord_description marker_description[] = { + { XD_LISP_OBJECT, offsetof (Lisp_Marker, next) }, + { XD_LISP_OBJECT, offsetof (Lisp_Marker, prev) }, + { XD_LISP_OBJECT, offsetof (Lisp_Marker, buffer) }, + { XD_END } +}; + DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker, mark_marker, print_marker, 0, - marker_equal, marker_hash, - struct Lisp_Marker); + marker_equal, marker_hash, marker_description, + Lisp_Marker); /* Operations on markers. */ @@ -135,7 +142,7 @@ static void check_marker_circularities (struct buffer *buf) { - struct Lisp_Marker *tortoise, *hare; + Lisp_Marker *tortoise, *hare; tortoise = BUF_MARKERS (buf); hare = tortoise; @@ -166,7 +173,7 @@ { Bufpos charno; struct buffer *b; - struct Lisp_Marker *m; + Lisp_Marker *m; int point_p; CHECK_MARKER (marker); @@ -282,7 +289,7 @@ void unchain_marker (Lisp_Object m) { - struct Lisp_Marker *marker = XMARKER (m); + Lisp_Marker *marker = XMARKER (m); struct buffer *b = marker->buffer; if (b == 0) @@ -309,7 +316,7 @@ Bytind bi_marker_position (Lisp_Object marker) { - struct Lisp_Marker *m = XMARKER (marker); + Lisp_Marker *m = XMARKER (marker); struct buffer *buf = m->buffer; Bytind pos; @@ -346,7 +353,7 @@ void set_bi_marker_position (Lisp_Object marker, Bytind pos) { - struct Lisp_Marker *m = XMARKER (marker); + Lisp_Marker *m = XMARKER (marker); struct buffer *buf = m->buffer; if (!buf) @@ -453,7 +460,7 @@ */ (position)) { - struct Lisp_Marker *marker; + Lisp_Marker *marker; Memind pos; /* A small optimization trick: convert POS to memind now, rather @@ -482,12 +489,12 @@ int compute_buffer_marker_usage (struct buffer *b, struct overhead_stats *ovstats) { - struct Lisp_Marker *m; + Lisp_Marker *m; int total = 0; int overhead; for (m = BUF_MARKERS (b); m; m = m->next) - total += sizeof (struct Lisp_Marker); + total += sizeof (Lisp_Marker); ovstats->was_requested += total; overhead = fixed_type_block_overhead (total); /* #### claiming this is all malloc overhead is not really right, @@ -533,7 +540,7 @@ { /* Unchain all markers of this buffer and leave them pointing nowhere. */ - REGISTER struct Lisp_Marker *m, *next; + REGISTER Lisp_Marker *m, *next; for (m = BUF_MARKERS (b); m; m = next) { m->buffer = 0; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/md5.c --- a/src/md5.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/md5.c Mon Aug 13 11:13:30 2007 +0200 @@ -110,7 +110,7 @@ static const unsigned char fillbuf[64] = { 0x80, 0 /* , 0, 0, ... */ }; -static void md5_process_block (CONST void *, size_t, struct md5_ctx *); +static void md5_process_block (const void *, size_t, struct md5_ctx *); /* Initialize structure containing state of computation. @@ -133,7 +133,7 @@ IMPORTANT: On some systems it is required that RESBUF is correctly aligned for a 32 bits value. */ static void * -md5_read_ctx (CONST struct md5_ctx *ctx, void *resbuf) +md5_read_ctx (const struct md5_ctx *ctx, void *resbuf) { ((md5_uint32 *) resbuf)[0] = SWAP (ctx->A); ((md5_uint32 *) resbuf)[1] = SWAP (ctx->B); @@ -251,7 +251,7 @@ static void -md5_process_bytes (CONST void *buffer, size_t len, struct md5_ctx *ctx) +md5_process_bytes (const void *buffer, size_t len, struct md5_ctx *ctx) { /* When we already have some bits in our internal buffer concatenate both inputs first. */ @@ -306,7 +306,7 @@ It is assumed that LEN % 64 == 0. */ static void -md5_process_block (CONST void *buffer, size_t len, struct md5_ctx *ctx) +md5_process_block (const void *buffer, size_t len, struct md5_ctx *ctx) { md5_uint32 correct_words[16]; const md5_uint32 *words = (const md5_uint32 *) buffer; @@ -482,7 +482,7 @@ { /* Attempt to autodetect the coding of the string. This is VERY hit-and-miss. */ - enum eol_type eol = EOL_AUTODETECT; + eol_type_t eol = EOL_AUTODETECT; coding_system = Fget_coding_system (Qundecided); determine_real_coding_system (XLSTREAM (istream), &coding_system, &eol); @@ -582,8 +582,8 @@ while (1) { Bufbyte tempbuf[1024]; /* some random amount */ - int size_in_bytes = Lstream_read (XLSTREAM (instream), - tempbuf, sizeof (tempbuf)); + ssize_t size_in_bytes = + Lstream_read (XLSTREAM (instream), tempbuf, sizeof (tempbuf)); if (!size_in_bytes) break; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/mem-limits.h --- a/src/mem-limits.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/mem-limits.h Mon Aug 13 11:13:30 2007 +0200 @@ -27,8 +27,8 @@ getrlimit() should be preferred to ulimit(). On Linux, ulimit() is deprecated and always returns -1. */ -#ifndef _XEMACS_MEM_LIMITS_H_ -#define _XEMACS_MEM_LIMITS_H_ +#ifndef INCLUDED_mem_limits_h_ +#define INCLUDED_mem_limits_h_ #ifdef HAVE_CONFIG_H #include <config.h> @@ -101,12 +101,7 @@ #endif extern POINTER start_of_data (void); -#ifdef DATA_SEG_BITS -#define EXCEEDS_LISP_PTR(ptr) \ - (((EMACS_UINT) (ptr) & ~DATA_SEG_BITS) >> VALBITS) -#else -#define EXCEEDS_LISP_PTR(ptr) ((EMACS_UINT) (ptr) >> VALBITS) -#endif +#define EXCEEDS_LISP_PTR(ptr) 0 #ifdef BSD #ifndef DATA_SEG_BITS @@ -225,4 +220,4 @@ #endif /* not NO_LIM_DATA */ #endif /* not HEAP_IN_DATA */ -#endif /* _XEMACS_MEM_LIMITS_H_ */ +#endif /* INCLUDED_mem_limits_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/menubar-msw.c --- a/src/menubar-msw.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/menubar-msw.c Mon Aug 13 11:13:30 2007 +0200 @@ -116,14 +116,12 @@ #define MENU_ITEM_ID_BITS(x) (((x) & 0x7FFF) | 0x8000) static HMENU top_level_menu; -#define MAX_MENUITEM_LENGTH 128 - /* * This returns Windows-style menu item string: * "Left Flush\tRight Flush" */ static char* -displayable_menu_item (struct gui_item* pgui_item, int bar_p) +displayable_menu_item (Lisp_Object gui_item, int bar_p) { /* We construct the name in a static buffer. That's fine, because menu items longer than 128 chars are probably programming errors, @@ -134,7 +132,7 @@ unsigned int ll, lr; /* Left flush part of the string */ - ll = gui_item_display_flush_left (pgui_item, buf, MAX_MENUITEM_LENGTH); + ll = gui_item_display_flush_left (gui_item, buf, MAX_MENUITEM_LENGTH); /* Escape '&' as '&&' */ ptr = buf; @@ -142,7 +140,7 @@ { if (ll+2 >= MAX_MENUITEM_LENGTH) signal_simple_error ("Menu item produces too long displayable string", - pgui_item->name); + XGUI_ITEM (gui_item)->name); memmove (ptr+1, ptr, (ll-(ptr-buf))+1); ll++; ptr+=2; @@ -165,7 +163,7 @@ if (!bar_p) { assert (MAX_MENUITEM_LENGTH > ll + 1); - lr = gui_item_display_flush_right (pgui_item, buf + ll + 1, + lr = gui_item_display_flush_right (gui_item, buf + ll + 1, MAX_MENUITEM_LENGTH - ll - 1); if (lr) buf [ll] = '\t'; @@ -279,21 +277,21 @@ { /* Submenu */ HMENU submenu; - struct gui_item gui_item; + Lisp_Object gui_item = allocate_gui_item (); + Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); struct gcpro gcpro1; - gui_item_init (&gui_item); - GCPRO_GUI_ITEM (&gui_item); + GCPRO1 (gui_item); - menu_parse_submenu_keywords (item, &gui_item); + menu_parse_submenu_keywords (item, gui_item); - if (!STRINGP (gui_item.name)) + if (!STRINGP (pgui_item->name)) signal_simple_error ("Menu name (first element) must be a string", item); - if (!gui_item_included_p (&gui_item, Vmenubar_configuration)) + if (!gui_item_included_p (gui_item, Vmenubar_configuration)) return; - if (!gui_item_active_p (&gui_item)) + if (!gui_item_active_p (gui_item)) item_info.fState = MFS_GRAYED; /* Temptation is to put 'else' right here. Although, the displayed item won't have an arrow indicating that it is a @@ -301,7 +299,7 @@ submenu = create_empty_popup_menu(); item_info.fMask |= MIIM_SUBMENU; - item_info.dwTypeData = displayable_menu_item (&gui_item, bar_p); + item_info.dwTypeData = displayable_menu_item (gui_item, bar_p); item_info.hSubMenu = submenu; if (!(item_info.fState & MFS_GRAYED)) @@ -310,12 +308,12 @@ keyed by menu handle */ if (NILP(path)) /* list1 cannot GC */ - path = list1 (gui_item.name); + path = list1 (pgui_item->name); else { Lisp_Object arg[2]; arg[0] = path; - arg[1] = list1 (gui_item.name); + arg[1] = list1 (pgui_item->name); /* Fappend gcpro'es its arg */ path = Fappend (2, arg); } @@ -329,22 +327,20 @@ { /* An ordinary item */ Lisp_Object style, id; - struct gui_item gui_item; + Lisp_Object gui_item = gui_parse_item_keywords (item); + Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); struct gcpro gcpro1; - gui_item_init (&gui_item); - GCPRO_GUI_ITEM (&gui_item); + GCPRO1 (gui_item); - gui_parse_item_keywords (item, &gui_item); - - if (!gui_item_included_p (&gui_item, Vmenubar_configuration)) + if (!gui_item_included_p (gui_item, Vmenubar_configuration)) return; - if (!gui_item_active_p (&gui_item)) + if (!gui_item_active_p (gui_item)) item_info.fState = MFS_GRAYED; - style = (NILP (gui_item.selected) || NILP (Feval (gui_item.selected)) - ? Qnil : gui_item.style); + style = (NILP (pgui_item->selected) || NILP (Feval (pgui_item->selected)) + ? Qnil : pgui_item->style); if (EQ (style, Qradio)) { @@ -356,13 +352,13 @@ item_info.fState |= MFS_CHECKED; } - id = allocate_menu_item_id (path, gui_item.name, - gui_item.suffix); - Fputhash (id, gui_item.callback, hash_tab); + id = allocate_menu_item_id (path, pgui_item->name, + pgui_item->suffix); + Fputhash (id, pgui_item->callback, hash_tab); item_info.wID = (UINT) XINT(id); item_info.fType |= MFT_STRING; - item_info.dwTypeData = displayable_menu_item (&gui_item, bar_p); + item_info.dwTypeData = displayable_menu_item (gui_item, bar_p); UNGCPRO; /* gui_item */ } @@ -396,10 +392,9 @@ int deep_p, flush_right; struct gcpro gcpro1; unsigned long checksum; - struct gui_item gui_item; - - gui_item_init (&gui_item); - GCPRO_GUI_ITEM (&gui_item); + Lisp_Object gui_item = allocate_gui_item (); + Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); + GCPRO1 (gui_item); /* We are sometimes called with the menubar unchanged, and with changed right flush. We have to update the menubar in this case, @@ -414,15 +409,15 @@ deep_p = !NILP (path); /* Fetch keywords prepending the item list */ - desc = menu_parse_submenu_keywords (desc, &gui_item); + desc = menu_parse_submenu_keywords (desc, gui_item); /* Check that menu name is specified when expected */ - if (NILP (gui_item.name) && deep_p) + if (NILP (pgui_item->name) && deep_p) signal_simple_error ("Menu must have a name", desc); /* Apply filter if specified */ - if (!NILP (gui_item.filter)) - desc = call1 (gui_item.filter, desc); + if (!NILP (pgui_item->filter)) + desc = call1 (pgui_item->filter, desc); /* Loop thru the desc's CDR and add items for each entry */ flush_right = 0; @@ -453,11 +448,11 @@ /* Add the header to the popup, if told so. The same as in X - an insensitive item, and a separator (Seems to me, there were two separators in X... In Windows this looks ugly, anyways. */ - if (!bar_p && !deep_p && popup_menu_titles && !NILP(gui_item.name)) + if (!bar_p && !deep_p && popup_menu_titles && !NILP(pgui_item->name)) { - CHECK_STRING (gui_item.name); + CHECK_STRING (pgui_item->name); InsertMenu (menu, 0, MF_BYPOSITION | MF_STRING | MF_DISABLED, - 0, XSTRING_DATA(gui_item.name)); + 0, XSTRING_DATA(pgui_item->name)); InsertMenu (menu, 1, MF_BYPOSITION | MF_SEPARATOR, 0, NULL); SetMenuDefaultItem (menu, 0, MF_BYPOSITION); } @@ -741,7 +736,7 @@ mswindows_popup_menu (Lisp_Object menu_desc, Lisp_Object event) { struct frame *f = selected_frame (); - struct Lisp_Event *eev = NULL; + Lisp_Event *eev = NULL; HMENU menu; POINT pt; int ok; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/menubar-msw.h --- a/src/menubar-msw.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/menubar-msw.h Mon Aug 13 11:13:30 2007 +0200 @@ -26,8 +26,8 @@ Initially written by kkm 12/24/97, */ -#ifndef _XEMACS_MENUBAR_MSW_H_ -#define _XEMACS_MENUBAR_MSW_H_ +#ifndef INCLUDED_menubar_msw_h_ +#define INCLUDED_menubar_msw_h_ #ifdef HAVE_MENUBARS @@ -39,5 +39,5 @@ #endif /* HAVE_MENUBARS */ -#endif /* _XEMACS_MENUBAR_MSW_H_ */ +#endif /* INCLUDED_menubar_msw_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/menubar-x.c --- a/src/menubar-x.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/menubar-x.c Mon Aug 13 11:13:30 2007 +0200 @@ -94,14 +94,11 @@ prohibits GC. */ /* !!#### This function has not been Mule-ized */ int menubar_root_p = (menu_type == MENUBAR_TYPE && depth == 0); - widget_value *wv; - Lisp_Object wv_closure; int count = specpdl_depth (); int partition_seen = 0; + widget_value *wv = xmalloc_widget_value (); + Lisp_Object wv_closure = make_opaque_ptr (wv); - wv = xmalloc_widget_value (); - - wv_closure = make_opaque_ptr (wv); record_unwind_protect (widget_value_unwind, wv_closure); if (STRINGP (desc)) @@ -120,7 +117,7 @@ } else { - wv->name = string_chars; + wv->name = xstrdup (string_chars); wv->enabled = 1; /* dverna Dec. 98: command_builder_operate_menu_accelerator will manipulate the accel as a Lisp_Object if the widget has a name. @@ -131,7 +128,8 @@ } else if (VECTORP (desc)) { - if (!button_item_to_widget_value (desc, wv, 1, + Lisp_Object gui_item = gui_parse_item_keywords (desc); + if (!button_item_to_widget_value (gui_item, wv, 1, (menu_type == MENUBAR_TYPE && depth <= 1))) { @@ -156,8 +154,9 @@ wv->type = CASCADE_TYPE; wv->enabled = 1; wv->name = (char *) XSTRING_DATA (LISP_GETTEXT (XCAR (desc))); + wv->name = xstrdup (wv->name); - accel = menu_name_to_accelerator (wv->name); + accel = gui_name_accelerator (LISP_GETTEXT (XCAR (desc))); wv->accel = LISP_TO_VOID (accel); desc = Fcdr (desc); @@ -225,6 +224,7 @@ incr_wv->type = INCREMENTAL_TYPE; incr_wv->enabled = 1; incr_wv->name = wv->name; + incr_wv->name = xstrdup (wv->name); /* This is automatically GC protected through the call to lw_map_widget_values(); no need to worry. */ @@ -241,7 +241,7 @@ widget_value *title_wv = xmalloc_widget_value (); widget_value *sep_wv = xmalloc_widget_value (); title_wv->type = TEXT_TYPE; - title_wv->name = wv->name; + title_wv->name = xstrdup (wv->name); title_wv->enabled = 1; title_wv->next = sep_wv; sep_wv->type = SEPARATOR_TYPE; @@ -257,7 +257,7 @@ widget_value *dummy; /* Add a fake entry so the menus show up */ wv->contents = dummy = xmalloc_widget_value (); - dummy->name = "(inactive)"; + dummy->name = xstrdup ("(inactive)"); dummy->accel = LISP_TO_VOID (Qnil); dummy->enabled = 0; dummy->selected = 0; @@ -272,7 +272,7 @@ } else if (menubar_root_p) { - wv->name = (char *) "menubar"; + wv->name = xstrdup ("menubar"); wv->type = CASCADE_TYPE; /* Well, nothing else seems to fit and this is ignored anyway... */ } @@ -360,7 +360,7 @@ static Lisp_Object restore_in_menu_callback (Lisp_Object val) { - in_menu_callback = XINT(val); + in_menu_callback = XINT (val); return Qnil; } #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */ @@ -465,10 +465,12 @@ wv = xmalloc_widget_value (); wv->type = CASCADE_TYPE; wv->next = NULL; + wv->accel = LISP_TO_VOID (Qnil); wv->contents = xmalloc_widget_value (); wv->contents->type = TEXT_TYPE; - wv->contents->name = (char *) "No menu"; + wv->contents->name = xstrdup ("No menu"); wv->contents->next = NULL; + wv->contents->accel = LISP_TO_VOID (Qnil); } assert (wv && wv->type == CASCADE_TYPE && wv->contents); replace_widget_value_tree (hack_wv, wv->contents); @@ -509,24 +511,21 @@ static widget_value * compute_menubar_data (struct frame *f, Lisp_Object menubar, int deep_p) { - widget_value *data; - if (NILP (menubar)) - data = 0; + return 0; else { - Lisp_Object old_buffer; + widget_value *data; int count = specpdl_depth (); - old_buffer = Fcurrent_buffer (); - record_unwind_protect (Fset_buffer, old_buffer); - Fset_buffer ( XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer); + record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); + Fset_buffer (XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer); data = menu_item_descriptor_to_widget_value (menubar, MENUBAR_TYPE, deep_p, 0); - Fset_buffer (old_buffer); unbind_to (count, Qnil); + + return data; } - return data; } static int @@ -536,7 +535,7 @@ Lisp_Object menubar; int menubar_visible; long id; - /* As for the toolbar, the minibuffer does not have its own menubar. */ + /* As with the toolbar, the minibuffer does not have its own menubar. */ struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)); if (! FRAME_X_P (f)) @@ -572,7 +571,7 @@ if (NILP (FRAME_MENUBAR_DATA (f))) { struct popup_data *mdata = - alloc_lcrecord_type (struct popup_data, lrecord_popup_data); + alloc_lcrecord_type (struct popup_data, &lrecord_popup_data); mdata->id = new_lwlib_id (); mdata->last_menubar_buffer = Qnil; @@ -657,9 +656,7 @@ static void -make_dummy_xbutton_event (XEvent *dummy, - Widget daddy, - struct Lisp_Event *eev) +make_dummy_xbutton_event (XEvent *dummy, Widget daddy, Lisp_Event *eev) /* NULL for eev means query pointer */ { XButtonPressedEvent *btn = (XButtonPressedEvent *) dummy; @@ -672,7 +669,6 @@ if (eev) { Position shellx, shelly, framex, framey; - Widget shell = XtParent (daddy); Arg al [2]; btn->time = eev->timestamp; btn->button = eev->event.button.button; @@ -680,9 +676,16 @@ btn->subwindow = (Window) NULL; btn->x = eev->event.button.x; btn->y = eev->event.button.y; - XtSetArg (al [0], XtNx, &shellx); - XtSetArg (al [1], XtNy, &shelly); - XtGetValues (shell, al, 2); + shellx = shelly = 0; +#ifndef HAVE_WMCOMMAND + { + Widget shell = XtParent (daddy); + + XtSetArg (al [0], XtNx, &shellx); + XtSetArg (al [1], XtNy, &shelly); + XtGetValues (shell, al, 2); + } +#endif XtSetArg (al [0], XtNx, &framex); XtSetArg (al [1], XtNy, &framey); XtGetValues (daddy, al, 2); @@ -772,7 +775,7 @@ widget_value *data; Widget parent; Widget menu; - struct Lisp_Event *eev = NULL; + Lisp_Event *eev = NULL; XEvent xev; Lisp_Object frame; @@ -852,9 +855,15 @@ } void +reinit_vars_of_menubar_x (void) +{ + last_popup_menu_selection_callback_id = (LWLIB_ID) -1; +} + +void vars_of_menubar_x (void) { - last_popup_menu_selection_callback_id = (LWLIB_ID) -1; + reinit_vars_of_menubar_x (); #if defined (LWLIB_MENUBARS_LUCID) Fprovide (intern ("lucid-menubars")); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/menubar.c --- a/src/menubar.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/menubar.c Mon Aug 13 11:13:30 2007 +0200 @@ -95,15 +95,17 @@ } Lisp_Object -current_frame_menubar (CONST struct frame* f) +current_frame_menubar (const struct frame* f) { struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)); return symbol_value_in_buffer (Qcurrent_menubar, w->buffer); } Lisp_Object -menu_parse_submenu_keywords (Lisp_Object desc, struct gui_item* pgui_item) +menu_parse_submenu_keywords (Lisp_Object desc, Lisp_Object gui_item) { + Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); + /* Menu descriptor should be a list */ CHECK_CONS (desc); @@ -130,7 +132,7 @@ desc = XCDR (desc); if (!NILP (desc)) CHECK_CONS (desc); - gui_item_add_keyval_pair (pgui_item, key, val, ERROR_ME); + gui_item_add_keyval_pair (gui_item, key, val, ERROR_ME); } /* Return the rest - supposed to be a list of items */ @@ -152,10 +154,10 @@ { Lisp_Object path_entry, submenu_desc, submenu; struct gcpro gcpro1; - struct gui_item gui_item; + Lisp_Object gui_item = allocate_gui_item (); + Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); - gui_item_init (&gui_item); - GCPRO_GUI_ITEM (&gui_item); + GCPRO1 (gui_item); EXTERNAL_LIST_LOOP (path_entry, path) { @@ -164,15 +166,15 @@ RETURN_UNGCPRO (Qnil); /* Parse this menu */ - desc = menu_parse_submenu_keywords (desc, &gui_item); + desc = menu_parse_submenu_keywords (desc, gui_item); /* Check that this (sub)menu is active */ - if (!gui_item_active_p (&gui_item)) + if (!gui_item_active_p (gui_item)) RETURN_UNGCPRO (Qnil); /* Apply :filter */ - if (!NILP (gui_item.filter)) - desc = call1 (gui_item.filter, desc); + if (!NILP (pgui_item->filter)) + desc = call1 (pgui_item->filter, desc); /* Find the next menu on the path inside this one */ EXTERNAL_LIST_LOOP (submenu_desc, desc) @@ -191,7 +193,7 @@ descend: /* Prepare for the next iteration */ - gui_item_init (&gui_item); + gui_item_init (gui_item); } /* We have successfully descended down the end of the path */ @@ -294,7 +296,7 @@ (name, buffer)) { struct buffer *buf = decode_buffer (buffer, 0); - struct Lisp_String *n; + Lisp_String *n; Charcount end; int i; Bufbyte *name_data; @@ -353,32 +355,21 @@ void vars_of_menubar (void) { - { - /* put in Vblank_menubar a menubar value which has no visible - * items. This is a bit tricky due to various quirks. We - * could use '(["" nil nil]), but this is apparently equivalent - * to '(nil), and a new frame created with this menubar will - * get a vertically-squished menubar. If we use " " as the - * button title instead of "", we get an etched button border. - * So we use - * '(("No active menubar" ["" nil nil])) - * which creates a menu whose title is "No active menubar", - * and this works fine. - */ + /* put in Vblank_menubar a menubar value which has no visible + * items. This is a bit tricky due to various quirks. We + * could use '(["" nil nil]), but this is apparently equivalent + * to '(nil), and a new frame created with this menubar will + * get a vertically-squished menubar. If we use " " as the + * button title instead of "", we get an etched button border. + * So we use + * '(("No active menubar" ["" nil nil])) + * which creates a menu whose title is "No active menubar", + * and this works fine. + */ - Lisp_Object menu_item[3]; - static CONST char *blank_msg = "No active menubar"; - - menu_item[0] = build_string (""); - menu_item[1] = Qnil; - menu_item[2] = Qnil; - Vblank_menubar = Fcons (Fcons (build_string (blank_msg), - Fcons (Fvector (3, &menu_item[0]), - Qnil)), - Qnil); - Vblank_menubar = Fpurecopy (Vblank_menubar); - staticpro (&Vblank_menubar); - } + Vblank_menubar = list1 (list2 (build_string ("No active menubar"), + vector3 (build_string (""), Qnil, Qnil))); + staticpro (&Vblank_menubar); DEFVAR_BOOL ("popup-menu-titles", &popup_menu_titles /* If true, popup menus will have title bars at the top. @@ -502,7 +493,7 @@ side-effects. :key-sequence keys Used in FSF Emacs as an hint to an equivalent keybinding. - Ignored by XEnacs for easymenu.el compatability. + Ignored by XEnacs for easymenu.el compatibility. :label <form> (unimplemented!) Like :suffix, but replaces label completely. @@ -587,11 +578,9 @@ set_specifier_fallback (Vmenubar_visible_p, list1 (Fcons (Qnil, Qt))); set_specifier_caching (Vmenubar_visible_p, - slot_offset (struct window, - menubar_visible_p), + offsetof (struct window, menubar_visible_p), menubar_visible_p_changed, - slot_offset (struct frame, - menubar_visible_p), + offsetof (struct frame, menubar_visible_p), menubar_visible_p_changed_in_frame); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/menubar.h --- a/src/menubar.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/menubar.h Mon Aug 13 11:13:30 2007 +0200 @@ -22,19 +22,19 @@ /* #### Not properly abstracted for device-independence. */ -#ifndef _XEMACS_MENUBAR_H_ -#define _XEMACS_MENUBAR_H_ +#ifndef INCLUDED_menubar_h_ +#define INCLUDED_menubar_h_ #ifdef HAVE_MENUBARS #include "gui.h" void update_frame_menubars (struct frame *f); void free_frame_menubars (struct frame *f); Lisp_Object menu_parse_submenu_keywords (Lisp_Object desc, - struct gui_item* pgui_item); -Lisp_Object current_frame_menubar (CONST struct frame* f); + Lisp_Object gui_item); +Lisp_Object current_frame_menubar (const struct frame* f); EXFUN (Fmenu_find_real_submenu, 2); #endif /* HAVE_MENUBARS */ -#endif /* _XEMACS_MENUBAR_H_ */ +#endif /* INCLUDED_menubar_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/minibuf.c --- a/src/minibuf.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/minibuf.c Mon Aug 13 11:13:30 2007 +0200 @@ -205,7 +205,7 @@ if IGNORE_CASE is true. */ Charcount -scmp_1 (CONST Bufbyte *s1, CONST Bufbyte *s2, Charcount len, +scmp_1 (const Bufbyte *s1, const Bufbyte *s2, Charcount len, int ignore_case) { Charcount l = len; @@ -244,7 +244,7 @@ int -regexp_ignore_completion_p (CONST Bufbyte *nonreloc, +regexp_ignore_completion_p (const Bufbyte *nonreloc, Lisp_Object reloc, Bytecount offset, Bytecount length) { @@ -387,7 +387,7 @@ { if (!ZEROP (bucket)) { - struct Lisp_Symbol *next; + Lisp_Symbol *next; if (!SYMBOLP (bucket)) { signal_simple_error ("Bad obarray passed to try-completions", @@ -590,7 +590,7 @@ { if (!ZEROP (bucket)) { - struct Lisp_Symbol *next = symbol_next (XSYMBOL (bucket)); + Lisp_Symbol *next = symbol_next (XSYMBOL (bucket)); elt = bucket; eltstring = Fsymbol_name (elt); if (next) @@ -681,8 +681,8 @@ } else { - write_string_to_stdio_stream (stderr, 0, (CONST Bufbyte *) "\n", 0, 1, - FORMAT_TERMINAL); + write_string_to_stdio_stream (stderr, 0, (const Bufbyte *) "\n", 0, 1, + Qterminal); return Qnil; } } @@ -702,7 +702,7 @@ } void -echo_area_append (struct frame *f, CONST Bufbyte *nonreloc, Lisp_Object reloc, +echo_area_append (struct frame *f, const Bufbyte *nonreloc, Lisp_Object reloc, Bytecount offset, Bytecount length, Lisp_Object label) { @@ -711,6 +711,12 @@ struct gcpro gcpro1; Lisp_Object frame; + /* There is an inlining bug in egcs-20000131 c++ that can be worked + around as follows: */ +#if defined (__GNUC__) && defined (__cplusplus) + alloca (4); +#endif + /* some callers pass in a null string as a way of clearing the echo area. check for length == 0 now; if this case, neither nonreloc nor reloc may be valid. */ @@ -745,12 +751,12 @@ if (STRINGP (reloc)) nonreloc = XSTRING_DATA (reloc); write_string_to_stdio_stream (stderr, 0, nonreloc, offset, length, - FORMAT_TERMINAL); + Qterminal); } } void -echo_area_message (struct frame *f, CONST Bufbyte *nonreloc, +echo_area_message (struct frame *f, const Bufbyte *nonreloc, Lisp_Object reloc, Bytecount offset, Bytecount length, Lisp_Object label) { @@ -795,7 +801,7 @@ /* Dump an informative message to the echo area. This function takes a string in internal format. */ void -message_internal (CONST Bufbyte *nonreloc, Lisp_Object reloc, +message_internal (const Bufbyte *nonreloc, Lisp_Object reloc, Bytecount offset, Bytecount length) { /* This function can call lisp */ @@ -805,7 +811,7 @@ } void -message_append_internal (CONST Bufbyte *nonreloc, Lisp_Object reloc, +message_append_internal (const Bufbyte *nonreloc, Lisp_Object reloc, Bytecount offset, Bytecount length) { /* This function can call lisp */ @@ -819,7 +825,7 @@ on the format string; message_no_translate() does not. */ static void -message_1 (CONST char *fmt, va_list args) +message_1 (const char *fmt, va_list args) { /* This function can call lisp */ if (fmt) @@ -827,7 +833,7 @@ struct gcpro gcpro1; /* message_internal() might GC, e.g. if there are after-change-hooks on the echo area buffer */ - Lisp_Object obj = emacs_doprnt_string_va ((CONST Bufbyte *) fmt, Qnil, + Lisp_Object obj = emacs_doprnt_string_va ((const Bufbyte *) fmt, Qnil, -1, args); GCPRO1 (obj); message_internal (0, obj, 0, -1); @@ -838,7 +844,7 @@ } static void -message_append_1 (CONST char *fmt, va_list args) +message_append_1 (const char *fmt, va_list args) { /* This function can call lisp */ if (fmt) @@ -846,7 +852,7 @@ struct gcpro gcpro1; /* message_internal() might GC, e.g. if there are after-change-hooks on the echo area buffer */ - Lisp_Object obj = emacs_doprnt_string_va ((CONST Bufbyte *) fmt, Qnil, + Lisp_Object obj = emacs_doprnt_string_va ((const Bufbyte *) fmt, Qnil, -1, args); GCPRO1 (obj); message_append_internal (0, obj, 0, -1); @@ -864,7 +870,7 @@ } void -message (CONST char *fmt, ...) +message (const char *fmt, ...) { /* This function can call lisp */ /* I think it's OK to pass the data of Lisp strings as arguments to @@ -880,7 +886,7 @@ } void -message_append (CONST char *fmt, ...) +message_append (const char *fmt, ...) { /* This function can call lisp */ va_list args; @@ -893,7 +899,7 @@ } void -message_no_translate (CONST char *fmt, ...) +message_no_translate (const char *fmt, ...) { /* This function can call lisp */ /* I think it's OK to pass the data of Lisp strings as arguments to @@ -936,9 +942,15 @@ } void +reinit_vars_of_minibuf (void) +{ + minibuf_level = 0; +} + +void vars_of_minibuf (void) { - minibuf_level = 0; + reinit_vars_of_minibuf (); staticpro (&Vminibuf_prompt); Vminibuf_prompt = Qnil; @@ -965,7 +977,7 @@ } void -complex_vars_of_minibuf (void) +reinit_complex_vars_of_minibuf (void) { /* This function can GC */ #ifdef I18N3 @@ -974,8 +986,14 @@ #endif Vminibuffer_zero = Fget_buffer_create - (Fpurecopy (build_string (DEFER_GETTEXT (" *Minibuf-0*")))); + (build_string (DEFER_GETTEXT (" *Minibuf-0*"))); Vecho_area_buffer = Fget_buffer_create - (Fpurecopy (build_string (DEFER_GETTEXT (" *Echo Area*")))); + (build_string (DEFER_GETTEXT (" *Echo Area*"))); } + +void +complex_vars_of_minibuf (void) +{ + reinit_complex_vars_of_minibuf (); +} diff -r f4aeb21a5bad -r 74fd4e045ea6 src/miscplay.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/miscplay.c Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,796 @@ +/* miscplay.c - general routines related to playing sounds + ** + ** Copyright (C) 1995,96 by Markus Gutschke (gutschk@math.uni-muenster.de) + ** This was sawed out from version 1.3 of linuxplay.c by + ** Robert Bihlmeyer <robbe@orcus.priv.at>. + ** + ** Parts of this code were inspired by sunplay.c, which is copyright 1989 by + ** Jef Poskanzer and 1991,92 by Jamie Zawinski; c.f. sunplay.c for further + ** information. + ** + ** Permission to use, copy, modify, and distribute this software and its + ** documentation for any purpose and without fee is hereby granted, provided + ** that the above copyright notice appear in all copies and that both that + ** copyright notice and this permission notice appear in supporting + ** documentation. This software is provided "as is" without express or + ** implied warranty. + */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include "miscplay.h" +#include "lisp.h" +#include "syssignal.h" +#include "sysfile.h" +#define warn(str) message("audio: %s ",GETTEXT(str)) + +#include <stdlib.h> + +#ifdef __GNUC__ +#define UNUSED(x) ((void)(x)) +#else +#define UNUSED(x) +#define __inline__ +#endif + +/* Maintain global variable for keeping parser state information; this struct + is set to zero before the first invocation of the parser. The use of a + global variable prevents multiple concurrent executions of this code, but + this does not happen anyways... */ +enum wvState +{ wvMain, + wvSubchunk, + wvOutOfBlock, + wvSkipChunk, + wvSoundChunk, + wvFatal, + wvFatalNotify +}; + +static union { + struct { + int align; + enum wvState state; + size_t left; + unsigned char leftover[HEADERSZ]; + signed long chunklength; + } wave; + struct { + int align; + int isdata; + int skipping; + size_t left; + unsigned char leftover[HEADERSZ]; + } audio; +} parsestate; + +/* Use a global buffer as scratch-pad for possible conversions of the + sampling format */ +unsigned char miscplay_sndbuf[SNDBUFSZ]; + +/* Initialize global parser state information to zero */ +void reset_parsestate() +{ + memset(&parsestate,0,sizeof(parsestate)); +} + +/* Verify that we could fully parse the entire soundfile; this is needed + only for files in WAVE format */ +int parse_wave_complete() +{ + if (parsestate.wave.state != wvOutOfBlock && + parsestate.wave.state != wvFatal) { + warn("Unexpected end of WAVE file"); + return 0; + } else + return 1; +} + +/* There is no special treatment required for parsing raw data files; we + assume that these files contain data in 8bit unsigned format that + has been sampled at 8kHz; there is no extra header */ +static size_t parseraw(void **data,size_t *sz,void **outbuf) +{ + int rc = *sz; + + *outbuf = *data; + *sz = 0; + return(rc); +} + +/* Currently we cannot cope with files in VOC format; if you really need + to play these files, they should be converted by using SOX */ +static size_t parsevoc(void **data,size_t *sz,void **outbuf) +{ + UNUSED(data); + UNUSED(sz); + UNUSED(outbuf); + return(0); +} + +/* We need to perform some look-ahead in order to parse files in WAVE format; + this might require re-partioning of the data segments if headers cross the + boundaries between two read operations. This is done in a two-step way: + first we request a certain amount of bytes... */ +static __inline__ int waverequire(void **data,size_t *sz,size_t rq) +{ + int rc = 1; + + if (rq > HEADERSZ) { + warn("Header size exceeded while parsing WAVE file"); + parsestate.wave.state = wvFatal; + *sz = 0; + return(0); } + if ((rq -= parsestate.wave.left) <= 0) + return(rc); + if (rq > *sz) {rq = *sz; rc = 0;} + memcpy(parsestate.wave.leftover+parsestate.wave.left, + *data,rq); + parsestate.wave.left += rq; + (*(unsigned char **)data) += rq; + *sz -= rq; + return(rc); +} + +/* ...and next we remove this many bytes from the buffer */ +static __inline__ void waveremove(size_t rq) +{ + if (parsestate.wave.left <= rq) + parsestate.wave.left = 0; + else { + parsestate.wave.left -= rq; + memmove(parsestate.wave.leftover, + parsestate.wave.leftover+rq, + parsestate.wave.left); } + return; +} + +/* Sound files in WAVE format can contain an arbitrary amount of tagged + chunks; this requires quite some effort for parsing the data */ +static size_t parsewave(void **data,size_t *sz,void **outbuf) +{ + for (;;) + switch (parsestate.wave.state) { + case wvMain: + if (!waverequire(data,sz,20)) + return(0); + /* Keep compatibility with Linux 68k, etc. by not relying on byte-sex */ + parsestate.wave.chunklength = parsestate.wave.leftover[16] + + 256*(parsestate.wave.leftover[17] + + 256*(parsestate.wave.leftover[18] + + 256*parsestate.wave.leftover[19])); + waveremove(20); + parsestate.wave.state = wvSubchunk; + break; + case wvSubchunk: + if (!waverequire(data,sz,parsestate.wave.chunklength)) + return(0); + parsestate.wave.align = parsestate.wave.chunklength < 14 ? 1 + : parsestate.wave.leftover[12]; + if (parsestate.wave.align != 1 && + parsestate.wave.align != 2 && + parsestate.wave.align != 4) { + warn("Illegal datawidth detected while parsing WAVE file"); + parsestate.wave.state = wvFatal; } + else + parsestate.wave.state = wvOutOfBlock; + waveremove(parsestate.wave.chunklength); + break; + case wvOutOfBlock: + if (!waverequire(data,sz,8)) + return(0); + /* Keep compatibility with Linux 68k, etc. by not relying on byte-sex */ + parsestate.wave.chunklength = parsestate.wave.leftover[4] + + 256*(parsestate.wave.leftover[5] + + 256*(parsestate.wave.leftover[6] + + 256*(parsestate.wave.leftover[7] & 0x7F))); + if (memcmp(parsestate.wave.leftover,"data",4)) + parsestate.wave.state = wvSkipChunk; + else + parsestate.wave.state = wvSoundChunk; + waveremove(8); + break; + case wvSkipChunk: + if (parsestate.wave.chunklength > 0 && *sz > 0 && + (signed long)*sz < (signed long)parsestate.wave.chunklength) { + parsestate.wave.chunklength -= *sz; + *sz = 0; } + else { + if (parsestate.wave.chunklength > 0 && *sz > 0) { + *sz -= parsestate.wave.chunklength; + (*(unsigned char **)data) += parsestate.wave.chunklength; } + parsestate.wave.state = wvOutOfBlock; } + break; + case wvSoundChunk: { + size_t count,rq; + if (parsestate.wave.left) { /* handle leftover bytes from last + alignment operation */ + count = parsestate.wave.left; + rq = HEADERSZ-count; + if (rq > (size_t) parsestate.wave.chunklength) + rq = parsestate.wave.chunklength; + if (!waverequire(data,sz,rq)) { + parsestate.wave.chunklength -= parsestate.wave.left - count; + return(0); } + parsestate.wave.chunklength -= rq; + *outbuf = parsestate.wave.leftover; + parsestate.wave.left = 0; + return(rq); } + if (*sz >= (size_t) parsestate.wave.chunklength) { + count = parsestate.wave.chunklength; + rq = 0; } + else { + count = *sz; + count -= rq = count % parsestate.wave.align; } + *outbuf = *data; + (*(unsigned char **)data) += count; + *sz -= count; + if ((parsestate.wave.chunklength -= count) < parsestate.wave.align) { + parsestate.wave.state = wvOutOfBlock; + /* Some broken software (e.g. SOX) attaches junk to the end of a sound + chunk; so, let's ignore this... */ + if (parsestate.wave.chunklength) + parsestate.wave.state = wvSkipChunk; } + else if (rq) + /* align data length to a multiple of datasize; keep additional data + in "leftover" buffer --- this is necessary to ensure proper + functioning of the sndcnv... routines */ + waverequire(data,sz,rq); + return(count); } + case wvFatalNotify: + warn("Irrecoverable error while parsing WAVE file"); + parsestate.wave.state = wvFatal; + break; + case wvFatal: + default: + *sz = 0; + return(0); } +} + +/* Strip the header from files in Sun/DEC audio format; this requires some + extra processing as the header can be an arbitrary size and it might + result in alignment errors for subsequent conversions --- thus we do + some buffering, where needed */ +static size_t parsesundecaudio(void **data,size_t *sz,void **outbuf) +{ + /* There is data left over from the last invocation of this function; join + it with the new data and return a sound chunk that is as big as a + single entry */ + if (parsestate.audio.left) { + if (parsestate.audio.left + *sz > (size_t) parsestate.audio.align) { + int count; + memmove(parsestate.audio.leftover + parsestate.audio.left, + *data, + count = parsestate.audio.align - parsestate.audio.left); + *outbuf = parsestate.audio.leftover; + *sz -= count; + *data = (*(char **)data) + count; + parsestate.audio.left = 0; + return(parsestate.audio.align); } + else { + /* We need even more data in order to get one complete single entry! */ + memmove(parsestate.audio.leftover + parsestate.audio.left, + *data, + *sz); + *data = (*(char **)data) + *sz; + parsestate.audio.left += *sz; + *sz = 0; + return(0); } } + + /* This is the main sound chunk, strip of any extra data that does not fit + the alignment requirements and move these bytes into the leftover buffer*/ + if (parsestate.audio.isdata) { + int rc = *sz; + *outbuf = *data; + if ((parsestate.audio.left = rc % parsestate.audio.align) != 0) { + memmove(parsestate.audio.leftover, + (char *)*outbuf + rc - parsestate.audio.left, + parsestate.audio.left); + rc -= parsestate.audio.left; } + *sz = 0; + return(rc); } + + /* This is the first invocation of this function; we need to parse the + header information and determine how many bytes we need to skip until + the start of the sound chunk */ + if (!parsestate.audio.skipping) { + unsigned char *header = (unsigned char *) *data; + if (*sz < 8) { + warn("Irrecoverable error while parsing Sun/DEC audio file"); + return(0); } + /* Keep compatibility with Linux 68k, etc. by not relying on byte-sex */ + if (header[3]) { /* Sun audio (big endian) */ + parsestate.audio.align = ((header[15] > 2)+1)*header[23]; + parsestate.audio.skipping = header[7]+256*(header[6]+256* + (header[5]+256*header[4])); } + else { /* DEC audio (little endian) */ + parsestate.audio.align = ((header[12] > 2)+1)*header[20]; + parsestate.audio.skipping = header[4]+256*(header[5]+256* + (header[6]+256*header[7])); }} + + /* We are skipping extra data that has been attached to header; most usually + this will be just a comment, such as the original filename and/or the + creation date. Make sure that we do not return less than one single sound + sample entry to the caller; if this happens, rather decide to move those + few bytes into the leftover buffer and deal with it later */ + if (*sz >= (size_t) parsestate.audio.skipping) { + /* Skip just the header information and return the sound chunk */ + int rc = *sz - parsestate.audio.skipping; + *outbuf = (char *)*data + parsestate.audio.skipping; + if ((parsestate.audio.left = rc % parsestate.audio.align) != 0) { + memmove(parsestate.audio.leftover, + (char *)*outbuf + rc - parsestate.audio.left, + parsestate.audio.left); + rc -= parsestate.audio.left; } + *sz = 0; + parsestate.audio.skipping = 0; + parsestate.audio.isdata++; + return(rc); } + else { + /* Skip everything */ + parsestate.audio.skipping -= *sz; + return(0); } +} + +/* If the soundcard could not be set to natively support the data format, we + try to do some limited on-the-fly conversion to a different format; if + no conversion is needed, though, we can output directly */ +size_t sndcnvnop(void **data,size_t *sz,void **outbuf) +{ + int rc = *sz; + + *outbuf = *data; + *sz = 0; + return(rc); +} + +/* Convert 8 bit unsigned stereo data to 8 bit unsigned mono data */ +size_t sndcnv8U_2mono(void **data,size_t *sz,void **outbuf) +{ + REGISTER unsigned char *src; + REGISTER unsigned char *dest; + int rc,count; + + count = *sz / 2; + if (count > SNDBUFSZ) { *sz -= 2*SNDBUFSZ; count = SNDBUFSZ; } + else *sz = 0; + rc = count; + src = (unsigned char *) *data; + *outbuf = + dest = miscplay_sndbuf; + while (count--) + *dest++ = (unsigned char)(((int)*(src)++ + + (int)*(src)++) / 2); + *data = src; + return(rc); +} + +/* Convert 8 bit signed stereo data to 8 bit signed mono data */ +size_t sndcnv8S_2mono(void **data,size_t *sz,void **outbuf) +{ + REGISTER unsigned char *src; + REGISTER unsigned char *dest; + int rc, count; + + count = *sz / 2; + if (count > SNDBUFSZ) { *sz -= 2*SNDBUFSZ; count = SNDBUFSZ; } + else *sz = 0; + rc = count; + src = (unsigned char *) *data; + *outbuf = + dest = miscplay_sndbuf; + while (count--) + *dest++ = (unsigned char)(((int)*((signed char *)(src++)) + + (int)*((signed char *)(src++))) / 2); + *data = src; + return(rc); +} + +/* Convert 8 bit signed stereo data to 8 bit unsigned mono data */ +size_t sndcnv2monounsigned(void **data,size_t *sz,void **outbuf) +{ + REGISTER unsigned char *src; + REGISTER unsigned char *dest; + int rc,count; + + count = *sz / 2; + if (count > SNDBUFSZ) { *sz -= 2*SNDBUFSZ; count = SNDBUFSZ; } + else *sz = 0; + rc = count; + src = (unsigned char *) *data; + *outbuf = + dest = miscplay_sndbuf; + while (count--) + *dest++ = (unsigned char)(((int)*((signed char *)(src++)) + + (int)*((signed char *)(src++))) / 2) ^ 0x80; + *data = src; + return(rc); +} + +/* Convert 8 bit signed mono data to 8 bit unsigned mono data */ +size_t sndcnv2unsigned(void **data,size_t *sz,void **outbuf) +{ + REGISTER unsigned char *src; + REGISTER unsigned char *dest; + int rc,count; + + count = *sz; + if (count > SNDBUFSZ) { *sz -= SNDBUFSZ; count = SNDBUFSZ; } + else *sz = 0; + rc = count; + src = (unsigned char *) *data; + *outbuf = + dest = miscplay_sndbuf; + while (count--) + *dest++ = *(src)++ ^ 0x80; + *data = src; + return(rc); +} + +/* Convert a number in the range -32768..32767 to an 8 bit ulaw encoded + number --- I hope, I got this conversion right :-) */ +static __inline__ signed char int2ulaw(int i) +{ + /* Lookup table for fast calculation of number of bits that need shifting*/ + static short int t_bits[128] = { + 0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, + 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6, + 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, + 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7}; + REGISTER int bits,logi; + + /* unrolling this condition (hopefully) improves execution speed */ + if (i < 0) { + if ((i = (132-i)) > 0x7FFF) i = 0x7FFF; + logi = (i >> ((bits = t_bits[i/256])+4)); + return((bits << 4 | logi) ^ 0x7F); } + else { + if ((i = 132+i) > 0x7FFF) i = 0x7FFF; + logi = (i >> ((bits = t_bits[i/256])+4)); + return(~(bits << 4 | logi)); } +} + +/* Convert from 8 bit ulaw mono to 8 bit linear mono */ +size_t sndcnvULaw_2linear(void **data,size_t *sz,void **outbuf) +{ + /* conversion table stolen from Linux's ulaw.h */ + static unsigned char ulaw_dsp[] = { + 3, 7, 11, 15, 19, 23, 27, 31, + 35, 39, 43, 47, 51, 55, 59, 63, + 66, 68, 70, 72, 74, 76, 78, 80, + 82, 84, 86, 88, 90, 92, 94, 96, + 98, 99, 100, 101, 102, 103, 104, 105, + 106, 107, 108, 109, 110, 111, 112, 113, + 113, 114, 114, 115, 115, 116, 116, 117, + 117, 118, 118, 119, 119, 120, 120, 121, + 121, 121, 122, 122, 122, 122, 123, 123, + 123, 123, 124, 124, 124, 124, 125, 125, + 125, 125, 125, 125, 126, 126, 126, 126, + 126, 126, 126, 126, 127, 127, 127, 127, + 127, 127, 127, 127, 127, 127, 127, 127, + 128, 128, 128, 128, 128, 128, 128, 128, + 128, 128, 128, 128, 128, 128, 128, 128, + 128, 128, 128, 128, 128, 128, 128, 128, + 253, 249, 245, 241, 237, 233, 229, 225, + 221, 217, 213, 209, 205, 201, 197, 193, + 190, 188, 186, 184, 182, 180, 178, 176, + 174, 172, 170, 168, 166, 164, 162, 160, + 158, 157, 156, 155, 154, 153, 152, 151, + 150, 149, 148, 147, 146, 145, 144, 143, + 143, 142, 142, 141, 141, 140, 140, 139, + 139, 138, 138, 137, 137, 136, 136, 135, + 135, 135, 134, 134, 134, 134, 133, 133, + 133, 133, 132, 132, 132, 132, 131, 131, + 131, 131, 131, 131, 130, 130, 130, 130, + 130, 130, 130, 130, 129, 129, 129, 129, + 129, 129, 129, 129, 129, 129, 129, 129, + 128, 128, 128, 128, 128, 128, 128, 128, + 128, 128, 128, 128, 128, 128, 128, 128, + 128, 128, 128, 128, 128, 128, 128, 128, + }; + unsigned char *p=(unsigned char *)*data; + + *outbuf = *data; + while ((*sz)--) + *p++ = ulaw_dsp[*p]; + *sz = 0; + *data = p; + return p - (unsigned char *)*outbuf; +} + +/* Convert 8 bit ulaw stereo data to 8 bit ulaw mono data */ +size_t sndcnvULaw_2mono(void **data,size_t *sz,void **outbuf) +{ + + static short int ulaw2int[256] = { + /* Precomputed lookup table for conversion from ulaw to 15 bit signed */ + -16062,-15550,-15038,-14526,-14014,-13502,-12990,-12478, + -11966,-11454,-10942,-10430, -9918, -9406, -8894, -8382, + -7998, -7742, -7486, -7230, -6974, -6718, -6462, -6206, + -5950, -5694, -5438, -5182, -4926, -4670, -4414, -4158, + -3966, -3838, -3710, -3582, -3454, -3326, -3198, -3070, + -2942, -2814, -2686, -2558, -2430, -2302, -2174, -2046, + -1950, -1886, -1822, -1758, -1694, -1630, -1566, -1502, + -1438, -1374, -1310, -1246, -1182, -1118, -1054, -990, + -942, -910, -878, -846, -814, -782, -750, -718, + -686, -654, -622, -590, -558, -526, -494, -462, + -438, -422, -406, -390, -374, -358, -342, -326, + -310, -294, -278, -262, -246, -230, -214, -198, + -186, -178, -170, -162, -154, -146, -138, -130, + -122, -114, -106, -98, -90, -82, -74, -66, + -60, -56, -52, -48, -44, -40, -36, -32, + -28, -24, -20, -16, -12, -8, -4, +0, + +16062,+15550,+15038,+14526,+14014,+13502,+12990,+12478, + +11966,+11454,+10942,+10430, +9918, +9406, +8894, +8382, + +7998, +7742, +7486, +7230, +6974, +6718, +6462, +6206, + +5950, +5694, +5438, +5182, +4926, +4670, +4414, +4158, + +3966, +3838, +3710, +3582, +3454, +3326, +3198, +3070, + +2942, +2814, +2686, +2558, +2430, +2302, +2174, +2046, + +1950, +1886, +1822, +1758, +1694, +1630, +1566, +1502, + +1438, +1374, +1310, +1246, +1182, +1118, +1054, +990, + +942, +910, +878, +846, +814, +782, +750, +718, + +686, +654, +622, +590, +558, +526, +494, +462, + +438, +422, +406, +390, +374, +358, +342, +326, + +310, +294, +278, +262, +246, +230, +214, +198, + +186, +178, +170, +162, +154, +146, +138, +130, + +122, +114, +106, +98, +90, +82, +74, +66, + +60, +56, +52, +48, +44, +40, +36, +32, + +28, +24, +20, +16, +12, +8, +4, +0}; + + REGISTER unsigned char *src; + REGISTER unsigned char *dest; + int rc,count; + + count = *sz / 2; + if (count > SNDBUFSZ) { *sz -= 2*SNDBUFSZ; count = SNDBUFSZ; } + else *sz = 0; + rc = count; + src = (unsigned char *) *data; + *outbuf = + dest = miscplay_sndbuf; + while (count--) + /* it is not possible to directly interpolate between two ulaw encoded + data bytes, thus we need to convert to linear format first and later + we convert back to ulaw format */ + *dest++ = int2ulaw(ulaw2int[*(src)++] + + ulaw2int[*(src)++]); + *data = src; + return(rc); +} + +size_t sndcnv16swap(void **data,size_t *sz,void **outbuf) +{ + size_t cnt = *sz / 2; + unsigned short *p; + + *outbuf = *data; + p = (unsigned short *) *outbuf; + while (cnt--) { + *p++ = ((*p & 0x00ff) << 8) | (*p >> 8); + } + *data = p; + cnt = *sz; + *sz = 0; + return cnt; +} + +/* Convert 16 bit little endian signed stereo data to 16 bit little endian + signed mono data */ +size_t sndcnv16_2monoLE(void **data,size_t *sz,void **outbuf) +{ + REGISTER unsigned char *src; + REGISTER unsigned char *dest; + int rc,count; + signed short i; + + count = *sz / 2; + if (count > SNDBUFSZ) { *sz -= 2*SNDBUFSZ; count = SNDBUFSZ; } + else *sz = 0; + rc = count; + src = (unsigned char *) *data; + *outbuf = + dest = miscplay_sndbuf; + for (count /= 2; count--; ) { + i = ((int)(src[0]) + + 256*(int)(src[1]) + + (int)(src[2]) + + 256*(int)(src[3])) / 2; + src += 4; + *dest++ = (unsigned char)(i & 0xFF); + *dest++ = (unsigned char)((i / 256) & 0xFF); } + *data = src; + return(rc); +} + +/* Convert 16 bit big endian signed stereo data to 16 bit big endian + signed mono data */ +size_t sndcnv16_2monoBE(void **data,size_t *sz,void **outbuf) +{ + REGISTER unsigned char *src; + REGISTER unsigned char *dest; + int rc,count; + signed short i; + + count = *sz / 2; + if (count > SNDBUFSZ) { *sz -= 2*SNDBUFSZ; count = SNDBUFSZ; } + else *sz = 0; + rc = count; + src = (unsigned char *) *data; + *outbuf = + dest = miscplay_sndbuf; + for (count /= 2; count--; ) { + i = ((int)(src[1]) + + 256*(int)(src[0]) + + (int)(src[3]) + + 256*(int)(src[2])) / 2; + src += 4; + *dest++ = (unsigned char)((i / 256) & 0xFF); + *dest++ = (unsigned char)(i & 0xFF); } + *data = src; + return(rc); +} + +/* Convert 16 bit little endian signed data to 8 bit unsigned data */ +size_t sndcnv2byteLE(void **data,size_t *sz,void **outbuf) +{ + REGISTER unsigned char *src; + REGISTER unsigned char *dest; + int rc,count; + + count = *sz / 2; + if (count > SNDBUFSZ) { *sz -= 2*SNDBUFSZ; count = SNDBUFSZ; } + else *sz = 0; + rc = count; + src = (unsigned char *) *data; + *outbuf = + dest = miscplay_sndbuf; + while (count--) { + *dest++ = (unsigned char)(((signed char *)src)[1] ^ (signed char)0x80); + src += 2; + } + *data = src; + return(rc); +} + +/* Convert 16 bit big endian signed data to 8 bit unsigned data */ +size_t sndcnv2byteBE(void **data,size_t *sz,void **outbuf) +{ + REGISTER unsigned char *src; + REGISTER unsigned char *dest; + int rc,count; + + count = *sz / 2; + if (count > SNDBUFSZ) { *sz -= 2*SNDBUFSZ; count = SNDBUFSZ; } + else *sz = 0; + rc = count; + src = (unsigned char *) *data; + *outbuf = + dest = miscplay_sndbuf; + while (count--) { + *dest++ = (unsigned char)(((signed char *)src)[0] ^ (signed char)0x80); + src += 2; + } + *data = src; + return(rc); +} + +/* Convert 16 bit little endian signed stereo data to 8 bit unsigned + mono data */ +size_t sndcnv2monobyteLE(void **data,size_t *sz,void **outbuf) +{ + REGISTER unsigned char *src; + REGISTER unsigned char *dest; + int rc,count; + + count = *sz / 4; + if (count > SNDBUFSZ) { *sz -= 4*SNDBUFSZ; count = SNDBUFSZ; } + else *sz = 0; + rc = count; + src = (unsigned char *) *data; + *outbuf = + dest = miscplay_sndbuf; + while (count--) { + *dest++ = (unsigned char)(((int)((signed char *)src)[1] + + (int)((signed char *)src)[3]) / 2 ^ 0x80); + src += 4; + } + *data = src; + return(rc); +} + +/* Convert 16 bit big endian signed stereo data to 8 bit unsigned + mono data */ +size_t sndcnv2monobyteBE(void **data,size_t *sz,void **outbuf) +{ + REGISTER unsigned char *src; + REGISTER unsigned char *dest; + int rc,count; + + count = *sz / 4; + if (count > SNDBUFSZ) { *sz -= 4*SNDBUFSZ; count = SNDBUFSZ; } + else *sz = 0; + rc = count; + src = (unsigned char *) *data; + *outbuf = + dest = miscplay_sndbuf; + while (count--) { + *dest++ = (unsigned char)(((int)((signed char *)src)[0] + + (int)((signed char *)src)[2]) / 2 ^ 0x80); + src += 4; + } + *data = src; + return(rc); +} + +/* Look at the header of the sound file and try to determine the format; + we can recognize files in VOC, WAVE, and, Sun/DEC-audio format--- everything + else is assumed to be raw 8 bit unsigned data sampled at 8kHz */ +fmtType analyze_format(unsigned char *format,int *fmt,int *speed, + int *tracks, + size_t (**parsesndfile)(void **,size_t *sz, + void **)) +{ + /* Keep compatibility with Linux 68k, etc. by not relying on byte-sex */ + if (!memcmp(format,"Creative Voice File\x1A\x1A\x00",22) && + (format[22]+256*format[23]) == + ((0x1233-format[24]-256*format[25])&0xFFFF)) { /* VOC */ + *fmt = AFMT_U8; + *speed = 8000; + *tracks = 2; + *parsesndfile = parsevoc; + return(fmtVoc); } + else if (!memcmp(format,"RIFF",4) && + !memcmp(format+8,"WAVEfmt ",8)) { /* WAVE */ + if (memcmp(format+20,"\001\000\001"/* PCM mono */,4) && + memcmp(format+20,"\001\000\002"/* PCM stereo */,4)) + return(fmtIllegal); + *fmt = (format[32]/(*tracks = format[22])) == 1 ? + AFMT_U8 : AFMT_S16_LE; + /* Keep compatibility with Linux 68k, etc. by not relying on byte-sex */ + *speed = format[24]+256*(format[25]+256* + (format[26]+256*format[27])); + *parsesndfile = parsewave; + return(fmtWave); } + else if (!memcmp(format,".snd",4)) { /* Sun Audio (big endian) */ + if (format[7]+256*(format[6]+256*(format[5]+256*format[4])) < 24) { + *fmt = AFMT_MU_LAW; + *speed = 8000; + *tracks = 1; + *parsesndfile = parsesundecaudio; + return(fmtSunAudio); } + if (!memcmp(format+12,"\000\000\000\001",4)) *fmt = AFMT_MU_LAW; + else if (!memcmp(format+12,"\000\000\000\002",4)) *fmt = AFMT_S8; + else if (!memcmp(format+12,"\000\000\000\003",4)) *fmt = AFMT_S16_BE; + else return(fmtIllegal); + /* Keep compatibility with Linux 68k, etc. by not relying on byte-sex */ + *speed = format[19]+256*(format[18]+256* + (format[17]+256*format[16])); + *tracks = format[23]; + *parsesndfile = parsesundecaudio; + return(fmtSunAudio); } + else if (!memcmp(format,".sd",4)) { /* DEC Audio (little endian) */ + if (format[4]+256*(format[5]+256*(format[6]+256*format[7])) < 24) { + *fmt = AFMT_MU_LAW; + *speed = 8000; + *tracks = 1; + *parsesndfile = parsesundecaudio; + return(fmtSunAudio); } + if (!memcmp(format+12,"\001\000\000",4)) *fmt = AFMT_MU_LAW; + else if (!memcmp(format+12,"\002\000\000",4)) *fmt = AFMT_S8; + else if (!memcmp(format+12,"\003\000\000",4)) *fmt = AFMT_S16_LE; + else return(fmtIllegal); + /* Keep compatibility with Linux 68k, etc. by not relying on byte-sex */ + *speed = format[16]+256*(format[17]+256* + (format[18]+256*format[19])); + *tracks = format[20]; + *parsesndfile = parsesundecaudio; + return(fmtSunAudio); } + else { + *fmt = AFMT_U8; + *speed = 8000; + *tracks = 1; + *parsesndfile = parseraw; + return(fmtRaw); } +} diff -r f4aeb21a5bad -r 74fd4e045ea6 src/miscplay.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/miscplay.h Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,63 @@ +/* miscplay.h - general routines related to playing sounds + ** + ** Copyright (C) 1995,96 by Markus Gutschke (gutschk@math.uni-muenster.de) + ** This was sawed out from version 1.3 of linuxplay.c by + ** Robert Bihlmeyer <robbe@orcus.priv.at>. + ** + ** Parts of this code were inspired by sunplay.c, which is copyright 1989 by + ** Jef Poskanzer and 1991,92 by Jamie Zawinski; c.f. sunplay.c for further + ** information. + ** + ** Permission to use, copy, modify, and distribute this software and its + ** documentation for any purpose and without fee is hereby granted, provided + ** that the above copyright notice appear in all copies and that both that + ** copyright notice and this permission notice appear in supporting + ** documentation. This software is provided "as is" without express or + ** implied warranty. + */ + +#ifndef INCLUDED_miscplay_h_ +#define INCLUDED_miscplay_h_ + +#include <stdlib.h> + +#define HEADERSZ 256 /* has to be at least as big as the biggest header */ +#define SNDBUFSZ 2048 /* has to be at least as big as HEADERSZ */ + +/* Audio data formats from <linux/soundcard.h> */ +#define AFMT_MU_LAW 0x00000001 +#define AFMT_A_LAW 0x00000002 +#define AFMT_IMA_ADPCM 0x00000004 +#define AFMT_U8 0x00000008 +#define AFMT_S16_LE 0x00000010 /* Little endian signed 16*/ +#define AFMT_S16_BE 0x00000020 /* Big endian signed 16 */ +#define AFMT_S8 0x00000040 +#define AFMT_U16_LE 0x00000080 /* Little endian U16 */ +#define AFMT_U16_BE 0x00000100 /* Big endian U16 */ +#define AFMT_MPEG 0x00000200 /* MPEG (2) audio */ + +typedef enum {fmtIllegal,fmtRaw,fmtVoc,fmtWave,fmtSunAudio} fmtType; + +size_t sndcnvnop(void **data,size_t *sz,void **outbuf); +size_t sndcnv8U_2mono(void **data,size_t *sz,void **outbuf); +size_t sndcnv8S_2mono(void **data,size_t *sz,void **outbuf); +size_t sndcnv2monounsigned(void **data,size_t *sz,void **outbuf); +size_t sndcnv2unsigned(void **data,size_t *sz,void **outbuf); +size_t sndcnvULaw_2linear(void **data,size_t *sz,void **outbuf); +size_t sndcnvULaw_2mono(void **data,size_t *sz,void **outbuf); +size_t sndcnv16swap(void **data,size_t *sz,void **outbuf); +size_t sndcnv16_2monoLE(void **data,size_t *sz,void **outbuf); +size_t sndcnv16_2monoBE(void **data,size_t *sz,void **outbuf); +size_t sndcnv2byteLE(void **data,size_t *sz,void **outbuf); +size_t sndcnv2byteBE(void **data,size_t *sz,void **outbuf); +size_t sndcnv2monobyteLE(void **data,size_t *sz,void **outbuf); +size_t sndcnv2monobyteBE(void **data,size_t *sz,void **outbuf); + +fmtType analyze_format(unsigned char *format,int *fmt,int *speed, + int *tracks, + size_t (**parsesndfile)(void **,size_t *sz, + void **)); +void reset_parsestate(void); +int parse_wave_complete(void); + +#endif /* INCLUDED_miscplay_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/mule-canna.c --- a/src/mule-canna.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/mule-canna.c Mon Aug 13 11:13:30 2007 +0200 @@ -1022,9 +1022,6 @@ void syms_of_mule_canna (void) { - DEFVAR_LISP ("CANNA", &VCANNA); /* hir@nec, 1992.5.21 */ - VCANNA = Qt; /* hir@nec, 1992.5.21 */ - DEFSUBR (Fcanna_key_proc); DEFSUBR (Fcanna_initialize); DEFSUBR (Fcanna_finalize); @@ -1048,6 +1045,9 @@ void vars_of_mule_canna (void) { + DEFVAR_LISP ("CANNA", &VCANNA); /* hir@nec, 1992.5.21 */ + VCANNA = Qt; /* hir@nec, 1992.5.21 */ + DEFVAR_LISP ("canna-kakutei-string", &Vcanna_kakutei_string /* */ ); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/mule-ccl.c --- a/src/mule-ccl.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/mule-ccl.c Mon Aug 13 11:13:30 2007 +0200 @@ -1,5 +1,5 @@ /* CCL (Code Conversion Language) interpreter. - Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN. + Copyright (C) 1995, 1997, 1998, 1999 Electrotechnical Laboratory, JAPAN. Licensed to the Free Software Foundation. This file is part of XEmacs. @@ -19,11 +19,19 @@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -/* Synched up with : FSF Emacs 20.2 */ +/* Synched up with : FSF Emacs 20.3.10 without ExCCL + * (including {Read|Write}MultibyteChar) */ #ifdef emacs #include <config.h> + +#if 0 +#ifdef STDC_HEADERS +#include <stdlib.h> +#endif +#endif + #include "lisp.h" #include "buffer.h" #include "mule-charset.h" @@ -37,9 +45,29 @@ #endif /* not emacs */ +/* This contains all code conversion map available to CCL. */ +/* +Lisp_Object Vcode_conversion_map_vector; +*/ + /* Alist of fontname patterns vs corresponding CCL program. */ Lisp_Object Vfont_ccl_encoder_alist; +/* This symbol is a property which assocates with ccl program vector. + Ex: (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector. */ +Lisp_Object Qccl_program; + +/* These symbols are properties which associate with code conversion + map and their ID respectively. */ +/* +Lisp_Object Qcode_conversion_map; +Lisp_Object Qcode_conversion_map_id; +*/ + +/* Symbols of ccl program have this property, a value of the property + is an index for Vccl_protram_table. */ +Lisp_Object Qccl_program_idx; + /* Vector of CCL program names vs corresponding program data. */ Lisp_Object Vccl_program_table; @@ -153,18 +181,18 @@ #define CCL_WriteConstJump 0x08 /* Write constant and jump: 1:A--D--D--R--E--S--S-000XXXXX - 2:CONST + 2:const ------------------------------ - write (CONST); + write (const); IC += ADDRESS; */ #define CCL_WriteConstReadJump 0x09 /* Write constant, read, and jump: 1:A--D--D--R--E--S--S-rrrXXXXX - 2:CONST + 2:const 3:A--D--D--R--E--S--S-rrrYYYYY ----------------------------- - write (CONST); + write (const); IC += 2; read (reg[rrr]); IC += ADDRESS; @@ -271,7 +299,8 @@ write (reg[RRR] OPERATION reg[Rrr]); */ -#define CCL_Call 0x13 /* Write a constant: +#define CCL_Call 0x13 /* Call the CCL program whose ID is + (CC..C). 1:CCCCCCCCCCCCCCCCCCCC000XXXXX ------------------------------ call (CC..C) @@ -393,7 +422,7 @@ IC += 2; */ -#define CCL_Extention 0x1F /* Extended CCL code +#define CCL_Extension 0x1F /* Extended CCL code 1:ExtendedCOMMNDRrrRRRrrrXXXXX 2:ARGUEMENT 3:... @@ -401,6 +430,192 @@ extended_command (rrr,RRR,Rrr,ARGS) */ +/* + Here after, Extended CCL Instructions. + Bit length of extended command is 14. + Therefore, the instruction code range is 0..16384(0x3fff). + */ + +/* Read a multibyte characeter. + A code point is stored into reg[rrr]. A charset ID is stored into + reg[RRR]. */ + +#define CCL_ReadMultibyteChar2 0x00 /* Read Multibyte Character + 1:ExtendedCOMMNDRrrRRRrrrXXXXX */ + +/* Write a multibyte character. + Write a character whose code point is reg[rrr] and the charset ID + is reg[RRR]. */ + +#define CCL_WriteMultibyteChar2 0x01 /* Write Multibyte Character + 1:ExtendedCOMMNDRrrRRRrrrXXXXX */ + +#if 0 +/* Translate a character whose code point is reg[rrr] and the charset + ID is reg[RRR] by a translation table whose ID is reg[Rrr]. + + A translated character is set in reg[rrr] (code point) and reg[RRR] + (charset ID). */ + +#define CCL_TranslateCharacter 0x02 /* Translate a multibyte character + 1:ExtendedCOMMNDRrrRRRrrrXXXXX */ + +/* Translate a character whose code point is reg[rrr] and the charset + ID is reg[RRR] by a translation table whose ID is ARGUMENT. + + A translated character is set in reg[rrr] (code point) and reg[RRR] + (charset ID). */ + +#define CCL_TranslateCharacterConstTbl 0x03 /* Translate a multibyte character + 1:ExtendedCOMMNDRrrRRRrrrXXXXX + 2:ARGUMENT(Translation Table ID) + */ + +/* Iterate looking up MAPs for reg[rrr] starting from the Nth (N = + reg[RRR]) MAP until some value is found. + + Each MAP is a Lisp vector whose element is number, nil, t, or + lambda. + If the element is nil, ignore the map and proceed to the next map. + If the element is t or lambda, finish without changing reg[rrr]. + If the element is a number, set reg[rrr] to the number and finish. + + Detail of the map structure is descibed in the comment for + CCL_MapMultiple below. */ + +#define CCL_IterateMultipleMap 0x10 /* Iterate multiple maps + 1:ExtendedCOMMNDXXXRRRrrrXXXXX + 2:NUMBER of MAPs + 3:MAP-ID1 + 4:MAP-ID2 + ... + */ + +/* Map the code in reg[rrr] by MAPs starting from the Nth (N = + reg[RRR]) map. + + MAPs are supplied in the succeeding CCL codes as follows: + + When CCL program gives this nested structure of map to this command: + ((MAP-ID11 + MAP-ID12 + (MAP-ID121 MAP-ID122 MAP-ID123) + MAP-ID13) + (MAP-ID21 + (MAP-ID211 (MAP-ID2111) MAP-ID212) + MAP-ID22)), + the compiled CCL codes has this sequence: + CCL_MapMultiple (CCL code of this command) + 16 (total number of MAPs and SEPARATORs) + -7 (1st SEPARATOR) + MAP-ID11 + MAP-ID12 + -3 (2nd SEPARATOR) + MAP-ID121 + MAP-ID122 + MAP-ID123 + MAP-ID13 + -7 (3rd SEPARATOR) + MAP-ID21 + -4 (4th SEPARATOR) + MAP-ID211 + -1 (5th SEPARATOR) + MAP_ID2111 + MAP-ID212 + MAP-ID22 + + A value of each SEPARATOR follows this rule: + MAP-SET := SEPARATOR [(MAP-ID | MAP-SET)]+ + SEPARATOR := -(number of MAP-IDs and SEPARATORs in the MAP-SET) + + (*)....Nest level of MAP-SET must not be over than MAX_MAP_SET_LEVEL. + + When some map fails to map (i.e. it doesn't have a value for + reg[rrr]), the mapping is treated as identity. + + The mapping is iterated for all maps in each map set (set of maps + separated by SEPARATOR) except in the case that lambda is + encountered. More precisely, the mapping proceeds as below: + + At first, VAL0 is set to reg[rrr], and it is translated by the + first map to VAL1. Then, VAL1 is translated by the next map to + VAL2. This mapping is iterated until the last map is used. The + result of the mapping is the last value of VAL?. + + But, when VALm is mapped to VALn and VALn is not a number, the + mapping proceed as below: + + If VALn is nil, the lastest map is ignored and the mapping of VALm + proceed to the next map. + + In VALn is t, VALm is reverted to reg[rrr] and the mapping of VALm + proceed to the next map. + + If VALn is lambda, the whole mapping process terminates, and VALm + is the result of this mapping. + + Each map is a Lisp vector of the following format (a) or (b): + (a)......[STARTPOINT VAL1 VAL2 ...] + (b)......[t VAL STARTPOINT ENDPOINT], + where + STARTPOINT is an offset to be used for indexing a map, + ENDPOINT is a maximum index number of a map, + VAL and VALn is a number, nil, t, or lambda. + + Valid index range of a map of type (a) is: + STARTPOINT <= index < STARTPOINT + map_size - 1 + Valid index range of a map of type (b) is: + STARTPOINT <= index < ENDPOINT */ + +#define CCL_MapMultiple 0x11 /* Mapping by multiple code conversion maps + 1:ExtendedCOMMNDXXXRRRrrrXXXXX + 2:N-2 + 3:SEPARATOR_1 (< 0) + 4:MAP-ID_1 + 5:MAP-ID_2 + ... + M:SEPARATOR_x (< 0) + M+1:MAP-ID_y + ... + N:SEPARATOR_z (< 0) + */ + +#define MAX_MAP_SET_LEVEL 20 + +typedef struct +{ + int rest_length; + int orig_val; +} tr_stack; + +static tr_stack mapping_stack[MAX_MAP_SET_LEVEL]; +static tr_stack *mapping_stack_pointer; +#endif + +#define PUSH_MAPPING_STACK(restlen, orig) \ +{ \ + mapping_stack_pointer->rest_length = (restlen); \ + mapping_stack_pointer->orig_val = (orig); \ + mapping_stack_pointer++; \ +} + +#define POP_MAPPING_STACK(restlen, orig) \ +{ \ + mapping_stack_pointer--; \ + (restlen) = mapping_stack_pointer->rest_length; \ + (orig) = mapping_stack_pointer->orig_val; \ +} \ + +#define CCL_MapSingle 0x12 /* Map by single code conversion map + 1:ExtendedCOMMNDXXXRRRrrrXXXXX + 2:MAP-ID + ------------------------------ + Map reg[rrr] by MAP-ID. + If some valid mapping is found, + set reg[rrr] to the result, + else + set reg[RRR] to -1. + */ /* CCL arithmetic/logical operators. */ #define CCL_PLUS 0x00 /* X = Y + Z */ @@ -423,18 +638,28 @@ #define CCL_GE 0x14 /* X = (X >= Y) */ #define CCL_NE 0x15 /* X = (X != Y) */ -#define CCL_ENCODE_SJIS 0x16 /* X = HIGHER_BYTE (SJIS (Y, Z)) +#define CCL_DECODE_SJIS 0x16 /* X = HIGHER_BYTE (DE-SJIS (Y, Z)) + r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */ +#define CCL_ENCODE_SJIS 0x17 /* X = HIGHER_BYTE (SJIS (Y, Z)) r[7] = LOWER_BYTE (SJIS (Y, Z) */ -#define CCL_DECODE_SJIS 0x17 /* X = HIGHER_BYTE (DE-SJIS (Y, Z)) - r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */ -/* Macros for exit status of CCL program. */ -#define CCL_STAT_SUCCESS 0 /* Terminated successfully. */ -#define CCL_STAT_SUSPEND 1 /* Terminated because of empty input - buffer or full output buffer. */ -#define CCL_STAT_INVALID_CMD 2 /* Terminated because of invalid - command. */ -#define CCL_STAT_QUIT 3 /* Terminated because of quit. */ +/* Suspend CCL program because of reading from empty input buffer or + writing to full output buffer. When this program is resumed, the + same I/O command is executed. The `if (1)' is for warning suppression. */ +#define CCL_SUSPEND(stat) \ + do { \ + ic--; \ + ccl->status = stat; \ + if (1) goto ccl_finish; \ + } while (0) + +/* Terminate CCL program because of invalid command. Should not occur + in the normal case. The `if (1)' is for warning suppression. */ +#define CCL_INVALID_CMD \ + do { \ + ccl->status = CCL_STAT_INVALID_CMD; \ + if (1) goto ccl_error_handler; \ + } while (0) /* Encode one character CH to multibyte form and write to the current output buffer. If CH is less than 256, CH is written as is. */ @@ -447,7 +672,8 @@ else \ { \ Bufbyte work[MAX_EMCHAR_LEN]; \ - int len = ( ch < 256 ) ? \ + int len = ( ch < ( conversion_mode == CCL_MODE_ENCODING ? \ + 256 : 128 ) ) ? \ simple_set_charptr_emchar (work, ch) : \ non_ascii_set_charptr_emchar (work, ch); \ Dynarr_add_many (destination, work, len); \ @@ -456,22 +682,32 @@ /* Write a string at ccl_prog[IC] of length LEN to the current output buffer. */ -#define CCL_WRITE_STRING(len) do { \ - if (!destination) \ - { \ - ccl->status = CCL_STAT_INVALID_CMD; \ - goto ccl_error_handler; \ - } \ - else \ - for (i = 0; i < len; i++) \ - Dynarr_add(destination, \ - (XINT (ccl_prog[ic + (i / 3)]) \ - >> ((2 - (i % 3)) * 8)) & 0xFF); \ +#define CCL_WRITE_STRING(len) do { \ + if (!destination) \ + { \ + ccl->status = CCL_STAT_INVALID_CMD; \ + goto ccl_error_handler; \ + } \ + else \ + { \ + Bufbyte work[MAX_EMCHAR_LEN]; \ + for (i = 0; i < len; i++) \ + { \ + int ch = (XINT (ccl_prog[ic + (i / 3)]) \ + >> ((2 - (i % 3)) * 8)) & 0xFF; \ + int bytes = \ + ( ch < ( conversion_mode == CCL_MODE_ENCODING ? \ + 256 : 128 ) ) ? \ + simple_set_charptr_emchar (work, ch) : \ + non_ascii_set_charptr_emchar (work, ch); \ + Dynarr_add_many (destination, work, bytes); \ + } \ + } \ } while (0) /* Read one byte from the current input buffer into Rth register. */ #define CCL_READ_CHAR(r) do { \ - if (!src) \ + if (!src && !ccl->last_block) \ { \ ccl->status = CCL_STAT_INVALID_CMD; \ goto ccl_error_handler; \ @@ -481,7 +717,7 @@ else if (ccl->last_block) \ { \ ic = ccl->eof_ic; \ - goto ccl_finish; \ + goto ccl_repeat; \ } \ else \ /* Suspend CCL program because of \ @@ -491,7 +727,7 @@ same I/O command is executed. */ \ { \ ic--; \ - ccl->status = CCL_STAT_SUSPEND; \ + ccl->status = CCL_STAT_SUSPEND_BY_SRC; \ goto ccl_finish; \ } \ } while (0) @@ -516,31 +752,41 @@ int ic; /* Instruction Counter. */ }; +/* For the moment, we only support depth 256 of stack. */ +static struct ccl_prog_stack ccl_prog_stack_struct[256]; + int -ccl_driver (struct ccl_program *ccl, CONST unsigned char *source, unsigned_char_dynarr *destination, int src_bytes, int *consumed) +ccl_driver (struct ccl_program *ccl, const unsigned char *source, + unsigned_char_dynarr *destination, int src_bytes, + int *consumed, int conversion_mode) { int *reg = ccl->reg; int ic = ccl->ic; int code = -1; /* init to illegal value, */ int field1, field2; Lisp_Object *ccl_prog = ccl->prog; - CONST unsigned char *src = source, *src_end = src + src_bytes; + const unsigned char *src = source, *src_end = src + src_bytes; int jump_address = 0; /* shut up the compiler */ - int i, j, op; - int stack_idx = 0; - /* For the moment, we only support depth 256 of stack. */ - struct ccl_prog_stack ccl_prog_stack_struct[256]; + int stack_idx = ccl->stack_idx; + /* Instruction counter of the current CCL code. */ + int this_ic = 0; if (ic >= ccl->eof_ic) ic = CCL_HEADER_MAIN; +#if 0 /* not for XEmacs ? */ + if (ccl->buf_magnification ==0) /* We can't produce any bytes. */ + dst = NULL; +#endif + #ifdef CCL_DEBUG ccl_backtrace_idx = 0; #endif for (;;) { + ccl_repeat: #ifdef CCL_DEBUG ccl_backtrace_table[ccl_backtrace_idx++] = ic; if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN) @@ -559,6 +805,7 @@ break; } + this_ic = ic; code = XINT (ccl_prog[ic]); ic++; field1 = code >> 8; field2 = (code & 0xFF) >> 5; @@ -567,6 +814,7 @@ #define RRR (field1 & 7) #define Rrr ((field1 >> 3) & 7) #define ADDR field1 +#define EXCMD (field1 >> 6) switch (code & 0x1F) { @@ -756,9 +1004,13 @@ ic = ccl_prog_stack_struct[stack_idx].ic; break; } + if (src) + src = src_end; + /* ccl->ic should points to this command code again to + suppress further processing. */ + ic--; /* Terminate CCL program successfully. */ ccl->status = CCL_STAT_SUCCESS; - ccl->ic = CCL_HEADER_MAIN; goto ccl_finish; case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */ @@ -856,8 +1108,8 @@ case CCL_LE: reg[rrr] = i <= j; break; case CCL_GE: reg[rrr] = i >= j; break; case CCL_NE: reg[rrr] = i != j; break; + case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break; case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break; - case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break; default: ccl->status = CCL_STAT_INVALID_CMD; goto ccl_error_handler; @@ -872,6 +1124,463 @@ ic = jump_address; break; + case CCL_Extension: + switch (EXCMD) + { + case CCL_ReadMultibyteChar2: + if (!src) + CCL_INVALID_CMD; + + do { + if (src >= src_end) + { + src++; + goto ccl_read_multibyte_character_suspend; + } + + i = *src++; +#if 0 + if (i == LEADING_CODE_COMPOSITION) + { + if (src >= src_end) + goto ccl_read_multibyte_character_suspend; + if (*src == 0xFF) + { + ccl->private_state = COMPOSING_WITH_RULE_HEAD; + src++; + } + else + ccl->private_state = COMPOSING_NO_RULE_HEAD; + + continue; + } + if (ccl->private_state != COMPOSING_NO) + { + /* composite character */ + if (i < 0xA0) + ccl->private_state = COMPOSING_NO; + else + { + if (COMPOSING_WITH_RULE_RULE == ccl->private_state) + { + ccl->private_state = COMPOSING_WITH_RULE_HEAD; + continue; + } + else if (COMPOSING_WITH_RULE_HEAD == ccl->private_state) + ccl->private_state = COMPOSING_WITH_RULE_RULE; + + if (i == 0xA0) + { + if (src >= src_end) + goto ccl_read_multibyte_character_suspend; + i = *src++ & 0x7F; + } + else + i -= 0x20; + } + } +#endif + + if (i < 0x80) + { + /* ASCII */ + reg[rrr] = i; + reg[RRR] = LEADING_BYTE_ASCII; + } + else if (i <= MAX_LEADING_BYTE_OFFICIAL_1) + { + if (src >= src_end) + goto ccl_read_multibyte_character_suspend; + reg[RRR] = i; + reg[rrr] = (*src++ & 0x7F); + } + else if (i <= MAX_LEADING_BYTE_OFFICIAL_2) + { + if ((src + 1) >= src_end) + goto ccl_read_multibyte_character_suspend; + reg[RRR] = i; + i = (*src++ & 0x7F); + reg[rrr] = ((i << 7) | (*src & 0x7F)); + src++; + } + else if (i == PRE_LEADING_BYTE_PRIVATE_1) + { + if ((src + 1) >= src_end) + goto ccl_read_multibyte_character_suspend; + reg[RRR] = *src++; + reg[rrr] = (*src++ & 0x7F); + } + else if (i == PRE_LEADING_BYTE_PRIVATE_2) + { + if ((src + 2) >= src_end) + goto ccl_read_multibyte_character_suspend; + reg[RRR] = *src++; + i = (*src++ & 0x7F); + reg[rrr] = ((i << 7) | (*src & 0x7F)); + src++; + } + else + { + /* INVALID CODE. Return a single byte character. */ + reg[RRR] = LEADING_BYTE_ASCII; + reg[rrr] = i; + } + break; + } while (1); + break; + + ccl_read_multibyte_character_suspend: + src--; + if (ccl->last_block) + { + ic = ccl->eof_ic; + goto ccl_repeat; + } + else + CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); + + break; + + case CCL_WriteMultibyteChar2: + i = reg[RRR]; /* charset */ + if (i == LEADING_BYTE_ASCII) + i = reg[rrr] & 0xFF; +#if 0 + else if (i == CHARSET_COMPOSITION) + i = MAKE_COMPOSITE_CHAR (reg[rrr]); +#endif + else if (XCHARSET_DIMENSION (CHARSET_BY_LEADING_BYTE (i)) == 1) + i = ((i - FIELD2_TO_OFFICIAL_LEADING_BYTE) << 7) + | (reg[rrr] & 0x7F); + else if (i < MIN_LEADING_BYTE_OFFICIAL_2) + i = ((i - FIELD1_TO_OFFICIAL_LEADING_BYTE) << 14) | reg[rrr]; + else + i = ((i - FIELD1_TO_PRIVATE_LEADING_BYTE) << 14) | reg[rrr]; + + CCL_WRITE_CHAR (i); + + break; + +#if 0 + case CCL_TranslateCharacter: + i = reg[RRR]; /* charset */ + if (i == LEADING_BYTE_ASCII) + i = reg[rrr]; + else if (i == CHARSET_COMPOSITION) + { + reg[RRR] = -1; + break; + } + else if (CHARSET_DIMENSION (i) == 1) + i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F); + else if (i < MIN_LEADING_BYTE_OFFICIAL_2) + i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF); + else + i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF); + + op = translate_char (GET_TRANSLATION_TABLE (reg[Rrr]), + i, -1, 0, 0); + SPLIT_CHAR (op, reg[RRR], i, j); + if (j != -1) + i = (i << 7) | j; + + reg[rrr] = i; + break; + + case CCL_TranslateCharacterConstTbl: + op = XINT (ccl_prog[ic]); /* table */ + ic++; + i = reg[RRR]; /* charset */ + if (i == LEADING_BYTE_ASCII) + i = reg[rrr]; + else if (i == CHARSET_COMPOSITION) + { + reg[RRR] = -1; + break; + } + else if (CHARSET_DIMENSION (i) == 1) + i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F); + else if (i < MIN_LEADING_BYTE_OFFICIAL_2) + i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF); + else + i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF); + + op = translate_char (GET_TRANSLATION_TABLE (op), i, -1, 0, 0); + SPLIT_CHAR (op, reg[RRR], i, j); + if (j != -1) + i = (i << 7) | j; + + reg[rrr] = i; + break; + + case CCL_IterateMultipleMap: + { + Lisp_Object map, content, attrib, value; + int point, size, fin_ic; + + j = XINT (ccl_prog[ic++]); /* number of maps. */ + fin_ic = ic + j; + op = reg[rrr]; + if ((j > reg[RRR]) && (j >= 0)) + { + ic += reg[RRR]; + i = reg[RRR]; + } + else + { + reg[RRR] = -1; + ic = fin_ic; + break; + } + + for (;i < j;i++) + { + + size = XVECTOR (Vcode_conversion_map_vector)->size; + point = XINT (ccl_prog[ic++]); + if (point >= size) continue; + map = + XVECTOR (Vcode_conversion_map_vector)->contents[point]; + + /* Check map varidity. */ + if (!CONSP (map)) continue; + map = XCONS(map)->cdr; + if (!VECTORP (map)) continue; + size = XVECTOR (map)->size; + if (size <= 1) continue; + + content = XVECTOR (map)->contents[0]; + + /* check map type, + [STARTPOINT VAL1 VAL2 ...] or + [t ELELMENT STARTPOINT ENDPOINT] */ + if (NUMBERP (content)) + { + point = XUINT (content); + point = op - point + 1; + if (!((point >= 1) && (point < size))) continue; + content = XVECTOR (map)->contents[point]; + } + else if (EQ (content, Qt)) + { + if (size != 4) continue; + if ((op >= XUINT (XVECTOR (map)->contents[2])) + && (op < XUINT (XVECTOR (map)->contents[3]))) + content = XVECTOR (map)->contents[1]; + else + continue; + } + else + continue; + + if (NILP (content)) + continue; + else if (NUMBERP (content)) + { + reg[RRR] = i; + reg[rrr] = XINT(content); + break; + } + else if (EQ (content, Qt) || EQ (content, Qlambda)) + { + reg[RRR] = i; + break; + } + else if (CONSP (content)) + { + attrib = XCONS (content)->car; + value = XCONS (content)->cdr; + if (!NUMBERP (attrib) || !NUMBERP (value)) + continue; + reg[RRR] = i; + reg[rrr] = XUINT (value); + break; + } + } + if (i == j) + reg[RRR] = -1; + ic = fin_ic; + } + break; + + case CCL_MapMultiple: + { + Lisp_Object map, content, attrib, value; + int point, size, map_vector_size; + int map_set_rest_length, fin_ic; + + map_set_rest_length = + XINT (ccl_prog[ic++]); /* number of maps and separators. */ + fin_ic = ic + map_set_rest_length; + if ((map_set_rest_length > reg[RRR]) && (reg[RRR] >= 0)) + { + ic += reg[RRR]; + i = reg[RRR]; + map_set_rest_length -= i; + } + else + { + ic = fin_ic; + reg[RRR] = -1; + break; + } + mapping_stack_pointer = mapping_stack; + op = reg[rrr]; + PUSH_MAPPING_STACK (0, op); + reg[RRR] = -1; + map_vector_size = XVECTOR (Vcode_conversion_map_vector)->size; + for (;map_set_rest_length > 0;i++, map_set_rest_length--) + { + point = XINT(ccl_prog[ic++]); + if (point < 0) + { + point = -point; + if (mapping_stack_pointer + >= &mapping_stack[MAX_MAP_SET_LEVEL]) + { + CCL_INVALID_CMD; + } + PUSH_MAPPING_STACK (map_set_rest_length - point, + reg[rrr]); + map_set_rest_length = point + 1; + reg[rrr] = op; + continue; + } + + if (point >= map_vector_size) continue; + map = (XVECTOR (Vcode_conversion_map_vector) + ->contents[point]); + + /* Check map varidity. */ + if (!CONSP (map)) continue; + map = XCONS (map)->cdr; + if (!VECTORP (map)) continue; + size = XVECTOR (map)->size; + if (size <= 1) continue; + + content = XVECTOR (map)->contents[0]; + + /* check map type, + [STARTPOINT VAL1 VAL2 ...] or + [t ELEMENT STARTPOINT ENDPOINT] */ + if (NUMBERP (content)) + { + point = XUINT (content); + point = op - point + 1; + if (!((point >= 1) && (point < size))) continue; + content = XVECTOR (map)->contents[point]; + } + else if (EQ (content, Qt)) + { + if (size != 4) continue; + if ((op >= XUINT (XVECTOR (map)->contents[2])) && + (op < XUINT (XVECTOR (map)->contents[3]))) + content = XVECTOR (map)->contents[1]; + else + continue; + } + else + continue; + + if (NILP (content)) + continue; + else if (NUMBERP (content)) + { + op = XINT (content); + reg[RRR] = i; + i += map_set_rest_length; + POP_MAPPING_STACK (map_set_rest_length, reg[rrr]); + } + else if (CONSP (content)) + { + attrib = XCONS (content)->car; + value = XCONS (content)->cdr; + if (!NUMBERP (attrib) || !NUMBERP (value)) + continue; + reg[RRR] = i; + op = XUINT (value); + i += map_set_rest_length; + POP_MAPPING_STACK (map_set_rest_length, reg[rrr]); + } + else if (EQ (content, Qt)) + { + reg[RRR] = i; + op = reg[rrr]; + i += map_set_rest_length; + POP_MAPPING_STACK (map_set_rest_length, reg[rrr]); + } + else if (EQ (content, Qlambda)) + { + break; + } + else + CCL_INVALID_CMD; + } + ic = fin_ic; + } + reg[rrr] = op; + break; + + case CCL_MapSingle: + { + Lisp_Object map, attrib, value, content; + int size, point; + j = XINT (ccl_prog[ic++]); /* map_id */ + op = reg[rrr]; + if (j >= XVECTOR (Vcode_conversion_map_vector)->size) + { + reg[RRR] = -1; + break; + } + map = XVECTOR (Vcode_conversion_map_vector)->contents[j]; + if (!CONSP (map)) + { + reg[RRR] = -1; + break; + } + map = XCONS(map)->cdr; + if (!VECTORP (map)) + { + reg[RRR] = -1; + break; + } + size = XVECTOR (map)->size; + point = XUINT (XVECTOR (map)->contents[0]); + point = op - point + 1; + reg[RRR] = 0; + if ((size <= 1) || + (!((point >= 1) && (point < size)))) + reg[RRR] = -1; + else + { + content = XVECTOR (map)->contents[point]; + if (NILP (content)) + reg[RRR] = -1; + else if (NUMBERP (content)) + reg[rrr] = XINT (content); + else if (EQ (content, Qt)) + reg[RRR] = i; + else if (CONSP (content)) + { + attrib = XCONS (content)->car; + value = XCONS (content)->cdr; + if (!NUMBERP (attrib) || !NUMBERP (value)) + continue; + reg[rrr] = XUINT(value); + break; + } + else + reg[RRR] = -1; + } + } + break; +#endif + + default: + CCL_INVALID_CMD; + } + break; + default: ccl->status = CCL_STAT_INVALID_CMD; goto ccl_error_handler; @@ -886,13 +1595,18 @@ there. */ char msg[256]; +#if 0 /* not for XEmacs ? */ + if (!dst) + dst = destination; +#endif + switch (ccl->status) { /* Terminate CCL program because of invalid command. Should not occur in the normal case. */ case CCL_STAT_INVALID_CMD: sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.", - code & 0x1F, code, ic); + code & 0x1F, code, this_ic); #ifdef CCL_DEBUG { int i = ccl_backtrace_idx - 1; @@ -908,9 +1622,10 @@ sprintf(msg, " %d", ccl_backtrace_table[i]); Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg)); } + goto ccl_finish; } #endif - goto ccl_finish; + break; case CCL_STAT_QUIT: sprintf(msg, "\nCCL: Quited."); @@ -925,6 +1640,8 @@ ccl_finish: ccl->ic = ic; + ccl->stack_idx = stack_idx; + ccl->prog = ccl_prog; if (consumed) *consumed = src - source; if (destination) return Dynarr_length (destination); @@ -933,31 +1650,91 @@ } /* Setup fields of the structure pointed by CCL appropriately for the - execution of compiled CCL code in VEC (vector of integer). */ + execution of compiled CCL code in VEC (vector of integer). + If VEC is nil, we skip setting ups based on VEC. */ void setup_ccl_program (struct ccl_program *ccl, Lisp_Object vec) { int i; - ccl->size = XVECTOR_LENGTH (vec); - ccl->prog = XVECTOR_DATA (vec); + if (VECTORP (vec)) + { + ccl->size = XVECTOR_LENGTH (vec); + ccl->prog = XVECTOR_DATA (vec); + ccl->eof_ic = XINT (XVECTOR_DATA (vec)[CCL_HEADER_EOF]); + ccl->buf_magnification = XINT (XVECTOR_DATA (vec)[CCL_HEADER_BUF_MAG]); + } ccl->ic = CCL_HEADER_MAIN; - ccl->eof_ic = XINT (XVECTOR_DATA (vec)[CCL_HEADER_EOF]); - ccl->buf_magnification = XINT (XVECTOR_DATA (vec)[CCL_HEADER_BUF_MAG]); for (i = 0; i < 8; i++) ccl->reg[i] = 0; ccl->last_block = 0; + ccl->private_state = 0; ccl->status = 0; + ccl->stack_idx = 0; } +/* Resolve symbols in the specified CCL code (Lisp vector). This + function converts symbols of code conversion maps and character + translation tables embeded in the CCL code into their ID numbers. */ + +static Lisp_Object +resolve_symbol_ccl_program (Lisp_Object ccl) +{ + int i, veclen; + Lisp_Object result, contents /*, prop */; + + result = ccl; + veclen = XVECTOR_LENGTH (result); + + /* Set CCL program's table ID */ + for (i = 0; i < veclen; i++) + { + contents = XVECTOR_DATA (result)[i]; + if (SYMBOLP (contents)) + { + if (EQ(result, ccl)) + result = Fcopy_sequence (ccl); + +#if 0 + prop = Fget (contents, Qtranslation_table_id); + if (NUMBERP (prop)) + { + XVECTOR_DATA (result)[i] = prop; + continue; + } + prop = Fget (contents, Qcode_conversion_map_id); + if (NUMBERP (prop)) + { + XVECTOR_DATA (result)[i] = prop; + continue; + } + prop = Fget (contents, Qccl_program_idx); + if (NUMBERP (prop)) + { + XVECTOR_DATA (result)[i] = prop; + continue; + } +#endif + } + } + + return result; +} + + #ifdef emacs DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /* Execute CCL-PROGRAM with registers initialized by REGISTERS. -CCL-PROGRAM is a compiled code generated by `ccl-compile', - no I/O commands should appear in the CCL program. + +CCL-PROGRAM is a symbol registered by register-ccl-program, +or a compiled code generated by `ccl-compile' (for backward compatibility, +in this case, the execution is slower). +No I/O commands should appear in CCL-PROGRAM. + REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value of Nth register. + As side effect, each element of REGISTER holds the value of corresponding register after the execution. */ @@ -965,11 +1742,25 @@ { struct ccl_program ccl; int i; + Lisp_Object ccl_id; - CHECK_VECTOR (ccl_prog); + if (SYMBOLP (ccl_prog) && + !NILP (ccl_id = Fget (ccl_prog, Qccl_program_idx, Qnil))) + { + ccl_prog = XVECTOR_DATA (Vccl_program_table)[XUINT (ccl_id)]; + CHECK_LIST (ccl_prog); + ccl_prog = XCDR (ccl_prog); + CHECK_VECTOR (ccl_prog); + } + else + { + CHECK_VECTOR (ccl_prog); + ccl_prog = resolve_symbol_ccl_program (ccl_prog); + } + CHECK_VECTOR (reg); if (XVECTOR_LENGTH (reg) != 8) - signal_simple_error ("Vector should be of length 8", reg); + error ("Invalid length of vector REGISTERS"); setup_ccl_program (&ccl, ccl_prog); for (i = 0; i < 8; i++) @@ -977,8 +1768,8 @@ ? XINT (XVECTOR_DATA (reg)[i]) : 0); - ccl_driver (&ccl, (CONST unsigned char *)0, (unsigned_char_dynarr *)0, - 0, (int *)0); + ccl_driver (&ccl, (const unsigned char *)0, (unsigned_char_dynarr *)0, + 0, (int *)0, CCL_MODE_ENCODING); QUIT; if (ccl.status != CCL_STAT_SUCCESS) error ("Error in CCL program at %dth code", ccl.ic); @@ -990,18 +1781,26 @@ DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, 3, 4, 0, /* Execute CCL-PROGRAM with initial STATUS on STRING. -CCL-PROGRAM is a compiled code generated by `ccl-compile'. + +CCL-PROGRAM is a symbol registered by register-ccl-program, +or a compiled code generated by `ccl-compile' (for backward compatibility, +in this case, the execution is slower). + Read buffer is set to STRING, and write buffer is allocated automatically. + +If IC is nil, it is initialized to head of the CCL program.\n\ STATUS is a vector of [R0 R1 ... R7 IC], where R0..R7 are initial values of corresponding registers, IC is the instruction counter specifying from where to start the program. If R0..R7 are nil, they are initialized to 0. If IC is nil, it is initialized to head of the CCL program. -Returns the contents of write buffer as a string, - and as side effect, STATUS is updated. + If optional 4th arg CONTINUE is non-nil, keep IC on read operation when read buffer is exausted, else, IC is always set to the end of CCL-PROGRAM on exit. + +It returns the contents of write buffer as a string, + and as side effect, STATUS is updated. */ (ccl_prog, status, str, contin)) { @@ -1010,8 +1809,22 @@ int i, produced; unsigned_char_dynarr *outbuf; struct gcpro gcpro1, gcpro2, gcpro3; + Lisp_Object ccl_id; - CHECK_VECTOR (ccl_prog); + if (SYMBOLP (ccl_prog) && + !NILP (ccl_id = Fget (ccl_prog, Qccl_program_idx, Qnil))) + { + ccl_prog = XVECTOR (Vccl_program_table)->contents[XUINT (ccl_id)]; + CHECK_LIST (ccl_prog); + ccl_prog = XCDR (ccl_prog); + CHECK_VECTOR (ccl_prog); + } + else + { + CHECK_VECTOR (ccl_prog); + ccl_prog = resolve_symbol_ccl_program (ccl_prog); + } + CHECK_VECTOR (status); if (XVECTOR_LENGTH (status) != 9) signal_simple_error ("Vector should be of length 9", status); @@ -1035,7 +1848,7 @@ outbuf = Dynarr_new (unsigned_char); ccl.last_block = NILP (contin); produced = ccl_driver (&ccl, XSTRING_DATA (str), outbuf, - XSTRING_LENGTH (str), (int *)0); + XSTRING_LENGTH (str), (int *)0, CCL_MODE_DECODING); for (i = 0; i < 8; i++) XVECTOR_DATA (status)[i] = make_int(ccl.reg[i]); XSETINT (XVECTOR_DATA (status)[8], ccl.ic); @@ -1045,7 +1858,8 @@ Dynarr_free (outbuf); QUIT; if (ccl.status != CCL_STAT_SUCCESS - && ccl.status != CCL_STAT_SUSPEND) + && ccl.status != CCL_STAT_SUSPEND_BY_SRC + && ccl.status != CCL_STAT_SUSPEND_BY_DST) error ("Error in CCL program at %dth code", ccl.ic); return val; @@ -1063,7 +1877,10 @@ CHECK_SYMBOL (name); if (!NILP (ccl_prog)) - CHECK_VECTOR (ccl_prog); + { + CHECK_VECTOR (ccl_prog); + ccl_prog = resolve_symbol_ccl_program (ccl_prog); + } for (i = 0; i < len; i++) { @@ -1091,15 +1908,107 @@ } XVECTOR_DATA (Vccl_program_table)[i] = Fcons (name, ccl_prog); + Fput (name, Qccl_program_idx, make_int (i)); return make_int (i); } +#if 0 +/* Register code conversion map. + A code conversion map consists of numbers, Qt, Qnil, and Qlambda. + The first element is start code point. + The rest elements are mapped numbers. + Symbol t means to map to an original number before mapping. + Symbol nil means that the corresponding element is empty. + Symbol lambda menas to terminate mapping here. +*/ + +DEFUN ("register-code-conversion-map", Fregister_code_conversion_map, + Sregister_code_conversion_map, + 2, 2, 0, + "Register SYMBOL as code conversion map MAP.\n\ +Return index number of the registered map.") + (symbol, map) + Lisp_Object symbol, map; +{ + int len = XVECTOR (Vcode_conversion_map_vector)->size; + int i; + Lisp_Object index; + + CHECK_SYMBOL (symbol, 0); + CHECK_VECTOR (map, 1); + + for (i = 0; i < len; i++) + { + Lisp_Object slot = XVECTOR (Vcode_conversion_map_vector)->contents[i]; + + if (!CONSP (slot)) + break; + + if (EQ (symbol, XCONS (slot)->car)) + { + index = make_int (i); + XCONS (slot)->cdr = map; + Fput (symbol, Qcode_conversion_map, map); + Fput (symbol, Qcode_conversion_map_id, index); + return index; + } + } + + if (i == len) + { + Lisp_Object new_vector = Fmake_vector (make_int (len * 2), Qnil); + int j; + + for (j = 0; j < len; j++) + XVECTOR (new_vector)->contents[j] + = XVECTOR (Vcode_conversion_map_vector)->contents[j]; + Vcode_conversion_map_vector = new_vector; + } + + index = make_int (i); + Fput (symbol, Qcode_conversion_map, map); + Fput (symbol, Qcode_conversion_map_id, index); + XVECTOR (Vcode_conversion_map_vector)->contents[i] = Fcons (symbol, map); + return index; +} +#endif + + void syms_of_mule_ccl (void) { + DEFSUBR (Fccl_execute); + DEFSUBR (Fccl_execute_on_string); + DEFSUBR (Fregister_ccl_program); +#if 0 + DEFSUBR (&Fregister_code_conversion_map); +#endif +} + +void +vars_of_mule_ccl (void) +{ staticpro (&Vccl_program_table); Vccl_program_table = Fmake_vector (make_int (32), Qnil); + Qccl_program = intern ("ccl-program"); + staticpro (&Qccl_program); + + Qccl_program_idx = intern ("ccl-program-idx"); + staticpro (&Qccl_program_idx); + +#if 0 + Qcode_conversion_map = intern ("code-conversion-map"); + staticpro (&Qcode_conversion_map); + + Qcode_conversion_map_id = intern ("code-conversion-map-id"); + staticpro (&Qcode_conversion_map_id); + + DEFVAR_LISP ("code-conversion-map-vector", &Vcode_conversion_map_vector /* +Vector of code conversion maps.*/ ); + Vcode_conversion_map_vector = Fmake_vector (make_int (16), Qnil); +#endif + DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /* Alist of fontname patterns vs corresponding CCL program. Each element looks like (REGEXP . CCL-CODE), @@ -1113,10 +2022,6 @@ If the font is single-byte font, the register R2 is not used. */ ); Vfont_ccl_encoder_alist = Qnil; - - DEFSUBR (Fccl_execute); - DEFSUBR (Fccl_execute_on_string); - DEFSUBR (Fregister_ccl_program); } #endif /* emacs */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/mule-ccl.h --- a/src/mule-ccl.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/mule-ccl.h Mon Aug 13 11:13:30 2007 +0200 @@ -1,5 +1,5 @@ /* Header for CCL (Code Conversion Language) interpreter. - Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. + Copyright (C) 1995,1999 Electrotechnical Laboratory, JAPAN. Licensed to the Free Software Foundation. This file is part of XEmacs. @@ -19,10 +19,18 @@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -/* Synched up with: FSF Emacs 20.2 */ +/* Synched up with: FSF Emacs 20.3.10 */ + +#ifndef INCLUDED_mule_ccl_h_ +#define INCLUDED_mule_ccl_h_ -#ifndef _CCL_H -#define _CCL_H +/* Macros for exit status of CCL program. */ +#define CCL_STAT_SUCCESS 0 /* Terminated successfully. */ +#define CCL_STAT_SUSPEND_BY_SRC 1 /* Terminated by empty input. */ +#define CCL_STAT_SUSPEND_BY_DST 2 /* Terminated by output buffer full. */ +#define CCL_STAT_INVALID_CMD 3 /* Terminated because of invalid + command. */ +#define CCL_STAT_QUIT 4 /* Terminated because of quit. */ /* Structure to hold information about running CCL code. Read comments in the file ccl.c for the detail of each field. */ @@ -35,19 +43,31 @@ int reg[8]; /* CCL registers, reg[7] is used for condition flag of relational operations. */ + int private_state; /* CCL instruction may use this + for private use, mainly for preservation + internal states for suspending. + This variable is set to 0 when ccl is + set up. */ int last_block; /* Set to 1 while processing the last block. */ int status; /* Exit status of the CCL program. */ int buf_magnification; /* Output buffer magnification. How many times bigger the output buffer should be than the input buffer. */ + int stack_idx; /* How deep the call of CCL_Call is nested. */ }; -int ccl_driver (struct ccl_program *ccl, CONST unsigned char *source, - unsigned_char_dynarr *destination, int src_bytes, int *consumed); + +#define CCL_MODE_ENCODING 0 +#define CCL_MODE_DECODING 1 + +int ccl_driver (struct ccl_program *ccl, const unsigned char *source, + unsigned_char_dynarr *destination, int src_bytes, + int *consumed, int conversion_mode); void setup_ccl_program (struct ccl_program *ccl, Lisp_Object val); /* Alist of fontname patterns vs corresponding CCL program. */ extern Lisp_Object Vfont_ccl_encoder_alist; +extern Lisp_Object Qccl_program; -#endif /* _CCL_H */ +#endif /* INCLUDED_mule_ccl_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/mule-charset.c --- a/src/mule-charset.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/mule-charset.c Mon Aug 13 11:13:30 2007 +0200 @@ -19,7 +19,7 @@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -/* Synched up with: Mule 2.3. Not in FSF. */ +/* Synched up with: FSF 20.3. Not in FSF. */ /* Rewritten by Ben Wing <ben@xemacs.org>. */ @@ -32,6 +32,7 @@ #include "lstream.h" #include "device.h" #include "faces.h" +#include "mule-ccl.h" /* The various pre-defined charsets. */ @@ -41,23 +42,23 @@ Lisp_Object Vcharset_latin_iso8859_2; Lisp_Object Vcharset_latin_iso8859_3; Lisp_Object Vcharset_latin_iso8859_4; -Lisp_Object Vcharset_cyrillic_iso8859_5; -Lisp_Object Vcharset_arabic_iso8859_6; +Lisp_Object Vcharset_thai_tis620; Lisp_Object Vcharset_greek_iso8859_7; +Lisp_Object Vcharset_arabic_iso8859_6; Lisp_Object Vcharset_hebrew_iso8859_8; -Lisp_Object Vcharset_latin_iso8859_9; -Lisp_Object Vcharset_thai_tis620; Lisp_Object Vcharset_katakana_jisx0201; Lisp_Object Vcharset_latin_jisx0201; +Lisp_Object Vcharset_cyrillic_iso8859_5; +Lisp_Object Vcharset_latin_iso8859_9; Lisp_Object Vcharset_japanese_jisx0208_1978; +Lisp_Object Vcharset_chinese_gb2312; Lisp_Object Vcharset_japanese_jisx0208; +Lisp_Object Vcharset_korean_ksc5601; Lisp_Object Vcharset_japanese_jisx0212; -Lisp_Object Vcharset_chinese_gb2312; +Lisp_Object Vcharset_chinese_cns11643_1; +Lisp_Object Vcharset_chinese_cns11643_2; Lisp_Object Vcharset_chinese_big5_1; Lisp_Object Vcharset_chinese_big5_2; -Lisp_Object Vcharset_chinese_cns11643_1; -Lisp_Object Vcharset_chinese_cns11643_2; -Lisp_Object Vcharset_korean_ksc5601; #ifdef ENABLE_COMPOSITE_CHARS Lisp_Object Vcharset_composite; @@ -73,11 +74,17 @@ #endif /* ENABLE_COMPOSITE_CHARS */ -/* Table of charsets indexed by leading byte. */ -Lisp_Object charset_by_leading_byte[128]; +struct charset_lookup *chlook; -/* Table of charsets indexed by type/final-byte/direction. */ -Lisp_Object charset_by_attributes[4][128][2]; +static const struct lrecord_description charset_lookup_description_1[] = { + { XD_LISP_OBJECT_ARRAY, offsetof (struct charset_lookup, charset_by_leading_byte), 128+4*128*2 }, + { XD_END } +}; + +static const struct struct_description charset_lookup_description = { + sizeof (struct charset_lookup), + charset_lookup_description_1 +}; /* Table of number of bytes in the string representation of a character indexed by the first byte of that representation. @@ -85,9 +92,9 @@ rep_bytes_by_first_byte(c) is more efficient than the equivalent canonical computation: - (BYTE_ASCII_P (c) ? 1 : XCHARSET_REP_BYTES (CHARSET_BY_LEADING_BYTE (c))) */ + XCHARSET_REP_BYTES (CHARSET_BY_LEADING_BYTE (c)) */ -Bytecount rep_bytes_by_first_byte[0xA0] = +const Bytecount rep_bytes_by_first_byte[0xA0] = { /* 0x00 - 0x7f are for straight ASCII */ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, @@ -111,33 +118,33 @@ Lisp_Object Qregistry, Qfinal, Qgraphic; Lisp_Object Qdirection; Lisp_Object Qreverse_direction_charset; -Lisp_Object Qccl_program; Lisp_Object Qleading_byte; +Lisp_Object Qshort_name, Qlong_name; -Lisp_Object Qascii, Qcontrol_1, - +Lisp_Object Qascii, + Qcontrol_1, Qlatin_iso8859_1, Qlatin_iso8859_2, Qlatin_iso8859_3, Qlatin_iso8859_4, - Qcyrillic_iso8859_5, + Qthai_tis620, + Qgreek_iso8859_7, Qarabic_iso8859_6, - Qgreek_iso8859_7, Qhebrew_iso8859_8, + Qkatakana_jisx0201, + Qlatin_jisx0201, + Qcyrillic_iso8859_5, Qlatin_iso8859_9, - - Qthai_tis620, - - Qkatakana_jisx0201, Qlatin_jisx0201, Qjapanese_jisx0208_1978, + Qchinese_gb2312, Qjapanese_jisx0208, + Qkorean_ksc5601, Qjapanese_jisx0212, - - Qchinese_gb2312, - Qchinese_big5_1, Qchinese_big5_2, - Qchinese_cns11643_1, Qchinese_cns11643_2, - - Qkorean_ksc5601, Qcomposite; + Qchinese_cns11643_1, + Qchinese_cns11643_2, + Qchinese_big5_1, + Qchinese_big5_2, + Qcomposite; Lisp_Object Ql2r, Qr2l; @@ -213,7 +220,7 @@ Use the macro charptr_emchar() instead. */ Emchar -non_ascii_charptr_emchar (CONST Bufbyte *str) +non_ascii_charptr_emchar (const Bufbyte *str) { Bufbyte i0 = *str, i1, i2 = 0; Lisp_Object charset; @@ -260,7 +267,8 @@ if (f3 < 0x20) return 0; - if (f3 != 0x20 && f3 != 0x7F) + if (f3 != 0x20 && f3 != 0x7F && !(f2 >= MIN_CHAR_FIELD2_PRIVATE && + f2 <= MAX_CHAR_FIELD2_PRIVATE)) return 1; /* @@ -269,6 +277,8 @@ FIELD2_TO_PRIVATE_LEADING_BYTE are the same. */ charset = CHARSET_BY_LEADING_BYTE (f2 + FIELD2_TO_OFFICIAL_LEADING_BYTE); + if (EQ (charset, Qnil)) + return 0; return (XCHARSET_CHARS (charset) == 96); } else @@ -293,7 +303,8 @@ } #endif /* ENABLE_COMPOSITE_CHARS */ - if (f2 != 0x20 && f2 != 0x7F && f3 != 0x20 && f3 != 0x7F) + if (f2 != 0x20 && f2 != 0x7F && f3 != 0x20 && f3 != 0x7F + && !(f1 >= MIN_CHAR_FIELD1_PRIVATE && f1 <= MAX_CHAR_FIELD1_PRIVATE)) return 1; if (f1 <= MAX_CHAR_FIELD1_OFFICIAL) @@ -303,6 +314,8 @@ charset = CHARSET_BY_LEADING_BYTE (f1 + FIELD1_TO_PRIVATE_LEADING_BYTE); + if (EQ (charset, Qnil)) + return 0; return (XCHARSET_CHARS (charset) == 96); } } @@ -317,7 +330,7 @@ charptr_copy_char() instead. */ Bytecount -non_ascii_charptr_copy_char (CONST Bufbyte *ptr, Bufbyte *str) +non_ascii_charptr_copy_char (const Bufbyte *ptr, Bufbyte *str) { Bufbyte *strptr = str; *strptr = *ptr++; @@ -394,20 +407,22 @@ /************************************************************************/ static Lisp_Object -mark_charset (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_charset (Lisp_Object obj) { - struct Lisp_Charset *cs = XCHARSET (obj); + Lisp_Charset *cs = XCHARSET (obj); - markobj (cs->doc_string); - markobj (cs->registry); - markobj (cs->ccl_program); + mark_object (cs->short_name); + mark_object (cs->long_name); + mark_object (cs->doc_string); + mark_object (cs->registry); + mark_object (cs->ccl_program); return cs->name; } static void print_charset (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { - struct Lisp_Charset *cs = XCHARSET (obj); + Lisp_Charset *cs = XCHARSET (obj); char buf[200]; if (print_readably) @@ -418,6 +433,10 @@ write_c_string ("#<charset ", printcharfun); print_internal (CHARSET_NAME (cs), printcharfun, 0); write_c_string (" ", printcharfun); + print_internal (CHARSET_SHORT_NAME (cs), printcharfun, 1); + write_c_string (" ", printcharfun); + print_internal (CHARSET_LONG_NAME (cs), printcharfun, 1); + write_c_string (" ", printcharfun); print_internal (CHARSET_DOC_STRING (cs), printcharfun, 1); sprintf (buf, " %s %s cols=%d g%d final='%c' reg=", CHARSET_TYPE (cs) == CHARSET_TYPE_94 ? "94" : @@ -434,25 +453,40 @@ write_c_string (buf, printcharfun); } +static const struct lrecord_description charset_description[] = { + { 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, short_name) }, + { XD_LISP_OBJECT, offsetof (Lisp_Charset, long_name) }, + { XD_LISP_OBJECT, offsetof (Lisp_Charset, reverse_direction_charset) }, + { XD_LISP_OBJECT, offsetof (Lisp_Charset, ccl_program) }, + { XD_END } +}; + DEFINE_LRECORD_IMPLEMENTATION ("charset", charset, - mark_charset, print_charset, 0, 0, 0, - struct Lisp_Charset); + mark_charset, print_charset, 0, 0, 0, charset_description, + Lisp_Charset); /* Make a new charset. */ static Lisp_Object -make_charset (int id, Lisp_Object name, Bufbyte leading_byte, unsigned char rep_bytes, +make_charset (int id, Lisp_Object name, unsigned char rep_bytes, unsigned char type, unsigned char columns, unsigned char graphic, - Bufbyte final, unsigned char direction, Lisp_Object doc, + Bufbyte final, unsigned char direction, Lisp_Object short_name, + Lisp_Object long_name, Lisp_Object doc, Lisp_Object reg) { Lisp_Object obj; - struct Lisp_Charset *cs = - alloc_lcrecord_type (struct Lisp_Charset, lrecord_charset); + Lisp_Charset *cs = alloc_lcrecord_type (Lisp_Charset, &lrecord_charset); + + zero_lcrecord (cs); + XSETCHARSET (obj, cs); CHARSET_ID (cs) = id; CHARSET_NAME (cs) = name; - CHARSET_LEADING_BYTE (cs) = leading_byte; + CHARSET_SHORT_NAME (cs) = short_name; + CHARSET_LONG_NAME (cs) = long_name; CHARSET_REP_BYTES (cs) = rep_bytes; CHARSET_DIRECTION (cs) = direction; CHARSET_TYPE (cs) = type; @@ -474,15 +508,12 @@ /* some charsets do not have final characters. This includes ASCII, Control-1, Composite, and the two faux private charsets. */ - assert (NILP (charset_by_attributes[type][final][direction])); - charset_by_attributes[type][final][direction] = obj; + assert (NILP (chlook->charset_by_attributes[type][final][direction])); + chlook->charset_by_attributes[type][final][direction] = obj; } - assert (NILP (charset_by_leading_byte[leading_byte - 128])); - charset_by_leading_byte[leading_byte - 128] = obj; - if (leading_byte < 0xA0) - /* official leading byte */ - rep_bytes_by_first_byte[leading_byte] = rep_bytes; + assert (NILP (chlook->charset_by_leading_byte[id - 128])); + chlook->charset_by_leading_byte[id - 128] = obj; /* Some charsets are "faux" and don't have names or really exist at all except in the leading-byte table. */ @@ -616,6 +647,8 @@ PROPS is a property list, describing the specific nature of the character set. Recognized properties are: +'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. 'dimension Number of octets used to index a character in this charset. @@ -655,13 +688,14 @@ */ (name, doc_string, props)) { - int lb, dimension = 1, chars = 94, graphic = 0, final = 0, columns = -1; + int id, dimension = 1, chars = 94, graphic = 0, final = 0, columns = -1; int direction = CHARSET_LEFT_TO_RIGHT; int type; Lisp_Object registry = Qnil; Lisp_Object charset; Lisp_Object rest, keyword, value; Lisp_Object ccl_program = Qnil; + Lisp_Object short_name = Qnil, long_name = Qnil; CHECK_SYMBOL (name); if (!NILP (doc_string)) @@ -673,7 +707,19 @@ EXTERNAL_PROPERTY_LIST_LOOP (rest, keyword, value, props) { - if (EQ (keyword, Qdimension)) + if (EQ (keyword, Qshort_name)) + { + CHECK_STRING (value); + short_name = value; + } + + if (EQ (keyword, Qlong_name)) + { + CHECK_STRING (value); + long_name = value; + } + + else if (EQ (keyword, Qdimension)) { CHECK_INT (value); dimension = XINT (value); @@ -756,7 +802,7 @@ error ("Character set already defined for this DIMENSION/CHARS/FINAL combo"); - lb = get_unallocated_leading_byte (dimension); + id = get_unallocated_leading_byte (dimension); if (NILP (doc_string)) doc_string = build_string (""); @@ -764,10 +810,16 @@ if (NILP (registry)) registry = build_string (""); + if (NILP (short_name)) + XSETSTRING (short_name, XSYMBOL (name)->name); + + if (NILP (long_name)) + long_name = doc_string; + if (columns == -1) columns = dimension; - charset = make_charset (-1, name, lb, dimension + 2, type, columns, graphic, - final, direction, doc_string, registry); + charset = make_charset (id, name, dimension + 2, type, columns, graphic, + final, direction, short_name, long_name, doc_string, registry); if (!NILP (ccl_program)) XCHARSET_CCL_PROGRAM (charset) = ccl_program; return charset; @@ -781,10 +833,10 @@ (charset, new_name)) { Lisp_Object new_charset = Qnil; - int lb, dimension, columns, graphic, final; + int id, dimension, columns, graphic, final; int direction, type; - Lisp_Object registry, doc_string; - struct Lisp_Charset *cs; + Lisp_Object registry, doc_string, short_name, long_name; + Lisp_Charset *cs; charset = Fget_charset (charset); if (!NILP (XCHARSET_REVERSE_DIRECTION_CHARSET (charset))) @@ -800,7 +852,7 @@ type = CHARSET_TYPE (cs); columns = CHARSET_COLUMNS (cs); dimension = CHARSET_DIMENSION (cs); - lb = get_unallocated_leading_byte (dimension); + id = get_unallocated_leading_byte (dimension); graphic = CHARSET_GRAPHIC (cs); final = CHARSET_FINAL (cs); @@ -808,10 +860,13 @@ if (CHARSET_DIRECTION (cs) == CHARSET_RIGHT_TO_LEFT) direction = CHARSET_LEFT_TO_RIGHT; doc_string = CHARSET_DOC_STRING (cs); + short_name = CHARSET_SHORT_NAME (cs); + long_name = CHARSET_LONG_NAME (cs); registry = CHARSET_REGISTRY (cs); - new_charset = make_charset (-1, new_name, lb, dimension + 2, type, columns, - graphic, final, direction, doc_string, registry); + new_charset = make_charset (id, new_name, dimension + 2, type, columns, + graphic, final, direction, short_name, long_name, + doc_string, registry); CHARSET_REVERSE_DIRECTION_CHARSET (cs) = new_charset; XCHARSET_REVERSE_DIRECTION_CHARSET (new_charset) = charset; @@ -891,8 +946,24 @@ return obj; } -DEFUN ("charset-doc-string", Fcharset_doc_string, 1, 1, 0, /* -Return doc string of CHARSET. +DEFUN ("charset-short-name", Fcharset_short_name, 1, 1, 0, /* +Return short name of CHARSET. +*/ + (charset)) +{ + return XCHARSET_SHORT_NAME (Fget_charset (charset)); +} + +DEFUN ("charset-long-name", Fcharset_long_name, 1, 1, 0, /* +Return long name of CHARSET. +*/ + (charset)) +{ + return XCHARSET_LONG_NAME (Fget_charset (charset)); +} + +DEFUN ("charset-description", Fcharset_description, 1, 1, 0, /* +Return description of CHARSET. */ (charset)) { @@ -914,13 +985,15 @@ */ (charset, prop)) { - struct Lisp_Charset *cs; + Lisp_Charset *cs; charset = Fget_charset (charset); cs = XCHARSET (charset); CHECK_SYMBOL (prop); if (EQ (prop, Qname)) return CHARSET_NAME (cs); + if (EQ (prop, Qshort_name)) return CHARSET_SHORT_NAME (cs); + if (EQ (prop, Qlong_name)) return CHARSET_LONG_NAME (cs); if (EQ (prop, Qdoc_string)) return CHARSET_DOC_STRING (cs); if (EQ (prop, Qdimension)) return make_int (CHARSET_DIMENSION (cs)); if (EQ (prop, Qcolumns)) return make_int (CHARSET_COLUMNS (cs)); @@ -929,7 +1002,6 @@ if (EQ (prop, Qchars)) return make_int (CHARSET_CHARS (cs)); if (EQ (prop, Qregistry)) return CHARSET_REGISTRY (cs); if (EQ (prop, Qccl_program)) return CHARSET_CCL_PROGRAM (cs); - if (EQ (prop, Qleading_byte)) return make_char (CHARSET_LEADING_BYTE (cs)); if (EQ (prop, Qdirection)) return CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? Ql2r : Qr2l; if (EQ (prop, Qreverse_direction_charset)) @@ -949,7 +1021,7 @@ */ (charset)) { - return make_int(XCHARSET_ID (Fget_charset (charset))); + return make_int(XCHARSET_LEADING_BYTE (Fget_charset (charset))); } /* #### We need to figure out which properties we really want to @@ -1000,11 +1072,14 @@ /************************************************************************/ DEFUN ("make-char", Fmake_char, 2, 3, 0, /* -Make a multi-byte character from CHARSET and octets ARG1 and ARG2. +Make a character from CHARSET and octets ARG1 and ARG2. +ARG2 is required only for characters from two-dimensional charsets. +For example, (make-char 'latin-iso8859-2 185) will return the Latin 2 +character s with caron. */ (charset, arg1, arg2)) { - struct Lisp_Charset *cs; + Lisp_Charset *cs; int a1, a2; int lowlim, highlim; @@ -1017,7 +1092,11 @@ else /* CHARSET_CHARS (cs) == 96) */ lowlim = 32, highlim = 127; CHECK_INT (arg1); - a1 = XINT (arg1); + /* It is useful (and safe, according to Olivier Galibert) to strip + the 8th bit off ARG1 and ARG2 becaue it allows programmers to + write (make-char 'latin-iso8859-2 CODE) where code is the actual + Latin 2 code of the character. */ + a1 = XINT (arg1) & 0x7f; if (a1 < lowlim || a1 > highlim) args_out_of_range_3 (arg1, make_int (lowlim), make_int (highlim)); @@ -1030,7 +1109,7 @@ } CHECK_INT (arg2); - a2 = XINT (arg2); + a2 = XINT (arg2) & 0x7f; if (a2 < lowlim || a2 > highlim) args_out_of_range_3 (arg2, make_int (lowlim), make_int (highlim)); @@ -1055,20 +1134,47 @@ (ch, n)) { Lisp_Object charset; - int c1, c2, int_n; + int octet0, octet1; CHECK_CHAR_COERCE_INT (ch); - if (NILP (n)) - int_n = 0; + + BREAKUP_CHAR (XCHAR (ch), charset, octet0, octet1); + + if (NILP (n) || EQ (n, Qzero)) + return make_int (octet0); + else if (EQ (n, make_int (1))) + return make_int (octet1); + else + signal_simple_error ("Octet number must be 0 or 1", n); +} + +DEFUN ("split-char", Fsplit_char, 1, 1, 0, /* +Return list of charset and one or two position-codes of CHAR. +*/ + (character)) +{ + /* This function can GC */ + struct gcpro gcpro1, gcpro2; + Lisp_Object charset = Qnil; + Lisp_Object rc = Qnil; + int c1, c2; + + GCPRO2 (charset, rc); + CHECK_CHAR_COERCE_INT (character); + + BREAKUP_CHAR (XCHAR (character), charset, c1, c2); + + if (XCHARSET_DIMENSION (Fget_charset (charset)) == 2) + { + rc = list3 (XCHARSET_NAME (charset), make_int (c1), make_int (c2)); + } else { - CHECK_INT (n); - int_n = XINT (n); - if (int_n != 0 && int_n != 1) - signal_simple_error ("Octet number must be 0 or 1", n); + rc = list2 (XCHARSET_NAME (charset), make_int (c1)); } - BREAKUP_CHAR (XCHAR (ch), charset, c1, c2); - return make_int (int_n == 0 ? c1 : c2); + UNGCPRO; + + return rc; } @@ -1162,7 +1268,9 @@ DEFSUBR (Fmake_reverse_direction_charset); /* DEFSUBR (Freverse_direction_charset); */ DEFSUBR (Fcharset_from_attributes); - DEFSUBR (Fcharset_doc_string); + DEFSUBR (Fcharset_short_name); + DEFSUBR (Fcharset_long_name); + DEFSUBR (Fcharset_description); DEFSUBR (Fcharset_dimension); DEFSUBR (Fcharset_property); DEFSUBR (Fcharset_id); @@ -1172,6 +1280,7 @@ DEFSUBR (Fmake_char); DEFSUBR (Fchar_charset); DEFSUBR (Fchar_octet); + DEFSUBR (Fsplit_char); #ifdef ENABLE_COMPOSITE_CHARS DEFSUBR (Fmake_composite_char); @@ -1184,13 +1293,13 @@ defsymbol (&Qgraphic, "graphic"); defsymbol (&Qdirection, "direction"); defsymbol (&Qreverse_direction_charset, "reverse-direction-charset"); - defsymbol (&Qccl_program, "ccl-program"); - defsymbol (&Qleading_byte, "leading-byte"); + defsymbol (&Qshort_name, "short-name"); + defsymbol (&Qlong_name, "long-name"); defsymbol (&Ql2r, "l2r"); defsymbol (&Qr2l, "r2l"); - /* Charsets, compatible with Emacs/Mule 19.33-delta + /* Charsets, compatible with FSF 20.3 Naming convention is Script-Charset[-Edition] */ defsymbol (&Qascii, "ascii"); defsymbol (&Qcontrol_1, "control-1"); @@ -1198,26 +1307,24 @@ defsymbol (&Qlatin_iso8859_2, "latin-iso8859-2"); defsymbol (&Qlatin_iso8859_3, "latin-iso8859-3"); defsymbol (&Qlatin_iso8859_4, "latin-iso8859-4"); - defsymbol (&Qcyrillic_iso8859_5, "cyrillic-iso8859-5"); + defsymbol (&Qthai_tis620, "thai-tis620"); + defsymbol (&Qgreek_iso8859_7, "greek-iso8859-7"); defsymbol (&Qarabic_iso8859_6, "arabic-iso8859-6"); - defsymbol (&Qgreek_iso8859_7, "greek-iso8859-7"); defsymbol (&Qhebrew_iso8859_8, "hebrew-iso8859-8"); - defsymbol (&Qlatin_iso8859_9, "latin-iso8859-9"); - defsymbol (&Qthai_tis620, "thai-tis620"); - defsymbol (&Qkatakana_jisx0201, "katakana-jisx0201"); defsymbol (&Qlatin_jisx0201, "latin-jisx0201"); + defsymbol (&Qcyrillic_iso8859_5, "cyrillic-iso8859-5"); + defsymbol (&Qlatin_iso8859_9, "latin-iso8859-9"); defsymbol (&Qjapanese_jisx0208_1978, "japanese-jisx0208-1978"); + defsymbol (&Qchinese_gb2312, "chinese-gb2312"); defsymbol (&Qjapanese_jisx0208, "japanese-jisx0208"); + defsymbol (&Qkorean_ksc5601, "korean-ksc5601"); defsymbol (&Qjapanese_jisx0212, "japanese-jisx0212"); - - defsymbol (&Qchinese_gb2312, "chinese-gb2312"); + defsymbol (&Qchinese_cns11643_1, "chinese-cns11643-1"); + defsymbol (&Qchinese_cns11643_2, "chinese-cns11643-2"); defsymbol (&Qchinese_big5_1, "chinese-big5-1"); defsymbol (&Qchinese_big5_2, "chinese-big5-2"); - defsymbol (&Qchinese_cns11643_1, "chinese-cns11643-1"); - defsymbol (&Qchinese_cns11643_2, "chinese-cns11643-2"); - defsymbol (&Qkorean_ksc5601, "korean-ksc5601"); defsymbol (&Qcomposite, "composite"); } @@ -1226,15 +1333,18 @@ { int i, j, k; + chlook = xnew (struct charset_lookup); + dumpstruct (&chlook, &charset_lookup_description); + /* Table of charsets indexed by leading byte. */ - for (i = 0; i < countof (charset_by_leading_byte); i++) - charset_by_leading_byte[i] = Qnil; + for (i = 0; i < countof (chlook->charset_by_leading_byte); i++) + chlook->charset_by_leading_byte[i] = Qnil; /* Table of charsets indexed by type/final-byte/direction. */ - for (i = 0; i < countof (charset_by_attributes); i++) - for (j = 0; j < countof (charset_by_attributes[0]); j++) - for (k = 0; k < countof (charset_by_attributes[0][0]); k++) - charset_by_attributes[i][j][k] = Qnil; + for (i = 0; i < countof (chlook->charset_by_attributes); i++) + for (j = 0; j < countof (chlook->charset_by_attributes[0]); j++) + for (k = 0; k < countof (chlook->charset_by_attributes[0][0]); k++) + chlook->charset_by_attributes[i][j][k] = Qnil; next_allocated_1_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_1; next_allocated_2_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_2; @@ -1250,174 +1360,237 @@ /* Predefined character sets. We store them into variables for ease of access. */ + staticpro (&Vcharset_ascii); Vcharset_ascii = - make_charset (0, Qascii, LEADING_BYTE_ASCII, 1, + make_charset (LEADING_BYTE_ASCII, Qascii, 1, CHARSET_TYPE_94, 1, 0, 'B', CHARSET_LEFT_TO_RIGHT, - build_string ("ASCII (ISO 646 IRV)"), - build_string ("iso8859-1")); + build_string ("ASCII"), + build_string ("ASCII)"), + build_string ("ASCII (ISO646 IRV)"), + build_string ("\\(iso8859-[0-9]*\\|-ascii\\)")); + staticpro (&Vcharset_control_1); Vcharset_control_1 = - make_charset (-1, Qcontrol_1, LEADING_BYTE_CONTROL_1, 2, + make_charset (LEADING_BYTE_CONTROL_1, Qcontrol_1, 2, CHARSET_TYPE_94, 1, 1, 0, CHARSET_LEFT_TO_RIGHT, + build_string ("C1"), build_string ("Control characters"), + build_string ("Control characters 128-191"), build_string ("")); + staticpro (&Vcharset_latin_iso8859_1); Vcharset_latin_iso8859_1 = - make_charset (129, Qlatin_iso8859_1, LEADING_BYTE_LATIN_ISO8859_1, 2, + make_charset (LEADING_BYTE_LATIN_ISO8859_1, Qlatin_iso8859_1, 2, CHARSET_TYPE_96, 1, 1, 'A', CHARSET_LEFT_TO_RIGHT, - build_string ("ISO 8859-1 (Latin-1)"), + build_string ("Latin-1"), + build_string ("ISO8859-1 (Latin-1)"), + build_string ("ISO8859-1 (Latin-1)"), build_string ("iso8859-1")); + staticpro (&Vcharset_latin_iso8859_2); Vcharset_latin_iso8859_2 = - make_charset (130, Qlatin_iso8859_2, LEADING_BYTE_LATIN_ISO8859_2, 2, + make_charset (LEADING_BYTE_LATIN_ISO8859_2, Qlatin_iso8859_2, 2, CHARSET_TYPE_96, 1, 1, 'B', CHARSET_LEFT_TO_RIGHT, - build_string ("ISO 8859-2 (Latin-2)"), + build_string ("Latin-2"), + build_string ("ISO8859-2 (Latin-2)"), + build_string ("ISO8859-2 (Latin-2)"), build_string ("iso8859-2")); + staticpro (&Vcharset_latin_iso8859_3); Vcharset_latin_iso8859_3 = - make_charset (131, Qlatin_iso8859_3, LEADING_BYTE_LATIN_ISO8859_3, 2, + make_charset (LEADING_BYTE_LATIN_ISO8859_3, Qlatin_iso8859_3, 2, CHARSET_TYPE_96, 1, 1, 'C', CHARSET_LEFT_TO_RIGHT, - build_string ("ISO 8859-3 (Latin-3)"), + build_string ("Latin-3"), + build_string ("ISO8859-3 (Latin-3)"), + build_string ("ISO8859-3 (Latin-3)"), build_string ("iso8859-3")); + staticpro (&Vcharset_latin_iso8859_4); Vcharset_latin_iso8859_4 = - make_charset (132, Qlatin_iso8859_4, LEADING_BYTE_LATIN_ISO8859_4, 2, + make_charset (LEADING_BYTE_LATIN_ISO8859_4, Qlatin_iso8859_4, 2, CHARSET_TYPE_96, 1, 1, 'D', CHARSET_LEFT_TO_RIGHT, - build_string ("ISO 8859-4 (Latin-4)"), + build_string ("Latin-4"), + build_string ("ISO8859-4 (Latin-4)"), + build_string ("ISO8859-4 (Latin-4)"), build_string ("iso8859-4")); - Vcharset_cyrillic_iso8859_5 = - make_charset (140, Qcyrillic_iso8859_5, LEADING_BYTE_CYRILLIC_ISO8859_5, 2, - CHARSET_TYPE_96, 1, 1, 'L', - CHARSET_LEFT_TO_RIGHT, - build_string ("ISO 8859-5 (Cyrillic)"), - build_string ("iso8859-5")); - Vcharset_arabic_iso8859_6 = - make_charset (135, Qarabic_iso8859_6, LEADING_BYTE_ARABIC_ISO8859_6, 2, - CHARSET_TYPE_96, 1, 1, 'G', - CHARSET_RIGHT_TO_LEFT, - build_string ("ISO 8859-6 (Arabic)"), - build_string ("iso8859-6")); - Vcharset_greek_iso8859_7 = - make_charset (134, Qgreek_iso8859_7, LEADING_BYTE_GREEK_ISO8859_7, 2, - CHARSET_TYPE_96, 1, 1, 'F', - CHARSET_LEFT_TO_RIGHT, - build_string ("ISO 8859-7 (Greek)"), - build_string ("iso8859-7")); - Vcharset_hebrew_iso8859_8 = - make_charset (136, Qhebrew_iso8859_8, LEADING_BYTE_HEBREW_ISO8859_8, 2, - CHARSET_TYPE_96, 1, 1, 'H', - CHARSET_RIGHT_TO_LEFT, - build_string ("ISO 8859-8 (Hebrew)"), - build_string ("iso8859-8")); - Vcharset_latin_iso8859_9 = - make_charset (141, Qlatin_iso8859_9, LEADING_BYTE_LATIN_ISO8859_9, 2, - CHARSET_TYPE_96, 1, 1, 'M', - CHARSET_LEFT_TO_RIGHT, - build_string ("ISO 8859-9 (Latin-5)"), - build_string ("iso8859-9")); + staticpro (&Vcharset_thai_tis620); Vcharset_thai_tis620 = - make_charset (133, Qthai_tis620, LEADING_BYTE_THAI_TIS620, 2, + make_charset (LEADING_BYTE_THAI_TIS620, Qthai_tis620, 2, CHARSET_TYPE_96, 1, 1, 'T', CHARSET_LEFT_TO_RIGHT, - build_string ("TIS 620.2529 (Thai)"), + build_string ("TIS620"), + build_string ("TIS620 (Thai)"), + build_string ("TIS620.2529 (Thai)"), build_string ("tis620")); - - /* Japanese */ + staticpro (&Vcharset_greek_iso8859_7); + Vcharset_greek_iso8859_7 = + make_charset (LEADING_BYTE_GREEK_ISO8859_7, Qgreek_iso8859_7, 2, + CHARSET_TYPE_96, 1, 1, 'F', + CHARSET_LEFT_TO_RIGHT, + build_string ("ISO8859-7"), + build_string ("ISO8859-7 (Greek)"), + build_string ("ISO8859-7 (Greek)"), + build_string ("iso8859-7")); + staticpro (&Vcharset_arabic_iso8859_6); + Vcharset_arabic_iso8859_6 = + make_charset (LEADING_BYTE_ARABIC_ISO8859_6, Qarabic_iso8859_6, 2, + CHARSET_TYPE_96, 1, 1, 'G', + CHARSET_RIGHT_TO_LEFT, + build_string ("ISO8859-6"), + build_string ("ISO8859-6 (Arabic)"), + build_string ("ISO8859-6 (Arabic)"), + build_string ("iso8859-6")); + staticpro (&Vcharset_hebrew_iso8859_8); + Vcharset_hebrew_iso8859_8 = + make_charset (LEADING_BYTE_HEBREW_ISO8859_8, Qhebrew_iso8859_8, 2, + CHARSET_TYPE_96, 1, 1, 'H', + CHARSET_RIGHT_TO_LEFT, + build_string ("ISO8859-8"), + build_string ("ISO8859-8 (Hebrew)"), + build_string ("ISO8859-8 (Hebrew)"), + build_string ("iso8859-8")); + staticpro (&Vcharset_katakana_jisx0201); Vcharset_katakana_jisx0201 = - make_charset (137, Qkatakana_jisx0201, - LEADING_BYTE_KATAKANA_JISX0201, 2, + make_charset (LEADING_BYTE_KATAKANA_JISX0201, Qkatakana_jisx0201, 2, CHARSET_TYPE_94, 1, 1, 'I', CHARSET_LEFT_TO_RIGHT, - build_string ("JIS X0201-Katakana"), + build_string ("JISX0201 Kana"), + build_string ("JISX0201.1976 (Japanese Kana)"), + build_string ("JISX0201.1976 Japanese Kana"), build_string ("jisx0201.1976")); + staticpro (&Vcharset_latin_jisx0201); Vcharset_latin_jisx0201 = - make_charset (138, Qlatin_jisx0201, - LEADING_BYTE_LATIN_JISX0201, 2, + make_charset (LEADING_BYTE_LATIN_JISX0201, Qlatin_jisx0201, 2, CHARSET_TYPE_94, 1, 0, 'J', CHARSET_LEFT_TO_RIGHT, - build_string ("JIS X0201-Latin"), + build_string ("JISX0201 Roman"), + build_string ("JISX0201.1976 (Japanese Roman)"), + build_string ("JISX0201.1976 Japanese Roman"), build_string ("jisx0201.1976")); + staticpro (&Vcharset_cyrillic_iso8859_5); + Vcharset_cyrillic_iso8859_5 = + make_charset (LEADING_BYTE_CYRILLIC_ISO8859_5, Qcyrillic_iso8859_5, 2, + CHARSET_TYPE_96, 1, 1, 'L', + CHARSET_LEFT_TO_RIGHT, + build_string ("ISO8859-5"), + build_string ("ISO8859-5 (Cyrillic)"), + build_string ("ISO8859-5 (Cyrillic)"), + build_string ("iso8859-5")); + staticpro (&Vcharset_latin_iso8859_9); + Vcharset_latin_iso8859_9 = + make_charset (LEADING_BYTE_LATIN_ISO8859_9, Qlatin_iso8859_9, 2, + CHARSET_TYPE_96, 1, 1, 'M', + CHARSET_LEFT_TO_RIGHT, + build_string ("Latin-5"), + build_string ("ISO8859-9 (Latin-5)"), + build_string ("ISO8859-9 (Latin-5)"), + build_string ("iso8859-9")); + staticpro (&Vcharset_japanese_jisx0208_1978); Vcharset_japanese_jisx0208_1978 = - make_charset (144, Qjapanese_jisx0208_1978, - LEADING_BYTE_JAPANESE_JISX0208_1978, 3, + make_charset (LEADING_BYTE_JAPANESE_JISX0208_1978, Qjapanese_jisx0208_1978, 3, CHARSET_TYPE_94X94, 2, 0, '@', CHARSET_LEFT_TO_RIGHT, + build_string ("JISX0208.1978"), + build_string ("JISX0208.1978 (Japanese)"), build_string - ("JIS X0208-1978 (Japanese Kanji; Old Version)"), - build_string ("\\(jisx0208\\|jisc6226\\).19")); + ("JISX0208.1978 Japanese Kanji (so called \"old JIS\")"), + build_string ("\\(jisx0208\\|jisc6226\\)\\.1978")); + staticpro (&Vcharset_chinese_gb2312); + Vcharset_chinese_gb2312 = + make_charset (LEADING_BYTE_CHINESE_GB2312, Qchinese_gb2312, 3, + CHARSET_TYPE_94X94, 2, 0, 'A', + CHARSET_LEFT_TO_RIGHT, + build_string ("GB2312"), + build_string ("GB2312)"), + build_string ("GB2312 Chinese simplified"), + build_string ("gb2312")); + staticpro (&Vcharset_japanese_jisx0208); Vcharset_japanese_jisx0208 = - make_charset (146, Qjapanese_jisx0208, - LEADING_BYTE_JAPANESE_JISX0208, 3, + make_charset (LEADING_BYTE_JAPANESE_JISX0208, Qjapanese_jisx0208, 3, CHARSET_TYPE_94X94, 2, 0, 'B', CHARSET_LEFT_TO_RIGHT, - build_string ("JIS X0208-1983 (Japanese Kanji)"), + build_string ("JISX0208"), + build_string ("JISX0208.1983/1990 (Japanese)"), + build_string ("JISX0208.1983/1990 Japanese Kanji"), build_string ("jisx0208.19\\(83\\|90\\)")); + staticpro (&Vcharset_korean_ksc5601); + Vcharset_korean_ksc5601 = + make_charset (LEADING_BYTE_KOREAN_KSC5601, Qkorean_ksc5601, 3, + CHARSET_TYPE_94X94, 2, 0, 'C', + CHARSET_LEFT_TO_RIGHT, + build_string ("KSC5601"), + build_string ("KSC5601 (Korean"), + build_string ("KSC5601 Korean Hangul and Hanja"), + build_string ("ksc5601")); + staticpro (&Vcharset_japanese_jisx0212); Vcharset_japanese_jisx0212 = - make_charset (148, Qjapanese_jisx0212, - LEADING_BYTE_JAPANESE_JISX0212, 3, + make_charset (LEADING_BYTE_JAPANESE_JISX0212, Qjapanese_jisx0212, 3, CHARSET_TYPE_94X94, 2, 0, 'D', CHARSET_LEFT_TO_RIGHT, - build_string ("JIS X0212 (Japanese Supplement)"), + build_string ("JISX0212"), + build_string ("JISX0212 (Japanese)"), + build_string ("JISX0212 Japanese Supplement"), build_string ("jisx0212")); - /* Chinese */ - Vcharset_chinese_gb2312 = - make_charset (145, Qchinese_gb2312, LEADING_BYTE_CHINESE_GB2312, 3, - CHARSET_TYPE_94X94, 2, 0, 'A', - CHARSET_LEFT_TO_RIGHT, - build_string ("GB 2312 (Simplified Chinese)"), - build_string ("gb2312")); #define CHINESE_CNS_PLANE_RE(n) "cns11643[.-]\\(.*[.-]\\)?" n "$" + staticpro (&Vcharset_chinese_cns11643_1); Vcharset_chinese_cns11643_1 = - make_charset (149, Qchinese_cns11643_1, - LEADING_BYTE_CHINESE_CNS11643_1, 3, + make_charset (LEADING_BYTE_CHINESE_CNS11643_1, Qchinese_cns11643_1, 3, CHARSET_TYPE_94X94, 2, 0, 'G', CHARSET_LEFT_TO_RIGHT, + build_string ("CNS11643-1"), + build_string ("CNS11643-1 (Chinese traditional)"), build_string - ("CNS 11643 Plane 1 (Traditional Chinese for daily use)"), + ("CNS 11643 Plane 1 Chinese traditional"), build_string (CHINESE_CNS_PLANE_RE("1"))); + staticpro (&Vcharset_chinese_cns11643_2); Vcharset_chinese_cns11643_2 = - make_charset (150, Qchinese_cns11643_2, - LEADING_BYTE_CHINESE_CNS11643_2, 3, + make_charset (LEADING_BYTE_CHINESE_CNS11643_2, Qchinese_cns11643_2, 3, CHARSET_TYPE_94X94, 2, 0, 'H', CHARSET_LEFT_TO_RIGHT, + build_string ("CNS11643-2"), + build_string ("CNS11643-2 (Chinese traditional)"), build_string - ("CNS 11643 Plane 2 (Traditional Chinese for daily use)"), + ("CNS 11643 Plane 2 Chinese traditional"), build_string (CHINESE_CNS_PLANE_RE("2"))); + staticpro (&Vcharset_chinese_big5_1); Vcharset_chinese_big5_1 = - make_charset (152, Qchinese_big5_1, LEADING_BYTE_CHINESE_BIG5_1, 3, + make_charset (LEADING_BYTE_CHINESE_BIG5_1, Qchinese_big5_1, 3, CHARSET_TYPE_94X94, 2, 0, '0', CHARSET_LEFT_TO_RIGHT, + build_string ("Big5"), + build_string ("Big5 (Level-1)"), build_string - ("Big5 Level 1 (Traditional Chinese for daily use)"), + ("Big5 Level-1 Chinese traditional"), build_string ("big5")); + staticpro (&Vcharset_chinese_big5_2); Vcharset_chinese_big5_2 = - make_charset (153, Qchinese_big5_2, LEADING_BYTE_CHINESE_BIG5_2, 3, + make_charset (LEADING_BYTE_CHINESE_BIG5_2, Qchinese_big5_2, 3, CHARSET_TYPE_94X94, 2, 0, '1', CHARSET_LEFT_TO_RIGHT, + build_string ("Big5"), + build_string ("Big5 (Level-2)"), build_string - ("Big5 Level 2 (Traditional Chinese for daily use)"), + ("Big5 Level-2 Chinese traditional"), build_string ("big5")); - Vcharset_korean_ksc5601 = - make_charset (147, Qkorean_ksc5601, LEADING_BYTE_KOREAN_KSC5601, 3, - CHARSET_TYPE_94X94, 2, 0, 'C', - CHARSET_LEFT_TO_RIGHT, - build_string ("KS C5601 (Hangul and Korean Hanja)"), - build_string ("ksc5601")); #ifdef ENABLE_COMPOSITE_CHARS /* #### For simplicity, we put composite chars into a 96x96 charset. This is going to lead to problems because you can run out of room, esp. as we don't yet recycle numbers. */ + staticpro (&Vcharset_composite); Vcharset_composite = - make_charset (-1, Qcomposite, LEADING_BYTE_COMPOSITE, 3, + make_charset (LEADING_BYTE_COMPOSITE, Qcomposite, 3, CHARSET_TYPE_96X96, 2, 0, 0, CHARSET_LEFT_TO_RIGHT, + build_string ("Composite"), + build_string ("Composite characters"), build_string ("Composite characters"), build_string ("")); + /* #### not dumped properly */ composite_char_row_next = 32; composite_char_col_next = 32; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/mule-charset.h --- a/src/mule-charset.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/mule-charset.h Mon Aug 13 11:13:30 2007 +0200 @@ -23,8 +23,8 @@ /* Rewritten by Ben Wing <ben@xemacs.org>. */ -#ifndef _XEMACS_MULE_CHARSET_H -#define _XEMACS_MULE_CHARSET_H +#ifndef INCLUDED_mule_charset_h_ +#define INCLUDED_mule_charset_h_ /* 1. Character Sets @@ -239,7 +239,7 @@ Character set Encoding (PC == position-code) ------------- -------- (LB == leading-byte) - ASCII PC1 | + ASCII PC1 | Control-1 LB | PC1 + 0xA0 Dimension-1 official LB | PC1 + 0x80 Dimension-1 private 0x9E | LB | PC1 + 0x80 @@ -332,40 +332,48 @@ #define LEADING_BYTE_COMPOSITE 0x80 /* for a composite character */ #define LEADING_BYTE_CONTROL_1 0x8F /* represent normal 80-9F */ -/** The following are for 1-byte characters in an official charset. **/ +/* Note the gap in each official charset can cause core dump + as first and last values are used to determine whether + charset is defined or not in non_ascii_valid_char_p */ -#define LEADING_BYTE_LATIN_ISO8859_1 0x81 /* Right half of ISO 8859-1 */ -#define LEADING_BYTE_LATIN_ISO8859_2 0x82 /* Right half of ISO 8859-2 */ -#define LEADING_BYTE_LATIN_ISO8859_3 0x83 /* Right half of ISO 8859-3 */ -#define LEADING_BYTE_LATIN_ISO8859_4 0x84 /* Right half of ISO 8859-4 */ -#define LEADING_BYTE_THAI_TIS620 0x85 /* TIS620-2533 */ -#define LEADING_BYTE_GREEK_ISO8859_7 0x86 /* Right half of ISO 8859-7 */ -#define LEADING_BYTE_ARABIC_ISO8859_6 0x87 /* Right half of ISO 8859-6 */ -#define LEADING_BYTE_HEBREW_ISO8859_8 0x88 /* Right half of ISO 8859-8 */ -#define LEADING_BYTE_KATAKANA_JISX0201 0x89 /* Right half of JIS X0201-1976 */ -#define LEADING_BYTE_LATIN_JISX0201 0x8A /* Left half of JIS X0201-1976 */ -#define LEADING_BYTE_CYRILLIC_ISO8859_5 0x8C /* Right half of ISO 8859-5 */ -#define LEADING_BYTE_LATIN_ISO8859_9 0x8D /* Right half of ISO 8859-9 */ +/** The following are for 1-byte characters in an official charset. **/ +enum LEADING_BYTE_OFFICIAL_1 +{ + LEADING_BYTE_LATIN_ISO8859_1 = 0x81, /* Right half of ISO 8859-1 */ + LEADING_BYTE_LATIN_ISO8859_2, /* 0x82 Right half of ISO 8859-2 */ + LEADING_BYTE_LATIN_ISO8859_3, /* 0x83 Right half of ISO 8859-3 */ + LEADING_BYTE_LATIN_ISO8859_4, /* 0x84 Right half of ISO 8859-4 */ + LEADING_BYTE_THAI_TIS620, /* 0x85 TIS620-2533 */ + LEADING_BYTE_GREEK_ISO8859_7, /* 0x86 Right half of ISO 8859-7 */ + LEADING_BYTE_ARABIC_ISO8859_6, /* 0x87 Right half of ISO 8859-6 */ + LEADING_BYTE_HEBREW_ISO8859_8, /* 0x88 Right half of ISO 8859-8 */ + LEADING_BYTE_KATAKANA_JISX0201, /* 0x89 Right half of JIS X0201-1976 */ + LEADING_BYTE_LATIN_JISX0201, /* 0x8A Left half of JIS X0201-1976 */ + LEADING_BYTE_CYRILLIC_ISO8859_5,/* 0x8B Right half of ISO 8859-5 */ + LEADING_BYTE_LATIN_ISO8859_9 /* 0x8C Right half of ISO 8859-9 */ + /* 0x8D unused */ +}; #define MIN_LEADING_BYTE_OFFICIAL_1 LEADING_BYTE_LATIN_ISO8859_1 #define MAX_LEADING_BYTE_OFFICIAL_1 LEADING_BYTE_LATIN_ISO8859_9 /** The following are for 2-byte characters in an official charset. **/ - -#define LEADING_BYTE_JAPANESE_JISX0208_1978 0x90/* Japanese JIS X0208-1978 */ -#define LEADING_BYTE_CHINESE_GB2312 0x91 /* Chinese Hanzi GB2312-1980 */ -#define LEADING_BYTE_JAPANESE_JISX0208 0x92 /* Japanese JIS X0208-1983 */ -#define LEADING_BYTE_KOREAN_KSC5601 0x93 /* Hangul KS C5601-1987 */ -#define LEADING_BYTE_JAPANESE_JISX0212 0x94 /* Japanese JIS X0212-1990 */ -#define LEADING_BYTE_CHINESE_CNS11643_1 0x95 /* Chinese CNS11643 Set 1 */ -#define LEADING_BYTE_CHINESE_CNS11643_2 0x96 /* Chinese CNS11643 Set 2 */ -#define LEADING_BYTE_CHINESE_BIG5_1 0x97 /* Big5 Level 1 */ -#define LEADING_BYTE_CHINESE_BIG5_2 0x98 /* Big5 Level 2 */ - /* 0x99 unused */ - /* 0x9A unused */ - /* 0x9B unused */ - /* 0x9C unused */ - /* 0x9D unused */ +enum LEADING_BYTE_OFFICIAL_2 +{ + LEADING_BYTE_JAPANESE_JISX0208_1978 = 0x90, /* Japanese JIS X0208-1978 */ + LEADING_BYTE_CHINESE_GB2312, /* 0x91 Chinese Hanzi GB2312-1980 */ + LEADING_BYTE_JAPANESE_JISX0208, /* 0x92 Japanese JIS X0208-1983 */ + LEADING_BYTE_KOREAN_KSC5601, /* 0x93 Hangul KS C5601-1987 */ + LEADING_BYTE_JAPANESE_JISX0212, /* 0x94 Japanese JIS X0212-1990 */ + LEADING_BYTE_CHINESE_CNS11643_1, /* 0x95 Chinese CNS11643 Set 1 */ + LEADING_BYTE_CHINESE_CNS11643_2, /* 0x96 Chinese CNS11643 Set 2 */ + LEADING_BYTE_CHINESE_BIG5_1, /* 0x97 Big5 Level 1 */ + LEADING_BYTE_CHINESE_BIG5_2 /* 0x98 Big5 Level 2 */ + /* 0x99 unused */ + /* 0x9A unused */ + /* 0x9B unused */ + /* 0x9C unused */ +}; #define MIN_LEADING_BYTE_OFFICIAL_2 LEADING_BYTE_JAPANESE_JISX0208_1978 #define MAX_LEADING_BYTE_OFFICIAL_2 LEADING_BYTE_CHINESE_BIG5_2 @@ -448,14 +456,15 @@ int id; Lisp_Object name; - Lisp_Object doc_string, registry; + Lisp_Object doc_string; + Lisp_Object registry; + Lisp_Object short_name; + Lisp_Object long_name; Lisp_Object reverse_direction_charset; Lisp_Object ccl_program; - Bufbyte leading_byte; - /* Final byte of this character set in ISO2022 designating escape sequence */ Bufbyte final; @@ -483,12 +492,12 @@ /* Which half of font to be used to display this character set */ unsigned int graphic; }; +typedef struct Lisp_Charset Lisp_Charset; -DECLARE_LRECORD (charset, struct Lisp_Charset); -#define XCHARSET(x) XRECORD (x, charset, struct Lisp_Charset) +DECLARE_LRECORD (charset, Lisp_Charset); +#define XCHARSET(x) XRECORD (x, charset, Lisp_Charset) #define XSETCHARSET(x, p) XSETRECORD (x, p, charset) #define CHARSETP(x) RECORDP (x, charset) -#define GC_CHARSETP(x) GC_RECORDP (x, charset) #define CHECK_CHARSET(x) CHECK_RECORD (x, charset) #define CONCHECK_CHARSET(x) CONCHECK_RECORD (x, charset) @@ -500,9 +509,12 @@ #define CHARSET_LEFT_TO_RIGHT 0 #define CHARSET_RIGHT_TO_LEFT 1 +/* Leading byte and id have been regrouped. -- OG */ #define CHARSET_ID(cs) ((cs)->id) +#define CHARSET_LEADING_BYTE(cs) ((Bufbyte) CHARSET_ID(cs)) #define CHARSET_NAME(cs) ((cs)->name) -#define CHARSET_LEADING_BYTE(cs) ((cs)->leading_byte) +#define CHARSET_SHORT_NAME(cs) ((cs)->short_name) +#define CHARSET_LONG_NAME(cs) ((cs)->long_name) #define CHARSET_REP_BYTES(cs) ((cs)->rep_bytes) #define CHARSET_COLUMNS(cs) ((cs)->columns) #define CHARSET_GRAPHIC(cs) ((cs)->graphic) @@ -521,6 +533,8 @@ #define XCHARSET_ID(cs) CHARSET_ID (XCHARSET (cs)) #define XCHARSET_NAME(cs) CHARSET_NAME (XCHARSET (cs)) +#define XCHARSET_SHORT_NAME(cs) CHARSET_SHORT_NAME (XCHARSET (cs)) +#define XCHARSET_LONG_NAME(cs) CHARSET_LONG_NAME (XCHARSET (cs)) #define XCHARSET_REP_BYTES(cs) CHARSET_REP_BYTES (XCHARSET (cs)) #define XCHARSET_COLUMNS(cs) CHARSET_COLUMNS (XCHARSET (cs)) #define XCHARSET_GRAPHIC(cs) CHARSET_GRAPHIC (XCHARSET (cs)) @@ -537,22 +551,15 @@ #define XCHARSET_REVERSE_DIRECTION_CHARSET(cs) \ CHARSET_REVERSE_DIRECTION_CHARSET (XCHARSET (cs)) -/* Table of charsets indexed by (leading byte - 128). */ -extern Lisp_Object charset_by_leading_byte[128]; - -/* Table of charsets indexed by type/final-byte/direction. */ -extern Lisp_Object charset_by_attributes[4][128][2]; +struct charset_lookup { + /* Table of charsets indexed by leading byte. */ + Lisp_Object charset_by_leading_byte[128]; -/* Table of number of bytes in the string representation of a character - indexed by the first byte of that representation. - - This value can be derived other ways -- e.g. something like + /* Table of charsets indexed by type/final-byte/direction. */ + Lisp_Object charset_by_attributes[4][128][2]; +}; - (BYTE_ASCII_P (first_byte) ? 1 : - XCHARSET_REP_BYTES (CHARSET_BY_LEADING_BYTE (first_byte))) - - but it's faster this way. */ -extern Bytecount rep_bytes_by_first_byte[0xA0]; +extern struct charset_lookup *chlook; #ifdef ERROR_CHECK_TYPECHECK /* int not Bufbyte even though that is the actual type of a leading byte. @@ -563,33 +570,38 @@ CHARSET_BY_LEADING_BYTE (int lb) { assert (lb >= 0x80 && lb <= 0xFF); - return charset_by_leading_byte[lb - 128]; + return chlook->charset_by_leading_byte[lb - 128]; } #else -#define CHARSET_BY_LEADING_BYTE(lb) (charset_by_leading_byte[(lb) - 128]) +#define CHARSET_BY_LEADING_BYTE(lb) (chlook->charset_by_leading_byte[(lb) - 128]) #endif #define CHARSET_BY_ATTRIBUTES(type, final, dir) \ - (charset_by_attributes[type][final][dir]) + (chlook->charset_by_attributes[type][final][dir]) + + +/* Table of number of bytes in the string representation of a character + indexed by the first byte of that representation. -#ifdef ERROR_CHECK_TYPECHECK + This value can be derived in other ways -- e.g. something like + XCHARSET_REP_BYTES (CHARSET_BY_LEADING_BYTE (first_byte)) + but it's faster this way. */ +extern const Bytecount rep_bytes_by_first_byte[0xA0]; -/* Number of bytes in the string representation of a character */ +/* Number of bytes in the string representation of a character. */ INLINE int REP_BYTES_BY_FIRST_BYTE (int fb); INLINE int REP_BYTES_BY_FIRST_BYTE (int fb) { - assert (fb >= 0 && fb < 0xA0); +#ifdef ERROR_CHECK_TYPECHECK + assert (0 <= fb && fb < 0xA0); +#endif return rep_bytes_by_first_byte[fb]; } -#else -#define REP_BYTES_BY_FIRST_BYTE(fb) (rep_bytes_by_first_byte[fb]) -#endif - /************************************************************************/ /* Dealing with characters */ @@ -774,9 +786,9 @@ int Lstream_fput_emchar (Lstream *stream, Emchar ch); void Lstream_funget_emchar (Lstream *stream, Emchar ch); -int copy_internal_to_external (CONST Bufbyte *internal, Bytecount len, +int copy_internal_to_external (const Bufbyte *internal, Bytecount len, unsigned char *external); -Bytecount copy_external_to_internal (CONST unsigned char *external, +Bytecount copy_external_to_internal (const unsigned char *external, int len, Bufbyte *internal); -#endif /* _XEMACS_MULE_CHARSET_H */ +#endif /* INCLUDED_mule_charset_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/mule-coding.c --- a/src/mule-coding.c Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4815 +0,0 @@ -/* Code conversion functions. - Copyright (C) 1991, 1995 Free Software Foundation, Inc. - Copyright (C) 1995 Sun Microsystems, Inc. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Mule 2.3. Not in FSF. */ - -/* Rewritten by Ben Wing <ben@xemacs.org>. */ - -#if 0 /* while file-coding not split up */ - -#include <config.h> -#include "lisp.h" - -#include "buffer.h" -#include "elhash.h" -#include "insdel.h" -#include "lstream.h" -#include "mule-ccl.h" -#include "mule-coding.h" - -Lisp_Object Qbuffer_file_coding_system, Qcoding_system_error; - -Lisp_Object Vkeyboard_coding_system; -Lisp_Object Vterminal_coding_system; -Lisp_Object Vcoding_system_for_read; -Lisp_Object Vcoding_system_for_write; -Lisp_Object Vfile_name_coding_system; - -/* Table of symbols identifying each coding category. */ -Lisp_Object coding_category_symbol[CODING_CATEGORY_LAST + 1]; - -/* Coding system currently associated with each coding category. */ -Lisp_Object coding_category_system[CODING_CATEGORY_LAST + 1]; - -/* Table of all coding categories in decreasing order of priority. - This describes a permutation of the possible coding categories. */ -int coding_category_by_priority[CODING_CATEGORY_LAST + 1]; - -Lisp_Object Qcoding_system_p; - -Lisp_Object Qbig5, Qshift_jis, Qno_conversion, Qccl, Qiso2022; -/* Qinternal in general.c */ - -Lisp_Object Qmnemonic, Qeol_type; -Lisp_Object Qcr, Qcrlf, Qlf; -Lisp_Object Qeol_cr, Qeol_crlf, Qeol_lf; -Lisp_Object Qpost_read_conversion; -Lisp_Object Qpre_write_conversion; - -Lisp_Object Qcharset_g0, Qcharset_g1, Qcharset_g2, Qcharset_g3; -Lisp_Object Qforce_g0_on_output, Qforce_g1_on_output; -Lisp_Object Qforce_g2_on_output, Qforce_g3_on_output; -Lisp_Object Qshort, Qno_ascii_eol, Qno_ascii_cntl, Qseven, Qlock_shift; -Lisp_Object Qno_iso6429, Qescape_quoted; -Lisp_Object Qinput_charset_conversion, Qoutput_charset_conversion; - -Lisp_Object Qencode, Qdecode; - -Lisp_Object Qctext; - -Lisp_Object Vcoding_system_hash_table; - -int enable_multibyte_characters; - -/* Additional information used by the ISO2022 decoder and detector. */ -struct iso2022_decoder -{ - /* CHARSET holds the character sets currently assigned to the G0 - through G3 variables. It is initialized from the array - INITIAL_CHARSET in CODESYS. */ - Lisp_Object charset[4]; - - /* Which registers are currently invoked into the left (GL) and - right (GR) halves of the 8-bit encoding space? */ - int register_left, register_right; - - /* ISO_ESC holds a value indicating part of an escape sequence - that has already been seen. */ - enum iso_esc_flag esc; - - /* This records the bytes we've seen so far in an escape sequence, - in case the sequence is invalid (we spit out the bytes unchanged). */ - unsigned char esc_bytes[8]; - - /* Index for next byte to store in ISO escape sequence. */ - int esc_bytes_index; - - /* Stuff seen so far when composing a string. */ - unsigned_char_dynarr *composite_chars; - - /* If we saw an invalid designation sequence for a particular - register, we flag it here and switch to ASCII. The next time we - see a valid designation for this register, we turn off the flag - and do the designation normally, but pretend the sequence was - invalid. The effect of all this is that (most of the time) the - escape sequences for both the switch to the unknown charset, and - the switch back to the known charset, get inserted literally into - the buffer and saved out as such. The hope is that we can - preserve the escape sequences so that the resulting written out - file makes sense. If we don't do any of this, the designation - to the invalid charset will be preserved but that switch back - to the known charset will probably get eaten because it was - the same charset that was already present in the register. */ - unsigned char invalid_designated[4]; - - /* We try to do similar things as above for direction-switching - sequences. If we encountered a direction switch while an - invalid designation was present, or an invalid designation - just after a direction switch (i.e. no valid designation - encountered yet), we insert the direction-switch escape - sequence literally into the output stream, and later on - insert the corresponding direction-restoring escape sequence - literally also. */ - unsigned int switched_dir_and_no_valid_charset_yet :1; - unsigned int invalid_switch_dir :1; - - /* Tells the decoder to output the escape sequence literally - even though it was valid. Used in the games we play to - avoid lossage when we encounter invalid designations. */ - unsigned int output_literally :1; - /* We encountered a direction switch followed by an invalid - designation. We didn't output the direction switch - literally because we didn't know about the invalid designation; - but we have to do so now. */ - unsigned int output_direction_sequence :1; -}; - -EXFUN (Fcopy_coding_system, 2); -struct detection_state; -static int detect_coding_sjis (struct detection_state *st, - CONST unsigned char *src, - unsigned int n); -static void decode_coding_sjis (Lstream *decoding, - CONST unsigned char *src, - unsigned_char_dynarr *dst, - unsigned int n); -static void encode_coding_sjis (Lstream *encoding, - CONST unsigned char *src, - unsigned_char_dynarr *dst, - unsigned int n); -static int detect_coding_big5 (struct detection_state *st, - CONST unsigned char *src, - unsigned int n); -static void decode_coding_big5 (Lstream *decoding, - CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n); -static void encode_coding_big5 (Lstream *encoding, - CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n); -static int postprocess_iso2022_mask (int mask); -static void reset_iso2022 (Lisp_Object coding_system, - struct iso2022_decoder *iso); -static int detect_coding_iso2022 (struct detection_state *st, - CONST unsigned char *src, - unsigned int n); -static void decode_coding_iso2022 (Lstream *decoding, - CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n); -static void encode_coding_iso2022 (Lstream *encoding, - CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n); -static void decode_coding_no_conversion (Lstream *decoding, - CONST unsigned char *src, - unsigned_char_dynarr *dst, - unsigned int n); -static void encode_coding_no_conversion (Lstream *encoding, - CONST unsigned char *src, - unsigned_char_dynarr *dst, - unsigned int n); -static void mule_decode (Lstream *decoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n); -static void mule_encode (Lstream *encoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n); - -typedef struct codesys_prop codesys_prop; -struct codesys_prop -{ - Lisp_Object sym; - int prop_type; -}; - -typedef struct -{ - Dynarr_declare (codesys_prop); -} codesys_prop_dynarr; - -codesys_prop_dynarr *the_codesys_prop_dynarr; - -enum codesys_prop_enum -{ - CODESYS_PROP_ALL_OK, - CODESYS_PROP_ISO2022, - CODESYS_PROP_CCL -}; - - -/************************************************************************/ -/* Coding system functions */ -/************************************************************************/ - -static Lisp_Object -mark_coding_system (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct Lisp_Coding_System *codesys = XCODING_SYSTEM (obj); - - markobj (CODING_SYSTEM_NAME (codesys)); - markobj (CODING_SYSTEM_DOC_STRING (codesys)); - markobj (CODING_SYSTEM_MNEMONIC (codesys)); - markobj (CODING_SYSTEM_EOL_LF (codesys)); - markobj (CODING_SYSTEM_EOL_CRLF (codesys)); - markobj (CODING_SYSTEM_EOL_CR (codesys)); - - switch (CODING_SYSTEM_TYPE (codesys)) - { - int i; - case CODESYS_ISO2022: - for (i = 0; i < 4; i++) - markobj (CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i)); - if (codesys->iso2022.input_conv) - { - for (i = 0; i < Dynarr_length (codesys->iso2022.input_conv); i++) - { - struct charset_conversion_spec *ccs = - Dynarr_atp (codesys->iso2022.input_conv, i); - markobj (ccs->from_charset); - markobj (ccs->to_charset); - } - } - if (codesys->iso2022.output_conv) - { - for (i = 0; i < Dynarr_length (codesys->iso2022.output_conv); i++) - { - struct charset_conversion_spec *ccs = - Dynarr_atp (codesys->iso2022.output_conv, i); - markobj (ccs->from_charset); - markobj (ccs->to_charset); - } - } - break; - - case CODESYS_CCL: - markobj (CODING_SYSTEM_CCL_DECODE (codesys)); - markobj (CODING_SYSTEM_CCL_ENCODE (codesys)); - break; - default: - break; - } - - markobj (CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys)); - return CODING_SYSTEM_POST_READ_CONVERSION (codesys); -} - -static void -print_coding_system (Lisp_Object obj, Lisp_Object printcharfun, - int escapeflag) -{ - struct Lisp_Coding_System *c = XCODING_SYSTEM (obj); - if (print_readably) - error ("printing unreadable object #<coding_system 0x%x>", - c->header.uid); - - write_c_string ("#<coding_system ", printcharfun); - print_internal (c->name, printcharfun, 1); - write_c_string (">", printcharfun); -} - -static void -finalize_coding_system (void *header, int for_disksave) -{ - struct Lisp_Coding_System *c = (struct Lisp_Coding_System *) header; - /* Since coding systems never go away, this function is not - necessary. But it would be necessary if we changed things - so that coding systems could go away. */ - if (!for_disksave) /* see comment in lstream.c */ - { - switch (CODING_SYSTEM_TYPE (c)) - { - case CODESYS_ISO2022: - if (c->iso2022.input_conv) - { - Dynarr_free (c->iso2022.input_conv); - c->iso2022.input_conv = 0; - } - if (c->iso2022.output_conv) - { - Dynarr_free (c->iso2022.output_conv); - c->iso2022.output_conv = 0; - } - break; - - default: - break; - } - } -} - -DEFINE_LRECORD_IMPLEMENTATION ("coding-system", coding_system, - mark_coding_system, print_coding_system, - finalize_coding_system, - 0, 0, struct Lisp_Coding_System); - -static enum eol_type -symbol_to_eol_type (Lisp_Object symbol) -{ - CHECK_SYMBOL (symbol); - if (NILP (symbol)) return EOL_AUTODETECT; - if (EQ (symbol, Qlf)) return EOL_LF; - if (EQ (symbol, Qcrlf)) return EOL_CRLF; - if (EQ (symbol, Qcr)) return EOL_CR; - - signal_simple_error ("Unrecognized eol type", symbol); - return EOL_AUTODETECT; /* not reached */ -} - -static Lisp_Object -eol_type_to_symbol (enum eol_type type) -{ - switch (type) - { - default: abort (); - case EOL_LF: return Qlf; - case EOL_CRLF: return Qcrlf; - case EOL_CR: return Qcr; - case EOL_AUTODETECT: return Qnil; - } -} - -static void -setup_eol_coding_systems (struct Lisp_Coding_System *codesys) -{ - Lisp_Object codesys_obj; - int len = string_length (XSYMBOL (CODING_SYSTEM_NAME (codesys))->name); - char *codesys_name = (char *) alloca (len + 7); - Lisp_Object codesys_name_sym, sub_codesys_obj; - - /* kludge */ - - XSETCODING_SYSTEM (codesys_obj, codesys); - - memcpy (codesys_name, - string_data (XSYMBOL (CODING_SYSTEM_NAME (codesys))->name), len); - -#define DEFINE_SUB_CODESYS(op_sys, Type) do { \ - strcpy (codesys_name + len, "-" op_sys); \ - codesys_name_sym = intern (codesys_name); \ - sub_codesys_obj = Fcopy_coding_system (codesys_obj, codesys_name_sym); \ - XCODING_SYSTEM_EOL_TYPE (sub_codesys_obj) = Type; \ - CODING_SYSTEM_##Type (codesys) = sub_codesys_obj; \ -} while (0) - - DEFINE_SUB_CODESYS("unix", EOL_LF); - DEFINE_SUB_CODESYS("dos", EOL_CRLF); - DEFINE_SUB_CODESYS("mac", EOL_CR); -} - -DEFUN ("coding-system-p", Fcoding_system_p, 1, 1, 0, /* -Return t if OBJECT is a coding system. -A coding system is an object that defines how text containing multiple -character sets is encoded into a stream of (typically 8-bit) bytes. -The coding system is used to decode the stream into a series of -characters (which may be from multiple charsets) when the text is read -from a file or process, and is used to encode the text back into the -same format when it is written out to a file or process. - -For example, many ISO2022-compliant coding systems (such as Compound -Text, which is used for inter-client data under the X Window System) -use escape sequences to switch between different charsets -- Japanese -Kanji, for example, is invoked with "ESC $ ( B"; ASCII is invoked -with "ESC ( B"; and Cyrillic is invoked with "ESC - L". See -`make-coding-system' for more information. - -Coding systems are normally identified using a symbol, and the -symbol is accepted in place of the actual coding system object whenever -a coding system is called for. (This is similar to how faces work.) -*/ - (object)) -{ - return CODING_SYSTEMP (object) ? Qt : Qnil; -} - -DEFUN ("find-coding-system", Ffind_coding_system, 1, 1, 0, /* -Retrieve the coding system of the given name. - -If CODING-SYSTEM-OR-NAME is a coding-system object, it is simply -returned. Otherwise, CODING-SYSTEM-OR-NAME should be a symbol. -If there is no such coding system, nil is returned. Otherwise the -associated coding system object is returned. -*/ - (coding_system_or_name)) -{ - if (NILP (coding_system_or_name)) - coding_system_or_name = Qbinary; - if (CODING_SYSTEMP (coding_system_or_name)) - return coding_system_or_name; - CHECK_SYMBOL (coding_system_or_name); - - return Fgethash (coding_system_or_name, Vcoding_system_hash_table, Qnil); -} - -DEFUN ("get-coding-system", Fget_coding_system, 1, 1, 0, /* -Retrieve the coding system of the given name. -Same as `find-coding-system' except that if there is no such -coding system, an error is signaled instead of returning nil. -*/ - (name)) -{ - Lisp_Object coding_system = Ffind_coding_system (name); - - if (NILP (coding_system)) - signal_simple_error ("No such coding system", name); - return coding_system; -} - -/* We store the coding systems in hash tables with the names as the key and the - actual coding system object as the value. Occasionally we need to use them - in a list format. These routines provide us with that. */ -struct coding_system_list_closure -{ - Lisp_Object *coding_system_list; -}; - -static int -add_coding_system_to_list_mapper (CONST void *hash_key, void *hash_contents, - void *coding_system_list_closure) -{ - /* This function can GC */ - Lisp_Object key, contents; - Lisp_Object *coding_system_list; - struct coding_system_list_closure *cscl = - (struct coding_system_list_closure *) coding_system_list_closure; - CVOID_TO_LISP (key, hash_key); - VOID_TO_LISP (contents, hash_contents); - coding_system_list = cscl->coding_system_list; - - *coding_system_list = Fcons (XCODING_SYSTEM (contents)->name, - *coding_system_list); - return 0; -} - -DEFUN ("coding-system-list", Fcoding_system_list, 0, 0, 0, /* -Return a list of the names of all defined coding systems. -*/ - ()) -{ - Lisp_Object coding_system_list = Qnil; - struct gcpro gcpro1; - struct coding_system_list_closure coding_system_list_closure; - - GCPRO1 (coding_system_list); - coding_system_list_closure.coding_system_list = &coding_system_list; - elisp_maphash (add_coding_system_to_list_mapper, Vcoding_system_hash_table, - &coding_system_list_closure); - UNGCPRO; - - return coding_system_list; -} - -DEFUN ("coding-system-name", Fcoding_system_name, 1, 1, 0, /* -Return the name of the given coding system. -*/ - (coding_system)) -{ - coding_system = Fget_coding_system (coding_system); - return XCODING_SYSTEM_NAME (coding_system); -} - -static struct Lisp_Coding_System * -allocate_coding_system (enum coding_system_type type, Lisp_Object name) -{ - struct Lisp_Coding_System *codesys = - alloc_lcrecord_type (struct Lisp_Coding_System, lrecord_coding_system); - - zero_lcrecord (codesys); - CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys) = Qnil; - CODING_SYSTEM_POST_READ_CONVERSION (codesys) = Qnil; - CODING_SYSTEM_EOL_TYPE (codesys) = EOL_AUTODETECT; - CODING_SYSTEM_EOL_CRLF (codesys) = Qnil; - CODING_SYSTEM_EOL_CR (codesys) = Qnil; - CODING_SYSTEM_EOL_LF (codesys) = Qnil; - CODING_SYSTEM_TYPE (codesys) = type; - - if (type == CODESYS_ISO2022) - { - int i; - for (i = 0; i < 4; i++) - CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i) = Qnil; - } - else if (type == CODESYS_CCL) - { - CODING_SYSTEM_CCL_DECODE (codesys) = Qnil; - CODING_SYSTEM_CCL_ENCODE (codesys) = Qnil; - } - - CODING_SYSTEM_NAME (codesys) = name; - - return codesys; -} - -/* Given a list of charset conversion specs as specified in a Lisp - program, parse it into STORE_HERE. */ - -static void -parse_charset_conversion_specs (charset_conversion_spec_dynarr *store_here, - Lisp_Object spec_list) -{ - Lisp_Object rest; - - EXTERNAL_LIST_LOOP (rest, spec_list) - { - Lisp_Object car = XCAR (rest); - Lisp_Object from, to; - struct charset_conversion_spec spec; - - if (!CONSP (car) || !CONSP (XCDR (car)) || !NILP (XCDR (XCDR (car)))) - signal_simple_error ("Invalid charset conversion spec", car); - from = Fget_charset (XCAR (car)); - to = Fget_charset (XCAR (XCDR (car))); - if (XCHARSET_TYPE (from) != XCHARSET_TYPE (to)) - signal_simple_error_2 - ("Attempted conversion between different charset types", - from, to); - spec.from_charset = from; - spec.to_charset = to; - - Dynarr_add (store_here, spec); - } -} - -/* Given a dynarr LOAD_HERE of internally-stored charset conversion - specs, return the equivalent as the Lisp programmer would see it. - - If LOAD_HERE is 0, return Qnil. */ - -static Lisp_Object -unparse_charset_conversion_specs (charset_conversion_spec_dynarr *load_here) -{ - int i; - Lisp_Object result = Qnil; - - if (!load_here) - return Qnil; - for (i = 0; i < Dynarr_length (load_here); i++) - { - struct charset_conversion_spec *ccs = - Dynarr_atp (load_here, i); - result = Fcons (list2 (ccs->from_charset, ccs->to_charset), result); - } - - return Fnreverse (result); -} - -DEFUN ("make-coding-system", Fmake_coding_system, 2, 4, 0, /* -Register symbol NAME as a coding system. - -TYPE describes the conversion method used and should be one of - -nil or 'undecided - Automatic conversion. XEmacs attempts to detect the coding system - used in the file. -'no-conversion - No conversion. Use this for binary files and such. On output, - graphic characters that are not in ASCII or Latin-1 will be - replaced by a ?. (For a no-conversion-encoded buffer, these - characters will only be present if you explicitly insert them.) -'shift-jis - Shift-JIS (a Japanese encoding commonly used in PC operating systems). -'iso2022 - Any ISO2022-compliant encoding. Among other things, this includes - JIS (the Japanese encoding commonly used for e-mail), EUC (the - standard Unix encoding for Japanese and other languages), and - Compound Text (the encoding used in X11). You can specify more - specific information about the conversion with the FLAGS argument. -'big5 - Big5 (the encoding commonly used for Taiwanese). -'ccl - The conversion is performed using a user-written pseudo-code - program. CCL (Code Conversion Language) is the name of this - pseudo-code. -'internal - Write out or read in the raw contents of the memory representing - the buffer's text. This is primarily useful for debugging - purposes, and is only enabled when XEmacs has been compiled with - DEBUG_XEMACS defined (via the --debug configure option). - WARNING: Reading in a file using 'internal conversion can result - in an internal inconsistency in the memory representing a - buffer's text, which will produce unpredictable results and may - cause XEmacs to crash. Under normal circumstances you should - never use 'internal conversion. - -DOC-STRING is a string describing the coding system. - -PROPS is a property list, describing the specific nature of the -character set. Recognized properties are: - -'mnemonic - String to be displayed in the modeline when this coding system is - active. - -'eol-type - End-of-line conversion to be used. It should be one of - - nil - Automatically detect the end-of-line type (LF, CRLF, - or CR). Also generate subsidiary coding systems named - `NAME-unix', `NAME-dos', and `NAME-mac', that are - identical to this coding system but have an EOL-TYPE - value of 'lf, 'crlf, and 'cr, respectively. - 'lf - The end of a line is marked externally using ASCII LF. - Since this is also the way that XEmacs represents an - end-of-line internally, specifying this option results - in no end-of-line conversion. This is the standard - format for Unix text files. - 'crlf - The end of a line is marked externally using ASCII - CRLF. This is the standard format for MS-DOS text - files. - 'cr - The end of a line is marked externally using ASCII CR. - This is the standard format for Macintosh text files. - t - Automatically detect the end-of-line type but do not - generate subsidiary coding systems. (This value is - converted to nil when stored internally, and - `coding-system-property' will return nil.) - -'post-read-conversion - Function called after a file has been read in, to perform the - decoding. Called with two arguments, BEG and END, denoting - a region of the current buffer to be decoded. - -'pre-write-conversion - Function called before a file is written out, to perform the - encoding. Called with two arguments, BEG and END, denoting - a region of the current buffer to be encoded. - - -The following additional properties are recognized if TYPE is 'iso2022: - -'charset-g0 -'charset-g1 -'charset-g2 -'charset-g3 - The character set initially designated to the G0 - G3 registers. - The value should be one of - - -- A charset object (designate that character set) - -- nil (do not ever use this register) - -- t (no character set is initially designated to - the register, but may be later on; this automatically - sets the corresponding `force-g*-on-output' property) - -'force-g0-on-output -'force-g1-on-output -'force-g2-on-output -'force-g2-on-output - If non-nil, send an explicit designation sequence on output before - using the specified register. - -'short - If non-nil, use the short forms "ESC $ @", "ESC $ A", and - "ESC $ B" on output in place of the full designation sequences - "ESC $ ( @", "ESC $ ( A", and "ESC $ ( B". - -'no-ascii-eol - If non-nil, don't designate ASCII to G0 at each end of line on output. - Setting this to non-nil also suppresses other state-resetting that - normally happens at the end of a line. - -'no-ascii-cntl - If non-nil, don't designate ASCII to G0 before control chars on output. - -'seven - If non-nil, use 7-bit environment on output. Otherwise, use 8-bit - environment. - -'lock-shift - If non-nil, use locking-shift (SO/SI) instead of single-shift - or designation by escape sequence. - -'no-iso6429 - If non-nil, don't use ISO6429's direction specification. - -'escape-quoted - If non-nil, literal control characters that are the same as - the beginning of a recognized ISO2022 or ISO6429 escape sequence - (in particular, ESC (0x1B), SO (0x0E), SI (0x0F), SS2 (0x8E), - SS3 (0x8F), and CSI (0x9B)) are "quoted" with an escape character - so that they can be properly distinguished from an escape sequence. - (Note that doing this results in a non-portable encoding.) This - encoding flag is used for byte-compiled files. Note that ESC - is a good choice for a quoting character because there are no - escape sequences whose second byte is a character from the Control-0 - or Control-1 character sets; this is explicitly disallowed by the - ISO2022 standard. - -'input-charset-conversion - A list of conversion specifications, specifying conversion of - characters in one charset to another when decoding is performed. - Each specification is a list of two elements: the source charset, - and the destination charset. - -'output-charset-conversion - A list of conversion specifications, specifying conversion of - characters in one charset to another when encoding is performed. - The form of each specification is the same as for - 'input-charset-conversion. - - -The following additional properties are recognized (and required) -if TYPE is 'ccl: - -'decode - CCL program used for decoding (converting to internal format). - -'encode - CCL program used for encoding (converting to external format). -*/ - (name, type, doc_string, props)) -{ - struct Lisp_Coding_System *codesys; - Lisp_Object rest, key, value; - enum coding_system_type ty; - int need_to_setup_eol_systems = 1; - - /* Convert type to constant */ - if (NILP (type) || EQ (type, Qundecided)) - { ty = CODESYS_AUTODETECT; } - else if (EQ (type, Qshift_jis)) { ty = CODESYS_SHIFT_JIS; } - else if (EQ (type, Qiso2022)) { ty = CODESYS_ISO2022; } - else if (EQ (type, Qbig5)) { ty = CODESYS_BIG5; } - else if (EQ (type, Qccl)) { ty = CODESYS_CCL; } - else if (EQ (type, Qno_conversion)) { ty = CODESYS_NO_CONVERSION; } -#ifdef DEBUG_XEMACS - else if (EQ (type, Qinternal)) { ty = CODESYS_INTERNAL; } -#endif - else - signal_simple_error ("Invalid coding system type", type); - - CHECK_SYMBOL (name); - - codesys = allocate_coding_system (ty, name); - - if (NILP (doc_string)) - doc_string = build_string (""); - else - CHECK_STRING (doc_string); - CODING_SYSTEM_DOC_STRING (codesys) = doc_string; - - EXTERNAL_PROPERTY_LIST_LOOP (rest, key, value, props) - { - if (EQ (key, Qmnemonic)) - { - if (!NILP (value)) - CHECK_STRING (value); - CODING_SYSTEM_MNEMONIC (codesys) = value; - } - - else if (EQ (key, Qeol_type)) - { - need_to_setup_eol_systems = NILP (value); - if (EQ (value, Qt)) - value = Qnil; - CODING_SYSTEM_EOL_TYPE (codesys) = symbol_to_eol_type (value); - } - - else if (EQ (key, Qpost_read_conversion)) CODING_SYSTEM_POST_READ_CONVERSION (codesys) = value; - else if (EQ (key, Qpre_write_conversion)) CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys) = value; - else if (ty == CODESYS_ISO2022) - { -#define FROB_INITIAL_CHARSET(charset_num) \ - CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, charset_num) = \ - ((EQ (value, Qt) || EQ (value, Qnil)) ? value : Fget_charset (value)) - - if (EQ (key, Qcharset_g0)) FROB_INITIAL_CHARSET (0); - else if (EQ (key, Qcharset_g1)) FROB_INITIAL_CHARSET (1); - else if (EQ (key, Qcharset_g2)) FROB_INITIAL_CHARSET (2); - else if (EQ (key, Qcharset_g3)) FROB_INITIAL_CHARSET (3); - -#define FROB_FORCE_CHARSET(charset_num) \ - CODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT (codesys, charset_num) = !NILP (value) - - else if (EQ (key, Qforce_g0_on_output)) FROB_FORCE_CHARSET (0); - else if (EQ (key, Qforce_g1_on_output)) FROB_FORCE_CHARSET (1); - else if (EQ (key, Qforce_g2_on_output)) FROB_FORCE_CHARSET (2); - else if (EQ (key, Qforce_g3_on_output)) FROB_FORCE_CHARSET (3); - -#define FROB_BOOLEAN_PROPERTY(prop) \ - CODING_SYSTEM_ISO2022_##prop (codesys) = !NILP (value) - - else if (EQ (key, Qshort)) FROB_BOOLEAN_PROPERTY (SHORT); - else if (EQ (key, Qno_ascii_eol)) FROB_BOOLEAN_PROPERTY (NO_ASCII_EOL); - else if (EQ (key, Qno_ascii_cntl)) FROB_BOOLEAN_PROPERTY (NO_ASCII_CNTL); - else if (EQ (key, Qseven)) FROB_BOOLEAN_PROPERTY (SEVEN); - else if (EQ (key, Qlock_shift)) FROB_BOOLEAN_PROPERTY (LOCK_SHIFT); - else if (EQ (key, Qno_iso6429)) FROB_BOOLEAN_PROPERTY (NO_ISO6429); - else if (EQ (key, Qescape_quoted)) FROB_BOOLEAN_PROPERTY (ESCAPE_QUOTED); - - else if (EQ (key, Qinput_charset_conversion)) - { - codesys->iso2022.input_conv = - Dynarr_new (charset_conversion_spec); - parse_charset_conversion_specs (codesys->iso2022.input_conv, - value); - } - else if (EQ (key, Qoutput_charset_conversion)) - { - codesys->iso2022.output_conv = - Dynarr_new (charset_conversion_spec); - parse_charset_conversion_specs (codesys->iso2022.output_conv, - value); - } - else - signal_simple_error ("Unrecognized property", key); - } - else if (EQ (type, Qccl)) - { - if (EQ (key, Qdecode)) - { - CHECK_VECTOR (value); - CODING_SYSTEM_CCL_DECODE (codesys) = value; - } - else if (EQ (key, Qencode)) - { - CHECK_VECTOR (value); - CODING_SYSTEM_CCL_ENCODE (codesys) = value; - } - else - signal_simple_error ("Unrecognized property", key); - } - else - signal_simple_error ("Unrecognized property", key); - } - - if (need_to_setup_eol_systems) - setup_eol_coding_systems (codesys); - - { - Lisp_Object codesys_obj; - XSETCODING_SYSTEM (codesys_obj, codesys); - Fputhash (name, codesys_obj, Vcoding_system_hash_table); - return codesys_obj; - } -} - -DEFUN ("copy-coding-system", Fcopy_coding_system, 2, 2, 0, /* -Copy OLD-CODING-SYSTEM to NEW-NAME. -If NEW-NAME does not name an existing coding system, a new one will -be created. -*/ - (old_coding_system, new_name)) -{ - Lisp_Object new_coding_system; - old_coding_system = Fget_coding_system (old_coding_system); - new_coding_system = Ffind_coding_system (new_name); - if (NILP (new_coding_system)) - { - XSETCODING_SYSTEM (new_coding_system, - allocate_coding_system - (XCODING_SYSTEM_TYPE (old_coding_system), - new_name)); - Fputhash (new_name, new_coding_system, Vcoding_system_hash_table); - } - - { - struct Lisp_Coding_System *to = XCODING_SYSTEM (new_coding_system); - struct Lisp_Coding_System *from = XCODING_SYSTEM (old_coding_system); - memcpy (((char *) to ) + sizeof (to->header), - ((char *) from) + sizeof (from->header), - sizeof (*from) - sizeof (from->header)); - to->name = new_name; - } - return new_coding_system; -} - -static Lisp_Object -subsidiary_coding_system (Lisp_Object coding_system, enum eol_type type) -{ - struct Lisp_Coding_System *cs = XCODING_SYSTEM (coding_system); - Lisp_Object new_coding_system; - - if (CODING_SYSTEM_EOL_TYPE (cs) != EOL_AUTODETECT) - return coding_system; - - switch (type) - { - case EOL_AUTODETECT: return coding_system; - case EOL_LF: new_coding_system = CODING_SYSTEM_EOL_LF (cs); break; - case EOL_CR: new_coding_system = CODING_SYSTEM_EOL_CR (cs); break; - case EOL_CRLF: new_coding_system = CODING_SYSTEM_EOL_CRLF (cs); break; - default: abort (); - } - - return NILP (new_coding_system) ? coding_system : new_coding_system; -} - -DEFUN ("subsidiary-coding-system", Fsubsidiary_coding_system, 2, 2, 0, /* -Return the subsidiary coding system of CODING-SYSTEM with eol type EOL-TYPE. -*/ - (coding_system, eol_type)) -{ - coding_system = Fget_coding_system (coding_system); - - return subsidiary_coding_system (coding_system, - symbol_to_eol_type (eol_type)); -} - - -/************************************************************************/ -/* Coding system accessors */ -/************************************************************************/ - -DEFUN ("coding-system-doc-string", Fcoding_system_doc_string, 1, 1, 0, /* -Return the doc string for CODING-SYSTEM. -*/ - (coding_system)) -{ - coding_system = Fget_coding_system (coding_system); - return XCODING_SYSTEM_DOC_STRING (coding_system); -} - -DEFUN ("coding-system-type", Fcoding_system_type, 1, 1, 0, /* -Return the type of CODING-SYSTEM. -*/ - (coding_system)) -{ - switch (XCODING_SYSTEM_TYPE (Fget_coding_system (coding_system))) - { - case CODESYS_AUTODETECT: return Qundecided; - case CODESYS_SHIFT_JIS: return Qshift_jis; - case CODESYS_ISO2022: return Qiso2022; - case CODESYS_BIG5: return Qbig5; - case CODESYS_CCL: return Qccl; - case CODESYS_NO_CONVERSION: return Qno_conversion; -#ifdef DEBUG_XEMACS - case CODESYS_INTERNAL: return Qinternal; -#endif - default: - abort (); - } - - return Qnil; /* not reached */ -} - -static -Lisp_Object coding_system_charset (Lisp_Object coding_system, int gnum) -{ - Lisp_Object cs - = XCODING_SYSTEM_ISO2022_INITIAL_CHARSET (coding_system, gnum); - - return CHARSETP (cs) ? XCHARSET_NAME (cs) : Qnil; -} - -DEFUN ("coding-system-charset", Fcoding_system_charset, 2, 2, 0, /* -Return initial charset of CODING-SYSTEM designated to GNUM. -GNUM allows 0 .. 3. -*/ - (coding_system, gnum)) -{ - coding_system = Fget_coding_system (coding_system); - CHECK_INT (gnum); - - return coding_system_charset (coding_system, XINT (gnum)); -} - -DEFUN ("coding-system-property", Fcoding_system_property, 2, 2, 0, /* -Return the PROP property of CODING-SYSTEM. -*/ - (coding_system, prop)) -{ - int i, ok = 0; - enum coding_system_type type; - - coding_system = Fget_coding_system (coding_system); - CHECK_SYMBOL (prop); - type = XCODING_SYSTEM_TYPE (coding_system); - - for (i = 0; !ok && i < Dynarr_length (the_codesys_prop_dynarr); i++) - if (EQ (Dynarr_at (the_codesys_prop_dynarr, i).sym, prop)) - { - ok = 1; - switch (Dynarr_at (the_codesys_prop_dynarr, i).prop_type) - { - case CODESYS_PROP_ALL_OK: - break; - - case CODESYS_PROP_ISO2022: - if (type != CODESYS_ISO2022) - signal_simple_error - ("Property only valid in ISO2022 coding systems", - prop); - break; - - case CODESYS_PROP_CCL: - if (type != CODESYS_CCL) - signal_simple_error - ("Property only valid in CCL coding systems", - prop); - break; - - default: - abort (); - } - } - - if (!ok) - signal_simple_error ("Unrecognized property", prop); - - if (EQ (prop, Qname)) - return XCODING_SYSTEM_NAME (coding_system); - else if (EQ (prop, Qtype)) - return Fcoding_system_type (coding_system); - else if (EQ (prop, Qdoc_string)) - return XCODING_SYSTEM_DOC_STRING (coding_system); - else if (EQ (prop, Qmnemonic)) - return XCODING_SYSTEM_MNEMONIC (coding_system); - else if (EQ (prop, Qeol_type)) - return eol_type_to_symbol (XCODING_SYSTEM_EOL_TYPE (coding_system)); - else if (EQ (prop, Qeol_lf)) - return XCODING_SYSTEM_EOL_LF (coding_system); - else if (EQ (prop, Qeol_crlf)) - return XCODING_SYSTEM_EOL_CRLF (coding_system); - else if (EQ (prop, Qeol_cr)) - return XCODING_SYSTEM_EOL_CR (coding_system); - else if (EQ (prop, Qpost_read_conversion)) - return XCODING_SYSTEM_POST_READ_CONVERSION (coding_system); - else if (EQ (prop, Qpre_write_conversion)) - return XCODING_SYSTEM_PRE_WRITE_CONVERSION (coding_system); - else if (type == CODESYS_ISO2022) - { - if (EQ (prop, Qcharset_g0)) - return coding_system_charset (coding_system, 0); - else if (EQ (prop, Qcharset_g1)) - return coding_system_charset (coding_system, 1); - else if (EQ (prop, Qcharset_g2)) - return coding_system_charset (coding_system, 2); - else if (EQ (prop, Qcharset_g3)) - return coding_system_charset (coding_system, 3); - -#define FORCE_CHARSET(charset_num) \ - (XCODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT \ - (coding_system, charset_num) ? Qt : Qnil) - - else if (EQ (prop, Qforce_g0_on_output)) return FORCE_CHARSET (0); - else if (EQ (prop, Qforce_g1_on_output)) return FORCE_CHARSET (1); - else if (EQ (prop, Qforce_g2_on_output)) return FORCE_CHARSET (2); - else if (EQ (prop, Qforce_g3_on_output)) return FORCE_CHARSET (3); - -#define LISP_BOOLEAN(prop) \ - (XCODING_SYSTEM_ISO2022_##prop (coding_system) ? Qt : Qnil) - - else if (EQ (prop, Qshort)) return LISP_BOOLEAN (SHORT); - else if (EQ (prop, Qno_ascii_eol)) return LISP_BOOLEAN (NO_ASCII_EOL); - else if (EQ (prop, Qno_ascii_cntl)) return LISP_BOOLEAN (NO_ASCII_CNTL); - else if (EQ (prop, Qseven)) return LISP_BOOLEAN (SEVEN); - else if (EQ (prop, Qlock_shift)) return LISP_BOOLEAN (LOCK_SHIFT); - else if (EQ (prop, Qno_iso6429)) return LISP_BOOLEAN (NO_ISO6429); - else if (EQ (prop, Qescape_quoted)) return LISP_BOOLEAN (ESCAPE_QUOTED); - - else if (EQ (prop, Qinput_charset_conversion)) - return - unparse_charset_conversion_specs - (XCODING_SYSTEM (coding_system)->iso2022.input_conv); - else if (EQ (prop, Qoutput_charset_conversion)) - return - unparse_charset_conversion_specs - (XCODING_SYSTEM (coding_system)->iso2022.output_conv); - else - abort (); - } - else if (type == CODESYS_CCL) - { - if (EQ (prop, Qdecode)) - return XCODING_SYSTEM_CCL_DECODE (coding_system); - else if (EQ (prop, Qencode)) - return XCODING_SYSTEM_CCL_ENCODE (coding_system); - else - abort (); - } - else - abort (); - - return Qnil; /* not reached */ -} - - -/************************************************************************/ -/* Coding category functions */ -/************************************************************************/ - -static int -decode_coding_category (Lisp_Object symbol) -{ - int i; - - CHECK_SYMBOL (symbol); - for (i = 0; i <= CODING_CATEGORY_LAST; i++) - if (EQ (coding_category_symbol[i], symbol)) - return i; - - signal_simple_error ("Unrecognized coding category", symbol); - return 0; /* not reached */ -} - -DEFUN ("coding-category-list", Fcoding_category_list, 0, 0, 0, /* -Return a list of all recognized coding categories. -*/ - ()) -{ - int i; - Lisp_Object list = Qnil; - - for (i = CODING_CATEGORY_LAST; i >= 0; i--) - list = Fcons (coding_category_symbol[i], list); - return list; -} - -DEFUN ("set-coding-priority-list", Fset_coding_priority_list, 1, 1, 0, /* -Change the priority order of the coding categories. -LIST should be list of coding categories, in descending order of -priority. Unspecified coding categories will be lower in priority -than all specified ones, in the same relative order they were in -previously. -*/ - (list)) -{ - int category_to_priority[CODING_CATEGORY_LAST + 1]; - int i, j; - Lisp_Object rest; - - /* First generate a list that maps coding categories to priorities. */ - - for (i = 0; i <= CODING_CATEGORY_LAST; i++) - category_to_priority[i] = -1; - - /* Highest priority comes from the specified list. */ - i = 0; - EXTERNAL_LIST_LOOP (rest, list) - { - int cat = decode_coding_category (XCAR (rest)); - - if (category_to_priority[cat] >= 0) - signal_simple_error ("Duplicate coding category in list", XCAR (rest)); - category_to_priority[cat] = i++; - } - - /* Now go through the existing categories by priority to retrieve - the categories not yet specified and preserve their priority - order. */ - for (j = 0; j <= CODING_CATEGORY_LAST; j++) - { - int cat = coding_category_by_priority[j]; - if (category_to_priority[cat] < 0) - category_to_priority[cat] = i++; - } - - /* Now we need to construct the inverse of the mapping we just - constructed. */ - - for (i = 0; i <= CODING_CATEGORY_LAST; i++) - coding_category_by_priority[category_to_priority[i]] = i; - - /* Phew! That was confusing. */ - return Qnil; -} - -DEFUN ("coding-priority-list", Fcoding_priority_list, 0, 0, 0, /* -Return a list of coding categories in descending order of priority. -*/ - ()) -{ - int i; - Lisp_Object list = Qnil; - - for (i = CODING_CATEGORY_LAST; i >= 0; i--) - list = Fcons (coding_category_symbol[coding_category_by_priority[i]], - list); - return list; -} - -DEFUN ("set-coding-category-system", Fset_coding_category_system, 2, 2, 0, /* -Change the coding system associated with a coding category. -*/ - (coding_category, coding_system)) -{ - int cat = decode_coding_category (coding_category); - - coding_system = Fget_coding_system (coding_system); - coding_category_system[cat] = coding_system; - return Qnil; -} - -DEFUN ("coding-category-system", Fcoding_category_system, 1, 1, 0, /* -Return the coding system associated with a coding category. -*/ - (coding_category)) -{ - int cat = decode_coding_category (coding_category); - Lisp_Object sys = coding_category_system[cat]; - - if (!NILP (sys)) - return XCODING_SYSTEM_NAME (sys); - return Qnil; -} - - -/************************************************************************/ -/* Detecting the encoding of data */ -/************************************************************************/ - -struct detection_state -{ - enum eol_type eol_type; - int seen_non_ascii; - int mask; - - struct - { - int mask; - int in_second_byte; - } - big5; - - struct - { - int mask; - int in_second_byte; - } - shift_jis; - - struct - { - int mask; - int initted; - struct iso2022_decoder iso; - unsigned int flags; - int high_byte_count; - unsigned int saw_single_shift:1; - } - iso2022; - - struct - { - int seen_anything; - int just_saw_cr; - } - eol; -}; - -static int -acceptable_control_char_p (int c) -{ - switch (c) - { - /* Allow and ignore control characters that you might - reasonably see in a text file */ - case '\r': - case '\n': - case '\t': - case 7: /* bell */ - case 8: /* backspace */ - case 11: /* vertical tab */ - case 12: /* form feed */ - case 26: /* MS-DOS C-z junk */ - case 31: /* '^_' -- for info */ - return 1; - default: - return 0; - } -} - -static int -mask_has_at_most_one_bit_p (int mask) -{ - /* Perhaps the only thing useful you learn from intensive Microsoft - technical interviews */ - return (mask & (mask - 1)) == 0; -} - -static enum eol_type -detect_eol_type (struct detection_state *st, CONST unsigned char *src, - unsigned int n) -{ - int c; - - while (n--) - { - c = *src++; - if (c == '\r') - st->eol.just_saw_cr = 1; - else - { - if (c == '\n') - { - if (st->eol.just_saw_cr) - return EOL_CRLF; - else if (st->eol.seen_anything) - return EOL_LF; - } - else if (st->eol.just_saw_cr) - return EOL_CR; - st->eol.just_saw_cr = 0; - } - st->eol.seen_anything = 1; - } - - return EOL_AUTODETECT; -} - -/* Attempt to determine the encoding and EOL type of the given text. - Before calling this function for the first type, you must initialize - st->eol_type as appropriate and initialize st->mask to ~0. - - st->eol_type holds the determined EOL type, or EOL_AUTODETECT if - not yet known. - - st->mask holds the determined coding category mask, or ~0 if only - ASCII has been seen so far. - - Returns: - - 0 == st->eol_type is EOL_AUTODETECT and/or more than coding category - is present in st->mask - 1 == definitive answers are here for both st->eol_type and st->mask -*/ - -static int -detect_coding_type (struct detection_state *st, CONST unsigned char *src, - unsigned int n, int just_do_eol) -{ - int c; - - if (st->eol_type == EOL_AUTODETECT) - st->eol_type = detect_eol_type (st, src, n); - - if (just_do_eol) - return st->eol_type != EOL_AUTODETECT; - - if (!st->seen_non_ascii) - { - for (; n; n--, src++) - { - c = *src; - if ((c < 0x20 && !acceptable_control_char_p (c)) || c >= 0x80) - { - st->seen_non_ascii = 1; - st->shift_jis.mask = ~0; - st->big5.mask = ~0; - st->iso2022.mask = ~0; - break; - } - } - } - - if (!n) - return 0; - - if (!mask_has_at_most_one_bit_p (st->iso2022.mask)) - st->iso2022.mask = detect_coding_iso2022 (st, src, n); - if (!mask_has_at_most_one_bit_p (st->shift_jis.mask)) - st->shift_jis.mask = detect_coding_sjis (st, src, n); - if (!mask_has_at_most_one_bit_p (st->big5.mask)) - st->big5.mask = detect_coding_big5 (st, src, n); - - st->mask = st->iso2022.mask | st->shift_jis.mask | st->big5.mask; - - { - int retval = mask_has_at_most_one_bit_p (st->mask); - st->mask |= CODING_CATEGORY_NO_CONVERSION_MASK; - return retval && st->eol_type != EOL_AUTODETECT; - } -} - -static Lisp_Object -coding_system_from_mask (int mask) -{ - if (mask == ~0) - { - /* If the file was entirely or basically ASCII, use the - default value of `buffer-file-coding-system'. */ - Lisp_Object retval = - XBUFFER (Vbuffer_defaults)->buffer_file_coding_system; - if (!NILP (retval)) - { - retval = Ffind_coding_system (retval); - if (NILP (retval)) - { - warn_when_safe - (Qbad_variable, Qwarning, - "Invalid `default-buffer-file-coding-system', set to nil"); - XBUFFER (Vbuffer_defaults)->buffer_file_coding_system = Qnil; - } - } - if (NILP (retval)) - retval = Fget_coding_system (Qno_conversion); - return retval; - } - else - { - int i; - int cat = -1; - - mask = postprocess_iso2022_mask (mask); - - /* Look through the coding categories by priority and find - the first one that is allowed. */ - for (i = 0; i <= CODING_CATEGORY_LAST; i++) - { - cat = coding_category_by_priority[i]; - if ((mask & (1 << cat)) && - !NILP (coding_category_system[cat])) - break; - } - if (cat >= 0) - return coding_category_system[cat]; - else - return Fget_coding_system (Qno_conversion); - } -} - -/* Given a seekable read stream and potential coding system and EOL type - as specified, do any autodetection that is called for. If the - coding system and/or EOL type are not autodetect, they will be left - alone; but this function will never return an autodetect coding system - or EOL type. - - This function does not automatically fetch subsidiary coding systems; - that should be unnecessary with the explicit eol-type argument. */ - -void -determine_real_coding_system (Lstream *stream, Lisp_Object *codesys_in_out, - enum eol_type *eol_type_in_out) -{ - struct detection_state decst; - - if (*eol_type_in_out == EOL_AUTODETECT) - *eol_type_in_out = XCODING_SYSTEM_EOL_TYPE (*codesys_in_out); - - xzero (decst); - decst.eol_type = *eol_type_in_out; - decst.mask = ~0; - - /* If autodetection is called for, do it now. */ - if (XCODING_SYSTEM_TYPE (*codesys_in_out) == CODESYS_AUTODETECT || - *eol_type_in_out == EOL_AUTODETECT) - { - - while (1) - { - unsigned char random_buffer[4096]; - int nread; - - nread = Lstream_read (stream, random_buffer, sizeof (random_buffer)); - if (!nread) - break; - if (detect_coding_type (&decst, random_buffer, nread, - XCODING_SYSTEM_TYPE (*codesys_in_out) != - CODESYS_AUTODETECT)) - break; - } - - *eol_type_in_out = decst.eol_type; - if (XCODING_SYSTEM_TYPE (*codesys_in_out) == CODESYS_AUTODETECT) - *codesys_in_out = coding_system_from_mask (decst.mask); - } - - /* If we absolutely can't determine the EOL type, just assume LF. */ - if (*eol_type_in_out == EOL_AUTODETECT) - *eol_type_in_out = EOL_LF; - - Lstream_rewind (stream); -} - -DEFUN ("detect-coding-region", Fdetect_coding_region, 2, 3, 0, /* -Detect coding system of the text in the region between START and END. -Returned a list of possible coding systems ordered by priority. -If only ASCII characters are found, it returns 'undecided or one of -its subsidiary coding systems according to a detected end-of-line -type. Optional arg BUFFER defaults to the current buffer. -*/ - (start, end, buffer)) -{ - Lisp_Object val = Qnil; - struct buffer *buf = decode_buffer (buffer, 0); - Bufpos b, e; - Lisp_Object instream, lb_instream; - Lstream *istr, *lb_istr; - struct detection_state decst; - struct gcpro gcpro1, gcpro2; - - get_buffer_range_char (buf, start, end, &b, &e, 0); - lb_instream = make_lisp_buffer_input_stream (buf, b, e, 0); - lb_istr = XLSTREAM (lb_instream); - instream = make_encoding_input_stream (lb_istr, Fget_coding_system (Qbinary)); - istr = XLSTREAM (instream); - GCPRO2 (instream, lb_instream); - xzero (decst); - decst.eol_type = EOL_AUTODETECT; - decst.mask = ~0; - while (1) - { - unsigned char random_buffer[4096]; - int nread = Lstream_read (istr, random_buffer, sizeof (random_buffer)); - - if (!nread) - break; - if (detect_coding_type (&decst, random_buffer, nread, 0)) - break; - } - - if (decst.mask == ~0) - val = subsidiary_coding_system (Fget_coding_system (Qundecided), - decst.eol_type); - else - { - int i; - - val = Qnil; - - decst.mask = postprocess_iso2022_mask (decst.mask); - - for (i = CODING_CATEGORY_LAST; i >= 0; i--) - { - int sys = coding_category_by_priority[i]; - if (decst.mask & (1 << sys)) - { - Lisp_Object codesys = coding_category_system[sys]; - if (!NILP (codesys)) - codesys = subsidiary_coding_system (codesys, decst.eol_type); - val = Fcons (codesys, val); - } - } - } - Lstream_close (istr); - UNGCPRO; - Lstream_delete (istr); - Lstream_delete (lb_istr); - return val; -} - - -/************************************************************************/ -/* Converting to internal Mule format ("decoding") */ -/************************************************************************/ - -/* A decoding stream is a stream used for decoding text (i.e. - converting from some external format to internal format). - The decoding-stream object keeps track of the actual coding - stream, the stream that is at the other end, and data that - needs to be persistent across the lifetime of the stream. */ - -/* Handle the EOL stuff related to just-read-in character C. - EOL_TYPE is the EOL type of the coding stream. - FLAGS is the current value of FLAGS in the coding stream, and may - be modified by this macro. (The macro only looks at the - CODING_STATE_CR flag.) DST is the Dynarr to which the decoded - bytes are to be written. You need to also define a local goto - label "label_continue_loop" that is at the end of the main - character-reading loop. - - If C is a CR character, then this macro handles it entirely and - jumps to label_continue_loop. Otherwise, this macro does not add - anything to DST, and continues normally. You should continue - processing C normally after this macro. */ - -#define DECODE_HANDLE_EOL_TYPE(eol_type, c, flags, dst) \ -do { \ - if (c == '\r') \ - { \ - if (eol_type == EOL_CR) \ - Dynarr_add (dst, '\n'); \ - else if (eol_type != EOL_CRLF || flags & CODING_STATE_CR) \ - Dynarr_add (dst, c); \ - else \ - flags |= CODING_STATE_CR; \ - goto label_continue_loop; \ - } \ - else if (flags & CODING_STATE_CR) \ - { /* eol_type == CODING_SYSTEM_EOL_CRLF */ \ - if (c != '\n') \ - Dynarr_add (dst, '\r'); \ - flags &= ~CODING_STATE_CR; \ - } \ -} while (0) - -/* C should be a binary character in the range 0 - 255; convert - to internal format and add to Dynarr DST. */ - -#define DECODE_ADD_BINARY_CHAR(c, dst) \ -do { \ - if (BYTE_ASCII_P (c)) \ - Dynarr_add (dst, c); \ - else if (BYTE_C1_P (c)) \ - { \ - Dynarr_add (dst, LEADING_BYTE_CONTROL_1); \ - Dynarr_add (dst, c + 0x20); \ - } \ - else \ - { \ - Dynarr_add (dst, LEADING_BYTE_LATIN_ISO8859_1); \ - Dynarr_add (dst, c); \ - } \ -} while (0) - -#define DECODE_OUTPUT_PARTIAL_CHAR(ch) \ -do { \ - if (ch) \ - { \ - DECODE_ADD_BINARY_CHAR (ch, dst); \ - ch = 0; \ - } \ -} while (0) - -#define DECODE_HANDLE_END_OF_CONVERSION(flags, ch, dst) \ -do { \ - DECODE_OUTPUT_PARTIAL_CHAR (ch); \ - if ((flags & CODING_STATE_END) && \ - (flags & CODING_STATE_CR)) \ - Dynarr_add (dst, '\r'); \ -} while (0) - -#define DECODING_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, decoding) - -struct decoding_stream -{ - /* Coding system that governs the conversion. */ - struct Lisp_Coding_System *codesys; - - /* Stream that we read the encoded data from or - write the decoded data to. */ - Lstream *other_end; - - /* If we are reading, then we can return only a fixed amount of - data, so if the conversion resulted in too much data, we store it - here for retrieval the next time around. */ - unsigned_char_dynarr *runoff; - - /* FLAGS holds flags indicating the current state of the decoding. - Some of these flags are dependent on the coding system. */ - unsigned int flags; - - /* CH holds a partially built-up character. Since we only deal - with one- and two-byte characters at the moment, we only use - this to store the first byte of a two-byte character. */ - unsigned int ch; - - /* EOL_TYPE specifies the type of end-of-line conversion that - currently applies. We need to keep this separate from the - EOL type stored in CODESYS because the latter might indicate - automatic EOL-type detection while the former will always - indicate a particular EOL type. */ - enum eol_type eol_type; - - /* Additional ISO2022 information. We define the structure above - because it's also needed by the detection routines. */ - struct iso2022_decoder iso2022; - - /* Additional information (the state of the running CCL program) - used by the CCL decoder. */ - struct ccl_program ccl; - - struct detection_state decst; -}; - -static int decoding_reader (Lstream *stream, unsigned char *data, size_t size); -static int decoding_writer (Lstream *stream, CONST unsigned char *data, size_t size); -static int decoding_rewinder (Lstream *stream); -static int decoding_seekable_p (Lstream *stream); -static int decoding_flusher (Lstream *stream); -static int decoding_closer (Lstream *stream); -static Lisp_Object decoding_marker (Lisp_Object stream, - void (*markobj) (Lisp_Object)); - -DEFINE_LSTREAM_IMPLEMENTATION ("decoding", lstream_decoding, - sizeof (struct decoding_stream)); - -static Lisp_Object -decoding_marker (Lisp_Object stream, void (*markobj) (Lisp_Object)) -{ - Lstream *str = DECODING_STREAM_DATA (XLSTREAM (stream))->other_end; - Lisp_Object str_obj; - - /* We do not need to mark the coding systems or charsets stored - within the stream because they are stored in a global list - and automatically marked. */ - - XSETLSTREAM (str_obj, str); - markobj (str_obj); - if (str->imp->marker) - return (str->imp->marker) (str_obj, markobj); - else - return Qnil; -} - -/* Read SIZE bytes of data and store it into DATA. We are a decoding stream - so we read data from the other end, decode it, and store it into DATA. */ - -static int -decoding_reader (Lstream *stream, unsigned char *data, size_t size) -{ - struct decoding_stream *str = DECODING_STREAM_DATA (stream); - unsigned char *orig_data = data; - int read_size; - int error_occurred = 0; - - /* We need to interface to mule_decode(), which expects to take some - amount of data and store the result into a Dynarr. We have - mule_decode() store into str->runoff, and take data from there - as necessary. */ - - /* We loop until we have enough data, reading chunks from the other - end and decoding it. */ - while (1) - { - /* Take data from the runoff if we can. Make sure to take at - most SIZE bytes, and delete the data from the runoff. */ - if (Dynarr_length (str->runoff) > 0) - { - size_t chunk = min (size, (size_t) Dynarr_length (str->runoff)); - memcpy (data, Dynarr_atp (str->runoff, 0), chunk); - Dynarr_delete_many (str->runoff, 0, chunk); - data += chunk; - size -= chunk; - } - - if (size == 0) - break; /* No more room for data */ - - if (str->flags & CODING_STATE_END) - /* This means that on the previous iteration, we hit the EOF on - the other end. We loop once more so that mule_decode() can - output any final stuff it may be holding, or any "go back - to a sane state" escape sequences. (This latter makes sense - during encoding.) */ - break; - - /* Exhausted the runoff, so get some more. DATA has at least - SIZE bytes left of storage in it, so it's OK to read directly - into it. (We'll be overwriting above, after we've decoded it - into the runoff.) */ - read_size = Lstream_read (str->other_end, data, size); - if (read_size < 0) - { - error_occurred = 1; - break; - } - if (read_size == 0) - /* There might be some more end data produced in the translation. - See the comment above. */ - str->flags |= CODING_STATE_END; - mule_decode (stream, data, str->runoff, read_size); - } - - if (data - orig_data == 0) - return error_occurred ? -1 : 0; - else - return data - orig_data; -} - -static int -decoding_writer (Lstream *stream, CONST unsigned char *data, size_t size) -{ - struct decoding_stream *str = DECODING_STREAM_DATA (stream); - int retval; - - /* Decode all our data into the runoff, and then attempt to write - it all out to the other end. Remove whatever chunk we succeeded - in writing. */ - mule_decode (stream, data, str->runoff, size); - retval = Lstream_write (str->other_end, Dynarr_atp (str->runoff, 0), - Dynarr_length (str->runoff)); - if (retval > 0) - Dynarr_delete_many (str->runoff, 0, retval); - /* Do NOT return retval. The return value indicates how much - of the incoming data was written, not how many bytes were - written. */ - return size; -} - -static void -reset_decoding_stream (struct decoding_stream *str) -{ - if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_ISO2022) - { - Lisp_Object coding_system; - XSETCODING_SYSTEM (coding_system, str->codesys); - reset_iso2022 (coding_system, &str->iso2022); - } - else if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_CCL) - { - setup_ccl_program (&str->ccl, CODING_SYSTEM_CCL_DECODE (str->codesys)); - } - - str->flags = str->ch = 0; -} - -static int -decoding_rewinder (Lstream *stream) -{ - struct decoding_stream *str = DECODING_STREAM_DATA (stream); - reset_decoding_stream (str); - Dynarr_reset (str->runoff); - return Lstream_rewind (str->other_end); -} - -static int -decoding_seekable_p (Lstream *stream) -{ - struct decoding_stream *str = DECODING_STREAM_DATA (stream); - return Lstream_seekable_p (str->other_end); -} - -static int -decoding_flusher (Lstream *stream) -{ - struct decoding_stream *str = DECODING_STREAM_DATA (stream); - return Lstream_flush (str->other_end); -} - -static int -decoding_closer (Lstream *stream) -{ - struct decoding_stream *str = DECODING_STREAM_DATA (stream); - if (stream->flags & LSTREAM_FL_WRITE) - { - str->flags |= CODING_STATE_END; - decoding_writer (stream, 0, 0); - } - Dynarr_free (str->runoff); - if (str->iso2022.composite_chars) - Dynarr_free (str->iso2022.composite_chars); - return Lstream_close (str->other_end); -} - -Lisp_Object -decoding_stream_coding_system (Lstream *stream) -{ - Lisp_Object coding_system; - struct decoding_stream *str = DECODING_STREAM_DATA (stream); - - XSETCODING_SYSTEM (coding_system, str->codesys); - return subsidiary_coding_system (coding_system, str->eol_type); -} - -void -set_decoding_stream_coding_system (Lstream *lstr, Lisp_Object codesys) -{ - struct Lisp_Coding_System *cs = XCODING_SYSTEM (codesys); - struct decoding_stream *str = DECODING_STREAM_DATA (lstr); - str->codesys = cs; - if (CODING_SYSTEM_EOL_TYPE (cs) != EOL_AUTODETECT) - str->eol_type = CODING_SYSTEM_EOL_TYPE (cs); - reset_decoding_stream (str); -} - -/* WARNING WARNING WARNING WARNING!!!!! If you open up a decoding - stream for writing, no automatic code detection will be performed. - The reason for this is that automatic code detection requires a - seekable input. Things will also fail if you open a decoding - stream for reading using a non-fully-specified coding system and - a non-seekable input stream. */ - -static Lisp_Object -make_decoding_stream_1 (Lstream *stream, Lisp_Object codesys, - CONST char *mode) -{ - Lstream *lstr = Lstream_new (lstream_decoding, mode); - struct decoding_stream *str = DECODING_STREAM_DATA (lstr); - Lisp_Object obj; - - xzero (*str); - str->other_end = stream; - str->runoff = (unsigned_char_dynarr *) Dynarr_new (unsigned_char); - str->eol_type = EOL_AUTODETECT; - if (!strcmp (mode, "r") - && Lstream_seekable_p (stream)) - /* We can determine the coding system now. */ - determine_real_coding_system (stream, &codesys, &str->eol_type); - set_decoding_stream_coding_system (lstr, codesys); - str->decst.eol_type = str->eol_type; - str->decst.mask = ~0; - XSETLSTREAM (obj, lstr); - return obj; -} - -Lisp_Object -make_decoding_input_stream (Lstream *stream, Lisp_Object codesys) -{ - return make_decoding_stream_1 (stream, codesys, "r"); -} - -Lisp_Object -make_decoding_output_stream (Lstream *stream, Lisp_Object codesys) -{ - return make_decoding_stream_1 (stream, codesys, "w"); -} - -/* Note: the decode_coding_* functions all take the same - arguments as mule_decode(), which is to say some SRC data of - size N, which is to be stored into dynamic array DST. - DECODING is the stream within which the decoding is - taking place, but no data is actually read from or - written to that stream; that is handled in decoding_reader() - or decoding_writer(). This allows the same functions to - be used for both reading and writing. */ - -static void -mule_decode (Lstream *decoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n) -{ - struct decoding_stream *str = DECODING_STREAM_DATA (decoding); - - /* If necessary, do encoding-detection now. We do this when - we're a writing stream or a non-seekable reading stream, - meaning that we can't just process the whole input, - rewind, and start over. */ - - if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_AUTODETECT || - str->eol_type == EOL_AUTODETECT) - { - Lisp_Object codesys; - - XSETCODING_SYSTEM (codesys, str->codesys); - detect_coding_type (&str->decst, src, n, - CODING_SYSTEM_TYPE (str->codesys) != - CODESYS_AUTODETECT); - if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_AUTODETECT && - str->decst.mask != ~0) - /* #### This is cheesy. What we really ought to do is - buffer up a certain amount of data so as to get a - less random result. */ - codesys = coding_system_from_mask (str->decst.mask); - str->eol_type = str->decst.eol_type; - if (XCODING_SYSTEM (codesys) != str->codesys) - { - /* Preserve the CODING_STATE_END flag in case it was set. - If we erase it, bad things might happen. */ - int was_end = str->flags & CODING_STATE_END; - set_decoding_stream_coding_system (decoding, codesys); - if (was_end) - str->flags |= CODING_STATE_END; - } - } - - switch (CODING_SYSTEM_TYPE (str->codesys)) - { -#ifdef DEBUG_XEMACS - case CODESYS_INTERNAL: - Dynarr_add_many (dst, src, n); - break; -#endif - case CODESYS_AUTODETECT: - /* If we got this far and still haven't decided on the coding - system, then do no conversion. */ - case CODESYS_NO_CONVERSION: - decode_coding_no_conversion (decoding, src, dst, n); - break; - case CODESYS_SHIFT_JIS: - decode_coding_sjis (decoding, src, dst, n); - break; - case CODESYS_BIG5: - decode_coding_big5 (decoding, src, dst, n); - break; - case CODESYS_CCL: - ccl_driver (&str->ccl, src, dst, n, 0); - break; - case CODESYS_ISO2022: - decode_coding_iso2022 (decoding, src, dst, n); - break; - default: - abort (); - } -} - -DEFUN ("decode-coding-region", Fdecode_coding_region, 3, 4, 0, /* -Decode the text between START and END which is encoded in CODING-SYSTEM. -This is useful if you've read in encoded text from a file without decoding -it (e.g. you read in a JIS-formatted file but used the `binary' or -`no-conversion' coding system, so that it shows up as "^[$B!<!+^[(B"). -Return length of decoded text. -BUFFER defaults to the current buffer if unspecified. -*/ - (start, end, coding_system, buffer)) -{ - Bufpos b, e; - struct buffer *buf = decode_buffer (buffer, 0); - Lisp_Object instream, lb_outstream, de_outstream, outstream; - Lstream *istr, *ostr; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - - get_buffer_range_char (buf, start, end, &b, &e, 0); - - barf_if_buffer_read_only (buf, b, e); - - coding_system = Fget_coding_system (coding_system); - instream = make_lisp_buffer_input_stream (buf, b, e, 0); - lb_outstream = make_lisp_buffer_output_stream (buf, b, 0); - de_outstream = make_decoding_output_stream (XLSTREAM (lb_outstream), - coding_system); - outstream = make_encoding_output_stream (XLSTREAM (de_outstream), - Fget_coding_system (Qbinary)); - istr = XLSTREAM (instream); - ostr = XLSTREAM (outstream); - GCPRO4 (instream, lb_outstream, de_outstream, outstream); - - /* The chain of streams looks like this: - - [BUFFER] <----- send through - ------> [ENCODE AS BINARY] - ------> [DECODE AS SPECIFIED] - ------> [BUFFER] - */ - - while (1) - { - char tempbuf[1024]; /* some random amount */ - Bufpos newpos, even_newer_pos; - Bufpos oldpos = lisp_buffer_stream_startpos (istr); - int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); - - if (!size_in_bytes) - break; - newpos = lisp_buffer_stream_startpos (istr); - Lstream_write (ostr, tempbuf, size_in_bytes); - even_newer_pos = lisp_buffer_stream_startpos (istr); - buffer_delete_range (buf, even_newer_pos - (newpos - oldpos), - even_newer_pos, 0); - } - Lstream_close (istr); - Lstream_close (ostr); - UNGCPRO; - Lstream_delete (istr); - Lstream_delete (ostr); - Lstream_delete (XLSTREAM (de_outstream)); - Lstream_delete (XLSTREAM (lb_outstream)); - return Qnil; -} - - -/************************************************************************/ -/* Converting to an external encoding ("encoding") */ -/************************************************************************/ - -/* An encoding stream is an output stream. When you create the - stream, you specify the coding system that governs the encoding - and another stream that the resulting encoded data is to be - sent to, and then start sending data to it. */ - -#define ENCODING_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, encoding) - -struct encoding_stream -{ - /* Coding system that governs the conversion. */ - struct Lisp_Coding_System *codesys; - - /* Stream that we read the encoded data from or - write the decoded data to. */ - Lstream *other_end; - - /* If we are reading, then we can return only a fixed amount of - data, so if the conversion resulted in too much data, we store it - here for retrieval the next time around. */ - unsigned_char_dynarr *runoff; - - /* FLAGS holds flags indicating the current state of the encoding. - Some of these flags are dependent on the coding system. */ - unsigned int flags; - - /* CH holds a partially built-up character. Since we only deal - with one- and two-byte characters at the moment, we only use - this to store the first byte of a two-byte character. */ - unsigned int ch; - - /* Additional information used by the ISO2022 encoder. */ - struct - { - /* CHARSET holds the character sets currently assigned to the G0 - through G3 registers. It is initialized from the array - INITIAL_CHARSET in CODESYS. */ - Lisp_Object charset[4]; - - /* Which registers are currently invoked into the left (GL) and - right (GR) halves of the 8-bit encoding space? */ - int register_left, register_right; - - /* Whether we need to explicitly designate the charset in the - G? register before using it. It is initialized from the - array FORCE_CHARSET_ON_OUTPUT in CODESYS. */ - unsigned char force_charset_on_output[4]; - - /* Other state variables that need to be preserved across - invocations. */ - Lisp_Object current_charset; - int current_half; - int current_char_boundary; - } iso2022; - - /* Additional information (the state of the running CCL program) - used by the CCL encoder. */ - struct ccl_program ccl; -}; - -static int encoding_reader (Lstream *stream, unsigned char *data, size_t size); -static int encoding_writer (Lstream *stream, CONST unsigned char *data, - size_t size); -static int encoding_rewinder (Lstream *stream); -static int encoding_seekable_p (Lstream *stream); -static int encoding_flusher (Lstream *stream); -static int encoding_closer (Lstream *stream); -static Lisp_Object encoding_marker (Lisp_Object stream, - void (*markobj) (Lisp_Object)); - -DEFINE_LSTREAM_IMPLEMENTATION ("encoding", lstream_encoding, - sizeof (struct encoding_stream)); - -static Lisp_Object -encoding_marker (Lisp_Object stream, void (*markobj) (Lisp_Object)) -{ - Lstream *str = ENCODING_STREAM_DATA (XLSTREAM (stream))->other_end; - Lisp_Object str_obj; - - /* We do not need to mark the coding systems or charsets stored - within the stream because they are stored in a global list - and automatically marked. */ - - XSETLSTREAM (str_obj, str); - markobj (str_obj); - if (str->imp->marker) - return (str->imp->marker) (str_obj, markobj); - else - return Qnil; -} - -/* Read SIZE bytes of data and store it into DATA. We are a encoding stream - so we read data from the other end, encode it, and store it into DATA. */ - -static int -encoding_reader (Lstream *stream, unsigned char *data, size_t size) -{ - struct encoding_stream *str = ENCODING_STREAM_DATA (stream); - unsigned char *orig_data = data; - int read_size; - int error_occurred = 0; - - /* We need to interface to mule_encode(), which expects to take some - amount of data and store the result into a Dynarr. We have - mule_encode() store into str->runoff, and take data from there - as necessary. */ - - /* We loop until we have enough data, reading chunks from the other - end and encoding it. */ - while (1) - { - /* Take data from the runoff if we can. Make sure to take at - most SIZE bytes, and delete the data from the runoff. */ - if (Dynarr_length (str->runoff) > 0) - { - int chunk = min ((int) size, Dynarr_length (str->runoff)); - memcpy (data, Dynarr_atp (str->runoff, 0), chunk); - Dynarr_delete_many (str->runoff, 0, chunk); - data += chunk; - size -= chunk; - } - - if (size == 0) - break; /* No more room for data */ - - if (str->flags & CODING_STATE_END) - /* This means that on the previous iteration, we hit the EOF on - the other end. We loop once more so that mule_encode() can - output any final stuff it may be holding, or any "go back - to a sane state" escape sequences. (This latter makes sense - during encoding.) */ - break; - - /* Exhausted the runoff, so get some more. DATA at least SIZE bytes - left of storage in it, so it's OK to read directly into it. - (We'll be overwriting above, after we've encoded it into the - runoff.) */ - read_size = Lstream_read (str->other_end, data, size); - if (read_size < 0) - { - error_occurred = 1; - break; - } - if (read_size == 0) - /* There might be some more end data produced in the translation. - See the comment above. */ - str->flags |= CODING_STATE_END; - mule_encode (stream, data, str->runoff, read_size); - } - - if (data == orig_data) - return error_occurred ? -1 : 0; - else - return data - orig_data; -} - -static int -encoding_writer (Lstream *stream, CONST unsigned char *data, size_t size) -{ - struct encoding_stream *str = ENCODING_STREAM_DATA (stream); - int retval; - - /* Encode all our data into the runoff, and then attempt to write - it all out to the other end. Remove whatever chunk we succeeded - in writing. */ - mule_encode (stream, data, str->runoff, size); - retval = Lstream_write (str->other_end, Dynarr_atp (str->runoff, 0), - Dynarr_length (str->runoff)); - if (retval > 0) - Dynarr_delete_many (str->runoff, 0, retval); - /* Do NOT return retval. The return value indicates how much - of the incoming data was written, not how many bytes were - written. */ - return size; -} - -static void -reset_encoding_stream (struct encoding_stream *str) -{ - switch (CODING_SYSTEM_TYPE (str->codesys)) - { - case CODESYS_ISO2022: - { - int i; - - for (i = 0; i < 4; i++) - { - str->iso2022.charset[i] = - CODING_SYSTEM_ISO2022_INITIAL_CHARSET (str->codesys, i); - str->iso2022.force_charset_on_output[i] = - CODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT (str->codesys, i); - } - str->iso2022.register_left = 0; - str->iso2022.register_right = 1; - str->iso2022.current_charset = Qnil; - str->iso2022.current_half = 0; - str->iso2022.current_char_boundary = 1; - break; - } - case CODESYS_CCL: - setup_ccl_program (&str->ccl, CODING_SYSTEM_CCL_ENCODE (str->codesys)); - break; - default: - break; - } - - str->flags = str->ch = 0; -} - -static int -encoding_rewinder (Lstream *stream) -{ - struct encoding_stream *str = ENCODING_STREAM_DATA (stream); - reset_encoding_stream (str); - Dynarr_reset (str->runoff); - return Lstream_rewind (str->other_end); -} - -static int -encoding_seekable_p (Lstream *stream) -{ - struct encoding_stream *str = ENCODING_STREAM_DATA (stream); - return Lstream_seekable_p (str->other_end); -} - -static int -encoding_flusher (Lstream *stream) -{ - struct encoding_stream *str = ENCODING_STREAM_DATA (stream); - return Lstream_flush (str->other_end); -} - -static int -encoding_closer (Lstream *stream) -{ - struct encoding_stream *str = ENCODING_STREAM_DATA (stream); - if (stream->flags & LSTREAM_FL_WRITE) - { - str->flags |= CODING_STATE_END; - encoding_writer (stream, 0, 0); - } - Dynarr_free (str->runoff); - return Lstream_close (str->other_end); -} - -Lisp_Object -encoding_stream_coding_system (Lstream *stream) -{ - Lisp_Object coding_system; - struct encoding_stream *str = ENCODING_STREAM_DATA (stream); - - XSETCODING_SYSTEM (coding_system, str->codesys); - return coding_system; -} - -void -set_encoding_stream_coding_system (Lstream *lstr, Lisp_Object codesys) -{ - struct Lisp_Coding_System *cs = XCODING_SYSTEM (codesys); - struct encoding_stream *str = ENCODING_STREAM_DATA (lstr); - str->codesys = cs; - reset_encoding_stream (str); -} - -static Lisp_Object -make_encoding_stream_1 (Lstream *stream, Lisp_Object codesys, - CONST char *mode) -{ - Lstream *lstr = Lstream_new (lstream_encoding, mode); - struct encoding_stream *str = ENCODING_STREAM_DATA (lstr); - Lisp_Object obj; - - xzero (*str); - str->runoff = Dynarr_new (unsigned_char); - str->other_end = stream; - set_encoding_stream_coding_system (lstr, codesys); - XSETLSTREAM (obj, lstr); - return obj; -} - -Lisp_Object -make_encoding_input_stream (Lstream *stream, Lisp_Object codesys) -{ - return make_encoding_stream_1 (stream, codesys, "r"); -} - -Lisp_Object -make_encoding_output_stream (Lstream *stream, Lisp_Object codesys) -{ - return make_encoding_stream_1 (stream, codesys, "w"); -} - -/* Convert N bytes of internally-formatted data stored in SRC to an - external format, according to the encoding stream ENCODING. - Store the encoded data into DST. */ - -static void -mule_encode (Lstream *encoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n) -{ - struct encoding_stream *str = ENCODING_STREAM_DATA (encoding); - - switch (CODING_SYSTEM_TYPE (str->codesys)) - { -#ifdef DEBUG_XEMACS - case CODESYS_INTERNAL: - Dynarr_add_many (dst, src, n); - break; -#endif - case CODESYS_AUTODETECT: - /* If we got this far and still haven't decided on the coding - system, then do no conversion. */ - case CODESYS_NO_CONVERSION: - encode_coding_no_conversion (encoding, src, dst, n); - break; - case CODESYS_SHIFT_JIS: - encode_coding_sjis (encoding, src, dst, n); - break; - case CODESYS_BIG5: - encode_coding_big5 (encoding, src, dst, n); - break; - case CODESYS_CCL: - ccl_driver (&str->ccl, src, dst, n, 0); - break; - case CODESYS_ISO2022: - encode_coding_iso2022 (encoding, src, dst, n); - break; - default: - abort (); - } -} - -DEFUN ("encode-coding-region", Fencode_coding_region, 3, 4, 0, /* -Encode the text between START and END using CODING-SYSTEM. -This will, for example, convert Japanese characters into stuff such as -"^[$B!<!+^[(B" if you use the JIS encoding. Return length of encoded -text. BUFFER defaults to the current buffer if unspecified. -*/ - (start, end, coding_system, buffer)) -{ - Bufpos b, e; - struct buffer *buf = decode_buffer (buffer, 0); - Lisp_Object instream, lb_outstream, de_outstream, outstream; - Lstream *istr, *ostr; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - - get_buffer_range_char (buf, start, end, &b, &e, 0); - - barf_if_buffer_read_only (buf, b, e); - - coding_system = Fget_coding_system (coding_system); - instream = make_lisp_buffer_input_stream (buf, b, e, 0); - lb_outstream = make_lisp_buffer_output_stream (buf, b, 0); - de_outstream = make_decoding_output_stream (XLSTREAM (lb_outstream), - Fget_coding_system (Qbinary)); - outstream = make_encoding_output_stream (XLSTREAM (de_outstream), - coding_system); - istr = XLSTREAM (instream); - ostr = XLSTREAM (outstream); - GCPRO4 (instream, outstream, de_outstream, lb_outstream); - /* The chain of streams looks like this: - - [BUFFER] <----- send through - ------> [ENCODE AS SPECIFIED] - ------> [DECODE AS BINARY] - ------> [BUFFER] - */ - while (1) - { - char tempbuf[1024]; /* some random amount */ - Bufpos newpos, even_newer_pos; - Bufpos oldpos = lisp_buffer_stream_startpos (istr); - int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); - - if (!size_in_bytes) - break; - newpos = lisp_buffer_stream_startpos (istr); - Lstream_write (ostr, tempbuf, size_in_bytes); - even_newer_pos = lisp_buffer_stream_startpos (istr); - buffer_delete_range (buf, even_newer_pos - (newpos - oldpos), - even_newer_pos, 0); - } - - { - Charcount retlen = - lisp_buffer_stream_startpos (XLSTREAM (instream)) - b; - Lstream_close (istr); - Lstream_close (ostr); - UNGCPRO; - Lstream_delete (istr); - Lstream_delete (ostr); - Lstream_delete (XLSTREAM (de_outstream)); - Lstream_delete (XLSTREAM (lb_outstream)); - return make_int (retlen); - } -} - - -/************************************************************************/ -/* Shift-JIS methods */ -/************************************************************************/ - -/* Shift-JIS is a coding system encoding three character sets: ASCII, right - half of JISX0201-Kana, and JISX0208. An ASCII character is encoded - as is. A character of JISX0201-Kana (TYPE94 character set) is - encoded by "position-code + 0x80". A character of JISX0208 - (TYPE94x94 character set) is encoded in 2-byte but two - position-codes are divided and shifted so that it fit in the range - below. - - --- CODE RANGE of Shift-JIS --- - (character set) (range) - ASCII 0x00 .. 0x7F - JISX0201-Kana 0xA0 .. 0xDF - JISX0208 (1st byte) 0x80 .. 0x9F and 0xE0 .. 0xEF - (2nd byte) 0x40 .. 0x7E and 0x80 .. 0xFC - ------------------------------- - -*/ - -/* Is this the first byte of a Shift-JIS two-byte char? */ - -#define BYTE_SJIS_TWO_BYTE_1_P(c) \ - (((c) >= 0x81 && (c) <= 0x9F) || ((c) >= 0xE0 && (c) <= 0xEF)) - -/* Is this the second byte of a Shift-JIS two-byte char? */ - -#define BYTE_SJIS_TWO_BYTE_2_P(c) \ - (((c) >= 0x40 && (c) <= 0x7E) || ((c) >= 0x80 && (c) <= 0xFC)) - -#define BYTE_SJIS_KATAKANA_P(c) \ - ((c) >= 0xA1 && (c) <= 0xDF) - -static int -detect_coding_sjis (struct detection_state *st, CONST unsigned char *src, - unsigned int n) -{ - int c; - - while (n--) - { - c = *src++; - if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO) - return 0; - if (st->shift_jis.in_second_byte) - { - st->shift_jis.in_second_byte = 0; - if (c < 0x40) - return 0; - } - else if ((c >= 0x80 && c < 0xA0) || c >= 0xE0) - st->shift_jis.in_second_byte = 1; - } - return CODING_CATEGORY_SHIFT_JIS_MASK; -} - -/* Convert Shift-JIS data to internal format. */ - -static void -decode_coding_sjis (Lstream *decoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n) -{ - unsigned char c; - unsigned int flags, ch; - enum eol_type eol_type; - struct decoding_stream *str = DECODING_STREAM_DATA (decoding); - - CODING_STREAM_DECOMPOSE (str, flags, ch); - eol_type = str->eol_type; - - while (n--) - { - c = *src++; - - if (ch) - { - /* Previous character was first byte of Shift-JIS Kanji char. */ - if (BYTE_SJIS_TWO_BYTE_2_P (c)) - { - unsigned char e1, e2; - - Dynarr_add (dst, LEADING_BYTE_JAPANESE_JISX0208); - DECODE_SJIS (ch, c, e1, e2); - Dynarr_add (dst, e1); - Dynarr_add (dst, e2); - } - else - { - DECODE_ADD_BINARY_CHAR (ch, dst); - DECODE_ADD_BINARY_CHAR (c, dst); - } - ch = 0; - } - else - { - DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst); - if (BYTE_SJIS_TWO_BYTE_1_P (c)) - ch = c; - else if (BYTE_SJIS_KATAKANA_P (c)) - { - Dynarr_add (dst, LEADING_BYTE_KATAKANA_JISX0201); - Dynarr_add (dst, c); - } - else - DECODE_ADD_BINARY_CHAR (c, dst); - } - label_continue_loop:; - } - - DECODE_HANDLE_END_OF_CONVERSION (flags, ch, dst); - - CODING_STREAM_COMPOSE (str, flags, ch); -} - -/* Convert internally-formatted data to Shift-JIS. */ - -static void -encode_coding_sjis (Lstream *encoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n) -{ - unsigned char c; - struct encoding_stream *str = ENCODING_STREAM_DATA (encoding); - unsigned int flags, ch; - enum eol_type eol_type; - - CODING_STREAM_DECOMPOSE (str, flags, ch); - eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys); - - while (n--) - { - c = *src++; - if (c == '\n') - { - if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT) - Dynarr_add (dst, '\r'); - if (eol_type != EOL_CR) - Dynarr_add (dst, '\n'); - ch = 0; - } - else if (BYTE_ASCII_P (c)) - { - Dynarr_add (dst, c); - ch = 0; - } - else if (BUFBYTE_LEADING_BYTE_P (c)) - ch = (c == LEADING_BYTE_KATAKANA_JISX0201 || - c == LEADING_BYTE_JAPANESE_JISX0208_1978 || - c == LEADING_BYTE_JAPANESE_JISX0208) ? c : 0; - else if (ch) - { - if (ch == LEADING_BYTE_KATAKANA_JISX0201) - { - Dynarr_add (dst, c); - ch = 0; - } - else if (ch == LEADING_BYTE_JAPANESE_JISX0208_1978 || - ch == LEADING_BYTE_JAPANESE_JISX0208) - ch = c; - else - { - unsigned char j1, j2; - ENCODE_SJIS (ch, c, j1, j2); - Dynarr_add (dst, j1); - Dynarr_add (dst, j2); - ch = 0; - } - } - } - - CODING_STREAM_COMPOSE (str, flags, ch); -} - -DEFUN ("decode-shift-jis-char", Fdecode_shift_jis_char, 1, 1, 0, /* -Decode a JISX0208 character of Shift-JIS coding-system. -CODE is the character code in Shift-JIS as a cons of type bytes. -Return the corresponding character. -*/ - (code)) -{ - unsigned char c1, c2, s1, s2; - - CHECK_CONS (code); - CHECK_INT (XCAR (code)); - CHECK_INT (XCDR (code)); - s1 = XINT (XCAR (code)); - s2 = XINT (XCDR (code)); - if (BYTE_SJIS_TWO_BYTE_1_P (s1) && - BYTE_SJIS_TWO_BYTE_2_P (s2)) - { - DECODE_SJIS (s1, s2, c1, c2); - return make_char (MAKE_CHAR (Vcharset_japanese_jisx0208, - c1 & 0x7F, c2 & 0x7F)); - } - else - return Qnil; -} - -DEFUN ("encode-shift-jis-char", Fencode_shift_jis_char, 1, 1, 0, /* -Encode a JISX0208 character CHAR to SHIFT-JIS coding-system. -Return the corresponding character code in SHIFT-JIS as a cons of two bytes. -*/ - (ch)) -{ - Lisp_Object charset; - int c1, c2, s1, s2; - - CHECK_CHAR_COERCE_INT (ch); - BREAKUP_CHAR (XCHAR (ch), charset, c1, c2); - if (EQ (charset, Vcharset_japanese_jisx0208)) - { - ENCODE_SJIS (c1 | 0x80, c2 | 0x80, s1, s2); - return Fcons (make_int (s1), make_int (s2)); - } - else - return Qnil; -} - - -/************************************************************************/ -/* Big5 methods */ -/************************************************************************/ - -/* BIG5 is a coding system encoding two character sets: ASCII and - Big5. An ASCII character is encoded as is. Big5 is a two-byte - character set and is encoded in two-byte. - - --- CODE RANGE of BIG5 --- - (character set) (range) - ASCII 0x00 .. 0x7F - Big5 (1st byte) 0xA1 .. 0xFE - (2nd byte) 0x40 .. 0x7E and 0xA1 .. 0xFE - -------------------------- - - Since the number of characters in Big5 is larger than maximum - characters in Emacs' charset (96x96), it can't be handled as one - charset. So, in Emacs, Big5 is divided into two: `charset-big5-1' - and `charset-big5-2'. Both <type>s are TYPE94x94. The former - contains frequently used characters and the latter contains less - frequently used characters. */ - -#define BYTE_BIG5_TWO_BYTE_1_P(c) \ - ((c) >= 0xA1 && (c) <= 0xFE) - -/* Is this the second byte of a Shift-JIS two-byte char? */ - -#define BYTE_BIG5_TWO_BYTE_2_P(c) \ - (((c) >= 0x40 && (c) <= 0x7E) || ((c) >= 0xA1 && (c) <= 0xFE)) - -/* Number of Big5 characters which have the same code in 1st byte. */ - -#define BIG5_SAME_ROW (0xFF - 0xA1 + 0x7F - 0x40) - -/* Code conversion macros. These are macros because they are used in - inner loops during code conversion. - - Note that temporary variables in macros introduce the classic - dynamic-scoping problems with variable names. We use capital- - lettered variables in the assumption that XEmacs does not use - capital letters in variables except in a very formalized way - (e.g. Qstring). */ - -/* Convert Big5 code (b1, b2) into its internal string representation - (lb, c1, c2). */ - -/* There is a much simpler way to split the Big5 charset into two. - For the moment I'm going to leave the algorithm as-is because it - claims to separate out the most-used characters into a single - charset, which perhaps will lead to optimizations in various - places. - - The way the algorithm works is something like this: - - Big5 can be viewed as a 94x157 charset, where the row is - encoded into the bytes 0xA1 .. 0xFE and the column is encoded - into the bytes 0x40 .. 0x7E and 0xA1 .. 0xFE. As for frequency, - the split between low and high column numbers is apparently - meaningless; ascending rows produce less and less frequent chars. - Therefore, we assign the lower half of rows (0xA1 .. 0xC8) to - the first charset, and the upper half (0xC9 .. 0xFE) to the - second. To do the conversion, we convert the character into - a single number where 0 .. 156 is the first row, 157 .. 313 - is the second, etc. That way, the characters are ordered by - decreasing frequency. Then we just chop the space in two - and coerce the result into a 94x94 space. - */ - -#define DECODE_BIG5(b1, b2, lb, c1, c2) do \ -{ \ - int B1 = b1, B2 = b2; \ - unsigned int I \ - = (B1 - 0xA1) * BIG5_SAME_ROW + B2 - (B2 < 0x7F ? 0x40 : 0x62); \ - \ - if (B1 < 0xC9) \ - { \ - lb = LEADING_BYTE_CHINESE_BIG5_1; \ - } \ - else \ - { \ - lb = LEADING_BYTE_CHINESE_BIG5_2; \ - I -= (BIG5_SAME_ROW) * (0xC9 - 0xA1); \ - } \ - c1 = I / (0xFF - 0xA1) + 0xA1; \ - c2 = I % (0xFF - 0xA1) + 0xA1; \ -} while (0) - -/* Convert the internal string representation of a Big5 character - (lb, c1, c2) into Big5 code (b1, b2). */ - -#define ENCODE_BIG5(lb, c1, c2, b1, b2) do \ -{ \ - unsigned int I = ((c1) - 0xA1) * (0xFF - 0xA1) + ((c2) - 0xA1); \ - \ - if (lb == LEADING_BYTE_CHINESE_BIG5_2) \ - { \ - I += BIG5_SAME_ROW * (0xC9 - 0xA1); \ - } \ - b1 = I / BIG5_SAME_ROW + 0xA1; \ - b2 = I % BIG5_SAME_ROW; \ - b2 += b2 < 0x3F ? 0x40 : 0x62; \ -} while (0) - -static int -detect_coding_big5 (struct detection_state *st, CONST unsigned char *src, - unsigned int n) -{ - int c; - - while (n--) - { - c = *src++; - if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO || - (c >= 0x80 && c <= 0xA0)) - return 0; - if (st->big5.in_second_byte) - { - st->big5.in_second_byte = 0; - if (c < 0x40 || (c >= 0x80 && c <= 0xA0)) - return 0; - } - else if (c >= 0xA1) - st->big5.in_second_byte = 1; - } - return CODING_CATEGORY_BIG5_MASK; -} - -/* Convert Big5 data to internal format. */ - -static void -decode_coding_big5 (Lstream *decoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n) -{ - unsigned char c; - unsigned int flags, ch; - enum eol_type eol_type; - struct decoding_stream *str = DECODING_STREAM_DATA (decoding); - - CODING_STREAM_DECOMPOSE (str, flags, ch); - eol_type = str->eol_type; - - while (n--) - { - c = *src++; - if (ch) - { - /* Previous character was first byte of Big5 char. */ - if (BYTE_BIG5_TWO_BYTE_2_P (c)) - { - unsigned char b1, b2, b3; - DECODE_BIG5 (ch, c, b1, b2, b3); - Dynarr_add (dst, b1); - Dynarr_add (dst, b2); - Dynarr_add (dst, b3); - } - else - { - DECODE_ADD_BINARY_CHAR (ch, dst); - DECODE_ADD_BINARY_CHAR (c, dst); - } - ch = 0; - } - else - { - DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst); - if (BYTE_BIG5_TWO_BYTE_1_P (c)) - ch = c; - else - DECODE_ADD_BINARY_CHAR (c, dst); - } - label_continue_loop:; - } - - DECODE_HANDLE_END_OF_CONVERSION (flags, ch, dst); - - CODING_STREAM_COMPOSE (str, flags, ch); -} - -/* Convert internally-formatted data to Big5. */ - -static void -encode_coding_big5 (Lstream *encoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n) -{ - unsigned char c; - struct encoding_stream *str = ENCODING_STREAM_DATA (encoding); - unsigned int flags, ch; - enum eol_type eol_type; - - CODING_STREAM_DECOMPOSE (str, flags, ch); - eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys); - - while (n--) - { - c = *src++; - if (c == '\n') - { - if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT) - Dynarr_add (dst, '\r'); - if (eol_type != EOL_CR) - Dynarr_add (dst, '\n'); - } - else if (BYTE_ASCII_P (c)) - { - /* ASCII. */ - Dynarr_add (dst, c); - } - else if (BUFBYTE_LEADING_BYTE_P (c)) - { - if (c == LEADING_BYTE_CHINESE_BIG5_1 || - c == LEADING_BYTE_CHINESE_BIG5_2) - { - /* A recognized leading byte. */ - ch = c; - continue; /* not done with this character. */ - } - /* otherwise just ignore this character. */ - } - else if (ch == LEADING_BYTE_CHINESE_BIG5_1 || - ch == LEADING_BYTE_CHINESE_BIG5_2) - { - /* Previous char was a recognized leading byte. */ - ch = (ch << 8) | c; - continue; /* not done with this character. */ - } - else if (ch) - { - /* Encountering second byte of a Big5 character. */ - unsigned char b1, b2; - - ENCODE_BIG5 (ch >> 8, ch & 0xFF, c, b1, b2); - Dynarr_add (dst, b1); - Dynarr_add (dst, b2); - } - - ch = 0; - } - - CODING_STREAM_COMPOSE (str, flags, ch); -} - - -DEFUN ("decode-big5-char", Fdecode_big5_char, 1, 1, 0, /* -Decode a Big5 character CODE of BIG5 coding-system. -CODE is the character code in BIG5, a cons of two integers. -Return the corresponding character. -*/ - (code)) -{ - unsigned char c1, c2, b1, b2; - - CHECK_CONS (code); - CHECK_INT (XCAR (code)); - CHECK_INT (XCDR (code)); - b1 = XINT (XCAR (code)); - b2 = XINT (XCDR (code)); - if (BYTE_BIG5_TWO_BYTE_1_P (b1) && - BYTE_BIG5_TWO_BYTE_2_P (b2)) - { - int leading_byte; - Lisp_Object charset; - DECODE_BIG5 (b1, b2, leading_byte, c1, c2); - charset = CHARSET_BY_LEADING_BYTE (leading_byte); - return make_char (MAKE_CHAR (charset, c1 & 0x7F, c2 & 0x7F)); - } - else - return Qnil; -} - -DEFUN ("encode-big5-char", Fencode_big5_char, 1, 1, 0, /* -Encode the Big5 character CH to BIG5 coding-system. -Return the corresponding character code in Big5. -*/ - (ch)) -{ - Lisp_Object charset; - int c1, c2, b1, b2; - - CHECK_CHAR_COERCE_INT (ch); - BREAKUP_CHAR (XCHAR (ch), charset, c1, c2); - if (EQ (charset, Vcharset_chinese_big5_1) || - EQ (charset, Vcharset_chinese_big5_2)) - { - ENCODE_BIG5 (XCHARSET_LEADING_BYTE (charset), c1 | 0x80, c2 | 0x80, - b1, b2); - return Fcons (make_int (b1), make_int (b2)); - } - else - return Qnil; -} - - -/************************************************************************/ -/* ISO2022 methods */ -/************************************************************************/ - -/* The following note describes the coding system ISO2022 briefly. - Since the intention of this note is to help understanding of the - programs in this file, some parts are NOT ACCURATE or OVERLY - SIMPLIFIED. For thorough understanding, please refer to the - original document of ISO2022. - - ISO2022 provides many mechanisms to encode several character sets - in 7-bit and 8-bit environments. If one chooses 7-bit environment, - all text is encoded by codes of less than 128. This may make the - encoded text a little bit longer, but the text get more stability - to pass through several gateways (some of them strip off MSB). - - There are two kind of character sets: control character set and - graphic character set. The former contains control characters such - as `newline' and `escape' to provide control functions (control - functions are provided also by escape sequence). The latter - contains graphic characters such as 'A' and '-'. Emacs recognizes - two control character sets and many graphic character sets. - - Graphic character sets are classified into one of four types, - according to the dimension and number of characters in the set: - TYPE94, TYPE96, TYPE94x94, and TYPE96x96. In addition, each - character set is assigned an identification byte, unique for each - type, called "final character" (denoted as <F> hereafter). The <F> - of each character set is decided by ECMA(*) when it is registered - in ISO. Code range of <F> is 0x30..0x7F (0x30..0x3F are for - private use only). - - Note (*): ECMA = European Computer Manufacturers Association - - Here are examples of graphic character set [NAME(<F>)]: - o TYPE94 -- ASCII('B'), right-half-of-JISX0201('I'), ... - o TYPE96 -- right-half-of-ISO8859-1('A'), ... - o TYPE94x94 -- GB2312('A'), JISX0208('B'), ... - o TYPE96x96 -- none for the moment - - A code area (1byte=8bits) is divided into 4 areas, C0, GL, C1, and GR. - C0 [0x00..0x1F] -- control character plane 0 - GL [0x20..0x7F] -- graphic character plane 0 - C1 [0x80..0x9F] -- control character plane 1 - GR [0xA0..0xFF] -- graphic character plane 1 - - A control character set is directly designated and invoked to C0 or - C1 by an escape sequence. The most common case is that: - - ISO646's control character set is designated/invoked to C0, and - - ISO6429's control character set is designated/invoked to C1, - and usually these designations/invocations are omitted in encoded - text. In a 7-bit environment, only C0 can be used, and a control - character for C1 is encoded by an appropriate escape sequence to - fit into the environment. All control characters for C1 are - defined to have corresponding escape sequences. - - A graphic character set is at first designated to one of four - graphic registers (G0 through G3), then these graphic registers are - invoked to GL or GR. These designations and invocations can be - done independently. The most common case is that G0 is invoked to - GL, G1 is invoked to GR, and ASCII is designated to G0. Usually - these invocations and designations are omitted in encoded text. - In a 7-bit environment, only GL can be used. - - When a graphic character set of TYPE94 or TYPE94x94 is invoked to - GL, codes 0x20 and 0x7F of the GL area work as control characters - SPACE and DEL respectively, and code 0xA0 and 0xFF of GR area - should not be used. - - There are two ways of invocation: locking-shift and single-shift. - With locking-shift, the invocation lasts until the next different - invocation, whereas with single-shift, the invocation works only - for the following character and doesn't affect locking-shift. - Invocations are done by the following control characters or escape - sequences. - - ---------------------------------------------------------------------- - abbrev function cntrl escape seq description - ---------------------------------------------------------------------- - SI/LS0 (shift-in) 0x0F none invoke G0 into GL - SO/LS1 (shift-out) 0x0E none invoke G1 into GL - LS1R (locking-shift-1 right) none ESC '~' invoke G1 into GR - LS2 (locking-shift-2) none ESC 'n' invoke G2 into GL - LS2R (locking-shift-2 right) none ESC '}' invoke G2 into GR - LS3 (locking-shift-3) none ESC 'o' invoke G3 into GL - LS3R (locking-shift 3 right) none ESC '|' invoke G3 into GR - SS2 (single-shift-2) 0x8E ESC 'N' invoke G2 for one char - SS3 (single-shift-3) 0x8F ESC 'O' invoke G3 for one char - ---------------------------------------------------------------------- - The first four are for locking-shift. Control characters for these - functions are defined by macros ISO_CODE_XXX in `coding.h'. - - Designations are done by the following escape sequences. - ---------------------------------------------------------------------- - escape sequence description - ---------------------------------------------------------------------- - ESC '(' <F> designate TYPE94<F> to G0 - ESC ')' <F> designate TYPE94<F> to G1 - ESC '*' <F> designate TYPE94<F> to G2 - ESC '+' <F> designate TYPE94<F> to G3 - ESC ',' <F> designate TYPE96<F> to G0 (*) - ESC '-' <F> designate TYPE96<F> to G1 - ESC '.' <F> designate TYPE96<F> to G2 - ESC '/' <F> designate TYPE96<F> to G3 - ESC '$' '(' <F> designate TYPE94x94<F> to G0 (**) - ESC '$' ')' <F> designate TYPE94x94<F> to G1 - ESC '$' '*' <F> designate TYPE94x94<F> to G2 - ESC '$' '+' <F> designate TYPE94x94<F> to G3 - ESC '$' ',' <F> designate TYPE96x96<F> to G0 (*) - ESC '$' '-' <F> designate TYPE96x96<F> to G1 - ESC '$' '.' <F> designate TYPE96x96<F> to G2 - ESC '$' '/' <F> designate TYPE96x96<F> to G3 - ---------------------------------------------------------------------- - In this list, "TYPE94<F>" means a graphic character set of type TYPE94 - and final character <F>, and etc. - - Note (*): Although these designations are not allowed in ISO2022, - Emacs accepts them on decoding, and produces them on encoding - TYPE96 or TYPE96x96 character set in a coding system which is - characterized as 7-bit environment, non-locking-shift, and - non-single-shift. - - Note (**): If <F> is '@', 'A', or 'B', the intermediate character - '(' can be omitted. We call this as "short-form" here after. - - Now you may notice that there are a lot of ways for encoding the - same multilingual text in ISO2022. Actually, there exist many - coding systems such as Compound Text (used in X's inter client - communication, ISO-2022-JP (used in Japanese internet), ISO-2022-KR - (used in Korean internet), EUC (Extended UNIX Code, used in Asian - localized platforms), and all of these are variants of ISO2022. - - In addition to the above, Emacs handles two more kinds of escape - sequences: ISO6429's direction specification and Emacs' private - sequence for specifying character composition. - - ISO6429's direction specification takes the following format: - o CSI ']' -- end of the current direction - o CSI '0' ']' -- end of the current direction - o CSI '1' ']' -- start of left-to-right text - o CSI '2' ']' -- start of right-to-left text - The control character CSI (0x9B: control sequence introducer) is - abbreviated to the escape sequence ESC '[' in 7-bit environment. - - Character composition specification takes the following format: - o ESC '0' -- start character composition - o ESC '1' -- end character composition - Since these are not standard escape sequences of any ISO, the use - of them for these meanings is restricted to Emacs only. */ - -static void -reset_iso2022 (Lisp_Object coding_system, struct iso2022_decoder *iso) -{ - int i; - - for (i = 0; i < 4; i++) - { - if (!NILP (coding_system)) - iso->charset[i] = - XCODING_SYSTEM_ISO2022_INITIAL_CHARSET (coding_system, i); - else - iso->charset[i] = Qt; - iso->invalid_designated[i] = 0; - } - iso->esc = ISO_ESC_NOTHING; - iso->esc_bytes_index = 0; - iso->register_left = 0; - iso->register_right = 1; - iso->switched_dir_and_no_valid_charset_yet = 0; - iso->invalid_switch_dir = 0; - iso->output_direction_sequence = 0; - iso->output_literally = 0; - if (iso->composite_chars) - Dynarr_reset (iso->composite_chars); -} - -static int -fit_to_be_escape_quoted (unsigned char c) -{ - switch (c) - { - case ISO_CODE_ESC: - case ISO_CODE_CSI: - case ISO_CODE_SS2: - case ISO_CODE_SS3: - case ISO_CODE_SO: - case ISO_CODE_SI: - return 1; - - default: - return 0; - } -} - -/* Parse one byte of an ISO2022 escape sequence. - If the result is an invalid escape sequence, return 0 and - do not change anything in STR. Otherwise, if the result is - an incomplete escape sequence, update ISO2022.ESC and - ISO2022.ESC_BYTES and return -1. Otherwise, update - all the state variables (but not ISO2022.ESC_BYTES) and - return 1. - - If CHECK_INVALID_CHARSETS is non-zero, check for designation - or invocation of an invalid character set and treat that as - an unrecognized escape sequence. */ - -static int -parse_iso2022_esc (Lisp_Object codesys, struct iso2022_decoder *iso, - unsigned char c, unsigned int *flags, - int check_invalid_charsets) -{ - /* (1) If we're at the end of a designation sequence, CS is the - charset being designated and REG is the register to designate - it to. - - (2) If we're at the end of a locking-shift sequence, REG is - the register to invoke and HALF (0 == left, 1 == right) is - the half to invoke it into. - - (3) If we're at the end of a single-shift sequence, REG is - the register to invoke. */ - Lisp_Object cs = Qnil; - int reg, half; - - /* NOTE: This code does goto's all over the fucking place. - The reason for this is that we're basically implementing - a state machine here, and hierarchical languages like C - don't really provide a clean way of doing this. */ - - if (! (*flags & CODING_STATE_ESCAPE)) - /* At beginning of escape sequence; we need to reset our - escape-state variables. */ - iso->esc = ISO_ESC_NOTHING; - - iso->output_literally = 0; - iso->output_direction_sequence = 0; - - switch (iso->esc) - { - case ISO_ESC_NOTHING: - iso->esc_bytes_index = 0; - switch (c) - { - case ISO_CODE_ESC: /* Start escape sequence */ - *flags |= CODING_STATE_ESCAPE; - iso->esc = ISO_ESC; - goto not_done; - - case ISO_CODE_CSI: /* ISO6429 (specifying directionality) */ - *flags |= CODING_STATE_ESCAPE; - iso->esc = ISO_ESC_5_11; - goto not_done; - - case ISO_CODE_SO: /* locking shift 1 */ - reg = 1; half = 0; - goto locking_shift; - case ISO_CODE_SI: /* locking shift 0 */ - reg = 0; half = 0; - goto locking_shift; - - case ISO_CODE_SS2: /* single shift */ - reg = 2; - goto single_shift; - case ISO_CODE_SS3: /* single shift */ - reg = 3; - goto single_shift; - - default: /* Other control characters */ - return 0; - } - - case ISO_ESC: - switch (c) - { - /**** single shift ****/ - - case 'N': /* single shift 2 */ - reg = 2; - goto single_shift; - case 'O': /* single shift 3 */ - reg = 3; - goto single_shift; - - /**** locking shift ****/ - - case '~': /* locking shift 1 right */ - reg = 1; half = 1; - goto locking_shift; - case 'n': /* locking shift 2 */ - reg = 2; half = 0; - goto locking_shift; - case '}': /* locking shift 2 right */ - reg = 2; half = 1; - goto locking_shift; - case 'o': /* locking shift 3 */ - reg = 3; half = 0; - goto locking_shift; - case '|': /* locking shift 3 right */ - reg = 3; half = 1; - goto locking_shift; - - /**** composite ****/ - - case '0': - iso->esc = ISO_ESC_START_COMPOSITE; - *flags = (*flags & CODING_STATE_ISO2022_LOCK) | - CODING_STATE_COMPOSITE; - return 1; - - case '1': - iso->esc = ISO_ESC_END_COMPOSITE; - *flags = (*flags & CODING_STATE_ISO2022_LOCK) & - ~CODING_STATE_COMPOSITE; - return 1; - - /**** directionality ****/ - - case '[': - iso->esc = ISO_ESC_5_11; - goto not_done; - - /**** designation ****/ - - case '$': /* multibyte charset prefix */ - iso->esc = ISO_ESC_2_4; - goto not_done; - - default: - if (0x28 <= c && c <= 0x2F) - { - iso->esc = (enum iso_esc_flag) (c - 0x28 + ISO_ESC_2_8); - goto not_done; - } - - /* This function is called with CODESYS equal to nil when - doing coding-system detection. */ - if (!NILP (codesys) - && XCODING_SYSTEM_ISO2022_ESCAPE_QUOTED (codesys) - && fit_to_be_escape_quoted (c)) - { - iso->esc = ISO_ESC_LITERAL; - *flags &= CODING_STATE_ISO2022_LOCK; - return 1; - } - - /* bzzzt! */ - return 0; - } - - - - /**** directionality ****/ - - case ISO_ESC_5_11: /* ISO6429 direction control */ - if (c == ']') - { - *flags &= (CODING_STATE_ISO2022_LOCK & ~CODING_STATE_R2L); - goto directionality; - } - if (c == '0') iso->esc = ISO_ESC_5_11_0; - else if (c == '1') iso->esc = ISO_ESC_5_11_1; - else if (c == '2') iso->esc = ISO_ESC_5_11_2; - else return 0; - goto not_done; - - case ISO_ESC_5_11_0: - if (c == ']') - { - *flags &= (CODING_STATE_ISO2022_LOCK & ~CODING_STATE_R2L); - goto directionality; - } - return 0; - - case ISO_ESC_5_11_1: - if (c == ']') - { - *flags = (CODING_STATE_ISO2022_LOCK & ~CODING_STATE_R2L); - goto directionality; - } - return 0; - - case ISO_ESC_5_11_2: - if (c == ']') - { - *flags = (*flags & CODING_STATE_ISO2022_LOCK) | CODING_STATE_R2L; - goto directionality; - } - return 0; - - directionality: - iso->esc = ISO_ESC_DIRECTIONALITY; - /* Various junk here to attempt to preserve the direction sequences - literally in the text if they would otherwise be swallowed due - to invalid designations that don't show up as actual charset - changes in the text. */ - if (iso->invalid_switch_dir) - { - /* We already inserted a direction switch literally into the - text. We assume (#### this may not be right) that the - next direction switch is the one going the other way, - and we need to output that literally as well. */ - iso->output_literally = 1; - iso->invalid_switch_dir = 0; - } - else - { - int jj; - - /* If we are in the thrall of an invalid designation, - then stick the directionality sequence literally into the - output stream so it ends up in the original text again. */ - for (jj = 0; jj < 4; jj++) - if (iso->invalid_designated[jj]) - break; - if (jj < 4) - { - iso->output_literally = 1; - iso->invalid_switch_dir = 1; - } - else - /* Indicate that we haven't yet seen a valid designation, - so that if a switch-dir is directly followed by an - invalid designation, both get inserted literally. */ - iso->switched_dir_and_no_valid_charset_yet = 1; - } - return 1; - - - /**** designation ****/ - - case ISO_ESC_2_4: - if (0x28 <= c && c <= 0x2F) - { - iso->esc = (enum iso_esc_flag) (c - 0x28 + ISO_ESC_2_4_8); - goto not_done; - } - if (0x40 <= c && c <= 0x42) - { - cs = CHARSET_BY_ATTRIBUTES (CHARSET_TYPE_94X94, c, - *flags & CODING_STATE_R2L ? - CHARSET_RIGHT_TO_LEFT : - CHARSET_LEFT_TO_RIGHT); - reg = 0; - goto designated; - } - return 0; - - default: - { - int type =-1; - - if (c < '0' || c > '~') - return 0; /* bad final byte */ - - if (iso->esc >= ISO_ESC_2_8 && - iso->esc <= ISO_ESC_2_15) - { - type = ((iso->esc >= ISO_ESC_2_12) ? - CHARSET_TYPE_96 : CHARSET_TYPE_94); - reg = (iso->esc - ISO_ESC_2_8) & 3; - } - else if (iso->esc >= ISO_ESC_2_4_8 && - iso->esc <= ISO_ESC_2_4_15) - { - type = ((iso->esc >= ISO_ESC_2_4_12) ? - CHARSET_TYPE_96X96 : CHARSET_TYPE_94X94); - reg = (iso->esc - ISO_ESC_2_4_8) & 3; - } - else - { - /* Can this ever be reached? -slb */ - abort(); - } - - cs = CHARSET_BY_ATTRIBUTES (type, c, - *flags & CODING_STATE_R2L ? - CHARSET_RIGHT_TO_LEFT : - CHARSET_LEFT_TO_RIGHT); - goto designated; - } - } - - not_done: - iso->esc_bytes[iso->esc_bytes_index++] = (unsigned char) c; - return -1; - - single_shift: - if (check_invalid_charsets && !CHARSETP (iso->charset[reg])) - /* can't invoke something that ain't there. */ - return 0; - iso->esc = ISO_ESC_SINGLE_SHIFT; - *flags &= CODING_STATE_ISO2022_LOCK; - if (reg == 2) - *flags |= CODING_STATE_SS2; - else - *flags |= CODING_STATE_SS3; - return 1; - - locking_shift: - if (check_invalid_charsets && - !CHARSETP (iso->charset[reg])) - /* can't invoke something that ain't there. */ - return 0; - if (half) - iso->register_right = reg; - else - iso->register_left = reg; - *flags &= CODING_STATE_ISO2022_LOCK; - iso->esc = ISO_ESC_LOCKING_SHIFT; - return 1; - - designated: - if (NILP (cs) && check_invalid_charsets) - { - iso->invalid_designated[reg] = 1; - iso->charset[reg] = Vcharset_ascii; - iso->esc = ISO_ESC_DESIGNATE; - *flags &= CODING_STATE_ISO2022_LOCK; - iso->output_literally = 1; - if (iso->switched_dir_and_no_valid_charset_yet) - { - /* We encountered a switch-direction followed by an - invalid designation. Ensure that the switch-direction - gets outputted; otherwise it will probably get eaten - when the text is written out again. */ - iso->switched_dir_and_no_valid_charset_yet = 0; - iso->output_direction_sequence = 1; - /* And make sure that the switch-dir going the other - way gets outputted, as well. */ - iso->invalid_switch_dir = 1; - } - return 1; - } - /* This function is called with CODESYS equal to nil when - doing coding-system detection. */ - if (!NILP (codesys)) - { - charset_conversion_spec_dynarr *dyn = - XCODING_SYSTEM (codesys)->iso2022.input_conv; - - if (dyn) - { - int i; - - for (i = 0; i < Dynarr_length (dyn); i++) - { - struct charset_conversion_spec *spec = Dynarr_atp (dyn, i); - if (EQ (cs, spec->from_charset)) - cs = spec->to_charset; - } - } - } - - iso->charset[reg] = cs; - iso->esc = ISO_ESC_DESIGNATE; - *flags &= CODING_STATE_ISO2022_LOCK; - if (iso->invalid_designated[reg]) - { - iso->invalid_designated[reg] = 0; - iso->output_literally = 1; - } - if (iso->switched_dir_and_no_valid_charset_yet) - iso->switched_dir_and_no_valid_charset_yet = 0; - return 1; -} - -static int -detect_coding_iso2022 (struct detection_state *st, CONST unsigned char *src, - unsigned int n) -{ - int c; - int mask; - - /* #### There are serious deficiencies in the recognition mechanism - here. This needs to be much smarter if it's going to cut it. */ - - if (!st->iso2022.initted) - { - reset_iso2022 (Qnil, &st->iso2022.iso); - st->iso2022.mask = (CODING_CATEGORY_ISO_7_MASK | - CODING_CATEGORY_ISO_8_DESIGNATE_MASK | - CODING_CATEGORY_ISO_8_1_MASK | - CODING_CATEGORY_ISO_8_2_MASK | - CODING_CATEGORY_ISO_LOCK_SHIFT_MASK); - st->iso2022.flags = 0; - st->iso2022.high_byte_count = 0; - st->iso2022.saw_single_shift = 0; - st->iso2022.initted = 1; - } - - mask = st->iso2022.mask; - - while (n--) - { - c = *src++; - if (c >= 0xA0) - { - mask &= ~CODING_CATEGORY_ISO_7_MASK; - st->iso2022.high_byte_count++; - } - else - { - if (st->iso2022.high_byte_count && !st->iso2022.saw_single_shift) - { - if (st->iso2022.high_byte_count & 1) - /* odd number of high bytes; assume not iso-8-2 */ - mask &= ~CODING_CATEGORY_ISO_8_2_MASK; - } - st->iso2022.high_byte_count = 0; - st->iso2022.saw_single_shift = 0; - if (c > 0x80) - mask &= ~CODING_CATEGORY_ISO_7_MASK; - } - if (!(st->iso2022.flags & CODING_STATE_ESCAPE) - && (BYTE_C0_P (c) || BYTE_C1_P (c))) - { /* control chars */ - switch (c) - { - /* Allow and ignore control characters that you might - reasonably see in a text file */ - case '\r': - case '\n': - case '\t': - case 7: /* bell */ - case 8: /* backspace */ - case 11: /* vertical tab */ - case 12: /* form feed */ - case 26: /* MS-DOS C-z junk */ - case 31: /* '^_' -- for info */ - goto label_continue_loop; - - default: - break; - } - } - - if ((st->iso2022.flags & CODING_STATE_ESCAPE) || BYTE_C0_P (c) - || BYTE_C1_P (c)) - { - if (parse_iso2022_esc (Qnil, &st->iso2022.iso, c, - &st->iso2022.flags, 0)) - { - switch (st->iso2022.iso.esc) - { - case ISO_ESC_DESIGNATE: - mask &= ~CODING_CATEGORY_ISO_8_1_MASK; - mask &= ~CODING_CATEGORY_ISO_8_2_MASK; - break; - case ISO_ESC_LOCKING_SHIFT: - mask = CODING_CATEGORY_ISO_LOCK_SHIFT_MASK; - goto ran_out_of_chars; - case ISO_ESC_SINGLE_SHIFT: - mask &= ~CODING_CATEGORY_ISO_8_DESIGNATE_MASK; - st->iso2022.saw_single_shift = 1; - break; - default: - break; - } - } - else - { - mask = 0; - goto ran_out_of_chars; - } - } - label_continue_loop:; - } - - ran_out_of_chars: - - return mask; -} - -static int -postprocess_iso2022_mask (int mask) -{ - /* #### kind of cheesy */ - /* If seven-bit ISO is allowed, then assume that the encoding is - entirely seven-bit and turn off the eight-bit ones. */ - if (mask & CODING_CATEGORY_ISO_7_MASK) - mask &= ~ (CODING_CATEGORY_ISO_8_DESIGNATE_MASK | - CODING_CATEGORY_ISO_8_1_MASK | - CODING_CATEGORY_ISO_8_2_MASK); - return mask; -} - -/* If FLAGS is a null pointer or specifies right-to-left motion, - output a switch-dir-to-left-to-right sequence to DST. - Also update FLAGS if it is not a null pointer. - If INTERNAL_P is set, we are outputting in internal format and - need to handle the CSI differently. */ - -static void -restore_left_to_right_direction (struct Lisp_Coding_System *codesys, - unsigned_char_dynarr *dst, - unsigned int *flags, - int internal_p) -{ - if (!flags || (*flags & CODING_STATE_R2L)) - { - if (CODING_SYSTEM_ISO2022_SEVEN (codesys)) - { - Dynarr_add (dst, ISO_CODE_ESC); - Dynarr_add (dst, '['); - } - else if (internal_p) - DECODE_ADD_BINARY_CHAR (ISO_CODE_CSI, dst); - else - Dynarr_add (dst, ISO_CODE_CSI); - Dynarr_add (dst, '0'); - Dynarr_add (dst, ']'); - if (flags) - *flags &= ~CODING_STATE_R2L; - } -} - -/* If FLAGS is a null pointer or specifies a direction different from - DIRECTION (which should be either CHARSET_RIGHT_TO_LEFT or - CHARSET_LEFT_TO_RIGHT), output the appropriate switch-dir escape - sequence to DST. Also update FLAGS if it is not a null pointer. - If INTERNAL_P is set, we are outputting in internal format and - need to handle the CSI differently. */ - -static void -ensure_correct_direction (int direction, struct Lisp_Coding_System *codesys, - unsigned_char_dynarr *dst, unsigned int *flags, - int internal_p) -{ - if ((!flags || (*flags & CODING_STATE_R2L)) && - direction == CHARSET_LEFT_TO_RIGHT) - restore_left_to_right_direction (codesys, dst, flags, internal_p); - else if (!CODING_SYSTEM_ISO2022_NO_ISO6429 (codesys) - && (!flags || !(*flags & CODING_STATE_R2L)) && - direction == CHARSET_RIGHT_TO_LEFT) - { - if (CODING_SYSTEM_ISO2022_SEVEN (codesys)) - { - Dynarr_add (dst, ISO_CODE_ESC); - Dynarr_add (dst, '['); - } - else if (internal_p) - DECODE_ADD_BINARY_CHAR (ISO_CODE_CSI, dst); - else - Dynarr_add (dst, ISO_CODE_CSI); - Dynarr_add (dst, '2'); - Dynarr_add (dst, ']'); - if (flags) - *flags |= CODING_STATE_R2L; - } -} - -/* Convert ISO2022-format data to internal format. */ - -static void -decode_coding_iso2022 (Lstream *decoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n) -{ - unsigned char c; - unsigned int flags, ch; - enum eol_type eol_type; - struct decoding_stream *str = DECODING_STREAM_DATA (decoding); - Lisp_Object coding_system; - unsigned_char_dynarr *real_dst = dst; - - CODING_STREAM_DECOMPOSE (str, flags, ch); - eol_type = str->eol_type; - XSETCODING_SYSTEM (coding_system, str->codesys); - - if (flags & CODING_STATE_COMPOSITE) - dst = str->iso2022.composite_chars; - - while (n--) - { - c = *src++; - if (flags & CODING_STATE_ESCAPE) - { /* Within ESC sequence */ - int retval = parse_iso2022_esc (coding_system, &str->iso2022, - c, &flags, 1); - - if (retval) - { - switch (str->iso2022.esc) - { - case ISO_ESC_START_COMPOSITE: - if (str->iso2022.composite_chars) - Dynarr_reset (str->iso2022.composite_chars); - else - str->iso2022.composite_chars = Dynarr_new (unsigned_char); - dst = str->iso2022.composite_chars; - break; - case ISO_ESC_END_COMPOSITE: - { - Bufbyte comstr[MAX_EMCHAR_LEN]; - Bytecount len; - Emchar emch = lookup_composite_char (Dynarr_atp (dst, 0), - Dynarr_length (dst)); - dst = real_dst; - len = set_charptr_emchar (comstr, emch); - Dynarr_add_many (dst, comstr, len); - break; - } - - case ISO_ESC_LITERAL: - DECODE_ADD_BINARY_CHAR (c, dst); - break; - - default: - /* Everything else handled already */ - break; - } - } - - /* Attempted error recovery. */ - if (str->iso2022.output_direction_sequence) - ensure_correct_direction (flags & CODING_STATE_R2L ? - CHARSET_RIGHT_TO_LEFT : - CHARSET_LEFT_TO_RIGHT, - str->codesys, dst, 0, 1); - /* More error recovery. */ - if (!retval || str->iso2022.output_literally) - { - /* Output the (possibly invalid) sequence */ - int i; - for (i = 0; i < str->iso2022.esc_bytes_index; i++) - DECODE_ADD_BINARY_CHAR (str->iso2022.esc_bytes[i], dst); - flags &= CODING_STATE_ISO2022_LOCK; - if (!retval) - n++, src--;/* Repeat the loop with the same character. */ - else - { - /* No sense in reprocessing the final byte of the - escape sequence; it could mess things up anyway. - Just add it now. */ - DECODE_ADD_BINARY_CHAR (c, dst); - } - } - ch = 0; - } - else if (BYTE_C0_P (c) || BYTE_C1_P (c)) - { /* Control characters */ - - /***** Error-handling *****/ - - /* If we were in the middle of a character, dump out the - partial character. */ - DECODE_OUTPUT_PARTIAL_CHAR (ch); - - /* If we just saw a single-shift character, dump it out. - This may dump out the wrong sort of single-shift character, - but least it will give an indication that something went - wrong. */ - if (flags & CODING_STATE_SS2) - { - DECODE_ADD_BINARY_CHAR (ISO_CODE_SS2, dst); - flags &= ~CODING_STATE_SS2; - } - if (flags & CODING_STATE_SS3) - { - DECODE_ADD_BINARY_CHAR (ISO_CODE_SS3, dst); - flags &= ~CODING_STATE_SS3; - } - - /***** Now handle the control characters. *****/ - - /* Handle CR/LF */ - DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst); - - flags &= CODING_STATE_ISO2022_LOCK; - - if (!parse_iso2022_esc (coding_system, &str->iso2022, c, &flags, 1)) - DECODE_ADD_BINARY_CHAR (c, dst); - } - else - { /* Graphic characters */ - Lisp_Object charset; - int lb; - int reg; - - DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst); - - /* Now determine the charset. */ - reg = ((flags & CODING_STATE_SS2) ? 2 - : (flags & CODING_STATE_SS3) ? 3 - : !BYTE_ASCII_P (c) ? str->iso2022.register_right - : str->iso2022.register_left); - charset = str->iso2022.charset[reg]; - - /* Error checking: */ - if (NILP (charset) || str->iso2022.invalid_designated[reg] - || (((c & 0x7F) == ' ' || (c & 0x7F) == ISO_CODE_DEL) - && XCHARSET_CHARS (charset) == 94)) - /* Mrmph. We are trying to invoke a register that has no - or an invalid charset in it, or trying to add a character - outside the range of the charset. Insert that char literally - to preserve it for the output. */ - { - DECODE_OUTPUT_PARTIAL_CHAR (ch); - DECODE_ADD_BINARY_CHAR (c, dst); - } - - else - { - /* Things are probably hunky-dorey. */ - - /* Fetch reverse charset, maybe. */ - if (((flags & CODING_STATE_R2L) && - XCHARSET_DIRECTION (charset) == CHARSET_LEFT_TO_RIGHT) - || - (!(flags & CODING_STATE_R2L) && - XCHARSET_DIRECTION (charset) == CHARSET_RIGHT_TO_LEFT)) - { - Lisp_Object new_charset = - XCHARSET_REVERSE_DIRECTION_CHARSET (charset); - if (!NILP (new_charset)) - charset = new_charset; - } - - lb = XCHARSET_LEADING_BYTE (charset); - switch (XCHARSET_REP_BYTES (charset)) - { - case 1: /* ASCII */ - DECODE_OUTPUT_PARTIAL_CHAR (ch); - Dynarr_add (dst, c & 0x7F); - break; - - case 2: /* one-byte official */ - DECODE_OUTPUT_PARTIAL_CHAR (ch); - Dynarr_add (dst, lb); - Dynarr_add (dst, c | 0x80); - break; - - case 3: /* one-byte private or two-byte official */ - if (XCHARSET_PRIVATE_P (charset)) - { - DECODE_OUTPUT_PARTIAL_CHAR (ch); - Dynarr_add (dst, PRE_LEADING_BYTE_PRIVATE_1); - Dynarr_add (dst, lb); - Dynarr_add (dst, c | 0x80); - } - else - { - if (ch) - { - Dynarr_add (dst, lb); - Dynarr_add (dst, ch | 0x80); - Dynarr_add (dst, c | 0x80); - ch = 0; - } - else - ch = c; - } - break; - - default: /* two-byte private */ - if (ch) - { - Dynarr_add (dst, PRE_LEADING_BYTE_PRIVATE_2); - Dynarr_add (dst, lb); - Dynarr_add (dst, ch | 0x80); - Dynarr_add (dst, c | 0x80); - ch = 0; - } - else - ch = c; - } - } - - if (!ch) - flags &= CODING_STATE_ISO2022_LOCK; - } - - label_continue_loop:; - } - - if (flags & CODING_STATE_END) - DECODE_OUTPUT_PARTIAL_CHAR (ch); - - CODING_STREAM_COMPOSE (str, flags, ch); -} - - -/***** ISO2022 encoder *****/ - -/* Designate CHARSET into register REG. */ - -static void -iso2022_designate (Lisp_Object charset, unsigned char reg, - struct encoding_stream *str, unsigned_char_dynarr *dst) -{ - CONST char *inter94 = "()*+", *inter96= ",-./"; - unsigned int type; - unsigned char final; - Lisp_Object old_charset = str->iso2022.charset[reg]; - - str->iso2022.charset[reg] = charset; - if (!CHARSETP (charset)) - /* charset might be an initial nil or t. */ - return; - type = XCHARSET_TYPE (charset); - final = XCHARSET_FINAL (charset); - if (!str->iso2022.force_charset_on_output[reg] && - CHARSETP (old_charset) && - XCHARSET_TYPE (old_charset) == type && - XCHARSET_FINAL (old_charset) == final) - return; - - str->iso2022.force_charset_on_output[reg] = 0; - - { - charset_conversion_spec_dynarr *dyn = - str->codesys->iso2022.output_conv; - - if (dyn) - { - int i; - - for (i = 0; i < Dynarr_length (dyn); i++) - { - struct charset_conversion_spec *spec = Dynarr_atp (dyn, i); - if (EQ (charset, spec->from_charset)) - charset = spec->to_charset; - } - } - } - - Dynarr_add (dst, ISO_CODE_ESC); - switch (type) - { - case CHARSET_TYPE_94: - Dynarr_add (dst, inter94[reg]); - break; - case CHARSET_TYPE_96: - Dynarr_add (dst, inter96[reg]); - break; - case CHARSET_TYPE_94X94: - Dynarr_add (dst, '$'); - if (reg != 0 - || !(CODING_SYSTEM_ISO2022_SHORT (str->codesys)) - || final < '@' - || final > 'B') - Dynarr_add (dst, inter94[reg]); - break; - case CHARSET_TYPE_96X96: - Dynarr_add (dst, '$'); - Dynarr_add (dst, inter96[reg]); - break; - } - Dynarr_add (dst, final); -} - -static void -ensure_normal_shift (struct encoding_stream *str, unsigned_char_dynarr *dst) -{ - if (str->iso2022.register_left != 0) - { - Dynarr_add (dst, ISO_CODE_SI); - str->iso2022.register_left = 0; - } -} - -static void -ensure_shift_out (struct encoding_stream *str, unsigned_char_dynarr *dst) -{ - if (str->iso2022.register_left != 1) - { - Dynarr_add (dst, ISO_CODE_SO); - str->iso2022.register_left = 1; - } -} - -/* Convert internally-formatted data to ISO2022 format. */ - -static void -encode_coding_iso2022 (Lstream *encoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n) -{ - unsigned char charmask, c; - unsigned int flags, ch; - enum eol_type eol_type; - unsigned char char_boundary; - struct encoding_stream *str = ENCODING_STREAM_DATA (encoding); - struct Lisp_Coding_System *codesys = str->codesys; - int i; - Lisp_Object charset; - int half; - - /* flags for handling composite chars. We do a little switcharoo - on the source while we're outputting the composite char. */ - unsigned int saved_n = 0; - CONST unsigned char *saved_src = NULL; - int in_composite = 0; - - CODING_STREAM_DECOMPOSE (str, flags, ch); - eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys); - char_boundary = str->iso2022.current_char_boundary; - charset = str->iso2022.current_charset; - half = str->iso2022.current_half; - - back_to_square_n: - while (n--) - { - c = *src++; - - if (BYTE_ASCII_P (c)) - { /* Processing ASCII character */ - ch = 0; - - restore_left_to_right_direction (codesys, dst, &flags, 0); - - /* Make sure G0 contains ASCII */ - if ((c > ' ' && c < ISO_CODE_DEL) || - !CODING_SYSTEM_ISO2022_NO_ASCII_CNTL (codesys)) - { - ensure_normal_shift (str, dst); - iso2022_designate (Vcharset_ascii, 0, str, dst); - } - - /* If necessary, restore everything to the default state - at end-of-line */ - if (c == '\n' && - !(CODING_SYSTEM_ISO2022_NO_ASCII_EOL (codesys))) - { - restore_left_to_right_direction (codesys, dst, &flags, 0); - - ensure_normal_shift (str, dst); - - for (i = 0; i < 4; i++) - { - Lisp_Object initial_charset = - CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i); - iso2022_designate (initial_charset, i, str, dst); - } - } - if (c == '\n') - { - if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT) - Dynarr_add (dst, '\r'); - if (eol_type != EOL_CR) - Dynarr_add (dst, c); - } - else - { - if (CODING_SYSTEM_ISO2022_ESCAPE_QUOTED (codesys) - && fit_to_be_escape_quoted (c)) - Dynarr_add (dst, ISO_CODE_ESC); - Dynarr_add (dst, c); - } - char_boundary = 1; - } - - else if (BUFBYTE_LEADING_BYTE_P (c) || BUFBYTE_LEADING_BYTE_P (ch)) - { /* Processing Leading Byte */ - ch = 0; - charset = CHARSET_BY_LEADING_BYTE (c); - if (LEADING_BYTE_PREFIX_P(c)) - ch = c; - else if (!EQ (charset, Vcharset_control_1) - && !EQ (charset, Vcharset_composite)) - { - int reg; - - ensure_correct_direction (XCHARSET_DIRECTION (charset), - codesys, dst, &flags, 0); - - /* Now determine which register to use. */ - reg = -1; - for (i = 0; i < 4; i++) - { - if (EQ (charset, str->iso2022.charset[i]) || - EQ (charset, - CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i))) - { - reg = i; - break; - } - } - - if (reg == -1) - { - if (XCHARSET_GRAPHIC (charset) != 0) - { - if (!NILP (str->iso2022.charset[1]) && - (!CODING_SYSTEM_ISO2022_SEVEN (codesys) || - CODING_SYSTEM_ISO2022_LOCK_SHIFT (codesys))) - reg = 1; - else if (!NILP (str->iso2022.charset[2])) - reg = 2; - else if (!NILP (str->iso2022.charset[3])) - reg = 3; - else - reg = 0; - } - else - reg = 0; - } - - iso2022_designate (charset, reg, str, dst); - - /* Now invoke that register. */ - switch (reg) - { - case 0: - ensure_normal_shift (str, dst); - half = 0; - break; - - case 1: - if (CODING_SYSTEM_ISO2022_SEVEN (codesys)) - { - ensure_shift_out (str, dst); - half = 0; - } - else - half = 1; - break; - - case 2: - if (CODING_SYSTEM_ISO2022_SEVEN (str->codesys)) - { - Dynarr_add (dst, ISO_CODE_ESC); - Dynarr_add (dst, 'N'); - half = 0; - } - else - { - Dynarr_add (dst, ISO_CODE_SS2); - half = 1; - } - break; - - case 3: - if (CODING_SYSTEM_ISO2022_SEVEN (str->codesys)) - { - Dynarr_add (dst, ISO_CODE_ESC); - Dynarr_add (dst, 'O'); - half = 0; - } - else - { - Dynarr_add (dst, ISO_CODE_SS3); - half = 1; - } - break; - - default: - abort (); - } - } - char_boundary = 0; - } - else - { /* Processing Non-ASCII character */ - charmask = (half == 0 ? 0x7F : 0xFF); - char_boundary = 1; - if (EQ (charset, Vcharset_control_1)) - { - if (CODING_SYSTEM_ISO2022_ESCAPE_QUOTED (codesys) - && fit_to_be_escape_quoted (c)) - Dynarr_add (dst, ISO_CODE_ESC); - /* you asked for it ... */ - Dynarr_add (dst, c - 0x20); - } - else - { - switch (XCHARSET_REP_BYTES (charset)) - { - case 2: - Dynarr_add (dst, c & charmask); - break; - case 3: - if (XCHARSET_PRIVATE_P (charset)) - { - Dynarr_add (dst, c & charmask); - ch = 0; - } - else if (ch) - { - if (EQ (charset, Vcharset_composite)) - { - if (in_composite) - { - /* #### Bother! We don't know how to - handle this yet. */ - Dynarr_add (dst, '~'); - } - else - { - Emchar emch = MAKE_CHAR (Vcharset_composite, - ch & 0x7F, c & 0x7F); - Lisp_Object lstr = composite_char_string (emch); - saved_n = n; - saved_src = src; - in_composite = 1; - src = XSTRING_DATA (lstr); - n = XSTRING_LENGTH (lstr); - Dynarr_add (dst, ISO_CODE_ESC); - Dynarr_add (dst, '0'); /* start composing */ - } - } - else - { - Dynarr_add (dst, ch & charmask); - Dynarr_add (dst, c & charmask); - } - ch = 0; - } - else - { - ch = c; - char_boundary = 0; - } - break; - case 4: - if (ch) - { - Dynarr_add (dst, ch & charmask); - Dynarr_add (dst, c & charmask); - ch = 0; - } - else - { - ch = c; - char_boundary = 0; - } - break; - default: - abort (); - } - } - } - } - - if (in_composite) - { - n = saved_n; - src = saved_src; - in_composite = 0; - Dynarr_add (dst, ISO_CODE_ESC); - Dynarr_add (dst, '1'); /* end composing */ - goto back_to_square_n; /* Wheeeeeeeee ..... */ - } - - if (char_boundary && flags & CODING_STATE_END) - { - restore_left_to_right_direction (codesys, dst, &flags, 0); - ensure_normal_shift (str, dst); - for (i = 0; i < 4; i++) - { - Lisp_Object initial_charset = - CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i); - iso2022_designate (initial_charset, i, str, dst); - } - } - - CODING_STREAM_COMPOSE (str, flags, ch); - str->iso2022.current_char_boundary = char_boundary; - str->iso2022.current_charset = charset; - str->iso2022.current_half = half; - - /* Verbum caro factum est! */ -} - - -/************************************************************************/ -/* No-conversion methods */ -/************************************************************************/ - -/* This is used when reading in "binary" files -- i.e. files that may - contain all 256 possible byte values and that are not to be - interpreted as being in any particular decoding. */ -static void -decode_coding_no_conversion (Lstream *decoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n) -{ - unsigned char c; - unsigned int flags, ch; - enum eol_type eol_type; - struct decoding_stream *str = DECODING_STREAM_DATA (decoding); - - CODING_STREAM_DECOMPOSE (str, flags, ch); - eol_type = str->eol_type; - - while (n--) - { - c = *src++; - - DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst); - DECODE_ADD_BINARY_CHAR (c, dst); - label_continue_loop:; - } - - DECODE_HANDLE_END_OF_CONVERSION (flags, ch, dst); - - CODING_STREAM_COMPOSE (str, flags, ch); -} - -static void -encode_coding_no_conversion (Lstream *encoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n) -{ - unsigned char c; - struct encoding_stream *str = ENCODING_STREAM_DATA (encoding); - unsigned int flags, ch; - enum eol_type eol_type; - - CODING_STREAM_DECOMPOSE (str, flags, ch); - eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys); - - while (n--) - { - c = *src++; - if (c == '\n') - { - if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT) - Dynarr_add (dst, '\r'); - if (eol_type != EOL_CR) - Dynarr_add (dst, '\n'); - ch = 0; - } - else if (BYTE_ASCII_P (c)) - { - assert (ch == 0); - Dynarr_add (dst, c); - } - else if (BUFBYTE_LEADING_BYTE_P (c)) - { - assert (ch == 0); - if (c == LEADING_BYTE_LATIN_ISO8859_1 || - c == LEADING_BYTE_CONTROL_1) - ch = c; - else - Dynarr_add (dst, '~'); /* untranslatable character */ - } - else - { - if (ch == LEADING_BYTE_LATIN_ISO8859_1) - Dynarr_add (dst, c); - else if (ch == LEADING_BYTE_CONTROL_1) - { - assert (c < 0xC0); - Dynarr_add (dst, c - 0x20); - } - /* else it should be the second or third byte of an - untranslatable character, so ignore it */ - ch = 0; - } - } - - CODING_STREAM_COMPOSE (str, flags, ch); -} - - -/************************************************************************/ -/* Simple internal/external functions */ -/************************************************************************/ - -static Extbyte_dynarr *conversion_out_dynarr; -static Bufbyte_dynarr *conversion_in_dynarr; - -/* Determine coding system from coding format */ - -/* #### not correct for all values of `fmt'! */ -static Lisp_Object -external_data_format_to_coding_system (enum external_data_format fmt) -{ - switch (fmt) - { - case FORMAT_FILENAME: - case FORMAT_TERMINAL: - if (EQ (Vfile_name_coding_system, Qnil) || - EQ (Vfile_name_coding_system, Qbinary)) - return Qnil; - else - return Fget_coding_system (Vfile_name_coding_system); - case FORMAT_CTEXT: - return Fget_coding_system (Qctext); - default: - return Qnil; - } -} - -CONST Extbyte * -convert_to_external_format (CONST Bufbyte *ptr, - Bytecount len, - Extcount *len_out, - enum external_data_format fmt) -{ - Lisp_Object coding_system = external_data_format_to_coding_system (fmt); - - if (!conversion_out_dynarr) - conversion_out_dynarr = Dynarr_new (Extbyte); - else - Dynarr_reset (conversion_out_dynarr); - - if (NILP (coding_system)) - { - CONST Bufbyte *end = ptr + len; - - for (; ptr < end;) - { - Bufbyte c = - (BYTE_ASCII_P (*ptr)) ? *ptr : - (*ptr == LEADING_BYTE_CONTROL_1) ? (*(ptr+1) - 0x20) : - (*ptr == LEADING_BYTE_LATIN_ISO8859_1) ? (*(ptr+1)) : - '~'; - - Dynarr_add (conversion_out_dynarr, (Extbyte) c); - INC_CHARPTR (ptr); - } - -#ifdef ERROR_CHECK_BUFPOS - assert (ptr == end); -#endif - } - else - { - Lisp_Object instream, outstream, da_outstream; - Lstream *istr, *ostr; - struct gcpro gcpro1, gcpro2, gcpro3; - char tempbuf[1024]; /* some random amount */ - - instream = make_fixed_buffer_input_stream ((unsigned char *) ptr, len); - da_outstream = make_dynarr_output_stream - ((unsigned_char_dynarr *) conversion_out_dynarr); - outstream = - make_encoding_output_stream (XLSTREAM (da_outstream), coding_system); - istr = XLSTREAM (instream); - ostr = XLSTREAM (outstream); - GCPRO3 (instream, outstream, da_outstream); - while (1) - { - int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); - if (!size_in_bytes) - break; - Lstream_write (ostr, tempbuf, size_in_bytes); - } - Lstream_close (istr); - Lstream_close (ostr); - UNGCPRO; - Lstream_delete (istr); - Lstream_delete (ostr); - Lstream_delete (XLSTREAM (da_outstream)); - } - - *len_out = Dynarr_length (conversion_out_dynarr); - Dynarr_add (conversion_out_dynarr, 0); /* remember to zero-terminate! */ - return Dynarr_atp (conversion_out_dynarr, 0); -} - -CONST Bufbyte * -convert_from_external_format (CONST Extbyte *ptr, - Extcount len, - Bytecount *len_out, - enum external_data_format fmt) -{ - Lisp_Object coding_system = external_data_format_to_coding_system (fmt); - - if (!conversion_in_dynarr) - conversion_in_dynarr = Dynarr_new (Bufbyte); - else - Dynarr_reset (conversion_in_dynarr); - - if (NILP (coding_system)) - { - CONST Extbyte *end = ptr + len; - for (; ptr < end; ptr++) - { - Extbyte c = *ptr; - DECODE_ADD_BINARY_CHAR (c, conversion_in_dynarr); - } - } - else - { - Lisp_Object instream, outstream, da_outstream; - Lstream *istr, *ostr; - struct gcpro gcpro1, gcpro2, gcpro3; - char tempbuf[1024]; /* some random amount */ - - instream = make_fixed_buffer_input_stream ((unsigned char *) ptr, len); - da_outstream = make_dynarr_output_stream - ((unsigned_char_dynarr *) conversion_in_dynarr); - outstream = - make_decoding_output_stream (XLSTREAM (da_outstream), coding_system); - istr = XLSTREAM (instream); - ostr = XLSTREAM (outstream); - GCPRO3 (instream, outstream, da_outstream); - while (1) - { - int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); - if (!size_in_bytes) - break; - Lstream_write (ostr, tempbuf, size_in_bytes); - } - Lstream_close (istr); - Lstream_close (ostr); - UNGCPRO; - Lstream_delete (istr); - Lstream_delete (ostr); - Lstream_delete (XLSTREAM (da_outstream)); - } - - *len_out = Dynarr_length (conversion_in_dynarr); - Dynarr_add (conversion_in_dynarr, 0); /* remember to zero-terminate! */ - return Dynarr_atp (conversion_in_dynarr, 0); -} - - -/************************************************************************/ -/* Initialization */ -/************************************************************************/ - -void -syms_of_mule_coding (void) -{ - defsymbol (&Qbuffer_file_coding_system, "buffer-file-coding-system"); - deferror (&Qcoding_system_error, "coding-system-error", - "Coding-system error", Qio_error); - - DEFSUBR (Fcoding_system_p); - DEFSUBR (Ffind_coding_system); - DEFSUBR (Fget_coding_system); - DEFSUBR (Fcoding_system_list); - DEFSUBR (Fcoding_system_name); - DEFSUBR (Fmake_coding_system); - DEFSUBR (Fcopy_coding_system); - DEFSUBR (Fsubsidiary_coding_system); - - DEFSUBR (Fcoding_system_type); - DEFSUBR (Fcoding_system_doc_string); - DEFSUBR (Fcoding_system_charset); - DEFSUBR (Fcoding_system_property); - - DEFSUBR (Fcoding_category_list); - DEFSUBR (Fset_coding_priority_list); - DEFSUBR (Fcoding_priority_list); - DEFSUBR (Fset_coding_category_system); - DEFSUBR (Fcoding_category_system); - - DEFSUBR (Fdetect_coding_region); - DEFSUBR (Fdecode_coding_region); - DEFSUBR (Fencode_coding_region); - DEFSUBR (Fdecode_shift_jis_char); - DEFSUBR (Fencode_shift_jis_char); - DEFSUBR (Fdecode_big5_char); - DEFSUBR (Fencode_big5_char); - - defsymbol (&Qcoding_system_p, "coding-system-p"); - - defsymbol (&Qbig5, "big5"); - defsymbol (&Qshift_jis, "shift-jis"); - defsymbol (&Qno_conversion, "no-conversion"); - defsymbol (&Qccl, "ccl"); - defsymbol (&Qiso2022, "iso2022"); - - defsymbol (&Qmnemonic, "mnemonic"); - defsymbol (&Qeol_type, "eol-type"); - defsymbol (&Qpost_read_conversion, "post-read-conversion"); - defsymbol (&Qpre_write_conversion, "pre-write-conversion"); - - defsymbol (&Qcr, "cr"); - defsymbol (&Qlf, "lf"); - defsymbol (&Qcrlf, "crlf"); - defsymbol (&Qeol_cr, "eol-cr"); - defsymbol (&Qeol_lf, "eol-lf"); - defsymbol (&Qeol_crlf, "eol-crlf"); - - defsymbol (&Qcharset_g0, "charset-g0"); - defsymbol (&Qcharset_g1, "charset-g1"); - defsymbol (&Qcharset_g2, "charset-g2"); - defsymbol (&Qcharset_g3, "charset-g3"); - defsymbol (&Qforce_g0_on_output, "force-g0-on-output"); - defsymbol (&Qforce_g1_on_output, "force-g1-on-output"); - defsymbol (&Qforce_g2_on_output, "force-g2-on-output"); - defsymbol (&Qforce_g3_on_output, "force-g3-on-output"); - defsymbol (&Qshort, "short"); - defsymbol (&Qno_ascii_eol, "no-ascii-eol"); - defsymbol (&Qno_ascii_cntl, "no-ascii-cntl"); - defsymbol (&Qseven, "seven"); - defsymbol (&Qlock_shift, "lock-shift"); - defsymbol (&Qno_iso6429, "no-iso6429"); - defsymbol (&Qescape_quoted, "escape-quoted"); - defsymbol (&Qinput_charset_conversion, "input-charset-conversion"); - defsymbol (&Qoutput_charset_conversion, "output-charset-conversion"); - - defsymbol (&Qencode, "encode"); - defsymbol (&Qdecode, "decode"); - - defsymbol (&Qctext, "ctext"); - - defsymbol (&coding_category_symbol[CODING_CATEGORY_SHIFT_JIS], - "shift-jis"); - defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_7], - "iso-7"); - defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_8_DESIGNATE], - "iso-8-designate"); - defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_8_1], - "iso-8-1"); - defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_8_2], - "iso-8-2"); - defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_LOCK_SHIFT], - "iso-lock-shift"); - defsymbol (&coding_category_symbol[CODING_CATEGORY_BIG5], - "big5"); - defsymbol (&coding_category_symbol[CODING_CATEGORY_NO_CONVERSION], - "no-conversion"); -} - -void -lstream_type_create_mule_coding (void) -{ - LSTREAM_HAS_METHOD (decoding, reader); - LSTREAM_HAS_METHOD (decoding, writer); - LSTREAM_HAS_METHOD (decoding, rewinder); - LSTREAM_HAS_METHOD (decoding, seekable_p); - LSTREAM_HAS_METHOD (decoding, flusher); - LSTREAM_HAS_METHOD (decoding, closer); - LSTREAM_HAS_METHOD (decoding, marker); - - LSTREAM_HAS_METHOD (encoding, reader); - LSTREAM_HAS_METHOD (encoding, writer); - LSTREAM_HAS_METHOD (encoding, rewinder); - LSTREAM_HAS_METHOD (encoding, seekable_p); - LSTREAM_HAS_METHOD (encoding, flusher); - LSTREAM_HAS_METHOD (encoding, closer); - LSTREAM_HAS_METHOD (encoding, marker); -} - -void -vars_of_mule_coding (void) -{ - int i; - - /* Initialize to something reasonable ... */ - for (i = 0; i <= CODING_CATEGORY_LAST; i++) - { - coding_category_system[i] = Qnil; - coding_category_by_priority[i] = i; - } - - DEFVAR_LISP ("keyboard-coding-system", &Vkeyboard_coding_system /* -Coding system used for TTY keyboard input. -Not used under a windowing system. -*/ ); - Vkeyboard_coding_system = Qnil; - - DEFVAR_LISP ("terminal-coding-system", &Vterminal_coding_system /* -Coding system used for TTY display output. -Not used under a windowing system. -*/ ); - Vterminal_coding_system = Qnil; - - DEFVAR_LISP ("coding-system-for-read", &Vcoding_system_for_read /* -Overriding coding system used when writing a file or process. -You should *bind* this, not set it. If this is non-nil, it specifies -the coding system that will be used when a file or process is read -in, and overrides `buffer-file-coding-system-for-read', -`insert-file-contents-pre-hook', etc. Use those variables instead of -this one for permanent changes to the environment. -*/ ); - Vcoding_system_for_read = Qnil; - - DEFVAR_LISP ("coding-system-for-write", - &Vcoding_system_for_write /* -Overriding coding system used when writing a file or process. -You should *bind* this, not set it. If this is non-nil, it specifies -the coding system that will be used when a file or process is wrote -in, and overrides `buffer-file-coding-system', -`write-region-pre-hook', etc. Use those variables instead of this one -for permanent changes to the environment. -*/ ); - Vcoding_system_for_write = Qnil; - - DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system /* -Coding system used to convert pathnames when accessing files. -*/ ); - Vfile_name_coding_system = Qnil; - - DEFVAR_BOOL ("enable-multibyte-characters", &enable_multibyte_characters /* -Non-nil means the buffer contents are regarded as multi-byte form -of characters, not a binary code. This affects the display, file I/O, -and behaviors of various editing commands. - -Setting this to nil does not do anything. -*/ ); - enable_multibyte_characters = 1; -} - -void -complex_vars_of_mule_coding (void) -{ - staticpro (&Vcoding_system_hash_table); - Vcoding_system_hash_table = - make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); - - the_codesys_prop_dynarr = Dynarr_new (codesys_prop); - -#define DEFINE_CODESYS_PROP(Prop_Type, Sym) do \ -{ \ - struct codesys_prop csp; \ - csp.sym = (Sym); \ - csp.prop_type = (Prop_Type); \ - Dynarr_add (the_codesys_prop_dynarr, csp); \ -} while (0) - - DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qmnemonic); - DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qeol_type); - DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qeol_cr); - DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qeol_crlf); - DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qeol_lf); - DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qpost_read_conversion); - DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qpre_write_conversion); - - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g0); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g1); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g2); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g3); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g0_on_output); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g1_on_output); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g2_on_output); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g3_on_output); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qshort); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qno_ascii_eol); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qno_ascii_cntl); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qseven); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qlock_shift); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qno_iso6429); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qescape_quoted); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qinput_charset_conversion); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qoutput_charset_conversion); - - DEFINE_CODESYS_PROP (CODESYS_PROP_CCL, Qencode); - DEFINE_CODESYS_PROP (CODESYS_PROP_CCL, Qdecode); - - /* Need to create this here or we're really screwed. */ - Fmake_coding_system (Qno_conversion, Qno_conversion, build_string ("No conversion"), - list2 (Qmnemonic, build_string ("Noconv"))); - - Fcopy_coding_system (Fcoding_system_property (Qno_conversion, Qeol_lf), - Qbinary); - - /* Need this for bootstrapping */ - coding_category_system[CODING_CATEGORY_NO_CONVERSION] = - Fget_coding_system (Qno_conversion); -} - -#endif diff -r f4aeb21a5bad -r 74fd4e045ea6 src/mule-coding.h --- a/src/mule-coding.h Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,450 +0,0 @@ -/* Header for code conversion stuff - Copyright (C) 1991, 1995 Free Software Foundation, Inc. - Copyright (C) 1995 Sun Microsystems, Inc. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Mule 2.3. Not in FSF. */ - -/* 91.10.09 written by K.Handa <handa@etl.go.jp> */ -/* Rewritten by Ben Wing <ben@xemacs.org>. */ - -#ifndef _XEMACS_MULE_CODING_H_ -#define _XEMACS_MULE_CODING_H_ - -struct decoding_stream; -struct encoding_stream; - -/* Coding system types. These go into the TYPE field of a - struct Lisp_Coding_System. */ - -enum coding_system_type -{ - CODESYS_AUTODETECT, /* Automatic conversion. */ - CODESYS_SHIFT_JIS, /* Shift-JIS; Hankaku (half-width) KANA - is also supported. */ - CODESYS_ISO2022, /* Any ISO2022-compliant coding system. - Includes JIS, EUC, CTEXT */ - CODESYS_BIG5, /* BIG5 (used for Taiwanese). */ - CODESYS_CCL, /* Converter written in CCL. */ - CODESYS_NO_CONVERSION /* "No conversion"; used for binary files. - We use quotes because there really - is some conversion being applied, - but it appears to the user as if - the text is read in without conversion. */ -#ifdef DEBUG_XEMACS - ,CODESYS_INTERNAL /* Raw (internally-formatted) data. */ -#endif -}; - -enum eol_type -{ - EOL_AUTODETECT, - EOL_LF, - EOL_CRLF, - EOL_CR -}; - -typedef struct charset_conversion_spec charset_conversion_spec; -struct charset_conversion_spec -{ - Lisp_Object from_charset; - Lisp_Object to_charset; -}; - -typedef struct -{ - Dynarr_declare (charset_conversion_spec); -} charset_conversion_spec_dynarr; - -struct Lisp_Coding_System -{ - struct lcrecord_header header; - - /* Name and doc string of this coding system. */ - Lisp_Object name, doc_string; - - /* This is the major type of the coding system -- one of Big5, ISO2022, - Shift-JIS, etc. See the constants above. */ - enum coding_system_type type; - - /* Mnemonic string displayed in the modeline when this coding - system is active for a particular buffer. */ - Lisp_Object mnemonic; - - Lisp_Object post_read_conversion, pre_write_conversion; - - enum eol_type eol_type; - - /* Subsidiary coding systems that specify a particular type of EOL - marking, rather than autodetecting it. These will only be non-nil - if (eol_type == EOL_AUTODETECT). */ - Lisp_Object eol_lf, eol_crlf, eol_cr; - - struct - { - /* What are the charsets to be initially designated to G0, G1, - G2, G3? If t, no charset is initially designated. If nil, - no charset is initially designated and no charset is allowed - to be designated. */ - Lisp_Object initial_charset[4]; - - /* If true, a designation escape sequence needs to be sent on output - for the charset in G[0-3] before that charset is used. */ - unsigned char force_charset_on_output[4]; - - charset_conversion_spec_dynarr *input_conv; - charset_conversion_spec_dynarr *output_conv; - - unsigned int shoort :1; /* C makes you speak Dutch */ - unsigned int no_ascii_eol :1; - unsigned int no_ascii_cntl :1; - unsigned int seven :1; - unsigned int lock_shift :1; - unsigned int no_iso6429 :1; - unsigned int escape_quoted :1; - } iso2022; - - struct - { - /* For a CCL coding system, these specify the CCL programs used for - decoding (input) and encoding (output). */ - Lisp_Object decode, encode; - } ccl; -}; - -DECLARE_LRECORD (coding_system, struct Lisp_Coding_System); -#define XCODING_SYSTEM(x) XRECORD (x, coding_system, struct Lisp_Coding_System) -#define XSETCODING_SYSTEM(x, p) XSETRECORD (x, p, coding_system) -#define CODING_SYSTEMP(x) RECORDP (x, coding_system) -#define GC_CODING_SYSTEMP(x) GC_RECORDP (x, coding_system) -#define CHECK_CODING_SYSTEM(x) CHECK_RECORD (x, coding_system) -#define CONCHECK_CODING_SYSTEM(x) CONCHECK_RECORD (x, coding_system) - -#define CODING_SYSTEM_NAME(codesys) ((codesys)->name) -#define CODING_SYSTEM_DOC_STRING(codesys) ((codesys)->doc_string) -#define CODING_SYSTEM_TYPE(codesys) ((codesys)->type) -#define CODING_SYSTEM_MNEMONIC(codesys) ((codesys)->mnemonic) -#define CODING_SYSTEM_POST_READ_CONVERSION(codesys) \ - ((codesys)->post_read_conversion) -#define CODING_SYSTEM_PRE_WRITE_CONVERSION(codesys) \ - ((codesys)->pre_write_conversion) -#define CODING_SYSTEM_EOL_TYPE(codesys) ((codesys)->eol_type) -#define CODING_SYSTEM_EOL_LF(codesys) ((codesys)->eol_lf) -#define CODING_SYSTEM_EOL_CRLF(codesys) ((codesys)->eol_crlf) -#define CODING_SYSTEM_EOL_CR(codesys) ((codesys)->eol_cr) -#define CODING_SYSTEM_ISO2022_INITIAL_CHARSET(codesys, g) \ - ((codesys)->iso2022.initial_charset[g]) -#define CODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT(codesys, g) \ - ((codesys)->iso2022.force_charset_on_output[g]) -#define CODING_SYSTEM_ISO2022_SHORT(codesys) ((codesys)->iso2022.shoort) -#define CODING_SYSTEM_ISO2022_NO_ASCII_EOL(codesys) \ - ((codesys)->iso2022.no_ascii_eol) -#define CODING_SYSTEM_ISO2022_NO_ASCII_CNTL(codesys) \ - ((codesys)->iso2022.no_ascii_cntl) -#define CODING_SYSTEM_ISO2022_SEVEN(codesys) ((codesys)->iso2022.seven) -#define CODING_SYSTEM_ISO2022_LOCK_SHIFT(codesys) \ - ((codesys)->iso2022.lock_shift) -#define CODING_SYSTEM_ISO2022_NO_ISO6429(codesys) \ - ((codesys)->iso2022.no_iso6429) -#define CODING_SYSTEM_ISO2022_ESCAPE_QUOTED(codesys) \ - ((codesys)->iso2022.escape_quoted) -#define CODING_SYSTEM_CCL_DECODE(codesys) ((codesys)->ccl.decode) -#define CODING_SYSTEM_CCL_ENCODE(codesys) ((codesys)->ccl.encode) - -#define XCODING_SYSTEM_NAME(codesys) \ - CODING_SYSTEM_NAME (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_DOC_STRING(codesys) \ - CODING_SYSTEM_DOC_STRING (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_TYPE(codesys) \ - CODING_SYSTEM_TYPE (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_MNEMONIC(codesys) \ - CODING_SYSTEM_MNEMONIC (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_POST_READ_CONVERSION(codesys) \ - CODING_SYSTEM_POST_READ_CONVERSION (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_PRE_WRITE_CONVERSION(codesys) \ - CODING_SYSTEM_PRE_WRITE_CONVERSION (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_EOL_TYPE(codesys) \ - CODING_SYSTEM_EOL_TYPE (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_EOL_LF(codesys) \ - CODING_SYSTEM_EOL_LF (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_EOL_CRLF(codesys) \ - CODING_SYSTEM_EOL_CRLF (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_EOL_CR(codesys) \ - CODING_SYSTEM_EOL_CR (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_ISO2022_INITIAL_CHARSET(codesys, g) \ - CODING_SYSTEM_ISO2022_INITIAL_CHARSET (XCODING_SYSTEM (codesys), g) -#define XCODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT(codesys, g) \ - CODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT (XCODING_SYSTEM (codesys), g) -#define XCODING_SYSTEM_ISO2022_SHORT(codesys) \ - CODING_SYSTEM_ISO2022_SHORT (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_ISO2022_NO_ASCII_EOL(codesys) \ - CODING_SYSTEM_ISO2022_NO_ASCII_EOL (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_ISO2022_NO_ASCII_CNTL(codesys) \ - CODING_SYSTEM_ISO2022_NO_ASCII_CNTL (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_ISO2022_SEVEN(codesys) \ - CODING_SYSTEM_ISO2022_SEVEN (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_ISO2022_LOCK_SHIFT(codesys) \ - CODING_SYSTEM_ISO2022_LOCK_SHIFT (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_ISO2022_NO_ISO6429(codesys) \ - CODING_SYSTEM_ISO2022_NO_ISO6429 (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_ISO2022_ESCAPE_QUOTED(codesys) \ - CODING_SYSTEM_ISO2022_ESCAPE_QUOTED (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_CCL_DECODE(codesys) \ - CODING_SYSTEM_CCL_DECODE (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_CCL_ENCODE(codesys) \ - CODING_SYSTEM_CCL_ENCODE (XCODING_SYSTEM (codesys)) - -extern Lisp_Object Qbuffer_file_coding_system, Qcoding_system_error; - -extern Lisp_Object Vkeyboard_coding_system; -extern Lisp_Object Vterminal_coding_system; -extern Lisp_Object Vcoding_system_for_read; -extern Lisp_Object Vcoding_system_for_write; -extern Lisp_Object Vpathname_coding_system; - -extern Lisp_Object Qescape_quoted; - -/* Flags indicating current state while converting code. */ - -/* Used by everyone. */ - -#define CODING_STATE_END (1 << 0) /* If set, this is the last chunk of - data being processed. When this - is finished, output any necessary - terminating control characters, - escape sequences, etc. */ -#define CODING_STATE_CR (1 << 1) /* If set, we just saw a CR. */ - - -/* Used by Big 5 on output. */ - -#define CODING_STATE_BIG5_1 (1 << 2) /* If set, we just encountered - LEADING_BYTE_BIG5_1. */ -#define CODING_STATE_BIG5_2 (1 << 3) /* If set, we just encountered - LEADING_BYTE_BIG5_2. */ - - -/* Used by ISO2022 on input and output. */ - -#define CODING_STATE_R2L (1 << 4) /* If set, the current - directionality is right-to-left. - Otherwise, it's left-to-right. */ - - -/* Used by ISO2022 on input. */ - -#define CODING_STATE_ESCAPE (1 << 5) /* If set, we're currently parsing - an escape sequence and the upper - 16 bits should be looked at to - indicate what partial escape - sequence we've seen so far. - Otherwise, we're running - through actual text. */ -#define CODING_STATE_SS2 (1 << 6) /* If set, G2 is invoked into GL, but - only for the next character. */ -#define CODING_STATE_SS3 (1 << 7) /* If set, G3 is invoked into GL, - but only for the next character. - If both CODING_STATE_SS2 and - CODING_STATE_SS3 are set, - CODING_STATE_SS2 overrides; but - this probably indicates an error - in the text encoding. */ -#define CODING_STATE_COMPOSITE (1 << 8) /* If set, we're currently processing - a composite character (i.e. a - character constructed by - overstriking two or more - characters). */ - - -/* CODING_STATE_ISO2022_LOCK is the mask of flags that remain on until - explicitly turned off when in the ISO2022 encoder/decoder. Other flags are - turned off at the end of processing each character or escape sequence. */ -# define CODING_STATE_ISO2022_LOCK \ - (CODING_STATE_END | CODING_STATE_COMPOSITE | CODING_STATE_R2L) -#define CODING_STATE_BIG5_LOCK \ - CODING_STATE_END - -/* Flags indicating what we've seen so far when parsing an - ISO2022 escape sequence. */ -enum iso_esc_flag -{ - /* Partial sequences */ - ISO_ESC_NOTHING, /* Nothing has been seen. */ - ISO_ESC, /* We've seen ESC. */ - ISO_ESC_2_4, /* We've seen ESC $. This indicates - that we're designating a multi-byte, rather - than a single-byte, character set. */ - ISO_ESC_2_8, /* We've seen ESC 0x28, i.e. ESC (. - This means designate a 94-character - character set into G0. */ - ISO_ESC_2_9, /* We've seen ESC 0x29 -- designate a - 94-character character set into G1. */ - ISO_ESC_2_10, /* We've seen ESC 0x2A. */ - ISO_ESC_2_11, /* We've seen ESC 0x2B. */ - ISO_ESC_2_12, /* We've seen ESC 0x2C -- designate a - 96-character character set into G0. - (This is not ISO2022-standard. - The following 96-character - control sequences are standard, - though.) */ - ISO_ESC_2_13, /* We've seen ESC 0x2D -- designate a - 96-character character set into G1. - */ - ISO_ESC_2_14, /* We've seen ESC 0x2E. */ - ISO_ESC_2_15, /* We've seen ESC 0x2F. */ - ISO_ESC_2_4_8, /* We've seen ESC $ 0x28 -- designate - a 94^N character set into G0. */ - ISO_ESC_2_4_9, /* We've seen ESC $ 0x29. */ - ISO_ESC_2_4_10, /* We've seen ESC $ 0x2A. */ - ISO_ESC_2_4_11, /* We've seen ESC $ 0x2B. */ - ISO_ESC_2_4_12, /* We've seen ESC $ 0x2C. */ - ISO_ESC_2_4_13, /* We've seen ESC $ 0x2D. */ - ISO_ESC_2_4_14, /* We've seen ESC $ 0x2E. */ - ISO_ESC_2_4_15, /* We've seen ESC $ 0x2F. */ - ISO_ESC_5_11, /* We've seen ESC [ or 0x9B. This - starts a directionality-control - sequence. The next character - must be 0, 1, 2, or ]. */ - ISO_ESC_5_11_0, /* We've seen 0x9B 0. The next - character must be ]. */ - ISO_ESC_5_11_1, /* We've seen 0x9B 1. The next - character must be ]. */ - ISO_ESC_5_11_2, /* We've seen 0x9B 2. The next - character must be ]. */ - - /* Full sequences. */ - ISO_ESC_START_COMPOSITE, /* Private usage for START COMPOSING */ - ISO_ESC_END_COMPOSITE, /* Private usage for END COMPOSING */ - ISO_ESC_SINGLE_SHIFT, /* We've seen a complete single-shift sequence. */ - ISO_ESC_LOCKING_SHIFT,/* We've seen a complete locking-shift sequence. */ - ISO_ESC_DESIGNATE, /* We've seen a complete designation sequence. */ - ISO_ESC_DIRECTIONALITY,/* We've seen a complete ISO6429 directionality - sequence. */ - ISO_ESC_LITERAL /* We've seen a literal character ala - escape-quoting. */ -}; - -/* Macros to define code of control characters for ISO2022's functions. */ - /* code */ /* function */ -#define ISO_CODE_LF 0x0A /* line-feed */ -#define ISO_CODE_CR 0x0D /* carriage-return */ -#define ISO_CODE_SO 0x0E /* shift-out */ -#define ISO_CODE_SI 0x0F /* shift-in */ -#define ISO_CODE_ESC 0x1B /* escape */ -#define ISO_CODE_DEL 0x7F /* delete */ -#define ISO_CODE_SS2 0x8E /* single-shift-2 */ -#define ISO_CODE_SS3 0x8F /* single-shift-3 */ -#define ISO_CODE_CSI 0x9B /* control-sequence-introduce */ - -/* Macros to access an encoding stream or decoding stream */ - -#define CODING_STREAM_DECOMPOSE(str, flags, ch) \ -do { \ - flags = (str)->flags; \ - ch = (str)->ch; \ -} while (0) - -#define CODING_STREAM_COMPOSE(str, flags, ch) \ -do { \ - (str)->flags = flags; \ - (str)->ch = ch; \ -} while (0) - - -/* For detecting the encoding of text */ -enum coding_category_type -{ - CODING_CATEGORY_SHIFT_JIS, - CODING_CATEGORY_ISO_7, /* ISO2022 system using only seven-bit bytes, - no locking shift */ - CODING_CATEGORY_ISO_8_DESIGNATE, /* ISO2022 system using eight-bit bytes, - no locking shift, no single shift, - using designation to switch charsets */ - CODING_CATEGORY_ISO_8_1, /* ISO2022 system using eight-bit bytes, - no locking shift, no designation sequences, - one-dimension characters in the upper half. */ - CODING_CATEGORY_ISO_8_2, /* ISO2022 system using eight-bit bytes, - no locking shift, no designation sequences, - two-dimension characters in the upper half. */ - CODING_CATEGORY_ISO_LOCK_SHIFT, /* ISO2022 system using locking shift */ - CODING_CATEGORY_BIG5, - CODING_CATEGORY_NO_CONVERSION -}; - -#define CODING_CATEGORY_LAST CODING_CATEGORY_NO_CONVERSION - -#define CODING_CATEGORY_SHIFT_JIS_MASK \ - (1 << CODING_CATEGORY_SHIFT_JIS) -#define CODING_CATEGORY_ISO_7_MASK \ - (1 << CODING_CATEGORY_ISO_7) -#define CODING_CATEGORY_ISO_8_DESIGNATE_MASK \ - (1 << CODING_CATEGORY_ISO_8_DESIGNATE) -#define CODING_CATEGORY_ISO_8_1_MASK \ - (1 << CODING_CATEGORY_ISO_8_1) -#define CODING_CATEGORY_ISO_8_2_MASK \ - (1 << CODING_CATEGORY_ISO_8_2) -#define CODING_CATEGORY_ISO_LOCK_SHIFT_MASK \ - (1 << CODING_CATEGORY_ISO_LOCK_SHIFT) -#define CODING_CATEGORY_BIG5_MASK \ - (1 << CODING_CATEGORY_BIG5) -#define CODING_CATEGORY_NO_CONVERSION_MASK \ - (1 << CODING_CATEGORY_NO_CONVERSION) -#define CODING_CATEGORY_NOT_FINISHED_MASK \ - (1 << 30) - -/* Convert shift-JIS code (sj1, sj2) into internal string - representation (c1, c2). (The leading byte is assumed.) */ - -#define DECODE_SJIS(sj1, sj2, c1, c2) \ -do { \ - int I1 = sj1, I2 = sj2; \ - if (I2 >= 0x9f) \ - c1 = (I1 << 1) - ((I1 >= 0xe0) ? 0xe0 : 0x60), \ - c2 = I2 + 2; \ - else \ - c1 = (I1 << 1) - ((I1 >= 0xe0) ? 0xe1 : 0x61), \ - c2 = I2 + ((I2 >= 0x7f) ? 0x60 : 0x61); \ -} while (0) - -/* Convert the internal string representation of a Shift-JIS character - (c1, c2) into Shift-JIS code (sj1, sj2). The leading byte is - assumed. */ - -#define ENCODE_SJIS(c1, c2, sj1, sj2) \ -do { \ - int I1 = c1, I2 = c2; \ - if (I1 & 1) \ - sj1 = (I1 >> 1) + ((I1 < 0xdf) ? 0x31 : 0x71), \ - sj2 = I2 - ((I2 >= 0xe0) ? 0x60 : 0x61); \ - else \ - sj1 = (I1 >> 1) + ((I1 < 0xdf) ? 0x30 : 0x70), \ - sj2 = I2 - 2; \ -} while (0) - -Lisp_Object make_decoding_input_stream (Lstream *stream, Lisp_Object codesys); -Lisp_Object make_encoding_input_stream (Lstream *stream, Lisp_Object codesys); -Lisp_Object make_decoding_output_stream (Lstream *stream, Lisp_Object codesys); -Lisp_Object make_encoding_output_stream (Lstream *stream, Lisp_Object codesys); -Lisp_Object decoding_stream_coding_system (Lstream *stream); -Lisp_Object encoding_stream_coding_system (Lstream *stream); -void set_decoding_stream_coding_system (Lstream *stream, Lisp_Object codesys); -void set_encoding_stream_coding_system (Lstream *stream, Lisp_Object codesys); -void determine_real_coding_system (Lstream *stream, Lisp_Object *codesys_in_out, - enum eol_type *eol_type_in_out); -#endif /* _XEMACS_MULE_CODING_H_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/mule-mcpath.c --- a/src/mule-mcpath.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/mule-mcpath.c Mon Aug 13 11:13:30 2007 +0200 @@ -32,7 +32,7 @@ Lisp_Object Qpathname_coding_system = 0; static void -mcpath_encode_code (struct Lisp_Coding_System *cp) +mcpath_encode_code (Lisp_Coding_System *cp) { Lisp_Object coding_system; @@ -46,7 +46,7 @@ mule_encode_path_1 (unsigned char *src, unsigned int srcsize, unsigned char *dst, unsigned int dstsize) { - struct Lisp_Coding_System code; + Lisp_Coding_System code; mcpath_encode_code (&code); if (CODE_TYPE (&code) > MULE_AUTOCONV) @@ -76,7 +76,7 @@ mule_decode_path_1 (unsigned char *src, unsigned char *dst, unsigned int dstsize) { - struct Lisp_Coding_System code; + Lisp_Coding_System code; mcpath_encode_code (&code); if (CODE_TYPE (&code) > MULE_AUTOCONV) @@ -239,13 +239,13 @@ mc_getwd (unsigned char path[]) { unsigned char *p; - + p = getwd (path); if (p) { unsigned char buffer[MC_MAXPATHLEN]; int len; - + len = mule_encode_path_1 (path, strlen (path) + 1, buffer, sizeof buffer); if (len > 0) { diff -r f4aeb21a5bad -r 74fd4e045ea6 src/mule-wnnfns.c --- a/src/mule-wnnfns.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/mule-wnnfns.c Mon Aug 13 11:13:30 2007 +0200 @@ -1875,9 +1875,22 @@ } void +reinit_vars_of_mule_wnn (void) +{ + int i; + + for (i = 0; i < NSERVER; i++) + { + wnnfns_buf[i] = (struct wnn_buf *) 0; + wnnfns_env_norm[i] = (struct wnn_env *) 0; + wnnfns_env_rev[i] = (struct wnn_env *) 0; + } +} + +void vars_of_mule_wnn (void) { - int i; + reinit_vars_of_mule_wnn (); DEFVAR_INT ("lb-sisheng", &lb_sisheng /* Leading character for Sisheng. @@ -1901,13 +1914,6 @@ Vwnn_uniq_level = Qwnn_uniq; - for (i = 0; i < NSERVER; i++) - { - wnnfns_buf[i] = (struct wnn_buf *) 0; - wnnfns_env_norm[i] = (struct wnn_env *) 0; - wnnfns_env_rev[i] = (struct wnn_env *) 0; - } - Fprovide(intern("wnn")); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/mule.c --- a/src/mule.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/mule.c Mon Aug 13 11:13:30 2007 +0200 @@ -40,7 +40,7 @@ int i, len; char *p; Lisp_Object temp; - struct Lisp_String *s; + Lisp_String *s; CHECK_CONS (pattern); len = XINT (Flength (pattern)); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/nas.c --- a/src/nas.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/nas.c Mon Aug 13 11:13:30 2007 +0200 @@ -108,7 +108,6 @@ #else /* !emacs */ # define warn(str) fprintf (stderr, "%s\n", (str)) -# define CONST const #endif /* emacs */ #ifdef XTOOLKIT @@ -146,10 +145,18 @@ #else char *server #endif + ); +char * +init_play ( +#ifdef XTOOLKIT + Display *display +#else + char *server +#endif ) { char *err_message; - SIGTYPE (*old_sigpipe) (); + SIGTYPE (*old_sigpipe) (int); #ifdef XTOOLKIT char * server = DisplayString (display); @@ -223,7 +230,7 @@ return NULL; } -void +static void close_down_play (void) { @@ -238,7 +245,7 @@ \********************************************************************/ static void -doneCB (AuServer *aud, +doneCB (AuServer *auserver, AuEventHandlerRec *handler, AuEvent *ev, AuPointer data) @@ -274,23 +281,23 @@ if (list == NULL) { - unsigned char *my_buf; + AuPointer my_buf; if (buf==NULL) { - if ((my_buf=malloc (SoundNumBytes (s)))==NULL) + if ((my_buf= (AuPointer) malloc (SoundNumBytes (s)))==NULL) { return; } - if (SoundReadFile (my_buf, SoundNumBytes (s), s) != SoundNumBytes (s)) + if (SoundReadFile ((char *) my_buf, SoundNumBytes (s), s) != SoundNumBytes (s)) { free (my_buf); return; } } else - my_buf=buf; + my_buf = (AuPointer) buf; id = AuSoundCreateBucketFromData (aud, s, @@ -322,6 +329,7 @@ #endif /* CACHE_SOUNDS */ +void wait_for_sounds (void); void wait_for_sounds (void) @@ -335,11 +343,12 @@ } } +int play_sound_file (char *sound_file, int volume); int play_sound_file (char *sound_file, int volume) { - SIGTYPE (*old_sigpipe) (); + SIGTYPE (*old_sigpipe) (int); #ifdef ROBUST_PLAY old_sigpipe=signal (SIGPIPE, sigpipe_handle); @@ -427,6 +436,7 @@ return 1; } +int play_sound_data (unsigned char *data, int length, int volume); int play_sound_data (unsigned char *data, int length, @@ -434,7 +444,7 @@ { Sound s; int offset; - SIGTYPE (*old_sigpipe) (); + SIGTYPE (*old_sigpipe) (int); #if !defined (XTEVENTS) AuEvent ev; @@ -613,11 +623,11 @@ /* Create a name from the sound. */ static char * -NameFromData (CONST unsigned char *buf, +NameFromData (const char *buf, int len) { - unsigned char name[9]; + char name[9]; int i; char *s; @@ -642,11 +652,11 @@ if (i==8) { - strcpy (s=malloc (10), name); + strcpy (s = (char *) malloc (10), name); } else { - strcpy (s=malloc (15), "short sound"); + strcpy (s = (char *) malloc (15), "short sound"); } return s; @@ -657,7 +667,7 @@ */ static SndInfo * -SndOpenDataForReading (CONST char *data, +SndOpenDataForReading (const char *data, int length) { @@ -729,15 +739,15 @@ /* These functions here are for faking file I/O from buffer. */ /* The "file" position */ -static int file_posn; +static size_t file_posn; /* The length of the "file" */ -static int file_len; +static size_t file_len; /* The actual "file" data. */ -CONST static char* file_data; +static const void* file_data; /* Like fopen, but for a buffer in memory */ static void -dopen(CONST char* data, int length) +dopen (const void* data, size_t length) { file_data = data; file_len = length; @@ -746,15 +756,13 @@ /* Like fread, but for a buffer in memory */ static int -dread(char* buf, int size, int nitems) +dread (void* buf, size_t size, size_t nitems) { - int nread; - - nread = size * nitems; + size_t nread = size * nitems; if (file_posn + nread <= file_len) { - memcpy(buf, file_data + file_posn, size * nitems); + memcpy(buf, (char *) file_data + file_posn, size * nitems); file_posn += nread; return nitems; } @@ -766,19 +774,17 @@ /* Like fgetc, but for a buffer in memory */ static int -dgetc() +dgetc (void) { - int ch; - if (file_posn < file_len) - return file_data[file_posn++]; + return ((char *)file_data)[file_posn++]; else return -1; } /* Like fseek, but for a buffer in memory */ static int -dseek(long offset, int from) +dseek (long offset, int from) { if (from == 0) file_posn = offset; @@ -791,8 +797,8 @@ } /* Like ftell, but for a buffer in memory */ -static int -dtell() +static long +dtell (void) { return file_posn; } @@ -800,7 +806,7 @@ /* Data buffer analogs for FileReadS and FileReadL in NAS. */ static unsigned short -DataReadS(int swapit) +DataReadS (int swapit) { unsigned short us; @@ -811,7 +817,7 @@ } static AuUint32 -DataReadL(int swapit) +DataReadL (int swapit) { AuUint32 ul; @@ -822,7 +828,7 @@ } static int -readChunk(RiffChunk *c) +readChunk (RiffChunk *c) { int status; char n; @@ -838,8 +844,8 @@ read the wave data from a buffer in memory. */ static WaveInfo * -WaveOpenDataForReading(CONST char *data, - int length) +WaveOpenDataForReading (const char *data, + int length) { RiffChunk ck; RIFF_FOURCC fourcc; @@ -981,20 +987,20 @@ if (!(s = (Sound) malloc (sizeof (SoundRec)))) return NULL; - if ((s->formatInfo = SndOpenDataForReading (data, length)) != NULL) + if ((s->formatInfo = SndOpenDataForReading ((char *) data, length)) != NULL) { - if (!(SoundFileInfo[SoundFileFormatSnd].toSound) (s)) + if (!((int(*)(Sound))(SoundFileInfo[SoundFileFormatSnd].toSound)) (s)) { - SndCloseFile (s->formatInfo); + SndCloseFile ((SndInfo *) (s->formatInfo)); free (s); return NULL; } } - else if ((s->formatInfo = WaveOpenDataForReading (data, length)) != NULL) + else if ((s->formatInfo = WaveOpenDataForReading ((char *) data, length)) != NULL) { - if (!(SoundFileInfo[SoundFileFormatWave].toSound) (s)) + if (!((int(*)(Sound))(SoundFileInfo[SoundFileFormatWave].toSound)) (s)) { - WaveCloseFile (s->formatInfo); + WaveCloseFile ((WaveInfo *) (s->formatInfo)); free (s); return NULL; } @@ -1002,4 +1008,3 @@ return s; } - diff -r f4aeb21a5bad -r 74fd4e045ea6 src/ndir.h --- a/src/ndir.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/ndir.h Mon Aug 13 11:13:30 2007 +0200 @@ -23,6 +23,9 @@ last edit: 09-Jul-1983 D A Gwyn */ +#ifndef INCLUDED_ndir_h_ +#define INCLUDED_ndir_h_ + #define DIRBLKSIZ 512 /* size of directory block */ #ifdef WINDOWSNT #define MAXNAMLEN 255 @@ -47,7 +50,7 @@ char dd_buf[DIRBLKSIZ]; /* directory block */ } DIR; /* stream data from opendir() */ -DIR *opendir (CONST char *filename); +DIR *opendir (const char *filename); int closedir (DIR *dirp); struct direct *readdir (DIR *dirp); struct direct *readdirver (DIR *dirp); @@ -55,3 +58,5 @@ void seekdir (DIR *dirp, long loc); #define rewinddir( dirp ) seekdir( dirp, 0L ) + +#endif /* INCLUDED_ndir_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/nt.c --- a/src/nt.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/nt.c Mon Aug 13 11:13:30 2007 +0200 @@ -34,6 +34,7 @@ #include "systime.h" #include "syssignal.h" #include "sysproc.h" +#include "sysfile.h" #include <ctype.h> #include <direct.h> @@ -42,13 +43,25 @@ #include <io.h> #include <pwd.h> #include <signal.h> -#include <stddef.h> /* for offsetof */ #include <string.h> #include <stdlib.h> #include <stdio.h> #include <windows.h> +#ifndef __MINGW32__ #include <mmsystem.h> +#else +typedef void (CALLBACK TIMECALLBACK)(UINT uTimerID, UINT uMsg, DWORD dwUser, DWORD dw1, DWORD dw2); + +typedef TIMECALLBACK FAR *LPTIMECALLBACK; +DWORD WINAPI timeGetTime(void); +MMRESULT WINAPI timeSetEvent(UINT uDelay, UINT uResolution, + LPTIMECALLBACK fptc, DWORD dwUser, UINT fuEvent); +MMRESULT WINAPI timeKillEvent(UINT uTimerID); +MMRESULT WINAPI timeGetDevCaps(TIMECAPS* ptc, UINT cbtc); +MMRESULT WINAPI timeBeginPeriod(UINT uPeriod); +MMRESULT WINAPI timeEndPeriod(UINT uPeriod); +#endif #include "nt.h" #include <sys/dir.h> @@ -61,7 +74,7 @@ #endif extern Lisp_Object Vmswindows_get_true_file_attributes; -extern char *get_home_directory(void); +int nt_fake_unix_uid; static char startup_dir[ MAXPATHLEN ]; @@ -118,39 +131,40 @@ the_passwd_shell, }; -int +uid_t getuid () -{ - return the_passwd.pw_uid; +{ + return nt_fake_unix_uid; } -int +uid_t geteuid () { - /* I could imagine arguing for checking to see whether the user is - in the Administrators group and returning a UID of 0 for that - case, but I don't know how wise that would be in the long run. */ - return getuid (); + return nt_fake_unix_uid; } -int +gid_t getgid () { return the_passwd.pw_gid; } -int +gid_t getegid () { return getgid (); } struct passwd * -getpwuid (int uid) +getpwuid (uid_t uid) { - if (uid == the_passwd.pw_uid) - return &the_passwd; - return NULL; + if (uid == nt_fake_unix_uid) + { + the_passwd.pw_gid = the_passwd.pw_uid = uid; + return &the_passwd; + } + else + return NULL; } struct passwd * @@ -171,6 +185,12 @@ void init_user_info () { + /* This code is pretty much of ad hoc nature. There is no unix-like + UIDs under Windows NT. There is no concept of root user, because + all security is ACL-based. Instead, let's use a simple variable, + nt-fake-unix-uid, which would allow the user to have a uid of + choice. --kkm, 02/03/2000 */ +#if 0 /* Find the user's real name by opening the process token and looking up the name associated with the user-sid in that token. @@ -246,6 +266,18 @@ the_passwd.pw_gid = 123; } + if (token) + CloseHandle (token); +#else + /* Obtain only logon id here, uid part is moved to getuid */ + char name[256]; + DWORD length = sizeof (name); + if (GetUserName (name, &length)) + strcpy (the_passwd.pw_name, name); + else + strcpy (the_passwd.pw_name, "unknown"); +#endif + /* Ensure HOME and SHELL are defined. */ #if 0 /* @@ -260,9 +292,6 @@ /* Set dir and shell from environment variables. */ strcpy (the_passwd.pw_dir, get_home_directory()); strcpy (the_passwd.pw_shell, getenv ("SHELL")); - - if (token) - CloseHandle (token); } /* Normalize filename by converting all path separators to @@ -533,7 +562,6 @@ LPBYTE lpvalue; HKEY hrootkey = NULL; DWORD cbData; - BOOL ok = FALSE; /* Check both the current user and the local machine to see if we have any resources. */ @@ -596,7 +624,9 @@ "EMACSLOCKDIR", "INFOPATH" }; - +#ifdef HEAP_IN_DATA + cache_system_info (); +#endif for (i = 0; i < countof (env_vars); i++) { if (!getenv (env_vars[i]) && @@ -942,7 +972,7 @@ static char shortname[MAX_PATH]; char * str = shortname; char c; - char * path; + const char * path; const char * save_name = name; if (is_fat_volume (name, &path)) /* truncate to 8.3 */ @@ -1052,7 +1082,7 @@ /* Opening is done by FindFirstFile. However, a read is inherent to this operation, so we defer the open until read time. */ - if (!(dirp = (DIR *) xmalloc (sizeof (DIR)))) + if (!(dirp = xnew_and_zero(DIR))) return NULL; if (dir_find_handle != INVALID_HANDLE_VALUE) return NULL; @@ -1077,7 +1107,7 @@ FindClose (dir_find_handle); dir_find_handle = INVALID_HANDLE_VALUE; } - xfree ((char *) dirp); + xfree (dirp); } struct direct * @@ -1190,8 +1220,11 @@ #endif /* 0 */ static FILETIME utc_base_ft; +static int init = 0; + +#if 0 + static long double utc_base; -static int init = 0; time_t convert_time (FILETIME ft) @@ -1224,6 +1257,77 @@ ret -= utc_base; return (time_t) (ret * 1e-7); } +#else + +static LARGE_INTEGER utc_base_li; + +time_t +convert_time (FILETIME uft) +{ + time_t ret; +#ifndef MAXLONGLONG + SYSTEMTIME st; + struct tm t; + FILETIME ft; + TIME_ZONE_INFORMATION tzi; + DWORD tzid; +#else + LARGE_INTEGER lft; +#endif + + if (!init) + { + /* Determine the delta between 1-Jan-1601 and 1-Jan-1970. */ + SYSTEMTIME st; + + st.wYear = 1970; + st.wMonth = 1; + st.wDay = 1; + st.wHour = 0; + st.wMinute = 0; + st.wSecond = 0; + st.wMilliseconds = 0; + + SystemTimeToFileTime (&st, &utc_base_ft); + + utc_base_li.LowPart = utc_base_ft.dwLowDateTime; + utc_base_li.HighPart = utc_base_ft.dwHighDateTime; + + init = 1; + } + +#ifdef MAXLONGLONG + + /* On a compiler that supports long integers, do it the easy way */ + lft.LowPart = uft.dwLowDateTime; + lft.HighPart = uft.dwHighDateTime; + ret = (time_t) ((lft.QuadPart - utc_base_li.QuadPart) / 10000000); + +#else + + /* Do it the hard way using mktime. */ + FileTimeToLocalFileTime(&uft, &ft); + FileTimeToSystemTime (&ft, &st); + tzid = GetTimeZoneInformation (&tzi); + t.tm_year = st.wYear - 1900; + t.tm_mon = st.wMonth - 1; + t.tm_mday = st.wDay; + t.tm_hour = st.wHour; + t.tm_min = st.wMinute; + t.tm_sec = st.wSecond; + t.tm_isdst = (tzid == TIME_ZONE_ID_DAYLIGHT); + /* st.wMilliseconds not applicable */ + ret = mktime(&t); + if (ret == -1) + { + ret = 0; + } + +#endif + + return ret; +} +#endif #if 0 /* in case we ever have need of this */ @@ -1301,6 +1405,46 @@ #endif +/* stat has been fixed since MSVC 5.0. + Oh, and do not encapsulater stat for non-MS compilers, too */ +/* #### popineau@ese-metz.fr says they still might be broken. + Oh well... Let's add that `1 ||' condition.... --kkm */ +#if 1 || defined(_MSC_VER) && _MSC_VER < 1100 + +/* Since stat is encapsulated on Windows NT, we need to encapsulate + the equally broken fstat as well. */ +int _cdecl +fstat (int handle, struct stat *buffer) +{ + int ret; + BY_HANDLE_FILE_INFORMATION lpFileInfo; + /* Initialize values */ + buffer->st_mode = 0; + buffer->st_size = 0; + buffer->st_dev = 0; + buffer->st_rdev = 0; + buffer->st_atime = 0; + buffer->st_ctime = 0; + buffer->st_mtime = 0; + buffer->st_nlink = 0; + ret = GetFileInformationByHandle((HANDLE) _get_osfhandle(handle), &lpFileInfo); + if (!ret) + { + return -1; + } + else + { + buffer->st_mtime = convert_time (lpFileInfo.ftLastWriteTime); + buffer->st_atime = convert_time (lpFileInfo.ftLastAccessTime); + if (buffer->st_atime == 0) buffer->st_atime = buffer->st_mtime; + buffer->st_ctime = convert_time (lpFileInfo.ftCreationTime); + if (buffer->st_ctime == 0) buffer->st_ctime = buffer->st_mtime; + buffer->st_size = lpFileInfo.nFileSizeLow; + buffer->st_nlink = (short) lpFileInfo.nNumberOfLinks; + return 0; + } +} + /* MSVC stat function can't cope with UNC names and has other bugs, so replace it with our own. This also allows us to calculate consistent inode values without hacks in the main Emacs code. */ @@ -1453,14 +1597,12 @@ buf->st_ino = (unsigned short) (fake_inode ^ (fake_inode >> 16)); /* consider files to belong to current user */ - buf->st_uid = the_passwd.pw_uid; - buf->st_gid = the_passwd.pw_gid; + buf->st_uid = buf->st_gid = nt_fake_unix_uid; /* volume_info is set indirectly by map_win32_filename */ buf->st_dev = volume_info.serialnum; buf->st_rdev = volume_info.serialnum; - buf->st_size = wfd.nFileSizeLow; /* Convert timestamps to Unix format. */ @@ -1493,6 +1635,7 @@ return 0; } +#endif /* defined(_MSC_VER) && _MSC_VER < 1100 */ /* From callproc.c */ extern Lisp_Object Vbinary_process_input; @@ -1527,67 +1670,6 @@ return rc; } -/* From ntproc.c */ -extern Lisp_Object Vwin32_pipe_read_delay; - -/* Function to do blocking read of one byte, needed to implement - select. It is only allowed on sockets and pipes. */ -int -_sys_read_ahead (int fd) -{ - child_process * cp; - int rc; - - if (fd < 0 || fd >= MAXDESC) - return STATUS_READ_ERROR; - - cp = fd_info[fd].cp; - - if (cp == NULL || cp->fd != fd || cp->status != STATUS_READ_READY) - return STATUS_READ_ERROR; - - if ((fd_info[fd].flags & (FILE_PIPE | FILE_SOCKET)) == 0 - || (fd_info[fd].flags & FILE_READ) == 0) - { - /* fd is not a pipe or socket */ - abort (); - } - - cp->status = STATUS_READ_IN_PROGRESS; - - if (fd_info[fd].flags & FILE_PIPE) - { - rc = _read (fd, &cp->chr, sizeof (char)); - - /* Give subprocess time to buffer some more output for us before - reporting that input is available; we need this because Win95 - connects DOS programs to pipes by making the pipe appear to be - the normal console stdout - as a result most DOS programs will - write to stdout without buffering, ie. one character at a - time. Even some Win32 programs do this - "dir" in a command - shell on NT is very slow if we don't do this. */ - if (rc > 0) - { - int wait = XINT (Vwin32_pipe_read_delay); - - if (wait > 0) - Sleep (wait); - else if (wait < 0) - while (++wait <= 0) - /* Yield remainder of our time slice, effectively giving a - temporary priority boost to the child process. */ - Sleep (0); - } - } - - if (rc == sizeof (char)) - cp->status = STATUS_READ_SUCCEEDED; - else - cp->status = STATUS_READ_FAILED; - - return cp->status; -} - void term_ntproc (int unused) { @@ -1810,6 +1892,7 @@ exit (3); /* Other signals are ignored by default */ + return 0; } /*--------------------------------------------------------------------*/ @@ -1928,4 +2011,57 @@ return errno = EINVAL; } +int +open_input_file (file_data *p_file, const char *filename) +{ + HANDLE file; + HANDLE file_mapping; + void *file_base; + DWORD size, upper_size; + + file = CreateFile (filename, GENERIC_READ, FILE_SHARE_READ, NULL, + OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); + if (file == INVALID_HANDLE_VALUE) + return FALSE; + + size = GetFileSize (file, &upper_size); + file_mapping = CreateFileMapping (file, NULL, PAGE_READONLY, + 0, size, NULL); + if (!file_mapping) + return FALSE; + + file_base = MapViewOfFile (file_mapping, FILE_MAP_READ, 0, 0, size); + if (file_base == 0) + return FALSE; + + p_file->name = (char*)filename; + p_file->size = size; + p_file->file = file; + p_file->file_mapping = file_mapping; + p_file->file_base = file_base; + + return TRUE; +} + +/* Close the system structures associated with the given file. */ +void +close_file_data (file_data *p_file) +{ + UnmapViewOfFile (p_file->file_base); + CloseHandle (p_file->file_mapping); + CloseHandle (p_file->file); +} + +void +vars_of_nt (void) +{ + DEFVAR_INT ("nt-fake-unix-uid", &nt_fake_unix_uid /* +*Set uid returned by `user-uid' and `user-real-uid'. +Under NT and 9x, there is no uids, and even no almighty user called root. +By setting this variable, you can have any uid of choice. Default is 0. +Changes to this variable take effect immediately. +*/ ); + nt_fake_unix_uid = 0; +} + /* end of nt.c */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/nt.h --- a/src/nt.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/nt.h Mon Aug 13 11:13:30 2007 +0200 @@ -1,6 +1,3 @@ -#ifndef _NT_H_ -#define _NT_H_ - /* Support routines for the NT version of XEmacs. Copyright (C) 1994 Free Software Foundation, Inc. @@ -26,6 +23,9 @@ /* #define FULL_DEBUG */ +#ifndef INCLUDED_nt_h_ +#define INCLUDED_nt_h_ + #ifdef DEBUG_XEMACS #define DebPrint(stuff) _DebPrint stuff #else @@ -34,6 +34,9 @@ #define R_OK 4 #define W_OK 2 +#ifdef X_OK +#undef X_OK +#endif #define X_OK 1 #define F_OK 0 @@ -147,4 +150,4 @@ extern void init_ntproc (); extern void term_ntproc (); -#endif /* _NT_H_ */ +#endif /* INCLUDED_nt_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/ntheap.c --- a/src/ntheap.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/ntheap.c Mon Aug 13 11:13:30 2007 +0200 @@ -38,38 +38,10 @@ int edata; int etext; -/* The major and minor versions of NT. */ -int nt_major_version; -int nt_minor_version; - -/* Distinguish between Windows NT and Windows 95. */ -int os_subtype; - /* Cache information describing the NT system for later use. */ void cache_system_info (void) { - union - { - struct info - { - char major; - char minor; - short platform; - } info; - DWORD data; - } version; - - /* Cache the version of the operating system. */ - version.data = GetVersion (); - nt_major_version = version.info.major; - nt_minor_version = version.info.minor; - - if (version.info.platform & 0x8000) - os_subtype = OS_WIN95; - else - os_subtype = OS_NT; - /* Cache page size, allocation unit, processor type, etc. */ GetSystemInfo (&sysinfo_cache); syspage_mask = sysinfo_cache.dwPageSize - 1; @@ -148,7 +120,8 @@ still a pretty decent arena to play in! */ unsigned long base = 0x01B00000; /* 27MB */ - unsigned long end = 1 << VALBITS; /* 256MB */ + /* Temporary hack for the non-starting problem - use 28 (256Mb) rather than VALBITS (1Gb) */ + unsigned long end = 1 << 28; /* 256MB */ void *ptr = NULL; #define NTHEAP_PROBE_BASE 1 @@ -189,20 +162,6 @@ if (!data_region_base) return NULL; -#ifndef USE_MINIMAL_TAGBITS - /* Ensure that the addresses don't use the upper tag bits since - the Lisp type goes there. */ -#ifdef USE_UNION_TYPE - if (((unsigned long) data_region_base & ~((1U << VALBITS) - 1)) != 0) -#else - if (((unsigned long) data_region_base & ~VALMASK) != 0) -#endif - { - printf ("Error: The heap was allocated in upper memory.\n"); - exit (1); - } -#endif - data_region_end = data_region_base; real_data_region_end = data_region_end; data_region_size = get_reserved_heap_size (); @@ -261,7 +220,7 @@ return result; } -#ifndef CANNOT_DUMP +#if !defined (CANNOT_DUMP) && !defined(HEAP_IN_DATA) && !defined(PDUMP) /* Recreate the heap from the data that was dumped to the executable. EXECUTABLE_PATH tells us where to find the executable. */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/ntheap.h --- a/src/ntheap.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/ntheap.h Mon Aug 13 11:13:30 2007 +0200 @@ -23,8 +23,8 @@ /* Adapted for XEmacs by David Hobley <david@spook-le0.cia.com.au> */ /* Synced with FSF Emacs 19.34.6 by Marc Paquette <marcpa@cam.org> */ -#ifndef NTHEAP_H_ -#define NTHEAP_H_ +#ifndef INCLUDED_ntheap_h_ +#define INCLUDED_ntheap_h_ #include <windows.h> @@ -54,13 +54,6 @@ #define UNINIT_PTR ((void *) 0xF0A0F0A0) #define UNINIT_LONG (0xF0A0F0A0L) -enum { - OS_WIN95 = 1, - OS_NT -}; - -extern int os_subtype; - /* Emulation of Unix sbrk(). */ extern void *sbrk (unsigned long size); @@ -87,7 +80,7 @@ /* Useful routines for manipulating memory-mapped files. */ typedef struct file_data { - char *name; + const char *name; unsigned long size; HANDLE file; HANDLE file_mapping; @@ -103,12 +96,8 @@ #define RVA_TO_PTR(var,section,filedata) \ ((void *)(RVA_TO_OFFSET(var,section) + (filedata).file_base)) -int open_input_file (file_data *p_file, char *name); -int open_output_file (file_data *p_file, char *name, unsigned long size); +int open_input_file (file_data *p_file, const char *name); +int open_output_file (file_data *p_file, const char *name, unsigned long size); void close_file_data (file_data *p_file); -/* Return pointer to section header for section containing the given - relative virtual address. */ -IMAGE_SECTION_HEADER * rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header); - -#endif /* NTHEAP_H_ */ +#endif /* INCLUDED_ntheap_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/ntplay.c --- a/src/ntplay.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/ntplay.c Mon Aug 13 11:13:30 2007 +0200 @@ -19,13 +19,13 @@ 02111-1307, USA.*/ #include <windows.h> -#undef CONST #include <config.h> #include <stdio.h> #include "sysfile.h" #include "lisp.h" -#ifdef __CYGWIN32__ +#if (defined (__CYGWIN32__) || defined(__MINGW32__)) && \ + CYGWIN_VERSION_DLL_MAJOR < 21 extern BOOL WINAPI PlaySound(LPCSTR,HMODULE,DWORD); #else #include <mmsystem.h> diff -r f4aeb21a5bad -r 74fd4e045ea6 src/ntproc.c --- a/src/ntproc.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/ntproc.c Mon Aug 13 11:13:30 2007 +0200 @@ -32,7 +32,7 @@ #include <signal.h> /* must include CRT headers *before* config.h */ -/* ### I don't believe it - martin */ +/* #### I don't believe it - martin */ #include <config.h> #undef signal #undef wait @@ -42,14 +42,18 @@ #include <windows.h> #include <sys/socket.h> - +#ifdef HAVE_A_OUT_H +#include <a.out.h> +#endif #include "lisp.h" #include "sysproc.h" #include "nt.h" #include "ntheap.h" /* From 19.34.6 */ #include "systime.h" #include "syssignal.h" +#include "sysfile.h" #include "syswait.h" +#include "buffer.h" #include "process.h" /*#include "w32term.h"*/ /* From 19.34.6: sync in ? --marcpa */ @@ -86,6 +90,8 @@ Lisp_Object Qhigh, Qlow; +extern Lisp_Object Vlisp_EXEC_SUFFIXES; + #ifndef DEBUG_XEMACS __inline #endif @@ -114,6 +120,13 @@ DWORD WINAPI reader_thread (void *arg); +/* Determine if running on Windows 9x and not NT */ +static int +windows9x_p (void) +{ + return GetVersion () & 0x80000000; +} + /* Find an unused process slot. */ child_process * new_child (void) @@ -223,6 +236,63 @@ return NULL; } +/* Function to do blocking read of one byte, needed to implement + select. It is only allowed on sockets and pipes. */ +static int +_sys_read_ahead (int fd) +{ + child_process * cp; + int rc = 0; + + if (fd < 0 || fd >= MAXDESC) + return STATUS_READ_ERROR; + + cp = fd_info[fd].cp; + + if (cp == NULL || cp->fd != fd || cp->status != STATUS_READ_READY) + return STATUS_READ_ERROR; + + if ((fd_info[fd].flags & (FILE_PIPE | FILE_SOCKET)) == 0 + || (fd_info[fd].flags & FILE_READ) == 0) + { + /* fd is not a pipe or socket */ + abort (); + } + + cp->status = STATUS_READ_IN_PROGRESS; + + if (fd_info[fd].flags & FILE_PIPE) + { + rc = _read (fd, &cp->chr, sizeof (char)); + + /* Give subprocess time to buffer some more output for us before + reporting that input is available; we need this because Win95 + connects DOS programs to pipes by making the pipe appear to be + the normal console stdout - as a result most DOS programs will + write to stdout without buffering, ie. one character at a + time. Even some Win32 programs do this - "dir" in a command + shell on NT is very slow if we don't do this. */ + if (rc > 0) + { + int wait = XINT (Vwin32_pipe_read_delay); + + if (wait > 0) + Sleep (wait); + else if (wait < 0) + while (++wait <= 0) + /* Yield remainder of our time slice, effectively giving a + temporary priority boost to the child process. */ + Sleep (0); + } + } + + if (rc == sizeof (char)) + cp->status = STATUS_READ_SUCCEEDED; + else + cp->status = STATUS_READ_FAILED; + + return cp->status; +} /* Thread proc for child process and socket reader threads. Each thread is normally blocked until woken by select() to check for input by @@ -330,7 +400,7 @@ static const char * process_dir; static BOOL -create_child (char *exe, char *cmdline, char *env, +create_child (const char *exe, char *cmdline, char *env, int * pPid, child_process *cp) { STARTUPINFO start; @@ -382,16 +452,8 @@ cp->procinfo.hThread=NULL; cp->procinfo.hProcess=NULL; - /* Hack for Windows 95, which assigns large (ie negative) pids */ - if (cp->pid < 0) - cp->pid = -cp->pid; + /* pid must fit in a Lisp_Int */ - /* pid must fit in a Lisp_Int */ -#ifdef USE_UNION_TYPE - cp->pid = (cp->pid & ((1U << VALBITS) - 1)); -#else - cp->pid = (cp->pid & VALMASK); -#endif *pPid = cp->pid; @@ -402,8 +464,30 @@ return FALSE; } +#ifndef __MINGW32__ +/* Return pointer to section header for section containing the given + relative virtual address. */ +static IMAGE_SECTION_HEADER * +rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header) +{ + PIMAGE_SECTION_HEADER section; + int i; + + section = IMAGE_FIRST_SECTION (nt_header); + + for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++) + { + if (rva >= section->VirtualAddress + && rva < section->VirtualAddress + section->SizeOfRawData) + return section; + section++; + } + return NULL; +} +#endif + void -win32_executable_type (char * filename, int * is_dos_app, int * is_cygnus_app) +win32_executable_type (const char * filename, int * is_dos_app, int * is_cygnus_app) { file_data executable; char * p; @@ -430,9 +514,9 @@ /* Actually, I think it uses the program association for that extension, which is defined in the registry. */ p = egetenv ("COMSPEC"); - if (p) + if (p) win32_executable_type (p, is_dos_app, is_cygnus_app); - } + } else { /* Look for DOS .exe signature - if found, we must also check that @@ -440,57 +524,77 @@ start with a DOS program stub. Note that 16-bit Windows executables use the OS/2 1.x format. */ - IMAGE_DOS_HEADER * dos_header; - IMAGE_NT_HEADERS * nt_header; +#ifdef __MINGW32__ + /* mingw32 doesn't have enough headers to detect cygwin + apps, just do what we can. */ + FILHDR * exe_header; + + exe_header = (FILHDR*) executable.file_base; + if (exe_header->e_magic != DOSMAGIC) + goto unwind; - dos_header = (PIMAGE_DOS_HEADER) executable.file_base; - if (dos_header->e_magic != IMAGE_DOS_SIGNATURE) - goto unwind; - - nt_header = (PIMAGE_NT_HEADERS) ((char *) dos_header + dos_header->e_lfanew); + if ((char *) exe_header->e_lfanew > (char *) executable.size) + { + /* Some dos headers (pkunzip) have bogus e_lfanew fields. */ + *is_dos_app = TRUE; + } + else if (exe_header->nt_signature != NT_SIGNATURE) + { + *is_dos_app = TRUE; + } +#else + IMAGE_DOS_HEADER * dos_header; + IMAGE_NT_HEADERS * nt_header; - if ((char *) nt_header > (char *) dos_header + executable.size) - { - /* Some dos headers (pkunzip) have bogus e_lfanew fields. */ - *is_dos_app = TRUE; - } - else if (nt_header->Signature != IMAGE_NT_SIGNATURE && - LOWORD (nt_header->Signature) != IMAGE_OS2_SIGNATURE) - { - *is_dos_app = TRUE; - } - else if (nt_header->Signature == IMAGE_NT_SIGNATURE) - { - /* Look for cygwin.dll in DLL import list. */ - IMAGE_DATA_DIRECTORY import_dir = - nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT]; - IMAGE_IMPORT_DESCRIPTOR * imports; - IMAGE_SECTION_HEADER * section; + dos_header = (PIMAGE_DOS_HEADER) executable.file_base; + if (dos_header->e_magic != IMAGE_DOS_SIGNATURE) + goto unwind; + + nt_header = (PIMAGE_NT_HEADERS) ((char *) dos_header + dos_header->e_lfanew); + + if ((char *) nt_header > (char *) dos_header + executable.size) + { + /* Some dos headers (pkunzip) have bogus e_lfanew fields. */ + *is_dos_app = TRUE; + } + else if (nt_header->Signature != IMAGE_NT_SIGNATURE && + LOWORD (nt_header->Signature) != IMAGE_OS2_SIGNATURE) + { + *is_dos_app = TRUE; + } + else if (nt_header->Signature == IMAGE_NT_SIGNATURE) + { + /* Look for cygwin.dll in DLL import list. */ + IMAGE_DATA_DIRECTORY import_dir = + nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT]; + IMAGE_IMPORT_DESCRIPTOR * imports; + IMAGE_SECTION_HEADER * section; - section = rva_to_section (import_dir.VirtualAddress, nt_header); - imports = RVA_TO_PTR (import_dir.VirtualAddress, section, executable); + section = rva_to_section (import_dir.VirtualAddress, nt_header); + imports = RVA_TO_PTR (import_dir.VirtualAddress, section, executable); + + for ( ; imports->Name; imports++) + { + char * dllname = RVA_TO_PTR (imports->Name, section, executable); - for ( ; imports->Name; imports++) - { - char * dllname = RVA_TO_PTR (imports->Name, section, executable); - - if (strcmp (dllname, "cygwin.dll") == 0) - { - *is_cygnus_app = TRUE; - break; + if (strcmp (dllname, "cygwin.dll") == 0) + { + *is_cygnus_app = TRUE; + break; + } } } +#endif } - } -unwind: - close_file_data (&executable); + unwind: + close_file_data (&executable); } int -compare_env (const char **strp1, const char **strp2) +compare_env (const void *strp1, const void *strp2) { - const char *str1 = *strp1, *str2 = *strp2; + const char *str1 = *(const char**)strp1, *str2 = *(const char**)strp2; while (*str1 && *str2 && *str1 != '=' && *str2 != '=') { @@ -534,8 +638,8 @@ /* When a new child process is created we need to register it in our list, so intercept spawn requests. */ int -sys_spawnve (int mode, CONST char *cmdname, - CONST char * CONST *argv, CONST char *CONST *envp) +sys_spawnve (int mode, const char *cmdname, + const char * const *argv, const char *const *envp) { Lisp_Object program, full; char *cmdline, *env, *parg, **targ; @@ -544,7 +648,7 @@ child_process *cp; int is_dos_app, is_cygnus_app; int do_quoting = 0; - char escape_char; + char escape_char = 0; /* We pass our process ID to our children by setting up an environment variable in their environment. */ char ppid_env_var_buffer[64]; @@ -564,24 +668,28 @@ if (NILP (Ffile_executable_p (program))) { full = Qnil; - locate_file (Vexec_path, program, EXEC_SUFFIXES, &full, 1); + locate_file (Vexec_path, program, Vlisp_EXEC_SUFFIXES, &full, 1); if (NILP (full)) { UNGCPRO; errno = EINVAL; return -1; } - cmdname = XSTRING_DATA (full); - /* #### KLUDGE */ - *(char**)(argv[0]) = cmdname; + TO_EXTERNAL_FORMAT (LISP_STRING, full, + C_STRING_ALLOCA, cmdname, + Qfile_name); + } + else + { + (char*)cmdname = alloca (strlen (argv[0]) + 1); + strcpy ((char*)cmdname, argv[0]); } UNGCPRO; /* make sure argv[0] and cmdname are both in DOS format */ - strcpy (cmdname = alloca (strlen (cmdname) + 1), argv[0]); - unixtodos_filename (cmdname); + unixtodos_filename ((char*)cmdname); /* #### KLUDGE */ - *(char**)(argv[0]) = cmdname; + ((const char**)argv)[0] = cmdname; /* Determine whether program is a 16-bit DOS executable, or a Win32 executable that is implicitly linked to the Cygnus dll (implying it @@ -597,13 +705,13 @@ { cmdname = alloca (MAXPATHLEN); if (egetenv ("CMDPROXY")) - strcpy (cmdname, egetenv ("CMDPROXY")); + strcpy ((char*)cmdname, egetenv ("CMDPROXY")); else { - strcpy (cmdname, XSTRING_DATA (Vinvocation_directory)); - strcat (cmdname, "cmdproxy.exe"); + strcpy ((char*)cmdname, XSTRING_DATA (Vinvocation_directory)); + strcat ((char*)cmdname, "cmdproxy.exe"); } - unixtodos_filename (cmdname); + unixtodos_filename ((char*)cmdname); } /* we have to do some conjuring here to put argv and envp into the @@ -649,7 +757,7 @@ /* do argv... */ arglen = 0; - targ = argv; + targ = (char**)argv; while (*targ) { char * p = *targ; @@ -695,7 +803,7 @@ arglen += strlen (*targ++) + 1; } cmdline = alloca (arglen); - targ = argv; + targ = (char**)argv; parg = cmdline; while (*targ) { @@ -776,7 +884,7 @@ /* and envp... */ arglen = 1; - targ = envp; + targ = (char**)envp; numenv = 1; /* for end null */ while (*targ) { @@ -791,7 +899,7 @@ /* merge env passed in and extra env into one, and sort it. */ targ = (char **) alloca (numenv * sizeof (char *)); - merge_and_sort_env (envp, extra_env, targ); + merge_and_sort_env ((char**)envp, extra_env, targ); /* concatenate env entries. */ env = alloca (arglen); @@ -838,7 +946,7 @@ GetClassName (hwnd, window_class, sizeof (window_class)); if (strcmp (window_class, - (os_subtype == OS_WIN95) + windows9x_p() ? "tty" : "ConsoleWindowClass") == 0) { @@ -882,7 +990,7 @@ pid = cp->procinfo.dwProcessId; /* Try to locate console window for process. */ - EnumWindows (find_child_console, (LPARAM) cp); + EnumWindows ((WNDENUMPROC)find_child_console, (LPARAM) cp); } if (sig == SIGINT) @@ -931,7 +1039,7 @@ if (NILP (Vwin32_start_process_share_console) && cp && cp->hwnd) { #if 1 - if (os_subtype == OS_WIN95) + if (windows9x_p()) { /* Another possibility is to try terminating the VDM out-right by @@ -992,7 +1100,7 @@ #if 0 /* Sync with FSF Emacs 19.34.6 note: ifdef'ed out in XEmacs */ -extern int report_file_error (CONST char *, Lisp_Object); +extern int report_file_error (const char *, Lisp_Object); #endif /* The following two routines are used to manipulate stdin, stdout, and stderr of our child processes. @@ -1320,7 +1428,7 @@ /* Sync with FSF Emacs 19.34.6 note: dwWinThreadId declared in w32term.h and defined in w32fns.c, both of which are not in current - XEmacs. ### Check what we lose by ifdef'ing out these. --marcpa */ + XEmacs. #### Check what we lose by ifdef'ing out these. --marcpa */ #if 0 /* Need to set input thread locale if present. */ if (dwWinThreadId) @@ -1335,9 +1443,6 @@ void syms_of_ntproc () { - Qhigh = intern ("high"); - Qlow = intern ("low"); - DEFSUBR (Fwin32_short_file_name); DEFSUBR (Fwin32_long_file_name); DEFSUBR (Fwin32_set_process_priority); @@ -1346,6 +1451,14 @@ DEFSUBR (Fwin32_get_default_locale_id); DEFSUBR (Fwin32_get_valid_locale_ids); DEFSUBR (Fwin32_set_current_locale); +} + + +void +vars_of_ntproc (void) +{ + defsymbol (&Qhigh, "high"); + defsymbol (&Qlow, "low"); DEFVAR_LISP ("win32-quote-process-args", &Vwin32_quote_process_args /* Non-nil enables quoting of process arguments to ensure correct parsing. @@ -1376,7 +1489,7 @@ subprocess group, but may allow Emacs to interrupt a subprocess that doesn't otherwise respond to interrupts from Emacs. */ ); - Vwin32_start_process_share_console = Qnil; + Vwin32_start_process_share_console = Qt; DEFVAR_LISP ("win32-pipe-read-delay", &Vwin32_pipe_read_delay /* Forced delay before reading subprocess output. @@ -1401,4 +1514,5 @@ Vwin32_generate_fake_inodes = Qnil; #endif } + /* end of ntproc.c */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/objects-msw.c --- a/src/objects-msw.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/objects-msw.c Mon Aug 13 11:13:30 2007 +0200 @@ -49,7 +49,8 @@ #include "device.h" #include "insdel.h" -#ifdef __CYGWIN32__ +#if (defined(__CYGWIN32__) || defined(__MINGW32__)) && \ + CYGWIN_VERSION_DLL_MAJOR < 21 #define stricmp strcasecmp #define FONTENUMPROC FONTENUMEXPROC #define ntmTm ntmentm @@ -57,12 +58,12 @@ typedef struct colormap_t { - CONST char *name; - CONST COLORREF colorref; + const char *name; + const COLORREF colorref; } colormap_t; /* Colors from X11R6 "XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp" */ -static CONST colormap_t mswindows_X_color_map[] = +static const colormap_t mswindows_X_color_map[] = { {"snow" , PALETTERGB (255, 250, 250) }, {"GhostWhite" , PALETTERGB (248, 248, 255) }, @@ -726,12 +727,12 @@ typedef struct fontmap_t { - CONST char *name; - CONST int value; + const char *name; + const int value; } fontmap_t; /* Default weight first, preferred names listed before synonyms */ -static CONST fontmap_t fontweight_map[] = +static const fontmap_t fontweight_map[] = { {"Regular" , FW_REGULAR}, /* The standard font weight */ {"Thin" , FW_THIN}, @@ -751,7 +752,7 @@ /* Default charset first, no synonyms allowed because these names are * matched against the names reported by win32 by match_font() */ -static CONST fontmap_t charset_map[] = +static const fontmap_t charset_map[] = { {"Western" , ANSI_CHARSET}, {"Symbol" , SYMBOL_CHARSET}, @@ -793,7 +794,7 @@ } COLORREF -mswindows_string_to_color(CONST char *name) +mswindows_string_to_color(const char *name) { int i; @@ -937,15 +938,15 @@ struct font_enum_t { HDC hdc; - struct device *d; + Lisp_Object list; }; static int CALLBACK font_enum_callback_2 (ENUMLOGFONTEX *lpelfe, NEWTEXTMETRICEX *lpntme, int FontType, struct font_enum_t *font_enum) { - struct mswindows_font_enum *fontlist, **fonthead; char fontname[MSW_FONTSIZE]; + Lisp_Object fontname_lispstr; int i; /* @@ -966,7 +967,7 @@ /* Formula for pointsize->height from LOGFONT docs in Platform SDK */ sprintf (fontname, "%s::%d::", lpelfe->elfLogFont.lfFaceName, MulDiv (lpntme->ntmTm.tmHeight - lpntme->ntmTm.tmInternalLeading, - 72, DEVICE_MSWINDOWS_LOGPIXELSY (font_enum->d))); + 72, GetDeviceCaps (font_enum->hdc, LOGPIXELSY))); /* * The enumerated font character set strings are not to be trusted because @@ -984,25 +985,11 @@ if (i==countof (charset_map)) strcpy (fontname, charset_map[0].name); - /* Check that the new font is not a duplicate */ - fonthead = &DEVICE_MSWINDOWS_FONTLIST (font_enum->d); - fontlist = *fonthead; - while (fontlist) - if (!strcmp (fontname, fontlist->fontname)) - return 1; /* found a duplicate */ - else - fontlist = fontlist->next; + /* Add the font name to the list if not already there */ + fontname_lispstr = build_string (fontname); + if (NILP (memq_no_quit (fontname_lispstr, font_enum->list))) + font_enum->list = Fcons (fontname_lispstr, font_enum->list); - /* Insert entry at head */ - fontlist = *fonthead; - *fonthead = xmalloc (sizeof (struct mswindows_font_enum)); - if (*fonthead == NULL) - { - *fonthead = fontlist; - return 0; - } - strcpy ((*fonthead)->fontname, fontname); - (*fonthead)->next = fontlist; return 1; } @@ -1018,13 +1005,13 @@ } /* - * Enumerate the available fonts. Called by mswindows_init_device(). - * Fills in the device's device-type-specfic fontlist. + * Enumerate the available on the HDC fonts and return a list of string + * font names. */ -void -mswindows_enumerate_fonts (struct device *d) +Lisp_Object +mswindows_enumerate_fonts (HDC hdc) { - HDC hdc = CreateCompatibleDC (NULL); + /* This cannot CG */ LOGFONT logfont; struct font_enum_t font_enum; @@ -1033,26 +1020,76 @@ logfont.lfFaceName[0] = '\0'; logfont.lfPitchAndFamily = DEFAULT_PITCH; font_enum.hdc = hdc; - font_enum.d = d; - DEVICE_MSWINDOWS_FONTLIST (d) = NULL; + font_enum.list = Qnil; EnumFontFamiliesEx (hdc, &logfont, (FONTENUMPROC) font_enum_callback_1, (LPARAM) (&font_enum), 0); - DeleteDC (hdc); + return font_enum.list; } +static HFONT +mswindows_create_font_variant (Lisp_Font_Instance* f, + int under, int strike) +{ + /* Cannot GC */ + + LOGFONT lf; + HFONT hfont; + + assert (FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, under, strike) == NULL); + + if (GetObject (FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, 0, 0), + sizeof (lf), (void*) &lf) == 0) + { + hfont = MSWINDOWS_BAD_HFONT; + } + else + { + lf.lfUnderline = under; + lf.lfStrikeOut = strike; + + hfont = CreateFontIndirect (&lf); + if (hfont == NULL) + hfont = MSWINDOWS_BAD_HFONT; + } + + FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, under, strike) = hfont; + return hfont; +} + +HFONT +mswindows_get_hfont (Lisp_Font_Instance* f, + int under, int strike) +{ + /* Cannot GC */ + HFONT hfont = FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, under, strike); + + if (hfont == NULL) + hfont = mswindows_create_font_variant (f, under, strike); + + /* If strikeout/underline variant of the font could not be + created, then use the base version of the font */ + if (hfont == MSWINDOWS_BAD_HFONT) + hfont = FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, 0, 0); + + assert (hfont != NULL && hfont != MSWINDOWS_BAD_HFONT); + + return hfont; +} /************************************************************************/ /* methods */ /************************************************************************/ static int -mswindows_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name, +mswindows_initialize_color_instance (Lisp_Color_Instance *c, Lisp_Object name, Lisp_Object device, Error_behavior errb) { - CONST char *extname; + const char *extname; COLORREF color; - GET_C_STRING_CTEXT_DATA_ALLOCA (name, extname); + TO_EXTERNAL_FORMAT (LISP_STRING, name, + C_STRING_ALLOCA, extname, + Qctext); color = mswindows_string_to_color(extname); if (color != -1) { @@ -1066,16 +1103,15 @@ #if 0 static void -mswindows_mark_color_instance (struct Lisp_Color_Instance *c, - void (*markobj) (Lisp_Object)) +mswindows_mark_color_instance (Lisp_Color_Instance *c) { } #endif static void -mswindows_print_color_instance (struct Lisp_Color_Instance *c, - Lisp_Object printcharfun, - int escapeflag) +mswindows_print_color_instance (Lisp_Color_Instance *c, + Lisp_Object printcharfun, + int escapeflag) { char buf[32]; COLORREF color = COLOR_INSTANCE_MSWINDOWS_COLOR (c); @@ -1085,7 +1121,7 @@ } static void -mswindows_finalize_color_instance (struct Lisp_Color_Instance *c) +mswindows_finalize_color_instance (Lisp_Color_Instance *c) { if (c->data) { @@ -1095,21 +1131,21 @@ } static int -mswindows_color_instance_equal (struct Lisp_Color_Instance *c1, - struct Lisp_Color_Instance *c2, - int depth) +mswindows_color_instance_equal (Lisp_Color_Instance *c1, + Lisp_Color_Instance *c2, + int depth) { return (COLOR_INSTANCE_MSWINDOWS_COLOR(c1) == COLOR_INSTANCE_MSWINDOWS_COLOR(c2)); } static unsigned long -mswindows_color_instance_hash (struct Lisp_Color_Instance *c, int depth) +mswindows_color_instance_hash (Lisp_Color_Instance *c, int depth) { - return (unsigned long)(COLOR_INSTANCE_MSWINDOWS_COLOR(c)); + return (unsigned long) COLOR_INSTANCE_MSWINDOWS_COLOR(c); } static Lisp_Object -mswindows_color_instance_rgb_components (struct Lisp_Color_Instance *c) +mswindows_color_instance_rgb_components (Lisp_Color_Instance *c) { COLORREF color = COLOR_INSTANCE_MSWINDOWS_COLOR (c); return list3 (make_int (GetRValue (color) * 257), @@ -1120,38 +1156,36 @@ static int mswindows_valid_color_name_p (struct device *d, Lisp_Object color) { - CONST char *extname; + const char *extname; - GET_C_STRING_CTEXT_DATA_ALLOCA (color, extname); + TO_EXTERNAL_FORMAT (LISP_STRING, color, + C_STRING_ALLOCA, extname, + Qctext); return (mswindows_string_to_color(extname)!=-1); } static void -mswindows_finalize_font_instance (struct Lisp_Font_Instance *f) +mswindows_finalize_font_instance (Lisp_Font_Instance *f); + +/* + * This is a work horse for both mswindows_initialize_font_instanc and + * msprinter_initialize_font_instance. + */ +static int +initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name, + Lisp_Object device_font_list, HDC hdc, + Error_behavior errb) { - if (f->data) - { - DeleteObject(f->data); - f->data=0; - } -} - - -static int -mswindows_initialize_font_instance (struct Lisp_Font_Instance *f, Lisp_Object name, - Lisp_Object device, Error_behavior errb) -{ - CONST char *extname; + const char *extname; LOGFONT logfont; int fields, i; int pt; char fontname[LF_FACESIZE], weight[LF_FACESIZE], *style, points[8]; char effects[LF_FACESIZE], charset[LF_FACESIZE]; char *c; - HDC hdc; - HFONT holdfont; + HFONT hfont, hfont2; TEXTMETRIC metrics; extname = XSTRING_DATA (name); @@ -1255,7 +1289,7 @@ } /* Formula for pointsize->height from LOGFONT docs in MSVC5 Platform SDK */ - logfont.lfHeight = -MulDiv(pt, DEVICE_MSWINDOWS_LOGPIXELSY (XDEVICE (device)), 72); + logfont.lfHeight = -MulDiv(pt, GetDeviceCaps (hdc, LOGPIXELSY), 72); logfont.lfWidth = 0; /* Effects */ @@ -1353,96 +1387,192 @@ /* Default to monospaced if the specified fontname doesn't exist. */ logfont.lfPitchAndFamily = FF_MODERN; - /* Windows will silently substitute a default font if the fontname - * specifies a non-existent font. So we check the font against the device's - * list of font patterns to make sure that at least one of them matches. */ - { - struct mswindows_font_enum *fontlist; - char truename[MSW_FONTSIZE]; - int done = 0; - - sprintf (truename, "%s:%s:%d:%s:%s", fontname, weight, pt, effects, charset); - fontlist = DEVICE_MSWINDOWS_FONTLIST (XDEVICE (device)); - while (fontlist && !done) - { - done = match_font (fontlist->fontname, truename, NULL); - fontlist = fontlist->next; - } - if (!done) - { - maybe_signal_simple_error ("No matching font", name, Qfont, errb); - return 0; - } - } + /* Windows will silently substitute a default font if the fontname specifies + a non-existent font. This is bad for screen fonts because it doesn't + allow higher-level code to see the error and to act appropriately. + For instance complex_vars_of_faces() sets up a fallback list of fonts + for the default face. */ + + if (!NILP (device_font_list)) + { + Lisp_Object fonttail; + char truename[MSW_FONTSIZE]; - if ((f->data = CreateFontIndirect(&logfont)) == NULL) + sprintf (truename, "%s:%s:%d:%s:%s", fontname, weight, pt, effects, charset); + LIST_LOOP (fonttail, device_font_list) + { + if (match_font (XSTRING_DATA (XCAR (fonttail)), truename, NULL)) + break; + } + if (NILP (fonttail)) + { + maybe_signal_simple_error ("No matching font", name, Qfont, errb); + return 0; + } + } + + if ((hfont = CreateFontIndirect(&logfont)) == NULL) { maybe_signal_simple_error ("Couldn't create font", name, Qfont, errb); return 0; } - hdc = CreateCompatibleDC (NULL); - if (hdc) + f->data = xnew_and_zero (struct mswindows_font_instance_data); + FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f,0,0) = hfont; + + /* Some underlined fonts have the descent of one pixel more than their + non-underlined counterparts. Font variants though are assumed to have + identical metrics. So get the font metrics from the underlined variant + of the font */ + hfont2 = mswindows_create_font_variant (f, 1, 0); + if (hfont2 != MSWINDOWS_BAD_HFONT) + hfont = hfont2; + + hfont2 = SelectObject(hdc, hfont); + if (!hfont2) { - holdfont = SelectObject(hdc, f->data); - if (holdfont) + mswindows_finalize_font_instance (f); + maybe_signal_simple_error ("Couldn't map font", name, Qfont, errb); + return 0; + } + GetTextMetrics (hdc, &metrics); + SelectObject(hdc, hfont2); + + f->width = (unsigned short) metrics.tmAveCharWidth; + f->height = (unsigned short) metrics.tmHeight; + f->ascent = (unsigned short) metrics.tmAscent; + f->descent = (unsigned short) metrics.tmDescent; + f->proportional_p = (metrics.tmPitchAndFamily & TMPF_FIXED_PITCH); + + return 1; +} + +static int +mswindows_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name, + Lisp_Object device, Error_behavior errb) +{ + HDC hdc = CreateCompatibleDC (NULL); + Lisp_Object font_list = DEVICE_MSWINDOWS_FONTLIST (XDEVICE (device)); + int res = initialize_font_instance (f, name, font_list, hdc, errb); + DeleteDC (hdc); + return res; +} + +static int +msprinter_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name, + Lisp_Object device, Error_behavior errb) +{ + HDC hdc = DEVICE_MSPRINTER_HDC (XDEVICE (device)); + Lisp_Object font_list = DEVICE_MSPRINTER_FONTLIST (XDEVICE (device)); + return initialize_font_instance (f, name, font_list, hdc, errb); +} + +static void +mswindows_finalize_font_instance (Lisp_Font_Instance *f) +{ + int i; + + if (f->data) + { + for (i = 0; i < MSWINDOWS_NUM_FONT_VARIANTS; i++) { - GetTextMetrics (hdc, &metrics); - SelectObject(hdc, holdfont); - DeleteDC (hdc); - f->width = (unsigned short) metrics.tmAveCharWidth; - f->height = (unsigned short) metrics.tmHeight; - f->ascent = (unsigned short) metrics.tmAscent; - f->descent = (unsigned short) metrics.tmDescent; - f->proportional_p = (metrics.tmPitchAndFamily & TMPF_FIXED_PITCH); - return 1; + if (FONT_INSTANCE_MSWINDOWS_HFONT_I (f, i) != NULL + && FONT_INSTANCE_MSWINDOWS_HFONT_I (f, i) != MSWINDOWS_BAD_HFONT) + DeleteObject (FONT_INSTANCE_MSWINDOWS_HFONT_I (f, i)); } - DeleteDC (hdc); - } - mswindows_finalize_font_instance (f); - maybe_signal_simple_error ("Couldn't map font", name, Qfont, errb); - return 0; + + xfree (f->data); + f->data = 0; + } } #if 0 static void -mswindows_mark_font_instance (struct Lisp_Font_Instance *f, - void (*markobj) (Lisp_Object)) +mswindows_mark_font_instance (Lisp_Font_Instance *f) { } #endif static void -mswindows_print_font_instance (struct Lisp_Font_Instance *f, - Lisp_Object printcharfun, - int escapeflag) +mswindows_print_font_instance (Lisp_Font_Instance *f, + Lisp_Object printcharfun, + int escapeflag) { + char buf[10]; + sprintf (buf, " 0x%lx", + (unsigned long)FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f,0,0)); + write_c_string (buf, printcharfun); } static Lisp_Object mswindows_list_fonts (Lisp_Object pattern, Lisp_Object device) { - Lisp_Object result = Qnil; - struct mswindows_font_enum *fontlist; - char fontname[MSW_FONTSIZE], *extpattern; + Lisp_Object fonttail, result = Qnil; + char *extpattern; - GET_C_STRING_CTEXT_DATA_ALLOCA (pattern, extpattern); - fontlist = DEVICE_MSWINDOWS_FONTLIST (XDEVICE (device)); - while (fontlist) + TO_EXTERNAL_FORMAT (LISP_STRING, pattern, + C_STRING_ALLOCA, extpattern, + Qctext); + + LIST_LOOP (fonttail, DEVICE_MSWINDOWS_FONTLIST (XDEVICE (device))) { - if (match_font (fontlist->fontname, extpattern, fontname)) - result = Fcons (build_string (fontname), result); - fontlist = fontlist->next; + if (match_font (XSTRING_DATA (XCAR (fonttail)), extpattern, NULL)) + result = Fcons (XCAR (fonttail), result); } return Fnreverse (result); } +/* Fill in missing parts of a font spec. This is primarily intended as a + * helper function for the functions below. + * mswindows fonts look like: + * fontname[:[weight][ style][:pointsize[:effects]]][:charset] + * A minimal mswindows font spec looks like: + * Courier New + * A maximal mswindows font spec looks like: + * Courier New:Bold Italic:10:underline strikeout:Western + * Missing parts of the font spec should be filled in with these values: + * Courier New:Regular:10::Western */ +static Lisp_Object +mswindows_font_instance_truename (Lisp_Font_Instance *f, Error_behavior errb) +{ + int nsep=0; + char *name = (char *) XSTRING_DATA (f->name); + char* ptr = name; + char* extname = alloca (strlen (name) + 19); + strcpy (extname, name); + + while ((ptr = strchr (ptr, ':')) != 0) + { + ptr++; + nsep++; + } + + switch (nsep) + { + case 0: + strcat (extname, ":Regular:10::Western"); + break; + case 1: + strcat (extname, ":10::Western"); + break; + case 2: + strcat (extname, "::Western"); + break; + case 3: + strcat (extname, ":Western"); + break; + default:; + } + + return build_ext_string (extname, Qnative); +} + #ifdef MULE static int mswindows_font_spec_matches_charset (struct device *d, Lisp_Object charset, - CONST Bufbyte *nonreloc, Lisp_Object reloc, + const Bufbyte *nonreloc, Lisp_Object reloc, Bytecount offset, Bytecount length) { /* #### Implement me */ @@ -1512,12 +1642,35 @@ /* CONSOLE_HAS_METHOD (mswindows, mark_font_instance); */ CONSOLE_HAS_METHOD (mswindows, print_font_instance); CONSOLE_HAS_METHOD (mswindows, finalize_font_instance); -/* CONSOLE_HAS_METHOD (mswindows, font_instance_truename); */ + CONSOLE_HAS_METHOD (mswindows, font_instance_truename); CONSOLE_HAS_METHOD (mswindows, list_fonts); #ifdef MULE CONSOLE_HAS_METHOD (mswindows, font_spec_matches_charset); CONSOLE_HAS_METHOD (mswindows, find_charset_font); #endif + + /* Printer methods - delegate most to windows methods, + since graphical objects behave the same way. */ + + CONSOLE_INHERITS_METHOD (msprinter, mswindows, initialize_color_instance); +/* CONSOLE_INHERITS_METHOD (msprinter, mswindows, mark_color_instance); */ + CONSOLE_INHERITS_METHOD (msprinter, mswindows, print_color_instance); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, finalize_color_instance); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, color_instance_equal); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, color_instance_hash); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, color_instance_rgb_components); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, valid_color_name_p); + + CONSOLE_HAS_METHOD (msprinter, initialize_font_instance); +/* CONSOLE_INHERITS_METHOD (msprinter, mswindows, mark_font_instance); */ + CONSOLE_INHERITS_METHOD (msprinter, mswindows, print_font_instance); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, finalize_font_instance); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, font_instance_truename); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, list_fonts); +#ifdef MULE + CONSOLE_INHERITS_METHOD (msprinter, mswindows, font_spec_matches_charset); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, find_charset_font); +#endif } void diff -r f4aeb21a5bad -r 74fd4e045ea6 src/objects-msw.h --- a/src/objects-msw.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/objects-msw.h Mon Aug 13 11:13:30 2007 +0200 @@ -31,8 +31,8 @@ */ -#ifndef _XEMACS_OBJECTS_MSW_H_ -#define _XEMACS_OBJECTS_MSW_H_ +#ifndef INCLUDED_objects_msw_h_ +#define INCLUDED_objects_msw_h_ #include "objects.h" @@ -46,6 +46,31 @@ #define COLOR_INSTANCE_MSWINDOWS_COLOR(c) \ (MSWINDOWS_COLOR_INSTANCE_DATA (c)->color) -#define FONT_INSTANCE_MSWINDOWS_HFONT(c) ((HFONT) (c)->data) +/* The four HFONTS are for the 4 (underlined, strikethrough) + combinations. Only the one at index 0, neither underlined nor + struk through is created with the font instance. Other fonts are + created as necessary during redisplay, using the one at index 0 + as protptype */ +#define MSWINDOWS_NUM_FONT_VARIANTS 4 +struct mswindows_font_instance_data +{ + HFONT hfont [MSWINDOWS_NUM_FONT_VARIANTS]; +}; + +#define MSWINDOWS_FONT_INSTANCE_DATA(c) \ + ((struct mswindows_font_instance_data *) (c)->data) -#endif /* _XEMACS_OBJECTS_MSW_H_ */ +#define FONT_INSTANCE_MSWINDOWS_HFONT_I(c,i) \ + (MSWINDOWS_FONT_INSTANCE_DATA(c)->hfont[(i)]) + +#define FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT(c,under,strike) \ + FONT_INSTANCE_MSWINDOWS_HFONT_I (c, (!!(strike)<<1)|!!(under)) + +/* If font creation during redisplay fails, then the following + value is used to prevent future attempts to create this font. + Redisplay uses the "main" font when encounters this value */ +#define MSWINDOWS_BAD_HFONT INVALID_HANDLE_VALUE + +HFONT mswindows_get_hfont (Lisp_Font_Instance* f, int under, int strike); + +#endif /* INCLUDED_objects_msw_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/objects-tty.c --- a/src/objects-tty.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/objects-tty.c Mon Aug 13 11:13:30 2007 +0200 @@ -143,7 +143,7 @@ #endif /* 0 */ static int -tty_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name, +tty_initialize_color_instance (Lisp_Color_Instance *c, Lisp_Object name, Lisp_Object device, Error_behavior errb) { Lisp_Object result; @@ -168,29 +168,28 @@ } static void -tty_mark_color_instance (struct Lisp_Color_Instance *c, - void (*markobj) (Lisp_Object)) +tty_mark_color_instance (Lisp_Color_Instance *c) { - markobj (COLOR_INSTANCE_TTY_SYMBOL (c)); + mark_object (COLOR_INSTANCE_TTY_SYMBOL (c)); } static void -tty_print_color_instance (struct Lisp_Color_Instance *c, +tty_print_color_instance (Lisp_Color_Instance *c, Lisp_Object printcharfun, int escapeflag) { } static void -tty_finalize_color_instance (struct Lisp_Color_Instance *c) +tty_finalize_color_instance (Lisp_Color_Instance *c) { if (c->data) xfree (c->data); } static int -tty_color_instance_equal (struct Lisp_Color_Instance *c1, - struct Lisp_Color_Instance *c2, +tty_color_instance_equal (Lisp_Color_Instance *c1, + Lisp_Color_Instance *c2, int depth) { return (EQ (COLOR_INSTANCE_TTY_SYMBOL (c1), @@ -198,7 +197,7 @@ } static unsigned long -tty_color_instance_hash (struct Lisp_Color_Instance *c, int depth) +tty_color_instance_hash (Lisp_Color_Instance *c, int depth) { return LISP_HASH (COLOR_INSTANCE_TTY_SYMBOL (c)); } @@ -215,13 +214,13 @@ static int -tty_initialize_font_instance (struct Lisp_Font_Instance *f, Lisp_Object name, +tty_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name, Lisp_Object device, Error_behavior errb) { Bufbyte *str = XSTRING_DATA (name); Lisp_Object charset = Qnil; - if (strncmp ((CONST char *) str, "normal", 6)) + if (strncmp ((const char *) str, "normal", 6)) return 0; str += 6; if (*str) @@ -230,7 +229,7 @@ if (*str != '/') return 0; str++; - charset = Ffind_charset (intern ((CONST char *) str)); + charset = Ffind_charset (intern ((const char *) str)); if (NILP (charset)) return 0; #else @@ -256,21 +255,20 @@ } static void -tty_mark_font_instance (struct Lisp_Font_Instance *f, - void (*markobj) (Lisp_Object)) +tty_mark_font_instance (Lisp_Font_Instance *f) { - markobj (FONT_INSTANCE_TTY_CHARSET (f)); + mark_object (FONT_INSTANCE_TTY_CHARSET (f)); } static void -tty_print_font_instance (struct Lisp_Font_Instance *f, +tty_print_font_instance (Lisp_Font_Instance *f, Lisp_Object printcharfun, int escapeflag) { } static void -tty_finalize_font_instance (struct Lisp_Font_Instance *f) +tty_finalize_font_instance (Lisp_Font_Instance *f) { if (f->data) xfree (f->data); @@ -286,10 +284,10 @@ static int tty_font_spec_matches_charset (struct device *d, Lisp_Object charset, - CONST Bufbyte *nonreloc, Lisp_Object reloc, + const Bufbyte *nonreloc, Lisp_Object reloc, Bytecount offset, Bytecount length) { - CONST Bufbyte *the_nonreloc = nonreloc; + const Bufbyte *the_nonreloc = nonreloc; if (!the_nonreloc) the_nonreloc = XSTRING_DATA (reloc); @@ -298,14 +296,14 @@ if (UNBOUNDP (charset)) return !memchr (the_nonreloc, '/', length); - the_nonreloc = (CONST Bufbyte *) memchr (the_nonreloc, '/', length); + the_nonreloc = (const Bufbyte *) memchr (the_nonreloc, '/', length); if (!the_nonreloc) return 0; the_nonreloc++; { - struct Lisp_String *s = symbol_name (XSYMBOL (XCHARSET_NAME (charset))); - return !strcmp ((CONST char *) the_nonreloc, - (CONST char *) string_data (s)); + Lisp_String *s = symbol_name (XSYMBOL (XCHARSET_NAME (charset))); + return !strcmp ((const char *) the_nonreloc, + (const char *) string_data (s)); } } @@ -317,7 +315,7 @@ { Bufbyte *fontname = XSTRING_DATA (font); - if (strchr ((CONST char *) fontname, '/')) + if (strchr ((const char *) fontname, '/')) { if (tty_font_spec_matches_charset (XDEVICE (device), charset, 0, font, 0, -1)) diff -r f4aeb21a5bad -r 74fd4e045ea6 src/objects-tty.h --- a/src/objects-tty.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/objects-tty.h Mon Aug 13 11:13:30 2007 +0200 @@ -21,8 +21,8 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_OBJECTS_TTY_H_ -#define _XEMACS_OBJECTS_TTY_H_ +#ifndef INCLUDED_objects_tty_h_ +#define INCLUDED_objects_tty_h_ #include "objects.h" @@ -49,4 +49,4 @@ extern Lisp_Object Vtty_color_alist, Vtty_dynamic_color_bg; extern Lisp_Object Vtty_dynamic_color_fg; -#endif /* _XEMACS_OBJECTS_TTY_H_ */ +#endif /* INCLUDED_objects_tty_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/objects-x.c --- a/src/objects-x.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/objects-x.c Mon Aug 13 11:13:30 2007 +0200 @@ -28,6 +28,7 @@ #include <config.h> #include "lisp.h" +#include <limits.h> #include "console-x.h" #include "objects-x.h" @@ -45,11 +46,13 @@ /* Replacement for XAllocColor() that tries to return the nearest available color if the colormap is full. Original was from FSFmacs, - but rewritten by Jareth Hein <jareth@camelot-soft.com> 97/11/25 */ + but rewritten by Jareth Hein <jareth@camelot-soft.com> 97/11/25 + Modified by Lee Kindness <lkindness@csl.co.uk> 31/08/99 to handle previous + total failure which was due to a read/write colorcell being the nearest + match - tries the next nearest... -/* Return value is 1 for normal success, 2 for nearest color success, - 3 for Non-deallocable sucess, and 0 for absolute failure (shouldn't - happen?) */ + Return value is 1 for normal success, 2 for nearest color success, + 3 for Non-deallocable sucess. */ int allocate_nearest_color (Display *display, Colormap colormap, Visual *visual, XColor *color_def) @@ -66,7 +69,7 @@ { /* We're dealing with a TrueColor/DirectColor visual, so play games with the RGB values in the XColor struct. */ - /* ### JH: I'm not sure how a call to XAllocColor can fail in a + /* #### JH: I'm not sure how a call to XAllocColor can fail in a TrueColor or DirectColor visual, so I will just reformat the request to match the requirements of the visual, and re-issue the request. If this fails for anybody, I wanna know about it @@ -115,7 +118,7 @@ else { int rd, gr, bl; - /* ### JH: I'm punting here, knowing that doing this will at + /* #### JH: I'm punting here, knowing that doing this will at least draw the color correctly. However, unless we convert all of the functions that allocate colors (graphics libraries, etc) to use this function doing this is very @@ -140,30 +143,35 @@ } else { + XColor *cells = NULL; + /* JH: I can't believe there's no way to go backwards from a + colormap ID and get its visual and number of entries, but X + apparently isn't built that way... */ + int no_cells = visual->map_entries; + status = 0; + if (XAllocColor (display, colormap, color_def) != 0) status = 1; - else + else while( status != 2 ) { /* If we got to this point, the colormap is full, so we're going to try and get the next closest color. The algorithm used is a least-squares matching, which is what X uses for closest color matching with StaticColor visuals. */ - XColor *cells; - /* JH: I can't believe there's no way to go backwards from a - colormap ID and get its visual and number of entries, but X - apparently isn't built that way... */ - int no_cells = visual->map_entries; int nearest; long nearest_delta, trial_delta; int x; - cells = alloca_array (XColor, no_cells); + if( cells == NULL ) + { + cells = alloca_array (XColor, no_cells); + for (x = 0; x < no_cells; x++) + cells[x].pixel = x; - for (x = 0; x < no_cells; x++) - cells[x].pixel = x; + /* read the current colormap */ + XQueryColors (display, colormap, cells, no_cells); + } - /* read the current colormap */ - XQueryColors (display, colormap, cells, no_cells); nearest = 0; /* I'm assuming CSE so I'm not going to condense this. */ nearest_delta = ((((color_def->red >> 8) - (cells[0].red >> 8)) @@ -184,7 +192,10 @@ + (((color_def->blue >> 8) - (cells[x].blue >> 8)) * ((color_def->blue >> 8) - (cells[x].blue >> 8)))); - if (trial_delta < nearest_delta) + + /* less? Ignore cells marked as previously failing */ + if( (trial_delta < nearest_delta) && + (cells[x].pixel != ULONG_MAX) ) { nearest = x; nearest_delta = trial_delta; @@ -193,12 +204,15 @@ color_def->red = cells[nearest].red; color_def->green = cells[nearest].green; color_def->blue = cells[nearest].blue; - if (XAllocColor (display, colormap, color_def) != 0) { - status = 2; - } else { - status = 0; /* JH: how does this happen??? DOES this happen??? */ - fprintf(stderr,"allocate_nearest_color returned 0!!!\n"); - } + if (XAllocColor (display, colormap, color_def) != 0) + status = 2; + else + /* LSK: Either the colour map has changed since + * we read it, or the colour is allocated + * read/write... Mark this cmap entry so it's + * ignored in the next iteration. + */ + cells[nearest].pixel = ULONG_MAX; } } return status; @@ -208,21 +222,19 @@ x_parse_nearest_color (struct device *d, XColor *color, Bufbyte *name, Bytecount len, Error_behavior errb) { - Display *dpy; - Colormap cmap; - Visual *visual; + Display *dpy = DEVICE_X_DISPLAY (d); + Colormap cmap = DEVICE_X_COLORMAP (d); + Visual *visual = DEVICE_X_VISUAL (d); int result; - dpy = DEVICE_X_DISPLAY (d); - cmap = DEVICE_X_COLORMAP(d); - visual = DEVICE_X_VISUAL (d); - xzero (*color); { - CONST Extbyte *extname; + const Extbyte *extname; Extcount extnamelen; - GET_CHARPTR_EXT_BINARY_DATA_ALLOCA (name, len, extname, extnamelen); + TO_EXTERNAL_FORMAT (DATA, (name, len), + ALLOCA, (extname, extnamelen), + Qbinary); result = XParseColor (dpy, cmap, (char *) extname, color); } if (!result) @@ -243,7 +255,7 @@ } static int -x_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name, +x_initialize_color_instance (Lisp_Color_Instance *c, Lisp_Object name, Lisp_Object device, Error_behavior errb) { XColor color; @@ -269,7 +281,7 @@ } static void -x_print_color_instance (struct Lisp_Color_Instance *c, +x_print_color_instance (Lisp_Color_Instance *c, Lisp_Object printcharfun, int escapeflag) { @@ -281,7 +293,7 @@ } static void -x_finalize_color_instance (struct Lisp_Color_Instance *c) +x_finalize_color_instance (Lisp_Color_Instance *c) { if (c->data) { @@ -304,8 +316,8 @@ be comparing their names or pixel values instead. */ static int -x_color_instance_equal (struct Lisp_Color_Instance *c1, - struct Lisp_Color_Instance *c2, +x_color_instance_equal (Lisp_Color_Instance *c1, + Lisp_Color_Instance *c2, int depth) { XColor color1 = COLOR_INSTANCE_X_COLOR (c1); @@ -316,14 +328,14 @@ } static unsigned long -x_color_instance_hash (struct Lisp_Color_Instance *c, int depth) +x_color_instance_hash (Lisp_Color_Instance *c, int depth) { XColor color = COLOR_INSTANCE_X_COLOR (c); return HASH3 (color.red, color.green, color.blue); } static Lisp_Object -x_color_instance_rgb_components (struct Lisp_Color_Instance *c) +x_color_instance_rgb_components (Lisp_Color_Instance *c) { XColor color = COLOR_INSTANCE_X_COLOR (c); return (list3 (make_int (color.red), @@ -338,12 +350,11 @@ Display *dpy = DEVICE_X_DISPLAY (d); Colormap cmap = DEVICE_X_COLORMAP (d); - CONST char *extname; + const char *extname; - GET_C_STRING_CTEXT_DATA_ALLOCA (color, extname); + TO_EXTERNAL_FORMAT (LISP_STRING, color, C_STRING_ALLOCA, extname, Qctext); - return XParseColor (dpy, cmap, - extname, &c); + return XParseColor (dpy, cmap, extname, &c); } @@ -352,15 +363,14 @@ /************************************************************************/ static int -x_initialize_font_instance (struct Lisp_Font_Instance *f, Lisp_Object name, +x_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name, Lisp_Object device, Error_behavior errb) { - Display *dpy; + Display *dpy = DEVICE_X_DISPLAY (XDEVICE (device)); XFontStruct *xf; - CONST char *extname; + const char *extname; - dpy = DEVICE_X_DISPLAY (XDEVICE (device)); - GET_C_STRING_CTEXT_DATA_ALLOCA (f->name, extname); + TO_EXTERNAL_FORMAT (LISP_STRING, f->name, C_STRING_ALLOCA, extname, Qctext); xf = XLoadQueryFont (dpy, extname); if (!xf) @@ -447,14 +457,13 @@ } static void -x_mark_font_instance (struct Lisp_Font_Instance *f, - void (*markobj) (Lisp_Object)) +x_mark_font_instance (Lisp_Font_Instance *f) { - markobj (FONT_INSTANCE_X_TRUENAME (f)); + mark_object (FONT_INSTANCE_X_TRUENAME (f)); } static void -x_print_font_instance (struct Lisp_Font_Instance *f, +x_print_font_instance (Lisp_Font_Instance *f, Lisp_Object printcharfun, int escapeflag) { @@ -464,7 +473,7 @@ } static void -x_finalize_font_instance (struct Lisp_Font_Instance *f) +x_finalize_font_instance (Lisp_Font_Instance *f) { if (f->data) @@ -764,7 +773,7 @@ } static Lisp_Object -x_font_instance_truename (struct Lisp_Font_Instance *f, Error_behavior errb) +x_font_instance_truename (Lisp_Font_Instance *f, Error_behavior errb) { struct device *d = XDEVICE (f->device); @@ -792,7 +801,7 @@ } static Lisp_Object -x_font_instance_properties (struct Lisp_Font_Instance *f) +x_font_instance_properties (Lisp_Font_Instance *f) { struct device *d = XDEVICE (f->device); int i; @@ -850,14 +859,16 @@ char **names; int count = 0; Lisp_Object result = Qnil; - CONST char *patternext; + const char *patternext; - GET_C_STRING_BINARY_DATA_ALLOCA (pattern, patternext); + TO_EXTERNAL_FORMAT (LISP_STRING, pattern, + C_STRING_ALLOCA, patternext, + Qbinary); names = XListFonts (DEVICE_X_DISPLAY (XDEVICE (device)), patternext, MAX_FONT_COUNT, &count); while (count--) - result = Fcons (build_ext_string (names [count], FORMAT_BINARY), result); + result = Fcons (build_ext_string (names [count], Qbinary), result); if (names) XFreeFontNames (names); return result; @@ -867,7 +878,7 @@ static int x_font_spec_matches_charset (struct device *d, Lisp_Object charset, - CONST Bufbyte *nonreloc, Lisp_Object reloc, + const Bufbyte *nonreloc, Lisp_Object reloc, Bytecount offset, Bytecount length) { if (UNBOUNDP (charset)) @@ -879,7 +890,7 @@ */ if (EQ (charset, Vcharset_ascii)) { - CONST Bufbyte *the_nonreloc = nonreloc; + const Bufbyte *the_nonreloc = nonreloc; int i; Bytecount the_length = length; @@ -891,7 +902,7 @@ { for (i = 0;; i++) { - CONST Bufbyte *new_nonreloc = (CONST Bufbyte *) + const Bufbyte *new_nonreloc = (const Bufbyte *) memchr (the_nonreloc, '-', the_length); if (!new_nonreloc) break; @@ -922,23 +933,27 @@ char **names; int count = 0; Lisp_Object result = Qnil; - CONST char *patternext; + const char *patternext; int i; - GET_C_STRING_BINARY_DATA_ALLOCA (font, patternext); + TO_EXTERNAL_FORMAT (LISP_STRING, font, + C_STRING_ALLOCA, patternext, + Qbinary); names = XListFonts (DEVICE_X_DISPLAY (XDEVICE (device)), patternext, MAX_FONT_COUNT, &count); - /* ### This code seems awfully bogus -- mrb */ + /* #### This code seems awfully bogus -- mrb */ for (i = 0; i < count; i ++) { - CONST Bufbyte *intname; + const char *intname; - GET_C_CHARPTR_INT_BINARY_DATA_ALLOCA (names[i], intname); + TO_INTERNAL_FORMAT (C_STRING, names[i], + C_STRING_ALLOCA, intname, + Qbinary); if (x_font_spec_matches_charset (XDEVICE (device), charset, - intname, Qnil, 0, -1)) + (Bufbyte *) intname, Qnil, 0, -1)) { - result = build_string ((char *) intname); + result = build_string (intname); break; } } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/objects-x.h --- a/src/objects-x.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/objects-x.h Mon Aug 13 11:13:30 2007 +0200 @@ -22,8 +22,8 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_OBJECTS_X_H_ -#define _XEMACS_OBJECTS_X_H_ +#ifndef INCLUDED_objects_x_h_ +#define INCLUDED_objects_x_h_ #include "objects.h" @@ -64,4 +64,5 @@ #define FONT_INSTANCE_X_TRUENAME(f) (X_FONT_INSTANCE_DATA (f)->truename) #endif /* HAVE_X_WINDOWS */ -#endif /* _XEMACS_OBJECTS_X_H_ */ + +#endif /* INCLUDED_objects_x_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/objects.c --- a/src/objects.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/objects.c Mon Aug 13 11:13:30 2007 +0200 @@ -57,12 +57,12 @@ Lisp_Object Qcolor_instancep; static Lisp_Object -mark_color_instance (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_color_instance (Lisp_Object obj) { - struct Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); - markobj (c->name); + Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); + mark_object (c->name); if (!NILP (c->device)) /* Vthe_null_color_instance */ - MAYBE_DEVMETH (XDEVICE (c->device), mark_color_instance, (c, markobj)); + MAYBE_DEVMETH (XDEVICE (c->device), mark_color_instance, (c)); return c->device; } @@ -72,7 +72,7 @@ int escapeflag) { char buf[100]; - struct Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); + Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); if (print_readably) error ("printing unreadable object #<color-instance 0x%x>", c->header.uid); @@ -90,7 +90,7 @@ static void finalize_color_instance (void *header, int for_disksave) { - struct Lisp_Color_Instance *c = (struct Lisp_Color_Instance *) header; + Lisp_Color_Instance *c = (Lisp_Color_Instance *) header; if (!NILP (c->device)) { @@ -102,11 +102,11 @@ static int color_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { - struct Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1); - struct Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (obj2); + Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1); + Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (obj2); return (c1 == c2) || - ((EQ (c1->device, c2->device)) && + (EQ (c1->device, c2->device) && DEVICEP (c1->device) && HAS_DEVMETH_P (XDEVICE (c1->device), color_instance_equal) && DEVMETH (XDEVICE (c1->device), color_instance_equal, (c1, c2, depth))); @@ -115,7 +115,7 @@ static unsigned long color_instance_hash (Lisp_Object obj, int depth) { - struct Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); + Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); struct device *d = DEVICEP (c->device) ? XDEVICE (c->device) : 0; return HASH2 ((unsigned long) d, @@ -127,8 +127,8 @@ DEFINE_LRECORD_IMPLEMENTATION ("color-instance", color_instance, mark_color_instance, print_color_instance, finalize_color_instance, color_instance_equal, - color_instance_hash, - struct Lisp_Color_Instance); + color_instance_hash, 0, + Lisp_Color_Instance); DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /* Return a new `color-instance' object named NAME (a string). @@ -149,14 +149,14 @@ */ (name, device, no_error)) { - struct Lisp_Color_Instance *c; + Lisp_Color_Instance *c; Lisp_Object val; int retval; CHECK_STRING (name); XSETDEVICE (device, decode_device (device)); - c = alloc_lcrecord_type (struct Lisp_Color_Instance, lrecord_color_instance); + c = alloc_lcrecord_type (Lisp_Color_Instance, &lrecord_color_instance); c->name = name; c->device = device; c->data = 0; @@ -195,7 +195,7 @@ */ (color_instance)) { - struct Lisp_Color_Instance *c; + Lisp_Color_Instance *c; CHECK_COLOR_INSTANCE (color_instance); c = XCOLOR_INSTANCE (color_instance); @@ -237,13 +237,13 @@ Error_behavior errb); static Lisp_Object -mark_font_instance (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_font_instance (Lisp_Object obj) { - struct Lisp_Font_Instance *f = XFONT_INSTANCE (obj); + Lisp_Font_Instance *f = XFONT_INSTANCE (obj); - markobj (f->name); + mark_object (f->name); if (!NILP (f->device)) /* Vthe_null_font_instance */ - MAYBE_DEVMETH (XDEVICE (f->device), mark_font_instance, (f, markobj)); + MAYBE_DEVMETH (XDEVICE (f->device), mark_font_instance, (f)); return f->device; } @@ -252,15 +252,16 @@ print_font_instance (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { char buf[200]; - struct Lisp_Font_Instance *f = XFONT_INSTANCE (obj); + Lisp_Font_Instance *f = XFONT_INSTANCE (obj); if (print_readably) error ("printing unreadable object #<font-instance 0x%x>", f->header.uid); write_c_string ("#<font-instance ", printcharfun); print_internal (f->name, printcharfun, 1); write_c_string (" on ", printcharfun); print_internal (f->device, printcharfun, 0); - MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance, - (f, printcharfun, escapeflag)); + if (!NILP (f->device)) + MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance, + (f, printcharfun, escapeflag)); sprintf (buf, " 0x%x>", f->header.uid); write_c_string (buf, printcharfun); } @@ -268,7 +269,7 @@ static void finalize_font_instance (void *header, int for_disksave) { - struct Lisp_Font_Instance *f = (struct Lisp_Font_Instance *) header; + Lisp_Font_Instance *f = (Lisp_Font_Instance *) header; if (!NILP (f->device)) { @@ -300,7 +301,7 @@ DEFINE_LRECORD_IMPLEMENTATION ("font-instance", font_instance, mark_font_instance, print_font_instance, finalize_font_instance, font_instance_equal, - font_instance_hash, struct Lisp_Font_Instance); + font_instance_hash, 0, Lisp_Font_Instance); DEFUN ("make-font-instance", Fmake_font_instance, 1, 3, 0, /* Return a new `font-instance' object named NAME. @@ -316,7 +317,7 @@ */ (name, device, no_error)) { - struct Lisp_Font_Instance *f; + Lisp_Font_Instance *f; Lisp_Object val; int retval = 0; Error_behavior errb = decode_error_behavior_flag (no_error); @@ -328,7 +329,7 @@ XSETDEVICE (device, decode_device (device)); - f = alloc_lcrecord_type (struct Lisp_Font_Instance, lrecord_font_instance); + f = alloc_lcrecord_type (Lisp_Font_Instance, &lrecord_font_instance); f->name = name; f->device = device; @@ -416,9 +417,17 @@ font_instance_truename_internal (Lisp_Object font_instance, Error_behavior errb) { - struct Lisp_Font_Instance *f = XFONT_INSTANCE (font_instance); - struct device *d = XDEVICE (f->device); - return DEVMETH_OR_GIVEN (d, font_instance_truename, (f, errb), f->name); + Lisp_Font_Instance *f = XFONT_INSTANCE (font_instance); + + if (NILP (f->device)) + { + maybe_signal_simple_error ("Couldn't determine font truename", + font_instance, Qfont, errb); + return Qnil; + } + + return DEVMETH_OR_GIVEN (XDEVICE (f->device), + font_instance_truename, (f, errb), f->name); } DEFUN ("font-instance-truename", Ffont_instance_truename, 1, 1, 0, /* @@ -438,11 +447,14 @@ */ (font_instance)) { - struct Lisp_Font_Instance *f; + Lisp_Font_Instance *f; CHECK_FONT_INSTANCE (font_instance); f = XFONT_INSTANCE (font_instance); + if (NILP (f->device)) + return Qnil; + return MAYBE_LISP_DEVMETH (XDEVICE (f->device), font_instance_properties, (f)); } @@ -470,19 +482,19 @@ static void color_create (Lisp_Object obj) { - struct Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); + Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); COLOR_SPECIFIER_FACE (color) = Qnil; COLOR_SPECIFIER_FACE_PROPERTY (color) = Qnil; } static void -color_mark (Lisp_Object obj, void (*markobj) (Lisp_Object)) +color_mark (Lisp_Object obj) { - struct Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); + Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); - markobj (COLOR_SPECIFIER_FACE (color)); - markobj (COLOR_SPECIFIER_FACE_PROPERTY (color)); + mark_object (COLOR_SPECIFIER_FACE (color)); + mark_object (COLOR_SPECIFIER_FACE_PROPERTY (color)); } /* No equal or hash methods; ignore the face the color is based off @@ -610,7 +622,7 @@ void set_color_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property) { - struct Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); + Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); COLOR_SPECIFIER_FACE (color) = face; COLOR_SPECIFIER_FACE_PROPERTY (color) = property; @@ -648,19 +660,19 @@ static void font_create (Lisp_Object obj) { - struct Lisp_Specifier *font = XFONT_SPECIFIER (obj); + Lisp_Specifier *font = XFONT_SPECIFIER (obj); FONT_SPECIFIER_FACE (font) = Qnil; FONT_SPECIFIER_FACE_PROPERTY (font) = Qnil; } static void -font_mark (Lisp_Object obj, void (*markobj) (Lisp_Object)) +font_mark (Lisp_Object obj) { - struct Lisp_Specifier *font = XFONT_SPECIFIER (obj); + Lisp_Specifier *font = XFONT_SPECIFIER (obj); - markobj (FONT_SPECIFIER_FACE (font)); - markobj (FONT_SPECIFIER_FACE_PROPERTY (font)); + mark_object (FONT_SPECIFIER_FACE (font)); + mark_object (FONT_SPECIFIER_FACE_PROPERTY (font)); } /* No equal or hash methods; ignore the face the font is based off @@ -670,7 +682,7 @@ int font_spec_matches_charset (struct device *d, Lisp_Object charset, - CONST Bufbyte *nonreloc, Lisp_Object reloc, + const Bufbyte *nonreloc, Lisp_Object reloc, Bytecount offset, Bytecount length) { return DEVMETH_OR_GIVEN (d, font_spec_matches_charset, @@ -820,7 +832,7 @@ void set_font_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property) { - struct Lisp_Specifier *font = XFONT_SPECIFIER (obj); + Lisp_Specifier *font = XFONT_SPECIFIER (obj); FONT_SPECIFIER_FACE (font) = face; FONT_SPECIFIER_FACE_PROPERTY (font) = property; @@ -855,19 +867,19 @@ static void face_boolean_create (Lisp_Object obj) { - struct Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); + Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = Qnil; FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = Qnil; } static void -face_boolean_mark (Lisp_Object obj, void (*markobj) (Lisp_Object)) +face_boolean_mark (Lisp_Object obj) { - struct Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); + Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); - markobj (FACE_BOOLEAN_SPECIFIER_FACE (face_boolean)); - markobj (FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean)); + mark_object (FACE_BOOLEAN_SPECIFIER_FACE (face_boolean)); + mark_object (FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean)); } /* No equal or hash methods; ignore the face the face-boolean is based off @@ -965,7 +977,7 @@ set_face_boolean_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property) { - struct Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); + Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = face; FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = property; @@ -1024,6 +1036,24 @@ defsymbol (&Qface_boolean, "face-boolean"); } +static const struct lrecord_description color_specifier_description[] = { + { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct color_specifier, face) }, + { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct color_specifier, face_property) }, + { XD_END } +}; + +static const struct lrecord_description font_specifier_description[] = { + { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct font_specifier, face) }, + { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct font_specifier, face_property) }, + { XD_END } +}; + +static const struct lrecord_description face_boolean_specifier_description[] = { + { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct face_boolean_specifier, face) }, + { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct face_boolean_specifier, face_property) }, + { XD_END } +}; + void specifier_type_create_objects (void) { @@ -1058,12 +1088,20 @@ } void -vars_of_objects (void) +reinit_specifier_type_create_objects (void) { - staticpro (&Vthe_null_color_instance); + REINITIALIZE_SPECIFIER_TYPE (color); + REINITIALIZE_SPECIFIER_TYPE (font); + REINITIALIZE_SPECIFIER_TYPE (face_boolean); +} + +void +reinit_vars_of_objects (void) +{ + staticpro_nodump (&Vthe_null_color_instance); { - struct Lisp_Color_Instance *c = - alloc_lcrecord_type (struct Lisp_Color_Instance, lrecord_color_instance); + Lisp_Color_Instance *c = + alloc_lcrecord_type (Lisp_Color_Instance, &lrecord_color_instance); c->name = Qnil; c->device = Qnil; c->data = 0; @@ -1071,10 +1109,10 @@ XSETCOLOR_INSTANCE (Vthe_null_color_instance, c); } - staticpro (&Vthe_null_font_instance); + staticpro_nodump (&Vthe_null_font_instance); { - struct Lisp_Font_Instance *f = - alloc_lcrecord_type (struct Lisp_Font_Instance, lrecord_font_instance); + Lisp_Font_Instance *f = + alloc_lcrecord_type (Lisp_Font_Instance, &lrecord_font_instance); f->name = Qnil; f->device = Qnil; f->data = 0; @@ -1087,3 +1125,9 @@ XSETFONT_INSTANCE (Vthe_null_font_instance, f); } } + +void +vars_of_objects (void) +{ + reinit_vars_of_objects (); +} diff -r f4aeb21a5bad -r 74fd4e045ea6 src/objects.h --- a/src/objects.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/objects.h Mon Aug 13 11:13:30 2007 +0200 @@ -21,8 +21,8 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_OBJECTS_H_ -#define _XEMACS_OBJECTS_H_ +#ifndef INCLUDED_objects_h_ +#define INCLUDED_objects_h_ #include "specifier.h" @@ -38,7 +38,7 @@ Lisp_Object face_property; /* property of that face */ }; -#define COLOR_SPECIFIER_DATA(g) (SPECIFIER_TYPE_DATA (g, color)) +#define COLOR_SPECIFIER_DATA(g) SPECIFIER_TYPE_DATA (g, color) #define COLOR_SPECIFIER_FACE(g) (COLOR_SPECIFIER_DATA (g)->face) #define COLOR_SPECIFIER_FACE_PROPERTY(g) \ (COLOR_SPECIFIER_DATA (g)->face_property) @@ -63,7 +63,7 @@ Lisp_Object face_property; /* property of that face */ }; -#define FONT_SPECIFIER_DATA(g) (SPECIFIER_TYPE_DATA (g, font)) +#define FONT_SPECIFIER_DATA(g) SPECIFIER_TYPE_DATA (g, font) #define FONT_SPECIFIER_FACE(g) (FONT_SPECIFIER_DATA (g)->face) #define FONT_SPECIFIER_FACE_PROPERTY(g) \ (FONT_SPECIFIER_DATA (g)->face_property) @@ -88,7 +88,7 @@ Lisp_Object face_property; /* property of that face */ }; -#define FACE_BOOLEAN_SPECIFIER_DATA(g) (SPECIFIER_TYPE_DATA (g, face_boolean)) +#define FACE_BOOLEAN_SPECIFIER_DATA(g) SPECIFIER_TYPE_DATA (g, face_boolean) #define FACE_BOOLEAN_SPECIFIER_FACE(g) (FACE_BOOLEAN_SPECIFIER_DATA (g)->face) #define FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY(g) \ (FACE_BOOLEAN_SPECIFIER_DATA (g)->face_property) @@ -111,15 +111,6 @@ * Color Instance Object * ****************************************************************************/ -DECLARE_LRECORD (color_instance, struct Lisp_Color_Instance); -#define XCOLOR_INSTANCE(x) \ - XRECORD (x, color_instance, struct Lisp_Color_Instance) -#define XSETCOLOR_INSTANCE(x, p) XSETRECORD (x, p, color_instance) -#define COLOR_INSTANCEP(x) RECORDP (x, color_instance) -#define GC_COLOR_INSTANCEP(x) GC_RECORDP (x, color_instance) -#define CHECK_COLOR_INSTANCE(x) CHECK_RECORD (x, color_instance) -#define CONCHECK_COLOR_INSTANCE(x) CONCHECK_RECORD (x, color_instance) - EXFUN (Fmake_color_instance, 3); extern Lisp_Object Vthe_null_color_instance; @@ -134,6 +125,13 @@ void *data; }; +DECLARE_LRECORD (color_instance, Lisp_Color_Instance); +#define XCOLOR_INSTANCE(x) XRECORD (x, color_instance, Lisp_Color_Instance) +#define XSETCOLOR_INSTANCE(x, p) XSETRECORD (x, p, color_instance) +#define COLOR_INSTANCEP(x) RECORDP (x, color_instance) +#define CHECK_COLOR_INSTANCE(x) CHECK_RECORD (x, color_instance) +#define CONCHECK_COLOR_INSTANCE(x) CONCHECK_RECORD (x, color_instance) + #define COLOR_INSTANCE_NAME(c) ((c)->name) #define COLOR_INSTANCE_DEVICE(c) ((c)->device) @@ -141,17 +139,16 @@ * Font Instance Object * ****************************************************************************/ -DECLARE_LRECORD (font_instance, struct Lisp_Font_Instance); -#define XFONT_INSTANCE(x) XRECORD (x, font_instance, struct Lisp_Font_Instance) +DECLARE_LRECORD (font_instance, Lisp_Font_Instance); +#define XFONT_INSTANCE(x) XRECORD (x, font_instance, Lisp_Font_Instance) #define XSETFONT_INSTANCE(x, p) XSETRECORD (x, p, font_instance) #define FONT_INSTANCEP(x) RECORDP (x, font_instance) -#define GC_FONT_INSTANCEP(x) GC_RECORDP (x, font_instance) #define CHECK_FONT_INSTANCE(x) CHECK_RECORD (x, font_instance) #define CONCHECK_FONT_INSTANCE(x) CONCHECK_RECORD (x, font_instance) #ifdef MULE int font_spec_matches_charset (struct device *d, Lisp_Object charset, - CONST Bufbyte *nonreloc, + const Bufbyte *nonreloc, Lisp_Object reloc, Bytecount offset, Bytecount length); #endif @@ -186,4 +183,4 @@ #define FONT_INSTANCE_WIDTH(f) ((f)->width) #define FONT_INSTANCE_HEIGHT(f) ((f)->height) -#endif /* _XEMACS_OBJECTS_H_ */ +#endif /* INCLUDED_objects_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/offix-types.h --- a/src/offix-types.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/offix-types.h Mon Aug 13 11:13:30 2007 +0200 @@ -14,8 +14,8 @@ Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ -#ifndef __DragAndDropTypesH__ -#define __DragAndDropTypesH__ +#ifndef INCLUDED_offix_types_h_ +#define INCLUDED_offix_types_h_ #define DndNotDnd -1 #define DndUnknown 0 @@ -31,4 +31,4 @@ #define DndEND 10 -#endif +#endif /* INCLUDED_offix_types_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/offix.h --- a/src/offix.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/offix.h Mon Aug 13 11:13:30 2007 +0200 @@ -19,8 +19,8 @@ Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ -#ifndef __DragAndDropH__ -#define __DragAndDropH__ 1L +#ifndef INCLUDED_offix_h_ +#define INCLUDED_offix_h_ /* The standard DND types are defined here */ #include "offix-types.h" @@ -63,6 +63,7 @@ int width,int height, char *image,char *mask, int hot_x,int hot_y); -#endif + +#endif /* INCLUDED_offix_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/opaque.c --- a/src/opaque.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/opaque.c Mon Aug 13 11:13:30 2007 +0200 @@ -32,79 +32,31 @@ OPAQUE OBJECTS SHOULD NEVER ESCAPE TO THE LISP LEVEL. Some code depends on this. As such, opaque objects are a generalization of the Qunbound marker. - - "Opaque lists" are used to keep track of lots of opaque objects - of a particular size so that they can be efficiently "freed" and - re-used again without actually entering the Lisp allocation system - (and consequently doing a malloc()). */ #include <config.h> #include "lisp.h" #include "opaque.h" -#include <stddef.h> -Lisp_Object Qopaquep; - -static int in_opaque_list_marking; - -/* Holds freed opaque objects created with make_opaque_ptr(). - We do this quite often so it's a noticeable win if we don't - create GC junk. */ Lisp_Object Vopaque_ptr_free_list; -static Lisp_Object -mark_opaque (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - Lisp_Opaque *p = XOPAQUE (obj); - /* Egcs 1.1.1 sometimes crashes on INTP (p->size_or_chain) */ - Lisp_Object size_or_chain = p->size_or_chain; -#ifdef ERROR_CHECK_GC - if (!in_opaque_list_marking) - /* size is non-int for objects on an opaque free list. We sure - as hell better not be marking any of these objects unless - we're marking an opaque list. */ - assert (GC_INTP (size_or_chain)); - else - /* marking an opaque on the free list doesn't do any recursive - markings, so we better not have non-freed opaques on a free - list. */ - assert (!GC_INTP (size_or_chain)); -#endif - if (GC_INTP (size_or_chain) && OPAQUE_MARKFUN (p)) - return OPAQUE_MARKFUN (p) (obj, markobj); - else - return size_or_chain; -} - /* Should never, ever be called. (except by an external debugger) */ static void print_opaque (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { - CONST Lisp_Opaque *p = XOPAQUE (obj); - /* Egcs 1.1.1 sometimes crashes on INTP (p->size_or_chain) */ - Lisp_Object size_or_chain = p->size_or_chain; + const Lisp_Opaque *p = XOPAQUE (obj); char buf[200]; - char size_buf[50]; - if (INTP (size_or_chain)) - sprintf (size_buf, "size=%lu", (unsigned long) OPAQUE_SIZE (p)); - else - sprintf (size_buf, "freed"); - - sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (opaque, %s) 0x%lx>", - size_buf, (unsigned long) p); + sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (opaque, size=%lu) 0x%lx>", + (long)(p->size), (unsigned long) p); write_c_string (buf, printcharfun); } static size_t -sizeof_opaque (CONST void *header) +sizeof_opaque (const void *header) { - CONST Lisp_Opaque *p = (CONST Lisp_Opaque *) header; - /* Egcs 1.1.1 sometimes crashes on INTP (p->size_or_chain) */ - Lisp_Object size_or_chain = p->size_or_chain; - return offsetof (Lisp_Opaque, data) - + (GC_INTP (size_or_chain) ? XINT (size_or_chain) : 0); + const Lisp_Opaque *p = (const Lisp_Opaque *) header; + return offsetof (Lisp_Opaque, data) + p->size; } /* Return an opaque object of size SIZE. @@ -112,12 +64,11 @@ If DATA is OPAQUE_UNINIT, the object's data is uninitialized. Else the object's data is initialized by copying from DATA. */ Lisp_Object -make_opaque (size_t size, CONST void *data) +make_opaque (const void *data, size_t size) { Lisp_Opaque *p = (Lisp_Opaque *) - alloc_lcrecord (offsetof (Lisp_Opaque, data) + size, lrecord_opaque); - p->markfun = 0; - p->size_or_chain = make_int (size); + alloc_lcrecord (offsetof (Lisp_Opaque, data) + size, &lrecord_opaque); + p->size = size; if (data == OPAQUE_CLEAR) memset (p->data, '\0', size); @@ -138,21 +89,9 @@ static int equal_opaque (Lisp_Object obj1, Lisp_Object obj2, int depth) { -#ifdef DEBUG_XEMACS - { - /* Egcs 1.1.1 sometimes crashes on INTP (p->size_or_chain) */ - Lisp_Object size_or_chain_1 = XOPAQUE (obj1)->size_or_chain; - Lisp_Object size_or_chain_2 = XOPAQUE (obj2)->size_or_chain; - assert (INTP (size_or_chain_1)); - assert (INTP (size_or_chain_2)); - assert (!XOPAQUE_MARKFUN (obj1) && !XOPAQUE_MARKFUN (obj2)); - } -#endif - { - size_t size; - return ((size = XOPAQUE_SIZE (obj1)) == XOPAQUE_SIZE (obj2) && - !memcmp (XOPAQUE_DATA (obj1), XOPAQUE_DATA (obj2), size)); - } + size_t size; + return ((size = XOPAQUE_SIZE (obj1)) == XOPAQUE_SIZE (obj2) && + !memcmp (XOPAQUE_DATA (obj1), XOPAQUE_DATA (obj2), size)); } /* This will not work correctly for opaques with subobjects! */ @@ -160,102 +99,59 @@ static unsigned long hash_opaque (Lisp_Object obj, int depth) { -#ifdef DEBUG_XEMACS - { - /* Egcs 1.1.1 sometimes crashes on INTP (p->size_or_chain) */ - Lisp_Object size_or_chain = XOPAQUE (obj)->size_or_chain; - assert (INTP (size_or_chain)); - assert (!XOPAQUE_MARKFUN (obj)); - } -#endif if (XOPAQUE_SIZE (obj) == sizeof (unsigned long)) return *((unsigned long *) XOPAQUE_DATA (obj)); else return memory_hash (XOPAQUE_DATA (obj), XOPAQUE_SIZE (obj)); } -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("opaque", opaque, - mark_opaque, print_opaque, 0, - equal_opaque, hash_opaque, - sizeof_opaque, Lisp_Opaque); - -static Lisp_Object -mark_opaque_list (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - in_opaque_list_marking++; - markobj (XOPAQUE_LIST (obj)->free); - in_opaque_list_marking--; - return Qnil; -} - -Lisp_Object -make_opaque_list (size_t size, - Lisp_Object (*markfun) (Lisp_Object obj, - void (*markobj) (Lisp_Object))) -{ - Lisp_Object val; - Lisp_Opaque_List *p = - alloc_lcrecord_type (Lisp_Opaque_List, lrecord_opaque_list); - - p->markfun = markfun; - p->size = size; - p->free = Qnil; - XSETOPAQUE_LIST (val, p); - return val; -} - -DEFINE_LRECORD_IMPLEMENTATION ("opaque-list", opaque_list, - mark_opaque_list, internal_object_printer, - 0, 0, 0, Lisp_Opaque_List); +static const struct lrecord_description opaque_description[] = { + { XD_END } +}; -Lisp_Object -allocate_managed_opaque (Lisp_Object opaque_list, CONST void *data) -{ - Lisp_Opaque_List *li = XOPAQUE_LIST (opaque_list); - Lisp_Object val; - - if (!NILP (li->free)) - { - val = li->free; - li->free = XOPAQUE (val)->size_or_chain; -#ifdef ERROR_CHECK_GC - assert (NILP (li->free) || OPAQUEP (li->free)); -#endif - XOPAQUE (val)->size_or_chain = make_int (li->size); - if (data) - memcpy (XOPAQUE (val)->data, data, li->size); - else - memset (XOPAQUE (val)->data, 0, li->size); - } - else - val = make_opaque (li->size, data); - XOPAQUE (val)->markfun = li->markfun; - return val; -} - -void -free_managed_opaque (Lisp_Object opaque_list, Lisp_Object opaque) -{ - Lisp_Opaque_List *li = XOPAQUE_LIST (opaque_list); - -#ifdef ERROR_CHECK_GC - { - /* Egcs 1.1.1 sometimes crashes on INTP (p->size_or_chain) */ - Lisp_Object size_or_chain = XOPAQUE (opaque)->size_or_chain; - assert (INTP (size_or_chain)); - } -#endif - XOPAQUE (opaque)->size_or_chain = li->free; - li->free = opaque; -} +DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("opaque", opaque, + 0, print_opaque, 0, + equal_opaque, hash_opaque, + opaque_description, + sizeof_opaque, Lisp_Opaque); /* stuff to handle opaque pointers */ -Lisp_Object -make_opaque_ptr (CONST void *val) +/* Should never, ever be called. (except by an external debugger) */ +static void +print_opaque_ptr (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) +{ + const Lisp_Opaque_Ptr *p = XOPAQUE_PTR (obj); + char buf[200]; + + sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (opaque_ptr, adr=0x%lx) 0x%lx>", + (long)(p->ptr), (unsigned long) p); + write_c_string (buf, printcharfun); +} + +static int +equal_opaque_ptr (Lisp_Object obj1, Lisp_Object obj2, int depth) { - return allocate_managed_opaque (Vopaque_ptr_free_list, - (CONST void *) &val); + return (XOPAQUE_PTR (obj1)->ptr == XOPAQUE_PTR (obj2)->ptr); +} + +static unsigned long +hash_opaque_ptr (Lisp_Object obj, int depth) +{ + return (unsigned long) XOPAQUE_PTR (obj)->ptr; +} + +DEFINE_LRECORD_IMPLEMENTATION ("opaque_ptr", opaque_ptr, + 0, print_opaque_ptr, 0, + equal_opaque_ptr, hash_opaque_ptr, 0, + Lisp_Opaque_Ptr); + +Lisp_Object +make_opaque_ptr (void *val) +{ + Lisp_Object res = allocate_managed_lcrecord(Vopaque_ptr_free_list); + set_opaque_ptr (res, val); + return res; } /* Be very very careful with this. Same admonitions as with @@ -264,18 +160,18 @@ void free_opaque_ptr (Lisp_Object ptr) { - free_managed_opaque (Vopaque_ptr_free_list, ptr); + free_managed_lcrecord (Vopaque_ptr_free_list, ptr); } -Lisp_Object -make_opaque_long (long val) +void +reinit_opaque_once_early (void) { - return make_opaque (sizeof (val), (void *) &val); + Vopaque_ptr_free_list = make_lcrecord_list (sizeof (Lisp_Opaque_Ptr), &lrecord_opaque_ptr); + staticpro_nodump (&Vopaque_ptr_free_list); } void init_opaque_once_early (void) { - Vopaque_ptr_free_list = make_opaque_list (sizeof (void *), 0); - staticpro (&Vopaque_ptr_free_list); + reinit_opaque_once_early (); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/opaque.h --- a/src/opaque.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/opaque.h Mon Aug 13 11:13:30 2007 +0200 @@ -23,10 +23,11 @@ /* Written by Ben Wing, October 1993. */ -#ifndef _XEMACS_OPAQUE_H_ -#define _XEMACS_OPAQUE_H_ +#ifndef INCLUDED_opaque_h_ +#define INCLUDED_opaque_h_ -typedef union { +typedef union +{ struct { Lisp_Object obj; } obj; struct { void *p; } p; struct { double d; } d; @@ -35,69 +36,46 @@ typedef struct Lisp_Opaque { struct lcrecord_header header; - Lisp_Object (*markfun) (Lisp_Object obj, void (*markobj) (Lisp_Object)); - /* An integral size for non-freed objects, an opaque or nil for - freed objects. */ - Lisp_Object size_or_chain; + size_t size; max_align_t data[1]; } Lisp_Opaque; -typedef struct Lisp_Opaque_List -{ - struct lcrecord_header header; - /* `markfun' allows you to put lisp objects inside of opaque objects - without having to create a new object type. */ - Lisp_Object (*markfun) (Lisp_Object obj, void (*markobj) (Lisp_Object)); - Lisp_Object free; - size_t size; -} Lisp_Opaque_List; - DECLARE_LRECORD (opaque, Lisp_Opaque); #define XOPAQUE(x) XRECORD (x, opaque, Lisp_Opaque) #define XSETOPAQUE(x, p) XSETRECORD (x, p, opaque) #define OPAQUEP(x) RECORDP (x, opaque) -#define GC_OPAQUEP(x) GC_RECORDP (x, opaque) /* #define CHECK_OPAQUE(x) CHECK_RECORD (x, opaque) Opaque pointers should never escape to the Lisp level, so functions should not be doing this. */ -DECLARE_LRECORD (opaque_list, Lisp_Opaque_List); -#define XOPAQUE_LIST(x) XRECORD (x, opaque_list, Lisp_Opaque_List) -#define XSETOPAQUE_LIST(x, p) XSETRECORD (x, p, opaque_list) -#define OPAQUE_LISTP(x) RECORDP (x, opaque_list) -#define GC_OPAQUE_LISTP(x) GC_RECORDP (x, opaque_list) -/* #define CHECK_OPAQUE_LIST(x) CHECK_RECORD (x, opaque_list) - Opaque lists should never escape to the Lisp level, so - functions should not be doing this. */ +/* Alternative DATA arguments to make_opaque() */ +#define OPAQUE_CLEAR ((const void *) 0) +#define OPAQUE_UNINIT ((const void *) -1) -/* Alternative DATA arguments to make_opaque */ -#define OPAQUE_CLEAR ((CONST void *) 0) -#define OPAQUE_UNINIT ((CONST void *) -1) - -Lisp_Object make_opaque (size_t size, CONST void *data); -Lisp_Object make_opaque_ptr (CONST void *val); -Lisp_Object make_opaque_long (long val); -void free_opaque_ptr (Lisp_Object ptr); - -#define OPAQUE_SIZE(op) XINT ((op)->size_or_chain) +#define OPAQUE_SIZE(op) ((op)->size) #define OPAQUE_DATA(op) ((void *) ((op)->data)) #define OPAQUE_MARKFUN(op) ((op)->markfun) #define XOPAQUE_SIZE(op) OPAQUE_SIZE (XOPAQUE (op)) #define XOPAQUE_DATA(op) OPAQUE_DATA (XOPAQUE (op)) #define XOPAQUE_MARKFUN(op) OPAQUE_MARKFUN (XOPAQUE (op)) -#define get_opaque_ptr(op) (* (void **) XOPAQUE_DATA (op)) -#define set_opaque_ptr(op, ptr) (get_opaque_ptr (op) = (void *) ptr) -#define get_opaque_long(op) (* (long *) XOPAQUE_DATA (op)) -#define set_opaque_long(op, ptr) (get_opaque_long (op) = ptr) -#define set_opaque_markfun(op, fun) (XOPAQUE_MARKFUN (op) = fun) +Lisp_Object make_opaque (const void *data, size_t size); + +typedef struct Lisp_Opaque_Ptr +{ + struct lcrecord_header header; + void *ptr; +} Lisp_Opaque_Ptr; -Lisp_Object make_opaque_list (size_t size, - Lisp_Object (*markfun) - (Lisp_Object obj, - void (*markobj) (Lisp_Object))); -Lisp_Object allocate_managed_opaque (Lisp_Object opaque_list, - CONST void *data); -void free_managed_opaque (Lisp_Object opaque_list, Lisp_Object opaque); +DECLARE_LRECORD (opaque_ptr, Lisp_Opaque_Ptr); +#define XOPAQUE_PTR(x) XRECORD (x, opaque_ptr, Lisp_Opaque_Ptr) +#define XSETOPAQUE_PTR(x, p) XSETRECORD (x, p, opaque_ptr) +#define OPAQUE_PTRP(x) RECORDP (x, opaque_ptr) -#endif /* _XEMACS_OPAQUE_H_ */ +Lisp_Object make_opaque_ptr (void *val); +void free_opaque_ptr (Lisp_Object ptr); + +#define get_opaque_ptr(op) (XOPAQUE_PTR (op)->ptr) +#define set_opaque_ptr(op, ptr_) (XOPAQUE_PTR (op)->ptr = (ptr_)) + +#endif /* INCLUDED_opaque_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/paths.h.in --- a/src/paths.h.in Mon Aug 13 11:12:06 2007 +0200 +++ b/src/paths.h.in Mon Aug 13 11:13:30 2007 +0200 @@ -65,9 +65,13 @@ #define PATH_VERSION "@version@" +#ifdef EXEC_PREFIX_USER_DEFINED #define PATH_EXEC_PREFIX "@EXEC_PREFIX@" +#endif +#ifdef PREFIX_USER_DEFINED #define PATH_PREFIX "@PREFIX@" +#endif #ifdef LISPDIR_USER_DEFINED #define PATH_LOADSEARCH "@LISPDIR@" @@ -101,6 +105,10 @@ #define PATH_LOCK "@LOCKDIR@" #endif +#ifdef DOCDIR_USER_DEFINED +#define PATH_DOC "@DOCDIR@" +#endif + #ifdef INFODIR_USER_DEFINED #define PATH_INFO "@INFODIR@" #endif diff -r f4aeb21a5bad -r 74fd4e045ea6 src/print.c --- a/src/print.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/print.c Mon Aug 13 11:13:30 2007 +0200 @@ -51,14 +51,13 @@ /* The subroutine object for external-debugging-output is kept here for the convenience of the debugger. */ Lisp_Object Qexternal_debugging_output; -Lisp_Object Qalternate_debugging_output; /* Avoid actual stack overflow in print. */ static int print_depth; /* Detect most circularities to print finite output. */ #define PRINT_CIRCLE 200 -Lisp_Object being_printed[PRINT_CIRCLE]; +static Lisp_Object being_printed[PRINT_CIRCLE]; /* Maximum length of list or vector to print in full; noninteger means effectively infinity */ @@ -92,9 +91,6 @@ Lisp_Object Vprint_gensym; Lisp_Object Vprint_gensym_alist; -Lisp_Object Qprint_escape_newlines; -Lisp_Object Qprint_readably; - Lisp_Object Qdisplay_error; Lisp_Object Qprint_message_label; @@ -111,14 +107,16 @@ void write_string_to_stdio_stream (FILE *stream, struct console *con, - CONST Bufbyte *str, + const Bufbyte *str, Bytecount offset, Bytecount len, - enum external_data_format fmt) + Lisp_Object coding_system) { - int extlen; - CONST Extbyte *extptr; + Extcount extlen; + const Extbyte *extptr; - GET_CHARPTR_EXT_DATA_ALLOCA (str + offset, len, fmt, extptr, extlen); + TO_EXTERNAL_FORMAT (DATA, (str + offset, len), + ALLOCA, (extptr, extlen), + coding_system); if (stream) { fwrite (extptr, 1, extlen, stream); @@ -154,7 +152,7 @@ buffer_insert_string_1() in insdel.c. */ static void -output_string (Lisp_Object function, CONST Bufbyte *nonreloc, +output_string (Lisp_Object function, const Bufbyte *nonreloc, Lisp_Object reloc, Bytecount offset, Bytecount len) { /* This function can GC */ @@ -164,7 +162,7 @@ other functions that take both a nonreloc and a reloc, or things may get confused and an assertion failure in fixup_internal_substring() may get triggered. */ - CONST Bufbyte *newnonreloc = nonreloc; + const Bufbyte *newnonreloc = nonreloc; struct gcpro gcpro1, gcpro2; /* Emacs won't print while GCing, but an external debugger might */ @@ -240,7 +238,7 @@ else if (EQ (function, Qt) || EQ (function, Qnil)) { write_string_to_stdio_stream (stdout, 0, newnonreloc, offset, len, - FORMAT_TERMINAL); + Qterminal); } else { @@ -349,7 +347,7 @@ /* Used for printing a single-byte character (*not* any Emchar). */ #define write_char_internal(string_of_length_1, stream) \ - output_string (stream, (CONST Bufbyte *) (string_of_length_1), \ + output_string (stream, (const Bufbyte *) (string_of_length_1), \ Qnil, 0, 1) /* NOTE: Do not call this with the data of a Lisp_String, as @@ -362,7 +360,7 @@ canonicalize_printcharfun() (i.e. Qnil means stdout, not Vstandard_output, etc.) */ void -write_string_1 (CONST Bufbyte *str, Bytecount size, Lisp_Object stream) +write_string_1 (const Bufbyte *str, Bytecount size, Lisp_Object stream) { /* This function can GC */ #ifdef ERROR_CHECK_BUFPOS @@ -372,10 +370,10 @@ } void -write_c_string (CONST char *str, Lisp_Object stream) +write_c_string (const char *str, Lisp_Object stream) { /* This function can GC */ - write_string_1 ((CONST Bufbyte *) str, strlen (str), stream); + write_string_1 ((const Bufbyte *) str, strlen (str), stream); } @@ -631,8 +629,13 @@ { int first = 1; int speccount = specpdl_depth (); + Lisp_Object frame = Qnil; + struct gcpro gcpro1; + GCPRO1 (stream); specbind (Qprint_message_label, Qerror); + stream = print_prepare (stream, &frame); + tail = Fcdr (error_object); if (EQ (type, Qerror)) { @@ -654,6 +657,8 @@ tail = Fcdr (tail); first = 0; } + print_finish (stream, frame); + UNGCPRO; unbind_to (speccount, Qnil); return; /* not reached */ @@ -711,11 +716,10 @@ #ifdef LISP_FLOAT_TYPE Lisp_Object Vfloat_output_format; -Lisp_Object Qfloat_output_format; /* * This buffer should be at least as large as the max string size of the - * largest float, printed in the biggest notation. This is undoubtably + * largest float, printed in the biggest notation. This is undoubtedly * 20d float_output_format, with the negative of the C-constant "HUGE" * from <math.h>. * @@ -806,41 +810,56 @@ faster. BUFFER should accept 24 bytes. This should suffice for the longest - numbers on 64-bit machines. */ + numbers on 64-bit machines, including the `-' sign and the trailing + \0. */ void long_to_string (char *buffer, long number) { - char *p; - int i, len; +#if (SIZEOF_LONG != 4) && (SIZEOF_LONG != 8) + /* Huh? */ + sprintf (buffer, "%ld", number); +#else /* (SIZEOF_LONG == 4) || (SIZEOF_LONG == 8) */ + char *p = buffer; + int force = 0; if (number < 0) { - *buffer++ = '-'; + *p++ = '-'; number = -number; } - p = buffer; - /* Print the digits to the string. */ - do - { - *p++ = number % 10 + '0'; - number /= 10; - } - while (number); - - /* And reverse them. */ - len = p - buffer - 1; - for (i = len / 2; i >= 0; i--) - { - char c = buffer[i]; - buffer[i] = buffer[len - i]; - buffer[len - i] = c; - } - buffer[len + 1] = '\0'; +#define FROB(figure) do { \ + if (force || number >= figure) \ + *p++ = number / figure + '0', number %= figure, force = 1; \ + } while (0) +#if SIZEOF_LONG == 8 + FROB (1000000000000000000L); + FROB (100000000000000000L); + FROB (10000000000000000L); + FROB (1000000000000000L); + FROB (100000000000000L); + FROB (10000000000000L); + FROB (1000000000000L); + FROB (100000000000L); + FROB (10000000000L); +#endif /* SIZEOF_LONG == 8 */ + FROB (1000000000); + FROB (100000000); + FROB (10000000); + FROB (1000000); + FROB (100000); + FROB (10000); + FROB (1000); + FROB (100); + FROB (10); +#undef FROB + *p++ = number + '0'; + *p = '\0'; +#endif /* (SIZEOF_LONG == 4) || (SIZEOF_LONG == 8) */ } static void -print_vector_internal (CONST char *start, CONST char *end, +print_vector_internal (const char *start, const char *end, Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { @@ -947,7 +966,7 @@ void print_string (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { - struct Lisp_String *s = XSTRING (obj); + Lisp_String *s = XSTRING (obj); /* We distinguish between Bytecounts and Charcounts, to make Vprint_string_length work correctly under Mule. */ Charcount size = string_char_length (s); @@ -1093,14 +1112,12 @@ switch (XTYPE (obj)) { -#ifdef USE_MINIMAL_TAGBITS case Lisp_Type_Int_Even: case Lisp_Type_Int_Odd: -#else - case Lisp_Type_Int: -#endif { - char buf[24]; + /* ASCII Decimal representation uses 2.4 times as many bits as + machine binary. */ + char buf[3 * sizeof (EMACS_INT) + 5]; long_to_string (buf, XINT (obj)); write_c_string (buf, printcharfun); break; @@ -1113,101 +1130,69 @@ Emchar ch = XCHAR (obj); char *p = buf; *p++ = '?'; - if (ch == '\n') - *p++ = '\\', *p++ = 'n'; - else if (ch == '\r') - *p++ = '\\', *p++ = 'r'; - else if (ch == '\t') - *p++ = '\\', *p++ = 't'; - else if (ch < 32) + if (ch < 32) + { + *p++ = '\\'; + switch (ch) + { + case '\t': *p++ = 't'; break; + case '\n': *p++ = 'n'; break; + case '\r': *p++ = 'r'; break; + default: + *p++ = '^'; + *p++ = ch + 64; + if ((ch + 64) == '\\') + *p++ = '\\'; + break; + } + } + else if (ch < 127) { - *p++ = '\\', *p++ = '^'; - *p++ = ch + 64; - if ((ch + 64) == '\\') - *p++ = '\\'; + /* syntactically special characters should be escaped. */ + switch (ch) + { + case ' ': + case '"': + case '#': + case '\'': + case '(': + case ')': + case ',': + case '.': + case ';': + case '?': + case '[': + case '\\': + case ']': + case '`': + *p++ = '\\'; + } + *p++ = ch; } else if (ch == 127) - *p++ = '\\', *p++ = '^', *p++ = '?'; - else if (ch >= 128 && ch < 160) + { + *p++ = '\\', *p++ = '^', *p++ = '?'; + } + else if (ch < 160) { *p++ = '\\', *p++ = '^'; - p += set_charptr_emchar ((Bufbyte *)p, ch + 64); + p += set_charptr_emchar ((Bufbyte *) p, ch + 64); } - else if (ch < 127 - && !isdigit (ch) - && !isalpha (ch) - && ch != '^') /* must not backslash this or it will - be interpreted as the start of a - control char */ - *p++ = '\\', *p++ = ch; else - p += set_charptr_emchar ((Bufbyte *)p, ch); - output_string (printcharfun, (Bufbyte *)buf, Qnil, 0, p - buf); - break; - } + { + p += set_charptr_emchar ((Bufbyte *) p, ch); + } -#ifndef LRECORD_STRING - case Lisp_Type_String: - { - print_string (obj, printcharfun, escapeflag); + output_string (printcharfun, (Bufbyte *) buf, Qnil, 0, p - buf); + break; } -#endif /* ! LRECORD_STRING */ - -#ifndef LRECORD_CONS - case Lisp_Type_Cons: - { - struct gcpro gcpro1, gcpro2; - - /* If deeper than spec'd depth, print placeholder. */ - if (INTP (Vprint_level) - && print_depth > XINT (Vprint_level)) - { - GCPRO2 (obj, printcharfun); - write_c_string ("...", printcharfun); - UNGCPRO; - break; - } - - print_cons (obj, printcharfun, escapeflag); - break; - } -#endif /* ! LRECORD_CONS */ - -#ifndef LRECORD_VECTOR - case Lisp_Type_Vector: - { - /* If deeper than spec'd depth, print placeholder. */ - if (INTP (Vprint_level) - && print_depth > XINT (Vprint_level)) - { - struct gcpro gcpro1, gcpro2; - GCPRO2 (obj, printcharfun); - write_c_string ("...", printcharfun); - UNGCPRO; - break; - } - - /* God intended that this be #(...), you know. */ - print_vector_internal ("[", "]", obj, printcharfun, escapeflag); - break; - } -#endif /* !LRECORD_VECTOR */ - -#ifndef LRECORD_SYMBOL - case Lisp_Type_Symbol: - { - print_symbol (obj, printcharfun, escapeflag); - break; - } -#endif /* !LRECORD_SYMBOL */ case Lisp_Type_Record: { struct lrecord_header *lheader = XRECORD_LHEADER (obj); struct gcpro gcpro1, gcpro2; -#if defined(LRECORD_CONS) || defined(LRECORD_VECTOR) if (CONSP (obj) || VECTORP(obj)) { /* If deeper than spec'd depth, print placeholder. */ @@ -1220,7 +1205,6 @@ break; } } -#endif GCPRO2 (obj, printcharfun); if (LHEADER_IMPLEMENTATION (lheader)->printer) @@ -1275,7 +1259,7 @@ /* This function can GC */ /* #### Bug!! (intern "") isn't printed in some distinguished way */ /* #### (the reader also loses on it) */ - struct Lisp_String *name = symbol_name (XSYMBOL (obj)); + Lisp_String *name = symbol_name (XSYMBOL (obj)); Bytecount size = string_length (name); struct gcpro gcpro1, gcpro2; @@ -1292,7 +1276,12 @@ /* If we print an uninterned symbol as part of a complex object and the flag print-gensym is non-nil, prefix it with #n= to read the object back with the #n# reader syntax later if needed. */ - if (!NILP (Vprint_gensym) && NILP (XSYMBOL (obj)->obarray)) + if (!NILP (Vprint_gensym) + /* #### Test whether this produces a noticable slow-down for + printing when print-gensym is non-nil. */ + && !EQ (obj, oblookup (Vobarray, + string_data (symbol_name (XSYMBOL (obj))), + string_length (symbol_name (XSYMBOL (obj)))))) { if (print_depth > 1) { @@ -1404,8 +1393,8 @@ getting rid of this function altogether? Does anything actually *use* it? --hniksic */ -int alternate_do_pointer; -char alternate_do_string[5000]; +static int alternate_do_pointer; +static char alternate_do_string[5000]; DEFUN ("alternate-debugging-output", Falternate_debugging_output, 1, 1, 0, /* Append CHARACTER to the array `alternate_do_string'. @@ -1418,11 +1407,13 @@ Bufbyte str[MAX_EMCHAR_LEN]; Bytecount len; int extlen; - CONST Extbyte *extptr; + const Extbyte *extptr; CHECK_CHAR_COERCE_INT (character); len = set_charptr_emchar (str, XCHAR (character)); - GET_CHARPTR_EXT_DATA_ALLOCA (str, len, FORMAT_TERMINAL, extptr, extlen); + TO_EXTERNAL_FORMAT (DATA, (str, len), + ALLOCA, (extptr, extlen), + Qterminal); memcpy (alternate_do_string + alternate_do_pointer, extptr, extlen); alternate_do_pointer += extlen; alternate_do_string[alternate_do_pointer] = 0; @@ -1470,7 +1461,7 @@ write_string_to_stdio_stream (file, con, XSTRING_DATA (char_or_string), 0, XSTRING_LENGTH (char_or_string), - FORMAT_TERMINAL); + Qterminal); else { Bufbyte str[MAX_EMCHAR_LEN]; @@ -1478,7 +1469,7 @@ CHECK_CHAR_COERCE_INT (char_or_string); len = set_charptr_emchar (str, XCHAR (char_or_string)); - write_string_to_stdio_stream (file, con, str, 0, len, FORMAT_TERMINAL); + write_string_to_stdio_stream (file, con, str, 0, len, Qterminal); } return char_or_string; @@ -1507,39 +1498,41 @@ #if 1 /* Debugging kludge -- unbuffered */ -static int debug_print_length = 50; -static int debug_print_level = 15; -Lisp_Object debug_temp; +static int debug_print_length = 50; +static int debug_print_level = 15; +static int debug_print_readably = -1; static void debug_print_no_newline (Lisp_Object debug_print_obj) { /* This function can GC */ - int old_print_readably = print_readably; - int old_print_depth = print_depth; - Lisp_Object old_print_length = Vprint_length; - Lisp_Object old_print_level = Vprint_level; - Lisp_Object old_inhibit_quit = Vinhibit_quit; + int save_print_readably = print_readably; + int save_print_depth = print_depth; + Lisp_Object save_Vprint_length = Vprint_length; + Lisp_Object save_Vprint_level = Vprint_level; + Lisp_Object save_Vinhibit_quit = Vinhibit_quit; struct gcpro gcpro1, gcpro2, gcpro3; - GCPRO3 (old_print_level, old_print_length, old_inhibit_quit); + GCPRO3 (save_Vprint_level, save_Vprint_length, save_Vinhibit_quit); if (gc_in_progress) stderr_out ("** gc-in-progress! Bad idea to print anything! **\n"); print_depth = 0; - print_readably = 0; + print_readably = debug_print_readably != -1 ? debug_print_readably : 0; print_unbuffered++; /* Could use unwind-protect, but why bother? */ if (debug_print_length > 0) Vprint_length = make_int (debug_print_length); if (debug_print_level > 0) Vprint_level = make_int (debug_print_level); + print_internal (debug_print_obj, Qexternal_debugging_output, 1); - Vinhibit_quit = old_inhibit_quit; - Vprint_level = old_print_level; - Vprint_length = old_print_length; - print_depth = old_print_depth; - print_readably = old_print_readably; + + Vinhibit_quit = save_Vinhibit_quit; + Vprint_level = save_Vprint_level; + Vprint_length = save_Vprint_length; + print_depth = save_print_depth; + print_readably = save_print_readably; print_unbuffered--; UNGCPRO; } @@ -1646,15 +1639,8 @@ void syms_of_print (void) { - defsymbol (&Qprint_escape_newlines, "print-escape-newlines"); - defsymbol (&Qprint_readably, "print-readably"); - defsymbol (&Qstandard_output, "standard-output"); -#ifdef LISP_FLOAT_TYPE - defsymbol (&Qfloat_output_format, "float-output-format"); -#endif - defsymbol (&Qprint_length, "print-length"); defsymbol (&Qprint_string_length, "print-string-length"); @@ -1671,7 +1657,6 @@ DEFSUBR (Fterpri); DEFSUBR (Fwrite_char); DEFSUBR (Falternate_debugging_output); - defsymbol (&Qalternate_debugging_output, "alternate-debugging-output"); DEFSUBR (Fexternal_debugging_output); DEFSUBR (Fopen_termscript); defsymbol (&Qexternal_debugging_output, "external-debugging-output"); @@ -1679,9 +1664,15 @@ } void +reinit_vars_of_print (void) +{ + alternate_do_pointer = 0; +} + +void vars_of_print (void) { - alternate_do_pointer = 0; + reinit_vars_of_print (); DEFVAR_LISP ("standard-output", &Vstandard_output /* Output stream `print' uses by default for outputting a character. diff -r f4aeb21a5bad -r 74fd4e045ea6 src/process-nt.c --- a/src/process-nt.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/process-nt.c Mon Aug 13 11:13:30 2007 +0200 @@ -32,8 +32,11 @@ #include "procimpl.h" #include "sysdep.h" -#include <windows.h> +#ifndef __MINGW32__ #include <shellapi.h> +#else +#include <errno.h> +#endif #include <signal.h> #ifdef HAVE_SOCKETS #include <winsock.h> @@ -49,6 +52,7 @@ struct nt_process_data { HANDLE h_process; + int need_enable_child_signals; }; #define NT_DATA(p) ((struct nt_process_data*)((p)->process_data)) @@ -60,7 +64,7 @@ /* This one breaks process abstraction. Prototype is in console-msw.h, used by select_process method in event-msw.c */ HANDLE -get_nt_process_handle (struct Lisp_Process *p) +get_nt_process_handle (Lisp_Process *p) { return (NT_DATA (p)->h_process); } @@ -164,7 +168,7 @@ LPVOID data, size_t data_size) { process_memory pm; - CONST size_t code_size = FRAGMENT_CODE_SIZE; + const size_t code_size = FRAGMENT_CODE_SIZE; /* Need at most 3 extra bytes of memory, for data alignment */ size_t total_size = code_size + data_size + 3; LPVOID remote_data; @@ -306,7 +310,8 @@ sigkill_data d; d.adr_ExitProcess = GetProcAddress (h_kernel, "ExitProcess"); assert (d.adr_ExitProcess); - retval = run_in_other_process (h_process, sigkill_proc, + retval = run_in_other_process (h_process, + (LPTHREAD_START_ROUTINE)sigkill_proc, &d, sizeof (d)); break; } @@ -317,7 +322,8 @@ GetProcAddress (h_kernel, "GenerateConsoleCtrlEvent"); assert (d.adr_GenerateConsoleCtrlEvent); d.event = CTRL_C_EVENT; - retval = run_in_other_process (h_process, sigint_proc, + retval = run_in_other_process (h_process, + (LPTHREAD_START_ROUTINE)sigint_proc, &d, sizeof (d)); break; } @@ -341,7 +347,7 @@ d.adr_SetConsoleCtrlHandler = GetProcAddress (h_kernel, "SetConsoleCtrlHandler"); assert (d.adr_SetConsoleCtrlHandler); - run_in_other_process (h_process, sig_enable_proc, + run_in_other_process (h_process, (LPTHREAD_START_ROUTINE)sig_enable_proc, &d, sizeof (d)); } @@ -368,13 +374,13 @@ */ static void -nt_alloc_process_data (struct Lisp_Process *p) +nt_alloc_process_data (Lisp_Process *p) { p->process_data = xnew_and_zero (struct nt_process_data); } static void -nt_finalize_process_data (struct Lisp_Process *p, int for_disksave) +nt_finalize_process_data (Lisp_Process *p, int for_disksave) { assert (!for_disksave); if (NT_DATA(p)->h_process) @@ -403,8 +409,6 @@ * must signal an error instead. */ -/* #### This function completely ignores Vprocess_environment */ - static void signal_cannot_launch (Lisp_Object image_file, DWORD err) { @@ -413,13 +417,14 @@ } static int -nt_create_process (struct Lisp_Process *p, +nt_create_process (Lisp_Process *p, Lisp_Object *argv, int nargv, Lisp_Object program, Lisp_Object cur_dir) { - HANDLE hmyshove, hmyslurp, hprocin, hprocout; + HANDLE hmyshove, hmyslurp, hprocin, hprocout, hprocerr; LPTSTR command_line; BOOL do_io, windowed; + char *proc_env; /* Find out whether the application is windowed or not */ { @@ -467,6 +472,10 @@ CreatePipe (&hprocin, &hmyshove, &sa, 0); CreatePipe (&hmyslurp, &hprocout, &sa, 0); + /* Duplicate the stdout handle for use as stderr */ + DuplicateHandle(GetCurrentProcess(), hprocout, GetCurrentProcess(), &hprocerr, + 0, TRUE, DUPLICATE_SAME_ACCESS); + /* Stupid Win32 allows to create a pipe with *both* ends either inheritable or not. We need process ends inheritable, and local ends not inheritable. */ @@ -507,6 +516,80 @@ UNGCPRO; /* args_or_ret */ } + /* Set `proc_env' to a nul-separated array of the strings in + Vprocess_environment terminated by 2 nuls. */ + + { + extern int compare_env (const char **strp1, const char **strp2); + char **env; + REGISTER Lisp_Object tem; + REGISTER char **new_env; + REGISTER int new_length = 0, i, new_space; + char *penv; + + for (tem = Vprocess_environment; + (CONSP (tem) + && STRINGP (XCAR (tem))); + tem = XCDR (tem)) + new_length++; + + /* new_length + 1 to include terminating 0. */ + env = new_env = alloca_array (char *, new_length + 1); + + /* Copy the Vprocess_environment strings into new_env. */ + for (tem = Vprocess_environment; + (CONSP (tem) + && STRINGP (XCAR (tem))); + tem = XCDR (tem)) + { + char **ep = env; + char *string = (char *) XSTRING_DATA (XCAR (tem)); + /* See if this string duplicates any string already in the env. + If so, don't put it in. + When an env var has multiple definitions, + we keep the definition that comes first in process-environment. */ + for (; ep != new_env; ep++) + { + char *p = *ep, *q = string; + while (1) + { + if (*q == 0) + /* The string is malformed; might as well drop it. */ + goto duplicate; + if (*q != *p) + break; + if (*q == '=') + goto duplicate; + p++, q++; + } + } + *new_env++ = string; + duplicate: ; + } + *new_env = 0; + + /* Sort the environment variables */ + new_length = new_env - env; + qsort (env, new_length, sizeof (char *), compare_env); + + /* Work out how much space to allocate */ + new_space = 0; + for (i = 0; i < new_length; i++) + { + new_space += strlen(env[i]) + 1; + } + new_space++; + + /* Allocate space and copy variables into it */ + penv = proc_env = alloca(new_space); + for (i = 0; i < new_length; i++) + { + strcpy(penv, env[i]); + penv += strlen(env[i]) + 1; + } + *penv = 0; + } + /* Create process */ { STARTUPINFO si; @@ -520,14 +603,14 @@ { si.hStdInput = hprocin; si.hStdOutput = hprocout; - si.hStdError = hprocout; + si.hStdError = hprocerr; si.dwFlags |= STARTF_USESTDHANDLES; } err = (CreateProcess (NULL, command_line, NULL, NULL, TRUE, CREATE_NEW_CONSOLE | CREATE_NEW_PROCESS_GROUP | CREATE_SUSPENDED, - NULL, (char *) XSTRING_DATA (cur_dir), &si, &pi) + proc_env, (char *) XSTRING_DATA (cur_dir), &si, &pi) ? 0 : GetLastError ()); if (do_io) @@ -535,6 +618,7 @@ /* These just have been inherited; we do not need a copy */ CloseHandle (hprocin); CloseHandle (hprocout); + CloseHandle (hprocerr); } /* Handle process creation failure */ @@ -561,15 +645,19 @@ CloseHandle (pi.hProcess); } - if (!windowed) - enable_child_signals (pi.hProcess); - ResumeThread (pi.hThread); CloseHandle (pi.hThread); - /* Hack to support Windows 95 negative pids */ - return ((int)pi.dwProcessId < 0 - ? -(int)pi.dwProcessId : (int)pi.dwProcessId); + /* Remember to enable child signals later if this is not a windowed + app. Can't do it right now because that screws up the MKS Toolkit + shell. */ + if (!windowed) + { + NT_DATA(p)->need_enable_child_signals = 10; + kick_status_notify (); + } + + return ((int)pi.dwProcessId); } } @@ -582,9 +670,21 @@ */ static void -nt_update_status_if_terminated (struct Lisp_Process* p) +nt_update_status_if_terminated (Lisp_Process* p) { DWORD exit_code; + + if (NT_DATA(p)->need_enable_child_signals > 1) + { + NT_DATA(p)->need_enable_child_signals -= 1; + kick_status_notify (); + } + else if (NT_DATA(p)->need_enable_child_signals == 1) + { + enable_child_signals(NT_DATA(p)->h_process); + NT_DATA(p)->need_enable_child_signals = 0; + } + if (GetExitCodeProcess (NT_DATA(p)->h_process, &exit_code) && exit_code != STILL_ACTIVE) { @@ -616,7 +716,8 @@ static void nt_send_process (Lisp_Object proc, struct lstream* lstream) { - struct Lisp_Process *p = XPROCESS (proc); + volatile Lisp_Object vol_proc = proc; + Lisp_Process *volatile p = XPROCESS (proc); /* use a reasonable-sized buffer (somewhere around the size of the stream buffer) so as to avoid inundating the stream with blocked @@ -626,7 +727,7 @@ while (1) { - int writeret; + ssize_t writeret; chunklen = Lstream_read (lstream, chunkbuf, 128); if (chunklen <= 0) @@ -646,7 +747,7 @@ p->core_dumped = 0; p->tick++; process_tick++; - deactivate_process (proc); + deactivate_process (*((Lisp_Object *) (&vol_proc))); error ("Broken pipe error sending to process %s; closed it", XSTRING_DATA (p->name)); } @@ -684,7 +785,15 @@ nt_kill_child_process (Lisp_Object proc, int signo, int current_group, int nomsg) { - struct Lisp_Process *p = XPROCESS (proc); + Lisp_Process *p = XPROCESS (proc); + + /* Enable child signals if necessary. This may lose the first + but it's better than nothing. */ + if (NT_DATA(p)->need_enable_child_signals > 0) + { + enable_child_signals(NT_DATA(p)->h_process); + NT_DATA(p)->need_enable_child_signals = 0; + } /* Signal error if SIGNO cannot be sent */ validate_signal_number (signo); @@ -779,6 +888,12 @@ /* Ok, got an answer */ if (WSAGETASYNCERROR(msg.lParam) == NO_ERROR) success = 1; + else + { + warn_when_safe(Qstream, Qwarning, + "cannot get IP address for host \"%s\"", + XSTRING_DATA (host)); + } goto done; } else if (msg.message == WM_TIMER && msg.wParam == SOCK_TIMER_ID) @@ -828,7 +943,7 @@ static void nt_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service, - Lisp_Object family, void** vinfd, void** voutfd) + Lisp_Object protocol, void** vinfd, void** voutfd) { struct sockaddr_in address; SOCKET s; @@ -837,9 +952,9 @@ CHECK_STRING (host); - if (!EQ (family, Qtcpip)) - error ("Unsupported protocol family \"%s\"", - string_data (symbol_name (XSYMBOL (family)))); + if (!EQ (protocol, Qtcp)) + error ("Unsupported protocol \"%s\"", + string_data (symbol_name (XSYMBOL (protocol)))); if (INTP (service)) port = htons ((unsigned short) XINT (service)); @@ -862,14 +977,13 @@ /* We don't want to be blocked on connect */ { - unsigned int nonblock = 1; + unsigned long nonblock = 1; ioctlsocket (s, FIONBIO, &nonblock); } retval = connect (s, (struct sockaddr *) &address, sizeof (address)); if (retval != NO_ERROR && WSAGetLastError() != WSAEWOULDBLOCK) goto connect_failed; - /* Wait while connection is established */ while (1) { @@ -912,6 +1026,18 @@ connect_failed: closesocket (s); + if (INTP (service)) { + warn_when_safe(Qstream, Qwarning, + "failure to open network stream to host \"%s\" for service \"%d\"", + XSTRING_DATA (host), + (unsigned short) XINT (service)); + } + else { + warn_when_safe(Qstream, Qwarning, + "failure to open network stream to host \"%s\" for service \"%s\"", + XSTRING_DATA (host), + XSTRING_DATA (service)); + } report_file_error ("connection failed", list2 (host, name)); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/process-unix.c --- a/src/process-unix.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/process-unix.c Mon Aug 13 11:13:30 2007 +0200 @@ -28,6 +28,9 @@ Kirill M. Katsnelson <kkm@kis.ru>, so please bash him and not the original author(s) */ +/* The IPv6 support is derived from the code for GNU Emacs-20.3 + written by Wolfgang S. Rupprecht */ + #include <config.h> #if !defined (NO_SUBPROCESSES) @@ -124,7 +127,7 @@ to get rid of irrelevant descriptors. */ static int -close_process_descs_mapfun (CONST void* key, void* contents, void* arg) +close_process_descs_mapfun (const void* key, void* contents, void* arg) { Lisp_Object proc; CVOID_TO_LISP (proc, contents); @@ -212,9 +215,11 @@ end of the ptys. */ int failed_count = 0; #endif + int fd; +#ifndef HAVE_GETPT int i; - int fd; int c; +#endif #ifdef PTY_ITERATION PTY_ITERATION @@ -261,7 +266,7 @@ #else sprintf (pty_name, "/dev/tty%c%x", c, i); #endif /* no PTY_TTY_NAME_SPRINTF */ -#ifndef UNIPLUS +#if !defined(UNIPLUS) && !defined(HAVE_GETPT) if (access (pty_name, 6) != 0) { close (fd); @@ -308,6 +313,7 @@ #ifdef HAVE_SOCKETS +#if !(defined(HAVE_GETADDRINFO) && defined(HAVE_GETNAMEINFO)) static int get_internet_address (Lisp_Object host, struct sockaddr_in *address, Error_behavior errb) @@ -363,9 +369,10 @@ return 1; } +#endif /* !(HAVE_GETADDRINFO && HAVE_GETNAMEINFO) */ static void -set_socket_nonblocking_maybe (int fd, int port, CONST char* proto) +set_socket_nonblocking_maybe (int fd, int port, const char* proto) { #ifdef PROCESS_IO_BLOCKING Lisp_Object tail; @@ -384,7 +391,7 @@ else continue; } - else if ((INTP (tail_port)) && (htons ((unsigned short) XINT (tail_port)) == port)) + else if (INTP (tail_port) && (htons ((unsigned short) XINT (tail_port)) == port)) break; } @@ -403,7 +410,7 @@ the numeric status that was returned by `wait'. */ static void -update_status_from_wait_code (struct Lisp_Process *p, int *w_fmh) +update_status_from_wait_code (Lisp_Process *p, int *w_fmh) { /* C compiler lossage when attempting to pass w directly */ int w = *w_fmh; @@ -518,7 +525,7 @@ } /* For any processes that have changed status and are recorded - and such, update the corresponding struct Lisp_Process. + and such, update the corresponding Lisp_Process. We separate this from record_exited_processes() so that we never have to call this function from within a signal handler. We block SIGCHLD in case record_exited_processes() @@ -647,7 +654,7 @@ */ static void -unix_alloc_process_data (struct Lisp_Process *p) +unix_alloc_process_data (Lisp_Process *p) { p->process_data = xnew (struct unix_process_data); @@ -663,10 +670,9 @@ */ static void -unix_mark_process_data (struct Lisp_Process *proc, - void (*markobj) (Lisp_Object)) +unix_mark_process_data (Lisp_Process *proc) { - markobj (UNIX_DATA(proc)->tty_name); + mark_object (UNIX_DATA(proc)->tty_name); } /* @@ -692,7 +698,7 @@ */ static void -unix_init_process_io_handles (struct Lisp_Process *p, void* in, void* out, int flags) +unix_init_process_io_handles (Lisp_Process *p, void* in, void* out, int flags) { UNIX_DATA(p)->infd = (int)in; } @@ -708,7 +714,7 @@ */ static int -unix_create_process (struct Lisp_Process *p, +unix_create_process (Lisp_Process *p, Lisp_Object *argv, int nargv, Lisp_Object program, Lisp_Object cur_dir) { @@ -922,7 +928,9 @@ } new_argv[i + 1] = 0; - GET_C_STRING_FILENAME_DATA_ALLOCA (cur_dir, current_dir); + TO_EXTERNAL_FORMAT (LISP_STRING, cur_dir, + C_STRING_ALLOCA, current_dir, + Qfile_name); child_setup (xforkin, xforkout, xforkout, new_argv, current_dir); } @@ -981,7 +989,7 @@ /* Return nonzero if this process is a ToolTalk connection. */ static int -unix_tooltalk_connection_p (struct Lisp_Process *p) +unix_tooltalk_connection_p (Lisp_Process *p) { return UNIX_DATA(p)->connected_via_filedesc_p; } @@ -989,7 +997,7 @@ /* This is called to set process' virtual terminal size */ static int -unix_set_window_size (struct Lisp_Process* p, int cols, int rows) +unix_set_window_size (Lisp_Process* p, int cols, int rows) { return set_window_size (UNIX_DATA(p)->infd, cols, rows); } @@ -1004,7 +1012,7 @@ #ifdef HAVE_WAITPID static void -unix_update_status_if_terminated (struct Lisp_Process* p) +unix_update_status_if_terminated (Lisp_Process* p) { int w; #ifdef SIGCHLD @@ -1030,7 +1038,7 @@ unix_reap_exited_processes (void) { int i; - struct Lisp_Process *p; + Lisp_Process *p; #ifndef OBNOXIOUS_SYSV_SIGCLD_BEHAVIOR record_exited_processes (1); @@ -1129,7 +1137,7 @@ /* Use volatile to protect variables from being clobbered by longjmp. */ SIGTYPE (*volatile old_sigpipe) (int) = 0; volatile Lisp_Object vol_proc = proc; - struct Lisp_Process *volatile p = XPROCESS (proc); + Lisp_Process *volatile p = XPROCESS (proc); if (!SETJMP (send_process_frame)) { @@ -1141,7 +1149,7 @@ while (1) { - int writeret; + ssize_t writeret; chunklen = Lstream_read (lstream, chunkbuf, 512); if (chunklen <= 0) @@ -1215,7 +1223,7 @@ Bufbyte eof_char = get_eof_char (XPROCESS (proc)); send_process (proc, Qnil, &eof_char, 0, 1); #else - send_process (proc, Qnil, (CONST Bufbyte *) "\004", 0, 1); + send_process (proc, Qnil, (const Bufbyte *) "\004", 0, 1); #endif return 1; } @@ -1235,7 +1243,7 @@ */ static USID -unix_deactivate_process (struct Lisp_Process *p) +unix_deactivate_process (Lisp_Process *p) { SIGTYPE (*old_sigpipe) (int) = 0; USID usid; @@ -1274,7 +1282,7 @@ int gid; int no_pgrp = 0; int kill_retval; - struct Lisp_Process *p = XPROCESS (proc); + Lisp_Process *p = XPROCESS (proc); if (!UNIX_DATA(p)->pty_flag) current_group = 0; @@ -1394,7 +1402,7 @@ */ static Lisp_Object -unix_get_tty_name (struct Lisp_Process *p) +unix_get_tty_name (Lisp_Process *p) { return UNIX_DATA (p)->tty_name; } @@ -1409,6 +1417,43 @@ static Lisp_Object unix_canonicalize_host_name (Lisp_Object host) { +#if defined(HAVE_GETADDRINFO) && defined(HAVE_GETNAMEINFO) + struct addrinfo hints, *res; + static char addrbuf[NI_MAXHOST]; + Lisp_Object canonname; + int retval; + char *ext_host; + + xzero (hints); + hints.ai_flags = AI_CANONNAME; + hints.ai_family = AF_UNSPEC; + hints.ai_socktype = SOCK_STREAM; + hints.ai_protocol = 0; + TO_EXTERNAL_FORMAT (LISP_STRING, host, C_STRING_ALLOCA, ext_host, Qnative); + retval = getaddrinfo (ext_host, NULL, &hints, &res); + if (retval != 0) + { + char *gai_error; + + TO_INTERNAL_FORMAT (C_STRING, gai_strerror (retval), + C_STRING_ALLOCA, gai_error, + Qnative); + maybe_error (Qprocess, ERROR_ME_NOT, + "%s \"%s\"", gai_error, XSTRING_DATA (host)); + canonname = host; + } + else + { + int gni = getnameinfo (res->ai_addr, res->ai_addrlen, + addrbuf, sizeof(addrbuf), + NULL, 0, NI_NUMERICHOST); + canonname = gni ? host : build_ext_string (addrbuf, Qnative); + + freeaddrinfo (res); + } + + return canonname; +#else /* ! HAVE_GETADDRINFO */ struct sockaddr_in address; if (!get_internet_address (host, &address, ERROR_ME_NOT)) @@ -1419,6 +1464,7 @@ else /* #### any clue what to do here? */ return host; +#endif /* ! HAVE_GETADDRINFO */ } /* open a TCP network connection to a given HOST/SERVICE. Treated @@ -1429,104 +1475,278 @@ static void unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service, - Lisp_Object family, void** vinfd, void** voutfd) + Lisp_Object protocol, void** vinfd, void** voutfd) { - struct sockaddr_in address; - int s, inch, outch; + int inch; + int outch; + volatile int s; volatile int port; volatile int retry = 0; int retval; CHECK_STRING (host); - if (!EQ (family, Qtcpip)) - error ("Unsupported protocol family \"%s\"", - string_data (symbol_name (XSYMBOL (family)))); + if (!EQ (protocol, Qtcp) && !EQ (protocol, Qudp)) + error ("Unsupported protocol \"%s\"", + string_data (symbol_name (XSYMBOL (protocol)))); - if (INTP (service)) - port = htons ((unsigned short) XINT (service)); - else - { - struct servent *svc_info; - CHECK_STRING (service); - svc_info = getservbyname ((char *) XSTRING_DATA (service), "tcp"); - if (svc_info == 0) - error ("Unknown service \"%s\"", XSTRING_DATA (service)); - port = svc_info->s_port; - } + { +#if defined(HAVE_GETADDRINFO) && defined(HAVE_GETNAMEINFO) + struct addrinfo hints, *res; + struct addrinfo * volatile lres; + char *portstring; + volatile int xerrno = 0; + volatile int failed_connect = 0; + char *ext_host; + /* + * Caution: service can either be a string or int. + * Convert to a C string for later use by getaddrinfo. + */ + if (INTP (service)) + { + char portbuf[128]; + snprintf (portbuf, sizeof (portbuf), "%ld", (long) XINT (service)); + portstring = portbuf; + port = htons ((unsigned short) XINT (service)); + } + else + { + CHECK_STRING (service); + TO_EXTERNAL_FORMAT (LISP_STRING, service, + C_STRING_ALLOCA, portstring, + Qnative); + port = 0; + } - get_internet_address (host, &address, ERROR_ME); - address.sin_port = port; + xzero (hints); + hints.ai_flags = 0; + hints.ai_family = AF_UNSPEC; + if (EQ (protocol, Qtcp)) + hints.ai_socktype = SOCK_STREAM; + else /* EQ (protocol, Qudp) */ + hints.ai_socktype = SOCK_DGRAM; + hints.ai_protocol = 0; + TO_EXTERNAL_FORMAT (LISP_STRING, host, C_STRING_ALLOCA, ext_host, Qnative); + retval = getaddrinfo (ext_host, portstring, &hints, &res); + if (retval != 0) + { + char *gai_error; + + TO_INTERNAL_FORMAT (C_STRING, gai_strerror (retval), + C_STRING_ALLOCA, gai_error, + Qnative); + error ("%s/%s %s", XSTRING_DATA (host), portstring, gai_error); + } + + /* address loop */ + for (lres = res; lres ; lres = lres->ai_next) + { + if (EQ (protocol, Qtcp)) + s = socket (lres->ai_family, SOCK_STREAM, 0); + else /* EQ (protocol, Qudp) */ + s = socket (lres->ai_family, SOCK_DGRAM, 0); + + if (s < 0) + continue; - s = socket (address.sin_family, SOCK_STREAM, 0); - if (s < 0) - report_file_error ("error creating socket", list1 (name)); + /* Turn off interrupts here -- see comments below. There used to + be code which called bind_polling_period() to slow the polling + period down rather than turn it off, but that seems rather + bogus to me. Best thing here is to use a non-blocking connect + or something, to check for QUIT. */ + + /* Comments that are not quite valid: */ + + /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR) + when connect is interrupted. So let's not let it get interrupted. + Note we do not turn off polling, because polling is only used + when not interrupt_input, and thus not normally used on the systems + which have this bug. On systems which use polling, there's no way + to quit if polling is turned off. */ - /* Turn off interrupts here -- see comments below. There used to - be code which called bind_polling_period() to slow the polling - period down rather than turn it off, but that seems rather - bogus to me. Best thing here is to use a non-blocking connect - or something, to check for QUIT. */ + /* Slow down polling. Some kernels have a bug which causes retrying + connect to fail after a connect. */ + + slow_down_interrupts (); + + loop: - /* Comments that are not quite valid: */ + /* A system call interrupted with a SIGALRM or SIGIO comes back + here, with can_break_system_calls reset to 0. */ + SETJMP (break_system_call_jump); + if (QUITP) + { + speed_up_interrupts (); + REALLY_QUIT; + /* In case something really weird happens ... */ + slow_down_interrupts (); + } - /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR) - when connect is interrupted. So let's not let it get interrupted. - Note we do not turn off polling, because polling is only used - when not interrupt_input, and thus not normally used on the systems - which have this bug. On systems which use polling, there's no way - to quit if polling is turned off. */ + /* Break out of connect with a signal (it isn't otherwise possible). + Thus you don't get screwed with a hung network. */ + can_break_system_calls = 1; + retval = connect (s, lres->ai_addr, lres->ai_addrlen); + can_break_system_calls = 0; + if (retval == -1) + { + xerrno = errno; + if (errno != EISCONN) + { + if (errno == EINTR) + goto loop; + if (errno == EADDRINUSE && retry < 20) + { + /* A delay here is needed on some FreeBSD systems, + and it is harmless, since this retrying takes time anyway + and should be infrequent. + `sleep-for' allowed for quitting this loop with interrupts + slowed down so it can't be used here. Async timers should + already be disabled at this point so we can use `sleep'. */ + sleep (1); + retry++; + goto loop; + } + } - /* Slow down polling. Some kernels have a bug which causes retrying - connect to fail after a connect. */ + failed_connect = 1; + close (s); - slow_down_interrupts (); + speed_up_interrupts (); + + continue; + } - loop: + if (port == 0) + { + int gni; + char servbuf[NI_MAXSERV]; + + if (EQ (protocol, Qtcp)) + gni = getnameinfo (lres->ai_addr, lres->ai_addrlen, + NULL, 0, servbuf, sizeof(servbuf), + NI_NUMERICSERV); + else /* EQ (protocol, Qudp) */ + gni = getnameinfo (lres->ai_addr, lres->ai_addrlen, + NULL, 0, servbuf, sizeof(servbuf), + NI_NUMERICSERV | NI_DGRAM); + + if (gni == 0) + port = strtol (servbuf, NULL, 10); + } + + break; + } /* address loop */ + + speed_up_interrupts (); + + freeaddrinfo (res); + if (s < 0) + { + errno = xerrno; - /* A system call interrupted with a SIGALRM or SIGIO comes back - here, with can_break_system_calls reset to 0. */ - SETJMP (break_system_call_jump); - if (QUITP) - { - speed_up_interrupts (); - REALLY_QUIT; - /* In case something really weird happens ... */ - slow_down_interrupts (); - } + if (failed_connect) + report_file_error ("connection failed", list2 (host, name)); + else + report_file_error ("error creating socket", list1 (name)); + } +#else /* ! HAVE_GETADDRINFO */ + struct sockaddr_in address; + + if (INTP (service)) + port = htons ((unsigned short) XINT (service)); + else + { + struct servent *svc_info; + CHECK_STRING (service); + + if (EQ (protocol, Qtcp)) + svc_info = getservbyname ((char *) XSTRING_DATA (service), "tcp"); + else /* EQ (protocol, Qudp) */ + svc_info = getservbyname ((char *) XSTRING_DATA (service), "udp"); + + if (svc_info == 0) + error ("Unknown service \"%s\"", XSTRING_DATA (service)); + port = svc_info->s_port; + } + + get_internet_address (host, &address, ERROR_ME); + address.sin_port = port; + + if (EQ (protocol, Qtcp)) + s = socket (address.sin_family, SOCK_STREAM, 0); + else /* EQ (protocol, Qudp) */ + s = socket (address.sin_family, SOCK_DGRAM, 0); + + if (s < 0) + report_file_error ("error creating socket", list1 (name)); - /* Break out of connect with a signal (it isn't otherwise possible). - Thus you don't get screwed with a hung network. */ - can_break_system_calls = 1; - retval = connect (s, (struct sockaddr *) &address, sizeof (address)); - can_break_system_calls = 0; - if (retval == -1 && errno != EISCONN) - { - int xerrno = errno; - if (errno == EINTR) - goto loop; - if (errno == EADDRINUSE && retry < 20) - { - /* A delay here is needed on some FreeBSD systems, - and it is harmless, since this retrying takes time anyway - and should be infrequent. - `sleep-for' allowed for quitting this loop with interrupts - slowed down so it can't be used here. Async timers should - already be disabled at this point so we can use `sleep'. */ - sleep (1); - retry++; + /* Turn off interrupts here -- see comments below. There used to + be code which called bind_polling_period() to slow the polling + period down rather than turn it off, but that seems rather + bogus to me. Best thing here is to use a non-blocking connect + or something, to check for QUIT. */ + + /* Comments that are not quite valid: */ + + /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR) + when connect is interrupted. So let's not let it get interrupted. + Note we do not turn off polling, because polling is only used + when not interrupt_input, and thus not normally used on the systems + which have this bug. On systems which use polling, there's no way + to quit if polling is turned off. */ + + /* Slow down polling. Some kernels have a bug which causes retrying + connect to fail after a connect. */ + + slow_down_interrupts (); + + loop: + + /* A system call interrupted with a SIGALRM or SIGIO comes back + here, with can_break_system_calls reset to 0. */ + SETJMP (break_system_call_jump); + if (QUITP) + { + speed_up_interrupts (); + REALLY_QUIT; + /* In case something really weird happens ... */ + slow_down_interrupts (); + } + + /* Break out of connect with a signal (it isn't otherwise possible). + Thus you don't get screwed with a hung network. */ + can_break_system_calls = 1; + retval = connect (s, (struct sockaddr *) &address, sizeof (address)); + can_break_system_calls = 0; + if (retval == -1 && errno != EISCONN) + { + int xerrno = errno; + if (errno == EINTR) goto loop; - } - - close (s); - - speed_up_interrupts (); + if (errno == EADDRINUSE && retry < 20) + { + /* A delay here is needed on some FreeBSD systems, + and it is harmless, since this retrying takes time anyway + and should be infrequent. + `sleep-for' allowed for quitting this loop with interrupts + slowed down so it can't be used here. Async timers should + already be disabled at this point so we can use `sleep'. */ + sleep (1); + retry++; + goto loop; + } - errno = xerrno; - report_file_error ("connection failed", list2 (host, name)); - } + close (s); + + speed_up_interrupts (); - speed_up_interrupts (); + errno = xerrno; + report_file_error ("connection failed", list2 (host, name)); + } + + speed_up_interrupts (); +#endif /* ! HAVE_GETADDRINFO */ + } inch = s; outch = dup (s); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/process.c --- a/src/process.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/process.c Mon Aug 13 11:13:30 2007 +0200 @@ -58,7 +58,7 @@ #include "systty.h" #include "syswait.h" -Lisp_Object Qprocessp; +Lisp_Object Qprocessp, Qprocess_live_p; /* Process methods */ struct process_methods the_process_methods; @@ -71,7 +71,7 @@ /* Qrun => Qopen, Qexit => Qclosed for "network connection" processes */ Lisp_Object Qopen, Qclosed; /* Protocol families */ -Lisp_Object Qtcpip; +Lisp_Object Qtcp, Qudp; #ifdef HAVE_MULTICAST Lisp_Object Qmulticast; /* Will be used for occasional warnings */ @@ -106,25 +106,27 @@ /* List of process objects. */ Lisp_Object Vprocess_list; +extern Lisp_Object Vlisp_EXEC_SUFFIXES; + static Lisp_Object -mark_process (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_process (Lisp_Object obj) { - struct Lisp_Process *proc = XPROCESS (obj); - MAYBE_PROCMETH (mark_process_data, (proc, markobj)); - markobj (proc->name); - markobj (proc->command); - markobj (proc->filter); - markobj (proc->sentinel); - markobj (proc->buffer); - markobj (proc->mark); - markobj (proc->pid); - markobj (proc->pipe_instream); - markobj (proc->pipe_outstream); + Lisp_Process *proc = XPROCESS (obj); + MAYBE_PROCMETH (mark_process_data, (proc)); + mark_object (proc->name); + mark_object (proc->command); + mark_object (proc->filter); + mark_object (proc->sentinel); + mark_object (proc->buffer); + mark_object (proc->mark); + mark_object (proc->pid); + mark_object (proc->pipe_instream); + mark_object (proc->pipe_outstream); #ifdef FILE_CODING - markobj (proc->coding_instream); - markobj (proc->coding_outstream); + mark_object (proc->coding_instream); + mark_object (proc->coding_outstream); #endif return proc->status_symbol; } @@ -132,7 +134,7 @@ static void print_process (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { - struct Lisp_Process *proc = XPROCESS (obj); + Lisp_Process *proc = XPROCESS (obj); if (print_readably) error ("printing unreadable object #<process %s>", @@ -145,10 +147,10 @@ else { int netp = network_connection_p (obj); - write_c_string (((netp) ? GETTEXT ("#<network connection ") : + write_c_string ((netp ? GETTEXT ("#<network connection ") : GETTEXT ("#<process ")), printcharfun); print_internal (proc->name, printcharfun, 1); - write_c_string (((netp) ? " " : " pid "), printcharfun); + write_c_string ((netp ? " " : " pid "), printcharfun); print_internal (proc->pid, printcharfun, 1); write_c_string (" state:", printcharfun); print_internal (proc->status_symbol, printcharfun, 1); @@ -158,7 +160,7 @@ } #ifdef HAVE_WINDOW_SYSTEM -extern void debug_process_finalization (struct Lisp_Process *p); +extern void debug_process_finalization (Lisp_Process *p); #endif /* HAVE_WINDOW_SYSTEM */ static void @@ -166,7 +168,7 @@ { /* #### this probably needs to be tied into the tty event loop */ /* #### when there is one */ - struct Lisp_Process *p = (struct Lisp_Process *) header; + Lisp_Process *p = (Lisp_Process *) header; #ifdef HAVE_WINDOW_SYSTEM if (!for_disksave) { @@ -184,7 +186,7 @@ DEFINE_LRECORD_IMPLEMENTATION ("process", process, mark_process, print_process, finalize_process, - 0, 0, struct Lisp_Process); + 0, 0, 0, Lisp_Process); /************************************************************************/ /* basic process accessors */ @@ -194,8 +196,7 @@ directly to the child process, rather than en/decoding FILE_CODING streams */ void -get_process_streams (struct Lisp_Process *p, - Lisp_Object *instr, Lisp_Object *outstr) +get_process_streams (Lisp_Process *p, Lisp_Object *instr, Lisp_Object *outstr) { assert (p); assert (NILP (p->pipe_instream) || LSTREAMP(p->pipe_instream)); @@ -204,14 +205,14 @@ *outstr = p->pipe_outstream; } -struct Lisp_Process * +Lisp_Process * get_process_from_usid (USID usid) { - CONST void *vval; + const void *vval; assert (usid != USID_ERROR && usid != USID_DONTHASH); - if (gethash ((CONST void*)usid, usid_to_process, &vval)) + if (gethash ((const void*)usid, usid_to_process, &vval)) { Lisp_Object proc; CVOID_TO_LISP (proc, vval); @@ -222,19 +223,19 @@ } int -get_process_selected_p (struct Lisp_Process *p) +get_process_selected_p (Lisp_Process *p) { return p->selected; } void -set_process_selected_p (struct Lisp_Process *p, int selected_p) +set_process_selected_p (Lisp_Process *p, int selected_p) { p->selected = !!selected_p; } int -connected_via_filedesc_p (struct Lisp_Process *p) +connected_via_filedesc_p (Lisp_Process *p) { return MAYBE_INT_PROCMETH (tooltalk_connection_p, (p)); } @@ -243,7 +244,7 @@ int network_connection_p (Lisp_Object process) { - return GC_CONSP (XPROCESS (process)->pid); + return CONSP (XPROCESS (process)->pid); } #endif @@ -255,6 +256,14 @@ return PROCESSP (obj) ? Qt : Qnil; } +DEFUN ("process-live-p", Fprocess_live_p, 1, 1, 0, /* +Return t if OBJECT is a process that is alive. +*/ + (obj)) +{ + return PROCESSP (obj) && PROCESS_LIVE_P (XPROCESS (obj)) ? Qt : Qnil; +} + DEFUN ("process-list", Fprocess_list, 0, 0, 0, /* Return a list of all processes. */ @@ -270,7 +279,7 @@ { Lisp_Object tail; - if (GC_PROCESSP (name)) + if (PROCESSP (name)) return name; if (!gc_in_progress) @@ -278,7 +287,7 @@ of a signal or crash. */ CHECK_STRING (name); - for (tail = Vprocess_list; GC_CONSP (tail); tail = XCDR (tail)) + for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) { Lisp_Object proc = XCAR (tail); QUIT; @@ -296,18 +305,18 @@ { Lisp_Object buf, tail, proc; - if (GC_NILP (name)) return Qnil; + if (NILP (name)) return Qnil; buf = Fget_buffer (name); - if (GC_NILP (buf)) return Qnil; + if (NILP (buf)) return Qnil; - for (tail = Vprocess_list; GC_CONSP (tail); tail = XCDR (tail)) + for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) { /* jwz: do not quit here - it isn't necessary, as there is no way for Vprocess_list to get circular or overwhelmingly long, and this function is called from layout_mode_element under redisplay. */ /* QUIT; */ proc = XCAR (tail); - if (GC_PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf)) + if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf)) return proc; } return Qnil; @@ -329,28 +338,28 @@ /* This may be called during a GC from process_send_signal() from kill_buffer_processes() if emacs decides to abort(). */ - if (GC_PROCESSP (name)) + if (PROCESSP (name)) return name; - if (GC_STRINGP (name)) + if (STRINGP (name)) { obj = Fget_process (name); - if (GC_NILP (obj)) + if (NILP (obj)) obj = Fget_buffer (name); - if (GC_NILP (obj)) + if (NILP (obj)) error ("Process %s does not exist", XSTRING_DATA (name)); } - else if (GC_NILP (name)) + else if (NILP (name)) obj = Fcurrent_buffer (); else obj = name; /* Now obj should be either a buffer object or a process object. */ - if (GC_BUFFERP (obj)) + if (BUFFERP (obj)) { proc = Fget_buffer_process (obj); - if (GC_NILP (proc)) + if (NILP (proc)) error ("Buffer %s has no process", XSTRING_DATA (XBUFFER(obj)->name)); } else @@ -414,8 +423,7 @@ { Lisp_Object val, name1; int i; - struct Lisp_Process *p = - alloc_lcrecord_type (struct Lisp_Process, lrecord_process); + Lisp_Process *p = alloc_lcrecord_type (Lisp_Process, &lrecord_process); /* If name is already in use, modify it until it is unused. */ name1 = name; @@ -462,7 +470,7 @@ } void -init_process_io_handles (struct Lisp_Process *p, void* in, void* out, int flags) +init_process_io_handles (Lisp_Process *p, void* in, void* out, int flags) { USID usid = event_stream_create_stream_pair (in, out, &p->pipe_instream, &p->pipe_outstream, @@ -475,7 +483,7 @@ { Lisp_Object proc = Qnil; XSETPROCESS (proc, p); - puthash ((CONST void*)usid, LISP_TO_VOID (proc), usid_to_process); + puthash ((const void*)usid, LISP_TO_VOID (proc), usid_to_process); } MAYBE_PROCMETH (init_process_io_handles, (p, in, out, flags)); @@ -497,7 +505,7 @@ create_process (Lisp_Object process, Lisp_Object *argv, int nargv, Lisp_Object program, Lisp_Object cur_dir) { - struct Lisp_Process *p = XPROCESS (process); + Lisp_Process *p = XPROCESS (process); int pid; /* *_create_process may change status_symbol, if the process @@ -508,7 +516,7 @@ pid = PROCMETH (create_process, (p, argv, nargv, program, cur_dir)); p->pid = make_int (pid); - if (!NILP(p->pipe_instream)) + if (PROCESS_LIVE_P (p)) event_stream_select_process (p); } @@ -591,8 +599,7 @@ tem = Qnil; NGCPRO1 (tem); - locate_file (Vexec_path, program, EXEC_SUFFIXES, &tem, - X_OK); + locate_file (Vexec_path, program, Vlisp_EXEC_SUFFIXES, &tem, X_OK); if (NILP (tem)) report_file_error ("Searching for program", list1 (program)); program = Fexpand_file_name (tem, Qnil); @@ -658,7 +665,7 @@ DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 5, 0, /* Open a TCP connection for a service to a host. -Returns a subprocess-object to represent the connection. +Return a subprocess-object to represent the connection. Input and output work as for subprocesses; `delete-process' closes it. NAME is name for process. It is modified if necessary to make it unique. @@ -670,10 +677,18 @@ Third arg is name of the host to connect to, or its IP address. Fourth arg SERVICE is name of the service desired, or an integer specifying a port number to connect to. -Fifth argument FAMILY is a protocol family. When omitted, 'tcp/ip -\(Internet protocol family TCP/IP) is assumed. +Fifth argument PROTOCOL is a network protocol. Currently 'tcp + (Transmission Control Protocol) and 'udp (User Datagram Protocol) are + supported. When omitted, 'tcp is assumed. + +Ouput via `process-send-string' and input via buffer or filter (see +`set-process-filter') are stream-oriented. That means UDP datagrams are +not guaranteed to be sent and received in discrete packets. (But small +datagrams around 500 bytes that are not truncated by `process-send-string' +are usually fine.) Note further that UDP protocol does not guard against +lost packets. */ - (name, buffer, host, service, family)) + (name, buffer, host, service, protocol)) { /* !!#### This function has not been Mule-ized */ /* This function can GC */ @@ -681,17 +696,17 @@ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1; void *inch, *outch; - GCPRO5 (name, buffer, host, service, family); + GCPRO5 (name, buffer, host, service, protocol); CHECK_STRING (name); - if (NILP(family)) - family = Qtcpip; + if (NILP(protocol)) + protocol = Qtcp; else - CHECK_SYMBOL (family); + CHECK_SYMBOL (protocol); /* Since this code is inside HAVE_SOCKETS, existence of open_network_stream is mandatory */ - PROCMETH (open_network_stream, (name, host, service, family, + PROCMETH (open_network_stream, (name, host, service, protocol, &inch, &outch)); if (!NILP (buffer)) @@ -715,7 +730,7 @@ DEFUN ("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /* Open a multicast connection on the specified dest/port/ttl. -Returns a subprocess-object to represent the connection. +Return a subprocess-object to represent the connection. Input and output work as for subprocesses; `delete-process' closes it. NAME is name for process. It is modified if necessary to make it unique. @@ -804,7 +819,7 @@ Bytecount nbytes, nchars; Bufbyte chars[1024]; Lisp_Object outstream; - struct Lisp_Process *p = XPROCESS (proc); + Lisp_Process *p = XPROCESS (proc); /* If there is a lot of output from the subprocess, the loop in execute_internal_event() might call read_process_output() more @@ -814,7 +829,7 @@ Really, the loop in execute_internal_event() should check itself for a process-filter change, like in status_notify(); but the struct Lisp_Process is not exported outside of this file. */ - if (NILP(p->pipe_instream)) + if (!PROCESS_LIVE_P (p)) return -1; /* already closed */ if (!NILP (p->filter) && (p->filter_does_read)) @@ -949,7 +964,7 @@ void send_process (Lisp_Object proc, - Lisp_Object relocatable, CONST Bufbyte *nonrelocatable, + Lisp_Object relocatable, const Bufbyte *nonrelocatable, int start, int len) { /* This function can GC */ @@ -964,7 +979,7 @@ if (nonrelocatable) lstream = make_fixed_buffer_input_stream (nonrelocatable + start, len); - else if (GC_BUFFERP (relocatable)) + else if (BUFFERP (relocatable)) lstream = make_lisp_buffer_input_stream (XBUFFER (relocatable), start, start + len, 0); else @@ -1023,7 +1038,7 @@ set_process_filter (Lisp_Object proc, Lisp_Object filter, int filter_does_read) { CHECK_PROCESS (proc); - if (PROCESS_LIVE_P (proc)) { + if (PROCESS_LIVE_P (XPROCESS (proc))) { if (EQ (filter, Qt)) event_stream_unselect_process (XPROCESS (proc)); else @@ -1112,6 +1127,7 @@ (process)) { process = get_process (process); + CHECK_LIVE_PROCESS (process); return decoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_instream) ); } @@ -1121,6 +1137,7 @@ (process)) { process = get_process (process); + CHECK_LIVE_PROCESS (process); return encoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_outstream)); } @@ -1130,6 +1147,7 @@ (process)) { process = get_process (process); + CHECK_LIVE_PROCESS (process); return Fcons (decoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_instream)), encoding_stream_coding_system @@ -1144,6 +1162,8 @@ { codesys = Fget_coding_system (codesys); process = get_process (process); + CHECK_LIVE_PROCESS (process); + set_decoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_instream), codesys); return Qnil; @@ -1157,6 +1177,8 @@ { codesys = Fget_coding_system (codesys); process = get_process (process); + CHECK_LIVE_PROCESS (process); + set_encoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_outstream), codesys); return Qnil; @@ -1165,6 +1187,8 @@ DEFUN ("set-process-coding-system", Fset_process_coding_system, 1, 3, 0, /* Set coding-systems of PROCESS to DECODING and ENCODING. +DECODING will be used to decode subprocess output and ENCODING to +encode subprocess input. */ (process, decoding, encoding)) { @@ -1186,7 +1210,7 @@ static Lisp_Object exec_sentinel_unwind (Lisp_Object datum) { - struct Lisp_Cons *d = XCONS (datum); + Lisp_Cons *d = XCONS (datum); XPROCESS (d->car)->sentinel = d->cdr; free_cons (d); return Qnil; @@ -1197,7 +1221,7 @@ { /* This function can GC */ int speccount = specpdl_depth (); - struct Lisp_Process *p = XPROCESS (proc); + Lisp_Process *p = XPROCESS (proc); Lisp_Object sentinel = p->sentinel; if (NILP (sentinel)) @@ -1242,13 +1266,13 @@ } -CONST char * +const char * signal_name (int signum) { if (signum >= 0 && signum < NSIG) - return (CONST char *) sys_siglist[signum]; + return (const char *) sys_siglist[signum]; - return (CONST char *) GETTEXT ("unknown signal"); + return (const char *) GETTEXT ("unknown signal"); } void @@ -1267,7 +1291,7 @@ /* Return a string describing a process status list. */ static Lisp_Object -status_message (struct Lisp_Process *p) +status_message (Lisp_Process *p) { Lisp_Object symbol = p->status_symbol; int code = p->exit_code; @@ -1351,7 +1375,7 @@ for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) { Lisp_Object proc = XCAR (tail); - struct Lisp_Process *p = XPROCESS (proc); + Lisp_Process *p = XPROCESS (proc); /* p->tick is also volatile. Same thing as above applies. */ int this_process_tick; @@ -1518,9 +1542,7 @@ if (network_connection_p (proc)) error ("Network connection %s is not a subprocess", XSTRING_DATA (XPROCESS(proc)->name)); - if (!PROCESS_LIVE_P (proc)) - error ("Process %s is not active", - XSTRING_DATA (XPROCESS(proc)->name)); + CHECK_LIVE_PROCESS (proc); MAYBE_PROCMETH (kill_child_process, (proc, signo, current_group, nomsg)); } @@ -1621,7 +1643,7 @@ name = string_data (XSYMBOL (sigcode)->name); #define handle_signal(signal) \ - else if (!strcmp ((CONST char *) name, #signal)) \ + else if (!strcmp ((const char *) name, #signal)) \ XSETINT (sigcode, signal) if (0) @@ -1810,7 +1832,7 @@ void deactivate_process (Lisp_Object proc) { - struct Lisp_Process *p = XPROCESS (proc); + Lisp_Process *p = XPROCESS (proc); USID usid; /* It's possible that we got as far in the process-creation @@ -1837,7 +1859,7 @@ p->pipe_outstream); if (usid != USID_DONTHASH) - remhash ((CONST void*)usid, usid_to_process); + remhash ((const void*)usid, usid_to_process); p->pipe_instream = Qnil; p->pipe_outstream = Qnil; @@ -1863,7 +1885,7 @@ (proc)) { /* This function can GC */ - struct Lisp_Process *p; + Lisp_Process *p; proc = get_process (proc); p = XPROCESS (proc); if (network_connection_p (proc)) @@ -1874,7 +1896,7 @@ p->tick++; process_tick++; } - else if (!NILP(p->pipe_instream)) + else if (PROCESS_LIVE_P (p)) { Fkill_process (proc, Qnil); /* Do this now, since remove_process will make sigchld_handler do nothing. */ @@ -1897,16 +1919,16 @@ { Lisp_Object tail; - for (tail = Vprocess_list; GC_CONSP (tail); + for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) { Lisp_Object proc = XCAR (tail); - if (GC_PROCESSP (proc) - && (GC_NILP (buffer) || GC_EQ (XPROCESS (proc)->buffer, buffer))) + if (PROCESSP (proc) + && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer))) { if (network_connection_p (proc)) Fdelete_process (proc); - else if (!NILP (XPROCESS (proc)->pipe_instream)) + else if (PROCESS_LIVE_P (XPROCESS (proc))) process_send_signal (proc, SIGHUP, 0, 1); } } @@ -1969,18 +1991,21 @@ syms_of_process (void) { defsymbol (&Qprocessp, "processp"); + defsymbol (&Qprocess_live_p, "process-live-p"); defsymbol (&Qrun, "run"); defsymbol (&Qstop, "stop"); defsymbol (&Qopen, "open"); defsymbol (&Qclosed, "closed"); - defsymbol (&Qtcpip, "tcp/ip"); + defsymbol (&Qtcp, "tcp"); + defsymbol (&Qudp, "udp"); #ifdef HAVE_MULTICAST defsymbol(&Qmulticast, "multicast"); /* Used for occasional warnings */ #endif DEFSUBR (Fprocessp); + DEFSUBR (Fprocess_live_p); DEFSUBR (Fget_process); DEFSUBR (Fget_buffer_process); DEFSUBR (Fdelete_process); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/process.h --- a/src/process.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/process.h Mon Aug 13 11:13:30 2007 +0200 @@ -18,8 +18,8 @@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -#ifndef _XEMACS_PROCESS_H_ -#define _XEMACS_PROCESS_H_ +#ifndef INCLUDED_process_h_ +#define INCLUDED_process_h_ #if defined (NO_SUBPROCESSES) #undef XPROCESS @@ -38,15 +38,19 @@ #else /* not NO_SUBPROCESSES */ /* Only process.c needs to know about the guts of this */ -struct Lisp_Process; -DECLARE_LRECORD (process, struct Lisp_Process); -#define XPROCESS(x) XRECORD (x, process, struct Lisp_Process) +DECLARE_LRECORD (process, Lisp_Process); +#define XPROCESS(x) XRECORD (x, process, Lisp_Process) #define XSETPROCESS(x, p) XSETRECORD (x, p, process) #define PROCESSP(x) RECORDP (x, process) -#define GC_PROCESSP(x) GC_RECORDP (x, process) #define CHECK_PROCESS(x) CHECK_RECORD (x, process) -#define PROCESS_LIVE_P(x) (!NILP (XPROCESS(x)->pipe_instream)) +#define PROCESS_LIVE_P(x) (!NILP ((x)->pipe_instream)) + +#define CHECK_LIVE_PROCESS(x) do { \ + CHECK_PROCESS (x); \ + if (! PROCESS_LIVE_P (XPROCESS (x))) \ + dead_wrong_type_argument (Qprocess_live_p, (x)); \ +} while (0) #ifdef emacs @@ -57,7 +61,7 @@ Lisp_Object buffer, Lisp_Object infd, Lisp_Object outfd); -int connected_via_filedesc_p (struct Lisp_Process *p); +int connected_via_filedesc_p (Lisp_Process *p); void kill_buffer_processes (Lisp_Object buffer); void close_process_descs (void); @@ -69,7 +73,7 @@ extern volatile int synch_process_alive; /* Nonzero => this is a string explaining death of synchronous subprocess. */ -extern CONST char *synch_process_death; +extern const char *synch_process_death; /* If synch_process_death is zero, this is exit code of synchronous subprocess. */ @@ -80,12 +84,12 @@ Lisp_Object status_symbol, int exit_code, int core_dumped); -void get_process_streams (struct Lisp_Process *p, +void get_process_streams (Lisp_Process *p, Lisp_Object *instr, Lisp_Object *outstr); -int get_process_selected_p (struct Lisp_Process *p); -void set_process_selected_p (struct Lisp_Process *p, int selected_p); +int get_process_selected_p (Lisp_Process *p); +void set_process_selected_p (Lisp_Process *p, int selected_p); -struct Lisp_Process *get_process_from_usid (USID usid); +Lisp_Process *get_process_from_usid (USID usid); #ifdef HAVE_SOCKETS int network_connection_p (Lisp_Object process); @@ -93,7 +97,7 @@ #define network_connection_p(x) 0 #endif -extern Lisp_Object Qclosed, Qmulticast, Qopen, Qrun, Qstop, Qtcpip; +extern Lisp_Object Qclosed, Qmulticast, Qopen, Qrun, Qstop, Qtcp, Qudp; extern Lisp_Object Vprocess_connection_type, Vprocess_list; /* Report all recent events of a change in process status @@ -110,11 +114,11 @@ void #endif child_setup (int in, int out, int err, - char **new_argv, CONST char *current_dir); + char **new_argv, const char *current_dir); Charcount read_process_output (Lisp_Object proc); -CONST char *signal_name (int signum); +const char *signal_name (int signum); Lisp_Object canonicalize_host_name (Lisp_Object host); @@ -134,4 +138,13 @@ #endif /* emacs */ -#endif /* _XEMACS_PROCESS_H_ */ +#ifdef HAVE_GETPT +#define PTY_ITERATION +#define PTY_OPEN \ + if ((fd = getpt()) < 0 || grantpt (fd) < 0 || unlockpt (fd) < 0) \ + return -1; +#define PTY_NAME_SPRINTF +#define PTY_TTY_NAME_SPRINTF strcpy (pty_name, ptsname (fd)); +#endif + +#endif /* INCLUDED_process_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/procimpl.h --- a/src/procimpl.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/procimpl.h Mon Aug 13 11:13:30 2007 +0200 @@ -22,10 +22,8 @@ process-unix.c, process-msw.c etc. The Lisp_Process structure and other contents of this file is not exported to the rest of the world */ -#ifndef _XEMACS_PROCIMPL_H_ -#define _XEMACS_PROCIMPL_H_ - -struct Lisp_Process; +#ifndef INCLUDED_procimpl_h_ +#define INCLUDED_procimpl_h_ /* * Structure which keeps methods of the process implementation. @@ -37,21 +35,19 @@ struct process_methods { - void (*mark_process_data) (struct Lisp_Process *proc, - void (*markobj) (Lisp_Object)); - void (*print_process_data) (struct Lisp_Process *proc, - Lisp_Object printcharfun); - void (*finalize_process_data) (struct Lisp_Process *proc, int for_disksave); - void (*alloc_process_data) (struct Lisp_Process *p); - void (*init_process_io_handles) (struct Lisp_Process *p, + void (*mark_process_data) (Lisp_Process *proc); + void (*print_process_data) (Lisp_Process *proc, Lisp_Object printcharfun); + void (*finalize_process_data) (Lisp_Process *proc, int for_disksave); + void (*alloc_process_data) (Lisp_Process *p); + void (*init_process_io_handles) (Lisp_Process *p, void* in, void* out, int flags); - int (*create_process) (struct Lisp_Process *p, + int (*create_process) (Lisp_Process *p, Lisp_Object *argv, int nargv, Lisp_Object program, Lisp_Object cur_dir); - int (*tooltalk_connection_p) (struct Lisp_Process *p); + int (*tooltalk_connection_p) (Lisp_Process *p); #ifdef HAVE_SOCKETS void (*open_network_stream) (Lisp_Object name, Lisp_Object host, - Lisp_Object service, Lisp_Object family, + Lisp_Object service, Lisp_Object protocol, void** vinfd, void** voutfd); #ifdef HAVE_MULTICAST void (*open_multicast_group) (Lisp_Object name, Lisp_Object dest, @@ -60,16 +56,16 @@ #endif /* HAVE_MULTICAST */ #endif /* HAVE_SOCKETS */ Lisp_Object (*canonicalize_host_name) (Lisp_Object host); - int (*set_window_size) (struct Lisp_Process* p, int height, int width); + int (*set_window_size) (Lisp_Process* p, int height, int width); void (*send_process) (Lisp_Object proc, struct lstream* lstream); void (*reap_exited_processes) (void); - void (*update_status_if_terminated) (struct Lisp_Process* p); + void (*update_status_if_terminated) (Lisp_Process* p); void (*kill_child_process) (Lisp_Object proc, int signo, int current_group, int nomsg); int (*kill_process_by_pid) (int pid, int sigcode); int (*process_send_eof) (Lisp_Object proc); - Lisp_Object (*get_tty_name) (struct Lisp_Process *p); - USID (*deactivate_process) (struct Lisp_Process *p); + Lisp_Object (*get_tty_name) (Lisp_Process *p); + USID (*deactivate_process) (Lisp_Process *p); void (*init_process) (void); }; @@ -159,7 +155,7 @@ /* Random externs from process.c */ extern Lisp_Object Qrun, Qstop, Qopen, Qclosed; -extern Lisp_Object Qtcpip; +extern Lisp_Object Qtcp, Qudp; extern Lisp_Object Vprocess_connection_type; extern Lisp_Object Vprocess_list; @@ -178,11 +174,11 @@ #endif /* PROCESS_IO_BLOCKING */ Lisp_Object make_process_internal (Lisp_Object name); -void init_process_io_handles (struct Lisp_Process *p, void* in, +void init_process_io_handles (Lisp_Process *p, void* in, void* out, int flags); void send_process (Lisp_Object proc, Lisp_Object relocatable, - CONST Bufbyte *nonrelocatable, + const Bufbyte *nonrelocatable, int start, int len); -#endif /* _XEMACS_PROCIMPL_H_ */ +#endif /* INCLUDED_procimpl_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/profile.c --- a/src/profile.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/profile.c Mon Aug 13 11:13:30 2007 +0200 @@ -57,7 +57,7 @@ even be useful to provide a way to turn on only one profiling mechanism, but I haven't done so yet. --hniksic */ -struct hash_table *big_profile_table; +static struct hash_table *big_profile_table; Lisp_Object Vcall_count_profile_table; int default_profiling_interval; @@ -68,10 +68,10 @@ and is not set the whole time we're in redisplay. */ int profiling_redisplay_flag; -Lisp_Object QSin_redisplay; -Lisp_Object QSin_garbage_collection; -Lisp_Object QSprocessing_events_at_top_level; -Lisp_Object QSunknown; +static Lisp_Object QSin_redisplay; +static Lisp_Object QSin_garbage_collection; +static Lisp_Object QSprocessing_events_at_top_level; +static Lisp_Object QSunknown; /* We use inside_profiling to prevent the handler from writing to the table while another routine is operating on it. We also set @@ -119,9 +119,10 @@ { fun = *backtrace_list->function; - if (!GC_SYMBOLP (fun) && - !GC_COMPILED_FUNCTIONP (fun) && - !GC_SUBRP (fun)) + if (!SYMBOLP (fun) + && !COMPILED_FUNCTIONP (fun) + && !SUBRP (fun) + && !CONSP (fun)) fun = QSunknown; } else @@ -134,14 +135,14 @@ lose because of this. Even worse, if the memory allocation fails, the `error' generated whacks everything hard. */ long count; - CONST void *vval; + const void *vval; if (gethash (LISP_TO_VOID (fun), big_profile_table, &vval)) count = (long) vval; else count = 0; count++; - vval = (CONST void *) count; + vval = (const void *) count; puthash (LISP_TO_VOID (fun), (void *) vval, big_profile_table); } @@ -225,7 +226,7 @@ }; static int -get_profiling_info_maphash (CONST void *void_key, +get_profiling_info_maphash (const void *void_key, void *void_val, void *void_closure) { @@ -262,34 +263,26 @@ return closure.accum; } -struct mark_profiling_info_closure -{ - void (*markfun) (Lisp_Object); -}; - static int -mark_profiling_info_maphash (CONST void *void_key, +mark_profiling_info_maphash (const void *void_key, void *void_val, void *void_closure) { Lisp_Object key; CVOID_TO_LISP (key, void_key); - (((struct mark_profiling_info_closure *) void_closure)->markfun) (key); + mark_object (key); return 0; } void -mark_profiling_info (void (*markfun) (Lisp_Object)) +mark_profiling_info (void) { - /* This function does not GC (if markfun doesn't) */ - struct mark_profiling_info_closure closure; - - closure.markfun = markfun; + /* This function does not GC */ if (big_profile_table) { inside_profiling = 1; - maphash (mark_profiling_info_maphash, big_profile_table, &closure); + maphash (mark_profiling_info_maphash, big_profile_table, 0); inside_profiling = 0; } } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/pure.c --- a/src/pure.c Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,36 +0,0 @@ -/* This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: FSF 19.30. Split out of alloc.c. */ - -#include <config.h> -#include "lisp.h" -#include "puresize.h" - -/* Moved from puresize.h to here so alloc.c does not get recompiled */ - -# include <puresize-adjust.h> -#define PURESIZE ((RAW_PURESIZE) + (PURESIZE_ADJUSTMENT)) - -size_t -get_PURESIZE (void) -{ - return PURESIZE; -} - -/* Force linker to put it into data space! */ -EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = { (EMACS_INT) 0}; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/puresize.h --- a/src/puresize.h Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,172 +0,0 @@ -/* Definition of PURESIZE. - Copyright (C) 1986, 1988, 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995, 1996 Ben Wing. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -#ifndef PURESIZE_H -#define PURESIZE_H - -/* If RAW_PURESIZE is already defined then the user overrode it at - configure time. */ -#ifndef RAW_PURESIZE - -/* Basic amount of purespace to use, in the absence of extra - things configured in. */ - - -/* This computation is Barbra Streisand, BS -#if (LONGBITS == 64) -# define BASE_PURESIZE 938000 -#else -# define BASE_PURESIZE 563000 -#endif -*/ - -#define BASE_PURESIZE 1400000 - -/* If any particular systems need to change the base puresize, they - should define SYSTEM_PURESIZE_EXTRA. Note that this can be - negative as well as positive. - - Do NOT define PURESIZE or any other values. This allows the - other values to shift while still keeping things in sync. */ - -#ifndef SYSTEM_PURESIZE_EXTRA -# define SYSTEM_PURESIZE_EXTRA 0 -#endif - -/* Extra amount of purespace needed for menubars. */ - -#ifdef HAVE_DIALOGS -# if (LONGBITS == 64) -# define DIALOG_PURESIZE_EXTRA 43000 -# else -# define DIALOG_PURESIZE_EXTRA 1800 -# endif -#else -# define DIALOG_PURESIZE_EXTRA 0 -#endif - -#ifdef HAVE_MENUBARS -# if (LONGBITS == 64) -# define MENUBAR_PURESIZE_EXTRA 43000 -# else -# define MENUBAR_PURESIZE_EXTRA 36000 -# endif -#else -# define MENUBAR_PURESIZE_EXTRA 0 -#endif - -#ifdef HAVE_SCROLLBARS -# if (LONGBITS == 64) -# define SCROLLBAR_PURESIZE_EXTRA 4000 -# else -# define SCROLLBAR_PURESIZE_EXTRA 1800 -# endif -#else -# define SCROLLBAR_PURESIZE_EXTRA 0 -#endif - -#ifdef HAVE_TOOLBARS -# if (LONGBITS == 64) -# define TOOLBAR_PURESIZE_EXTRA 4000 -# else -# define TOOLBAR_PURESIZE_EXTRA 8400 -# endif -#else -# define TOOLBAR_PURESIZE_EXTRA 0 -#endif - -/* Extra amount of purespace needed for X11, separate from menubars - and scrollbars. */ - -#ifdef HAVE_X_WINDOWS -# if (LONGBITS == 64) -# define X11_PURESIZE_EXTRA 95000 -# else -# define X11_PURESIZE_EXTRA 68000 -# endif -#else -# define X11_PURESIZE_EXTRA 0 -#endif - -/* Extra amount of purespace needed for Mule. */ - -#ifdef MULE -#ifdef HAVE_CANNA -# define MULE_PURESIZE_CANNA 5000 -#else -# define MULE_PURESIZE_CANNA 0 -#endif -#ifdef HAVE_WNN -# define MULE_PURESIZE_WNN 5000 -#else -# define MULE_PURESIZE_WNN 0 -#endif -# if (LONGBITS == 64) -# define MULE_PURESIZE_EXTRA 99000+MULE_PURESIZE_CANNA+MULE_PURESIZE_WNN -# else -# define MULE_PURESIZE_EXTRA 78000+MULE_PURESIZE_CANNA+MULE_PURESIZE_WNN -# endif -#else -# define MULE_PURESIZE_EXTRA 0 -#endif - -/* Extra amount of purespace needed for Tooltalk. */ - -#ifdef TOOLTALK -# if (LONGBITS == 64) -# define TOOLTALK_PURESIZE_EXTRA 100000 -# else -# define TOOLTALK_PURESIZE_EXTRA 8300 -# endif -#else -# define TOOLTALK_PURESIZE_EXTRA 0 -#endif - -/* Extra amount of purespace needed for Sunpro builds. */ - -#ifdef SUNPRO -#define SUNPRO_PURESIZE_EXTRA 95000 -#else -# define SUNPRO_PURESIZE_EXTRA 0 -#endif - -#define RAW_PURESIZE ((BASE_PURESIZE) + \ - (DIALOG_PURESIZE_EXTRA) + \ - (MENUBAR_PURESIZE_EXTRA) + \ - (SCROLLBAR_PURESIZE_EXTRA) + \ - (TOOLBAR_PURESIZE_EXTRA) + \ - (X11_PURESIZE_EXTRA) + \ - (SYSTEM_PURESIZE_EXTRA) + \ - (MULE_PURESIZE_EXTRA) + \ - (TOOLTALK_PURESIZE_EXTRA) + \ - (SUNPRO_PURESIZE_EXTRA)) - -#endif /* !RAW_PURESIZE */ - -# include <puresize-adjust.h> -#define PURESIZE ((RAW_PURESIZE) + (PURESIZE_ADJUSTMENT)) -#define get_PURESIZE() PURESIZE - -extern EMACS_INT pure[]; - -#endif /* PURESIZE_H */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/ralloc.c --- a/src/ralloc.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/ralloc.c Mon Aug 13 11:13:30 2007 +0200 @@ -53,8 +53,6 @@ /* Unconditionally use unsigned char * for this. */ typedef unsigned char *POINTER; -typedef unsigned long SIZE; - #ifdef DOUG_LEA_MALLOC #define M_TOP_PAD -2 #include <malloc.h> @@ -69,7 +67,6 @@ #include <stddef.h> -typedef size_t SIZE; typedef void *POINTER; #include <unistd.h> @@ -79,7 +76,6 @@ #endif /* emacs. */ void init_ralloc (void); -#define safe_bcopy(x, y, z) memmove (y, x, z) #define NIL ((POINTER) 0) @@ -98,7 +94,7 @@ /* Declarations for working with the malloc, ralloc, and system breaks. */ /* Function to set the real break value. */ -static POINTER (*real_morecore) (long size); +static POINTER (*real_morecore) (ptrdiff_t size); /* The break value, as seen by malloc (). */ static POINTER virtual_break_value; @@ -185,7 +181,7 @@ struct bp *prev; POINTER *variable; POINTER data; - SIZE size; + size_t size; POINTER new_data; /* temporarily used for relocation */ struct heap *heap; /* Heap this bloc is in. */ } *bloc_ptr; @@ -245,10 +241,10 @@ allocate the memory. */ static POINTER -obtain (POINTER address, SIZE size) +obtain (POINTER address, size_t size) { heap_ptr heap; - SIZE already_available; + size_t already_available; /* Find the heap that ADDRESS falls within. */ for (heap = last_heap; heap; heap = heap->prev) @@ -275,7 +271,7 @@ if (heap == NIL_HEAP) { POINTER new = (*real_morecore)(0); - SIZE get; + size_t get; already_available = (char *)last_heap->end - (char *)address; @@ -325,7 +321,7 @@ If we could not allocate the space, return zero. */ static POINTER -get_more_space (SIZE size) +get_more_space (size_t size) { POINTER ptr = break_value; if (obtain (size)) @@ -339,7 +335,7 @@ If SIZE is more than a page, return the space to the system. */ static void -relinquish () +relinquish (void) { register heap_ptr h; int excess = 0; @@ -388,7 +384,7 @@ long r_alloc_size_in_use (void); long -r_alloc_size_in_use () +r_alloc_size_in_use (void) { return break_value - virtual_break_value; } @@ -420,7 +416,7 @@ memory for the new block. */ static bloc_ptr -get_bloc (SIZE size) +get_bloc (size_t size) { register bloc_ptr new_bloc; register heap_ptr heap; @@ -501,7 +497,7 @@ if (heap == NIL_HEAP) { register bloc_ptr tb = b; - register SIZE s = 0; + register size_t s = 0; /* Add up the size of all the following blocs. */ while (tb != NIL_BLOC) @@ -628,12 +624,12 @@ that come after BLOC in memory. */ static int -resize_bloc (bloc_ptr bloc, SIZE size) +resize_bloc (bloc_ptr bloc, size_t size) { register bloc_ptr b; heap_ptr heap; POINTER address; - SIZE old_size; + size_t old_size; /* No need to ever call this if arena is frozen, bug somewhere! */ if (r_alloc_freeze_level) @@ -681,7 +677,7 @@ } else { - safe_bcopy (b->data, b->new_data, b->size); + memmove (b->new_data, b->data, b->size); *b->variable = b->data = b->new_data; } } @@ -692,7 +688,7 @@ } else { - safe_bcopy (bloc->data, bloc->new_data, old_size); + memmove (bloc->new_data, bloc->data, old_size); memset (bloc->new_data + old_size, 0, size - old_size); *bloc->variable = bloc->data = bloc->new_data; } @@ -708,7 +704,7 @@ } else { - safe_bcopy (b->data, b->new_data, b->size); + memmove (b->new_data, b->data, b->size); *b->variable = b->data = b->new_data; } } @@ -790,9 +786,9 @@ __morecore hook values - in particular, __default_morecore in the GNU malloc package. */ -POINTER r_alloc_sbrk (long size); +POINTER r_alloc_sbrk (ptrdiff_t size); POINTER -r_alloc_sbrk (long size) +r_alloc_sbrk (ptrdiff_t size) { register bloc_ptr b; POINTER address; @@ -813,7 +809,7 @@ not always find a space which is contiguous to the previous. */ POINTER new_bloc_start; heap_ptr h = first_heap; - SIZE get = ROUNDUP (size); + size_t get = ROUNDUP (size); address = (POINTER) ROUNDUP (virtual_break_value); @@ -862,7 +858,7 @@ header. */ for (b = last_bloc; b != NIL_BLOC; b = b->prev) { - safe_bcopy (b->data, b->new_data, b->size); + memmove (b->new_data, b->data, b->size); *b->variable = b->data = b->new_data; } @@ -893,7 +889,7 @@ } else /* size < 0 */ { - SIZE excess = (char *)first_heap->bloc_start + size_t excess = (char *)first_heap->bloc_start - ((char *)virtual_break_value + size); address = virtual_break_value; @@ -908,7 +904,7 @@ for (b = first_bloc; b != NIL_BLOC; b = b->next) { - safe_bcopy (b->data, b->new_data, b->size); + memmove (b->new_data, b->data, b->size); *b->variable = b->data = b->new_data; } } @@ -941,9 +937,9 @@ If we can't allocate the necessary memory, set *PTR to zero, and return zero. */ -POINTER r_alloc (POINTER *ptr, SIZE size); +POINTER r_alloc (POINTER *ptr, size_t size); POINTER -r_alloc (POINTER *ptr, SIZE size) +r_alloc (POINTER *ptr, size_t size) { bloc_ptr new_bloc; @@ -1000,9 +996,9 @@ If more memory cannot be allocated, then leave *PTR unchanged, and return zero. */ -POINTER r_re_alloc (POINTER *ptr, SIZE size); +POINTER r_re_alloc (POINTER *ptr, size_t size); POINTER -r_re_alloc (POINTER *ptr, SIZE size) +r_re_alloc (POINTER *ptr, size_t size) { register bloc_ptr bloc; @@ -1082,7 +1078,7 @@ void r_alloc_thaw (void); void -r_alloc_thaw () +r_alloc_thaw (void) { if (! r_alloc_initialized) @@ -1092,7 +1088,7 @@ abort (); /* This frees all unused blocs. It is not too inefficient, as the resize - and bcopy is done only once. Afterwards, all unreferenced blocs are + and memmove is done only once. Afterwards, all unreferenced blocs are already shrunk to zero size. */ if (!r_alloc_freeze_level) { @@ -1109,14 +1105,11 @@ /* The hook `malloc' uses for the function which gets more space from the system. */ #ifndef DOUG_LEA_MALLOC -extern POINTER (*__morecore) (long size); +extern POINTER (*__morecore) (ptrdiff_t size); #endif /* Initialize various things for memory allocation. */ -#define SET_FUN_PTR(fun_ptr, fun_val) \ - (*((void **) (&fun_ptr)) = ((void *) (fun_val))) - void init_ralloc (void) { @@ -1124,8 +1117,12 @@ return; r_alloc_initialized = 1; - SET_FUN_PTR (real_morecore, __morecore); - SET_FUN_PTR (__morecore, r_alloc_sbrk); + real_morecore = (POINTER (*) (ptrdiff_t)) __morecore; + __morecore = +#ifdef __GNUC__ + (__typeof__ (__morecore)) +#endif + r_alloc_sbrk; first_heap = last_heap = &heap_base; first_heap->next = first_heap->prev = NIL_HEAP; @@ -1172,21 +1169,25 @@ Emacs. This is needed when using Doug Lea's malloc from GNU libc. */ void r_alloc_reinit (void); void -r_alloc_reinit () +r_alloc_reinit (void) { /* Only do this if the hook has been reset, so that we don't get an infinite loop, in case Emacs was linked statically. */ - if ( ((void*) __morecore) != (void *) (r_alloc_sbrk)) + if ( (POINTER (*) (ptrdiff_t)) __morecore != r_alloc_sbrk) { - SET_FUN_PTR (real_morecore, __morecore); - SET_FUN_PTR (__morecore, r_alloc_sbrk); + real_morecore = (POINTER (*) (ptrdiff_t)) __morecore; + __morecore = +#ifdef __GNUC__ + (__typeof__ (__morecore)) +#endif + r_alloc_sbrk; } } #if 0 #ifdef DEBUG void -r_alloc_check () +r_alloc_check (void) { int found = 0; heap_ptr h, ph = 0; @@ -1232,7 +1233,7 @@ { assert (b->prev == pb); assert ((POINTER) MEM_ROUNDUP (b->data) == b->data); - assert ((SIZE) MEM_ROUNDUP (b->size) == b->size); + assert ((size_t) MEM_ROUNDUP (b->size) == b->size); ph = 0; for (h = first_heap; h; h = h->next) @@ -1318,7 +1319,7 @@ #include <stdio.h> typedef void *VM_ADDR; /* VM addresses */ -static CONST VM_ADDR VM_FAILURE_ADDR = (VM_ADDR) -1; /* mmap returns this when it fails. */ +static const VM_ADDR VM_FAILURE_ADDR = (VM_ADDR) -1; /* mmap returns this when it fails. */ /* Configuration for relocating allocator. */ @@ -1692,10 +1693,10 @@ static void Addr_Block_initialize(void); /* Get a suitable VM_ADDR via mmap */ -static VM_ADDR New_Addr_Block( SIZE sz ); +static VM_ADDR New_Addr_Block (size_t sz); /* Free a VM_ADDR allocated via New_Addr_Block */ -static void Free_Addr_Block( VM_ADDR addr, SIZE sz ); +static void Free_Addr_Block (VM_ADDR addr, size_t sz); #ifdef MMAP_GENERATE_ADDRESSES /* Implementation of the three calls for address picking when XEmacs is incharge */ @@ -1706,7 +1707,7 @@ typedef struct addr_chain { POINTER addr; - SIZE sz; + size_t sz; addr_status flag; struct addr_chain *next; } ADDRESS_BLOCK, *ADDRESS_CHAIN; @@ -1718,7 +1719,8 @@ WRT the addition/deletion of address blocks because of the assert in Coalesce() and the strict ordering of blocks by their address */ -static void Addr_Block_initialize() +static void +Addr_Block_initialize (void) { MEMMETER( MVAL( M_Addrlist_Size )++) addr_chain = (ADDRESS_CHAIN) UNDERLYING_MALLOC( sizeof( ADDRESS_BLOCK )); @@ -1730,7 +1732,8 @@ /* Coalesce address blocks if they are contiguous. Only empty and unavailable slots are coalesced. */ -static void Coalesce_Addr_Blocks() +static void +Coalesce_Addr_Blocks (void) { ADDRESS_CHAIN p; for (p = addr_chain; p; p = p->next) @@ -1756,7 +1759,8 @@ } /* Get an empty address block of specified size. */ -static VM_ADDR New_Addr_Block( SIZE sz ) +static VM_ADDR +New_Addr_Block (size_t sz) { ADDRESS_CHAIN p = addr_chain; VM_ADDR new_addr = VM_FAILURE_ADDR; @@ -1793,7 +1797,8 @@ /* Free an address block. We mark the block as being empty, and attempt to do any coalescing that may have resulted from this. */ -static void Free_Addr_Block( VM_ADDR addr, SIZE sz ) +static void +Free_Addr_Block (VM_ADDR addr, size_t sz) { ADDRESS_CHAIN p = addr_chain; for (; p; p = p->next ) @@ -1814,18 +1819,21 @@ /* This is an alternate (simpler) implementation in cases where the address is picked by the kernel. */ -static void Addr_Block_initialize(void) +static void +Addr_Block_initialize (void) { /* Nothing. */ } -static VM_ADDR New_Addr_Block( SIZE sz ) +static VM_ADDR +New_Addr_Block (size_t sz) { return mmap (0, sz, PROT_READ|PROT_WRITE, MAP_FLAGS, DEV_ZERO_FD, 0 ); } -static void Free_Addr_Block( VM_ADDR addr, SIZE sz ) +static void +Free_Addr_Block (VM_ADDR addr, size_t sz) { munmap ((caddr_t) addr, sz ); } @@ -1836,13 +1844,13 @@ /* IMPLEMENTATION OF EXPORTED RELOCATOR INTERFACE */ /* - r_alloc( POINTER, SIZE ): Allocate a relocatable area with the start + r_alloc (POINTER, SIZE): Allocate a relocatable area with the start address aliased to the first parameter. */ -POINTER r_alloc (POINTER *ptr, SIZE size); +POINTER r_alloc (POINTER *ptr, size_t size); POINTER -r_alloc (POINTER *ptr, SIZE size) +r_alloc (POINTER *ptr, size_t size) { MMAP_HANDLE mh; @@ -1857,8 +1865,8 @@ mh = new_mmap_handle( size ); if (mh) { - SIZE hysteresis = (mmap_hysteresis > 0 ? mmap_hysteresis : 0); - SIZE mmapped_size = ROUNDUP( size + hysteresis ); + size_t hysteresis = (mmap_hysteresis > 0 ? mmap_hysteresis : 0); + size_t mmapped_size = ROUNDUP( size + hysteresis ); MEMMETER( MVAL(M_Map)++ ) MEMMETER( MVAL(M_Pages_Map) += (mmapped_size/page_size) ) MEMMETER( MVAL(M_Wastage) += mmapped_size - size ) @@ -1926,9 +1934,9 @@ If more memory cannot be allocated, then leave *PTR unchanged, and return zero. */ -POINTER r_re_alloc (POINTER *ptr, SIZE sz); +POINTER r_re_alloc (POINTER *ptr, size_t sz); POINTER -r_re_alloc (POINTER *ptr, SIZE sz) +r_re_alloc (POINTER *ptr, size_t sz) { if (r_alloc_initialized == 0) { @@ -1944,8 +1952,8 @@ } else { - SIZE hysteresis = (mmap_hysteresis > 0 ? mmap_hysteresis : 0); - SIZE actual_sz = ROUNDUP( sz + hysteresis ); + size_t hysteresis = (mmap_hysteresis > 0 ? mmap_hysteresis : 0); + size_t actual_sz = ROUNDUP( sz + hysteresis ); MMAP_HANDLE h = find_mmap_handle( ptr ); VM_ADDR new_vm_addr; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/rangetab.c --- a/src/rangetab.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/rangetab.c Mon Aug 13 11:13:30 2007 +0200 @@ -41,20 +41,20 @@ is not hard but just requires moving that stuff out of that file. */ static Lisp_Object -mark_range_table (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_range_table (Lisp_Object obj) { - struct Lisp_Range_Table *rt = XRANGE_TABLE (obj); + Lisp_Range_Table *rt = XRANGE_TABLE (obj); int i; for (i = 0; i < Dynarr_length (rt->entries); i++) - markobj (Dynarr_at (rt->entries, i).val); + mark_object (Dynarr_at (rt->entries, i).val); return Qnil; } static void print_range_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { - struct Lisp_Range_Table *rt = XRANGE_TABLE (obj); + Lisp_Range_Table *rt = XRANGE_TABLE (obj); char buf[200]; int i; @@ -77,8 +77,8 @@ static int range_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { - struct Lisp_Range_Table *rt1 = XRANGE_TABLE (obj1); - struct Lisp_Range_Table *rt2 = XRANGE_TABLE (obj2); + Lisp_Range_Table *rt1 = XRANGE_TABLE (obj1); + Lisp_Range_Table *rt2 = XRANGE_TABLE (obj2); int i; if (Dynarr_length (rt1->entries) != Dynarr_length (rt2->entries)) @@ -107,7 +107,7 @@ static unsigned long range_table_hash (Lisp_Object obj, int depth) { - struct Lisp_Range_Table *rt = XRANGE_TABLE (obj); + Lisp_Range_Table *rt = XRANGE_TABLE (obj); int i; int size = Dynarr_length (rt->entries); unsigned long hash = size; @@ -132,10 +132,36 @@ return hash; } +static const struct lrecord_description rte_description_1[] = { + { XD_LISP_OBJECT, offsetof (range_table_entry, val) }, + { XD_END } +}; + +static const struct struct_description rte_description = { + sizeof (range_table_entry), + rte_description_1 +}; + +static const struct lrecord_description rted_description_1[] = { + XD_DYNARR_DESC (range_table_entry_dynarr, &rte_description), + { XD_END } +}; + +static const struct struct_description rted_description = { + sizeof (range_table_entry_dynarr), + rted_description_1 +}; + +static const struct lrecord_description range_table_description[] = { + { XD_STRUCT_PTR, offsetof (Lisp_Range_Table, entries), 1, &rted_description }, + { XD_END } +}; + DEFINE_LRECORD_IMPLEMENTATION ("range-table", range_table, mark_range_table, print_range_table, 0, range_table_equal, range_table_hash, - struct Lisp_Range_Table); + range_table_description, + Lisp_Range_Table); /************************************************************************/ /* Range table operations */ @@ -144,7 +170,7 @@ #ifdef ERROR_CHECK_TYPECHECK static void -verify_range_table (struct Lisp_Range_Table *rt) +verify_range_table (Lisp_Range_Table *rt) { int i; @@ -207,8 +233,8 @@ ()) { Lisp_Object obj; - struct Lisp_Range_Table *rt = alloc_lcrecord_type (struct Lisp_Range_Table, - lrecord_range_table); + Lisp_Range_Table *rt = alloc_lcrecord_type (Lisp_Range_Table, + &lrecord_range_table); rt->entries = Dynarr_new (range_table_entry); XSETRANGE_TABLE (obj, rt); return obj; @@ -220,13 +246,13 @@ */ (old_table)) { - struct Lisp_Range_Table *rt, *rtnew; + Lisp_Range_Table *rt, *rtnew; Lisp_Object obj; CHECK_RANGE_TABLE (old_table); rt = XRANGE_TABLE (old_table); - rtnew = alloc_lcrecord_type (struct Lisp_Range_Table, lrecord_range_table); + rtnew = alloc_lcrecord_type (Lisp_Range_Table, &lrecord_range_table); rtnew->entries = Dynarr_new (range_table_entry); Dynarr_add_many (rtnew->entries, Dynarr_atp (rt->entries, 0), @@ -241,7 +267,7 @@ */ (pos, table, default_)) { - struct Lisp_Range_Table *rt; + Lisp_Range_Table *rt; CHECK_RANGE_TABLE (table); rt = XRANGE_TABLE (table); @@ -258,7 +284,7 @@ { int i; int insert_me_here = -1; - struct Lisp_Range_Table *rt = XRANGE_TABLE (table); + Lisp_Range_Table *rt = XRANGE_TABLE (table); /* Now insert in the proper place. This gets tricky because we may be overlapping one or more existing ranges and need diff -r f4aeb21a5bad -r 74fd4e045ea6 src/rangetab.h --- a/src/rangetab.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/rangetab.h Mon Aug 13 11:13:30 2007 +0200 @@ -23,8 +23,8 @@ /* Extracted from rangetab.c by O. Galibert, 1998. */ -#ifndef _XEMACS_RANGETAB_H_ -#define _XEMACS_RANGETAB_H_ +#ifndef INCLUDED_rangetab_h_ +#define INCLUDED_rangetab_h_ typedef struct range_table_entry range_table_entry; struct range_table_entry @@ -44,13 +44,12 @@ struct lcrecord_header header; range_table_entry_dynarr *entries; }; +typedef struct Lisp_Range_Table Lisp_Range_Table; -DECLARE_LRECORD (range_table, struct Lisp_Range_Table); -#define XRANGE_TABLE(x) \ - XRECORD (x, range_table, struct Lisp_Range_Table) +DECLARE_LRECORD (range_table, Lisp_Range_Table); +#define XRANGE_TABLE(x) XRECORD (x, range_table, Lisp_Range_Table) #define XSETRANGE_TABLE(x, p) XSETRECORD (x, p, range_table) #define RANGE_TABLEP(x) RECORDP (x, range_table) -#define GC_RANGE_TABLEP(x) GC_RECORDP (x, range_table) #define CHECK_RANGE_TABLE(x) CHECK_RECORD (x, range_table) -#endif +#endif /* INCLUDED_rangetab_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/realpath.c --- a/src/realpath.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/realpath.c Mon Aug 13 11:13:30 2007 +0200 @@ -22,25 +22,20 @@ /* Synched up with: Not in FSF. */ -#ifdef HAVE_CONFIG_H #include <config.h> -#endif #include <sys/types.h> -#if defined(HAVE_UNISTD_H) || defined(STDC_HEADERS) +#include <stdio.h> +#include <string.h> +#include <errno.h> +#ifdef HAVE_UNISTD_H #include <unistd.h> #endif -#include <stdio.h> -#include <string.h> #ifdef _POSIX_VERSION #include <limits.h> /* for PATH_MAX */ #else #include <sys/param.h> /* for MAXPATHLEN */ #endif -#include <errno.h> -#ifndef STDC_HEADERS -extern int errno; -#endif #ifdef WINDOWSNT #include <direct.h> @@ -48,33 +43,32 @@ #include <sys/stat.h> /* for S_IFLNK */ +#if !defined (HAVE_GETCWD) && defined (HAVE_GETWD) +#undef getcwd +#define getcwd(buffer, len) getwd (buffer) +#endif + #ifndef PATH_MAX -#ifdef _POSIX_VERSION -#define PATH_MAX _POSIX_PATH_MAX -#else -#ifdef MAXPATHLEN -#define PATH_MAX MAXPATHLEN -#else -#define PATH_MAX 1024 -#endif -#endif +# if defined (_POSIX_PATH_MAX) +# define PATH_MAX _POSIX_PATH_MAX +# elif defined (MAXPATHLEN) +# define PATH_MAX MAXPATHLEN +# else +# define PATH_MAX 1024 +# endif #endif #define MAX_READLINKS 32 -#ifdef __STDC__ -char *xrealpath(const char *path, char resolved_path []) -#else -char *xrealpath(path, resolved_path) -const char *path; -char resolved_path []; -#endif +char * xrealpath (const char *path, char resolved_path []); +char * +xrealpath (const char *path, char resolved_path []) { char copy_path[PATH_MAX]; char *new_path = resolved_path; char *max_path; +#ifdef S_IFLNK int readlinks = 0; -#ifdef S_IFLNK char link_path[PATH_MAX]; int n; #endif @@ -109,7 +103,7 @@ */ else if (*path == '/') { - getcwd(new_path, PATH_MAX - 1); + getcwd (new_path, PATH_MAX - 1); new_path += 3; path++; } @@ -119,21 +113,17 @@ */ else { - getcwd(new_path, PATH_MAX - 1); + getcwd (new_path, PATH_MAX - 1); new_path += strlen(new_path); if (new_path[-1] != '/') *new_path++ = '/'; } #else - /* If it's a relative pathname use getwd for starters. */ + /* If it's a relative pathname use getcwd for starters. */ if (*path != '/') { -#ifdef HAVE_GETCWD - getcwd(new_path, PATH_MAX - 1); -#else - getwd(new_path); -#endif + getcwd (new_path, PATH_MAX - 1); new_path += strlen(new_path); if (new_path[-1] != '/') *new_path++ = '/'; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/redisplay-msw.c --- a/src/redisplay-msw.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/redisplay-msw.c Mon Aug 13 11:13:30 2007 +0200 @@ -26,8 +26,9 @@ Chuck Thompson Lots of work done by Ben Wing for Mule - Partially rewritten for mswindows by Jonathan Harris, November 1997 for 21.0. - */ + + Partially rewritten for mswindows by Jonathan Harris, November 1997 + for 21.0. */ #include <config.h> #include "lisp.h" @@ -41,11 +42,11 @@ #include "faces.h" #include "frame.h" #include "glyphs-msw.h" +#include "gutter.h" #include "redisplay.h" #include "sysdep.h" #include "window.h" -#include "windows.h" #ifdef MULE #include "mule-ccl.h" #include "mule-charset.h" @@ -56,25 +57,17 @@ /* * Random forward declarations */ -static void mswindows_update_dc (HDC hdc, Lisp_Object font, Lisp_Object fg, - Lisp_Object bg, Lisp_Object bg_pmap); +static void mswindows_update_dc (HDC hdc, Lisp_Object fg, Lisp_Object bg, + Lisp_Object bg_pmap); +static void mswindows_set_dc_font (HDC hdc, Lisp_Object font, + int under, int strike); static void mswindows_output_vertical_divider (struct window *w, int clear); static void mswindows_redraw_exposed_windows (Lisp_Object window, int x, int y, int width, int height); static void mswindows_output_dibitmap (struct frame *f, - struct Lisp_Image_Instance *p, - int x, int y, - int clip_x, int clip_y, - int clip_width, int clip_height, - int width, int height, - int pixmap_offset, - int offset_bitmap); -static void mswindows_output_pixmap (struct window *w, struct display_line *dl, - Lisp_Object image_instance, int xpos, - int xoffset, int start_pixpos, int width, - face_index findex, int cursor_start, - int cursor_width, int cursor_height, - int offset_bitmap); + Lisp_Image_Instance *p, + struct display_box* db, + struct display_glyph_area* dga); typedef struct textual_run { @@ -99,7 +92,7 @@ static int separate_textual_runs (unsigned char *text_storage, textual_run *run_storage, - CONST Emchar *str, Charcount len) + const Emchar *str, Charcount len) { Lisp_Object prev_charset = Qunbound; /* not Qnil because that is a possible valid charset when @@ -165,7 +158,7 @@ char_converter.reg[1] = byte1; char_converter.reg[2] = byte2; char_converter.ic = 0; /* start at beginning each time */ - ccl_driver (&char_converter, 0, 0, 0, 0); + ccl_driver (&char_converter, 0, 0, 0, 0, CCL_MODE_ENCODING); byte1 = char_converter.reg[1]; byte2 = char_converter.reg[2]; } @@ -192,7 +185,7 @@ textual_run *run) { Lisp_Object font_inst = FACE_CACHEL_FONT (cachel, run->charset); - struct Lisp_Font_Instance *fi = XFONT_INSTANCE (font_inst); + Lisp_Font_Instance *fi = XFONT_INSTANCE (font_inst); SIZE size; if (!fi->proportional_p || !hdc) @@ -200,12 +193,42 @@ else { assert(run->dimension == 1); /* #### FIXME! */ - mswindows_update_dc (hdc, font_inst, Qnil, Qnil, Qnil); + mswindows_set_dc_font (hdc, font_inst, + cachel->underline, cachel->strikethru); GetTextExtentPoint32 (hdc, run->ptr, run->len, &size); return(size.cx); } } +/* + * Given F, retrieve device context. F can be a display frame, or + * a print job. + */ +INLINE HDC +get_frame_dc (struct frame *f) +{ + if (FRAME_MSWINDOWS_P (f)) + return FRAME_MSWINDOWS_DC (f); + else + { + if (!FRAME_MSPRINTER_PAGE_STARTED (f)) + msprinter_start_page (f); + return DEVICE_MSPRINTER_HDC (XDEVICE (FRAME_DEVICE (f))); + } +} + +/* + * Given F, retrieve compatible device context. F can be a display + * frame, or a print job. + */ +INLINE HDC +get_frame_compdc (struct frame *f) +{ + if (FRAME_MSWINDOWS_P (f)) + return FRAME_MSWINDOWS_CDC (f); + else + return FRAME_MSPRINTER_CDC (f); +} /***************************************************************************** mswindows_update_dc @@ -213,18 +236,15 @@ Given a number of parameters munge the DC so it has those properties. ****************************************************************************/ static void -mswindows_update_dc (HDC hdc, Lisp_Object font, Lisp_Object fg, - Lisp_Object bg, Lisp_Object bg_pmap) +mswindows_update_dc (HDC hdc, Lisp_Object fg, Lisp_Object bg, + Lisp_Object bg_pmap) { - if (!NILP (font)) - SelectObject(hdc, FONT_INSTANCE_MSWINDOWS_HFONT (XFONT_INSTANCE (font))); - - if (!NILP (fg)) { SetTextColor (hdc, COLOR_INSTANCE_MSWINDOWS_COLOR (XCOLOR_INSTANCE (fg))); } + if (!NILP (bg)) { SetBkMode (hdc, OPAQUE); @@ -236,54 +256,13 @@ } } - -/***************************************************************************** - mswindows_apply_face_effects - - Draw underline and strikeout as if this was X. - #### On mswindows this really should be done as part of drawing the font. - The line width used is chosen arbitrarily from the font height. - ****************************************************************************/ -static void -mswindows_apply_face_effects (HDC hdc, struct display_line *dl, int xpos, - int width, struct Lisp_Font_Instance *fi, - struct face_cachel *cachel, - struct face_cachel *color_cachel) +static void mswindows_set_dc_font (HDC hdc, Lisp_Object font, + int under, int strike) { - int yclip; - HBRUSH brush, oldbrush; - RECT rect; - - brush = CreateSolidBrush (COLOR_INSTANCE_MSWINDOWS_COLOR ( - XCOLOR_INSTANCE (color_cachel->foreground))); - if (brush) - { - yclip = dl->ypos + dl->descent - dl->clip; - rect.left = xpos; - rect.right = xpos + width; - oldbrush = SelectObject (hdc, brush); - - if (cachel->underline) - { - rect.top = dl->ypos + dl->descent/2; - rect.bottom = rect.top + (fi->height >= 0x20 ? 2 : 1); - if (rect.bottom <= yclip) - FillRect (hdc, &rect, brush); - } - if (cachel->strikethru) - { - rect.top = dl->ypos + dl->descent - (dl->ascent + dl->descent)/2; - rect.bottom = rect.top + (fi->height >= 0x20 ? 2 : 1); - if (rect.bottom <= yclip) - FillRect (hdc, &rect, brush); - } - - SelectObject (hdc, oldbrush); - DeleteObject (brush); - } + SelectObject(hdc, mswindows_get_hfont (XFONT_INSTANCE (font), + under, strike)); } - /***************************************************************************** mswindows_output_hline @@ -302,37 +281,44 @@ of its face. ****************************************************************************/ static void -mswindows_output_blank (struct window *w, struct display_line *dl, struct rune *rb, int start_pixpos) +mswindows_output_blank (struct window *w, struct display_line *dl, + struct rune *rb, int start_pixpos) { struct frame *f = XFRAME (w->frame); - RECT rect = { rb->xpos, dl->ypos-dl->ascent, - rb->xpos+rb->width, dl->ypos+dl->descent-dl->clip }; + HDC hdc = get_frame_dc (f); + RECT rect = { rb->xpos, DISPLAY_LINE_YPOS (dl), + rb->xpos+rb->width, + DISPLAY_LINE_YEND (dl) }; struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, rb->findex); Lisp_Object bg_pmap = WINDOW_FACE_CACHEL_BACKGROUND_PIXMAP (w, rb->findex); + /* Unmap all subwindows in the area we are going to blank. */ + redisplay_unmap_subwindows_maybe (f, rb->xpos, DISPLAY_LINE_YPOS (dl), + rb->width, DISPLAY_LINE_HEIGHT (dl)); + if (!IMAGE_INSTANCEP (bg_pmap) || !IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap))) bg_pmap = Qnil; if (!NILP(bg_pmap)) { + struct display_box db; + struct display_glyph_area dga; + redisplay_calculate_display_boxes (dl, rb->xpos, + /*rb->object.dglyph.xoffset*/ 0, + start_pixpos, rb->width, + &db, &dga); /* blank the background in the appropriate color */ - mswindows_update_dc (FRAME_MSWINDOWS_DC (f), Qnil, cachel->foreground, + mswindows_update_dc (hdc, cachel->foreground, cachel->background, Qnil); - - mswindows_output_pixmap (w, dl, bg_pmap, - rb->xpos, 0 /*rb->object.dglyph.xoffset*/, - start_pixpos, rb->width, rb->findex, + redisplay_output_pixmap (w, bg_pmap, &db, &dga, rb->findex, 0, 0, 0, TRUE); } else { - mswindows_update_dc (FRAME_MSWINDOWS_DC (f), Qnil, Qnil, - cachel->background, Qnil); - - ExtTextOut (FRAME_MSWINDOWS_DC (f), 0, 0, ETO_OPAQUE, - &rect, NULL, 0, NULL); + mswindows_update_dc (hdc, Qnil, cachel->background, Qnil); + ExtTextOut (hdc, 0, 0, ETO_OPAQUE, &rect, NULL, 0, NULL); } } @@ -352,20 +338,24 @@ struct face_cachel *cachel=0; Lisp_Object font = Qnil; int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d)); - HDC hdc = FRAME_MSWINDOWS_DC (f); - unsigned int face_index=0; + HDC hdc = get_frame_dc (f); + unsigned int local_face_index=0; char *p_char = NULL; int n_char = 0; RECT rect = { xpos, - dl->ypos - dl->ascent, + DISPLAY_LINE_YPOS (dl), xpos + width, - dl->ypos + dl->descent - dl->clip}; + DISPLAY_LINE_YEND (dl) }; Lisp_Object bar = symbol_value_in_buffer (Qbar_cursor, WINDOW_BUFFER (w)); int bar_p = image_p || !NILP (bar); int cursor_p = !NILP (w->text_cursor_visible_p); int real_char_p = ch != 0; + /* Unmap all subwindows in the area we are going to blank. */ + redisplay_unmap_subwindows_maybe (f, xpos, DISPLAY_LINE_YPOS (dl), + width, DISPLAY_LINE_HEIGHT (dl)); + if (real_char_p) { /* Use the font from the underlying character */ @@ -388,16 +378,16 @@ /* Use cursor fg/bg for block cursor, or character fg/bg for the bar or when we need to erase the cursor. Output nothing at eol if bar cursor */ - face_index = get_builtin_face_cache_index (w, Vtext_cursor_face); + local_face_index = get_builtin_face_cache_index (w, Vtext_cursor_face); color_cachel = WINDOW_FACE_CACHEL (w, ((!cursor_p || bar_p) ? - findex : face_index)); - mswindows_update_dc (hdc, font, color_cachel->foreground, + findex : local_face_index)); + mswindows_update_dc (hdc, color_cachel->foreground, color_cachel->background, Qnil); + if (real_char_p) + mswindows_set_dc_font (hdc, font, + cachel->underline, cachel->strikethru); + ExtTextOut (hdc, xpos, dl->ypos, ETO_OPAQUE|ETO_CLIPPED, &rect, p_char, n_char, NULL); - if (real_char_p && (cachel->underline || cachel->strikethru)) - mswindows_apply_face_effects (hdc, dl, xpos, width, - XFONT_INSTANCE (font), - cachel, color_cachel); } if (!cursor_p) @@ -406,9 +396,9 @@ if (focus && bar_p) { rect.right = rect.left + (EQ (bar, Qt) ? 1 : min (2, width)); - face_index = get_builtin_face_cache_index (w, Vtext_cursor_face); - cachel = WINDOW_FACE_CACHEL (w, face_index); - mswindows_update_dc (hdc, Qnil, Qnil, cachel->background, Qnil); + local_face_index = get_builtin_face_cache_index (w, Vtext_cursor_face); + cachel = WINDOW_FACE_CACHEL (w, local_face_index); + mswindows_update_dc (hdc, Qnil, cachel->background, Qnil); ExtTextOut (hdc, xpos, dl->ypos, ETO_OPAQUE, &rect, NULL, 0, NULL); } else if (!focus) @@ -424,16 +414,12 @@ n_char = 1; } - face_index = get_builtin_face_cache_index (w, Vdefault_face); - cachel = WINDOW_FACE_CACHEL (w, (real_char_p ? findex : face_index)); - mswindows_update_dc (hdc, Qnil, cachel->foreground, - cachel->background, Qnil); + local_face_index = get_builtin_face_cache_index (w, Vdefault_face); + cachel = WINDOW_FACE_CACHEL (w, (real_char_p ? findex : local_face_index)); + mswindows_update_dc (hdc, + cachel->foreground, cachel->background, Qnil); ExtTextOut (hdc, xpos, dl->ypos, ETO_OPAQUE | ETO_CLIPPED, &rect, p_char, n_char, NULL); - if (cachel->underline || cachel->strikethru) - mswindows_apply_face_effects (hdc, dl, xpos+1, width-2, - XFONT_INSTANCE (font), - cachel, cachel); } } @@ -462,15 +448,17 @@ FINDEX Index for the face cache element describing how to display the text. ****************************************************************************/ -void +static void mswindows_output_string (struct window *w, struct display_line *dl, - Emchar_dynarr *buf, int xpos, int xoffset, int clip_start, - int width, face_index findex) + Emchar_dynarr *buf, int xpos, int xoffset, int clip_start, + int width, face_index findex, + int cursor, int cursor_start, int cursor_width, + int cursor_height) { struct frame *f = XFRAME (w->frame); /* struct device *d = XDEVICE (f->device);*/ Lisp_Object window; - HDC hdc = FRAME_MSWINDOWS_DC (f); + HDC hdc = get_frame_dc (f); int clip_end; Lisp_Object bg_pmap; int len = Dynarr_length (buf); @@ -504,9 +492,13 @@ /* sort out the destination rectangle */ height = DISPLAY_LINE_HEIGHT (dl); rect.left = clip_start; - rect.top = dl->ypos - dl->ascent; + rect.top = DISPLAY_LINE_YPOS (dl); rect.right = clip_end; - rect.bottom = height + dl->ypos - dl->ascent; + rect.bottom = rect.top + height; + + /* make sure the area we are about to display is subwindow free. */ + redisplay_unmap_subwindows_maybe (f, clip_start, DISPLAY_LINE_YPOS (dl), + clip_end - clip_start, DISPLAY_LINE_HEIGHT (dl)); /* output the background pixmap if there is one */ bg_pmap = cachel->background_pixmap; @@ -516,13 +508,14 @@ if (!NILP(bg_pmap)) { + struct display_box db; + struct display_glyph_area dga; + redisplay_calculate_display_boxes (dl, xpos + xoffset, 0, + clip_start, width, &db, &dga); /* blank the background in the appropriate color */ - mswindows_update_dc (hdc, Qnil, cachel->foreground, - cachel->background, Qnil); - - mswindows_output_pixmap (w, dl, bg_pmap, - xpos, xoffset, - clip_start, width, findex, + mswindows_update_dc (hdc, + cachel->foreground, cachel->background, Qnil); + redisplay_output_pixmap (w, bg_pmap, &db, &dga, findex, 0, 0, 0, TRUE); /* output pixmap calls this so we have to recall to get correct references */ @@ -535,26 +528,27 @@ for (i = 0; i < nruns; i++) { Lisp_Object font = FACE_CACHEL_FONT (cachel, runs[i].charset); - struct Lisp_Font_Instance *fi = XFONT_INSTANCE (font); + Lisp_Font_Instance *fi = XFONT_INSTANCE (font); int this_width; if (EQ (font, Vthe_null_font_instance)) continue; - mswindows_update_dc (hdc, font, cachel->foreground, + mswindows_update_dc (hdc, cachel->foreground, NILP(bg_pmap) ? cachel->background : Qnil, Qnil); + mswindows_set_dc_font (hdc, font, cachel->underline, cachel->strikethru); this_width = mswindows_text_width_single_run (hdc, cachel, runs + i); /* cope with fonts taller than lines */ - if ((int) fi->height < (int) (height + dl->clip)) + if ((int) fi->height < (int) (height + dl->clip + dl->top_clip)) { int clear_start = max (xpos, clip_start); int clear_end = min (xpos + this_width, clip_end); { redisplay_clear_region (window, findex, clear_start, - dl->ypos - dl->ascent, + DISPLAY_LINE_YPOS (dl), clear_end - clear_start, height); /* output pixmap calls this so we have to recall to get correct @@ -568,42 +562,19 @@ NILP(bg_pmap) ? ETO_CLIPPED | ETO_OPAQUE : ETO_CLIPPED, &rect, (char *) runs[i].ptr, runs[i].len, NULL); - /* #### X does underline/strikethrough here so we do the same. - On mswindows, underline/strikethrough really belongs to the font */ - if (cachel->underline || cachel->strikethru) - mswindows_apply_face_effects (hdc, dl, xpos, this_width, fi, - cachel, cachel); xpos += this_width; } } static void -mswindows_output_dibitmap (struct frame *f, struct Lisp_Image_Instance *p, - int x, int y, - int clip_x, int clip_y, - int clip_width, int clip_height, - int width, int height, int pixmap_offset, - int offset_bitmap) +mswindows_output_dibitmap (struct frame *f, Lisp_Image_Instance *p, + struct display_box* db, + struct display_glyph_area* dga) { - HDC hdc = FRAME_MSWINDOWS_DC (f); + HDC hdc = get_frame_dc (f); + HDC hcompdc = get_frame_compdc (f); HGDIOBJ old=NULL; COLORREF bgcolor = GetBkColor (hdc); - int need_clipping = (clip_x || clip_y); - int yoffset=0; - int xoffset=0; - - /* do we need to offset the pixmap vertically? this is necessary - for background pixmaps. */ - if (offset_bitmap) - { - yoffset = y % IMAGE_INSTANCE_PIXMAP_HEIGHT (p); - xoffset = x % IMAGE_INSTANCE_PIXMAP_WIDTH (p); - /* the width is handled by mswindows_output_pixmap_region */ - } - - if (need_clipping) - { - } /* first blt the mask */ if (IMAGE_INSTANCE_MSWINDOWS_MASK (p)) @@ -614,200 +585,118 @@ col.rgbGreen = GetGValue (bgcolor); col.rgbReserved = 0; - old = SelectObject (FRAME_MSWINDOWS_CDC (f), - IMAGE_INSTANCE_MSWINDOWS_MASK (p)); + old = SelectObject (hcompdc, IMAGE_INSTANCE_MSWINDOWS_MASK (p)); - SetDIBColorTable (FRAME_MSWINDOWS_CDC (f), 1, 1, &col); + SetDIBColorTable (hcompdc, 1, 1, &col); BitBlt (hdc, - x,y, - width, height, - FRAME_MSWINDOWS_CDC (f), - xoffset,yoffset, + db->xpos, db->ypos, + dga->width, dga->height, + hcompdc, + dga->xoffset, dga->yoffset, SRCCOPY); - SelectObject (FRAME_MSWINDOWS_CDC (f), old); + SelectObject (hcompdc, old); } - /* now blt the bitmap itself. */ - old = SelectObject (FRAME_MSWINDOWS_CDC (f), - IMAGE_INSTANCE_MSWINDOWS_BITMAP (p)); + /* Now blt the bitmap itself, or one of its slices. */ + old = SelectObject (hcompdc, + IMAGE_INSTANCE_MSWINDOWS_BITMAP_SLICE + (p, IMAGE_INSTANCE_PIXMAP_SLICE (p))); BitBlt (hdc, - x,y, - width, height, - FRAME_MSWINDOWS_CDC (f), - xoffset, yoffset, + db->xpos, db->ypos, + dga->width, dga->height, + hcompdc, + dga->xoffset, dga->yoffset, IMAGE_INSTANCE_MSWINDOWS_MASK (p) ? SRCINVERT : SRCCOPY); - SelectObject (FRAME_MSWINDOWS_CDC (f),old); - - if (need_clipping) - { - } + SelectObject (hcompdc, old); } -/* - * X gc's have this nice property that setting the bg pixmap will +/* X gc's have this nice property that setting the bg pixmap will * output it offset relative to the window. Windows doesn't have this - * feature so we have to emulate this by outputting multiple pixmaps - */ + * feature so we have to emulate this by outputting multiple pixmaps. + * This is only used for background pixmaps. Normal pixmaps are + * outputted once and are scrollable */ static void mswindows_output_dibitmap_region (struct frame *f, - struct Lisp_Image_Instance *p, - int x, int y, - int clip_x, int clip_y, - int clip_width, int clip_height, - int width, int height, int pixmap_offset, - int offset_bitmap) + Lisp_Image_Instance *p, + struct display_box *db, + struct display_glyph_area *dga) { - int pwidth = min (width, IMAGE_INSTANCE_PIXMAP_WIDTH (p)); - int pheight = min (height, IMAGE_INSTANCE_PIXMAP_HEIGHT (p)); + struct display_box xdb = { db->xpos, db->ypos, db->width, db->height }; + struct display_glyph_area xdga + = { 0, 0, IMAGE_INSTANCE_PIXMAP_WIDTH (p), + IMAGE_INSTANCE_PIXMAP_HEIGHT (p) }; int pxoffset = 0, pyoffset = 0; + if (dga) + { + xdga.width = dga->width; + xdga.height = dga->height; + } + else if (!redisplay_normalize_glyph_area (&xdb, &xdga)) + return; + /* when doing a bg pixmap do a partial pixmap first so that we blt whole pixmaps thereafter */ + xdga.height = min (xdga.height, IMAGE_INSTANCE_PIXMAP_HEIGHT (p) - + db->ypos % IMAGE_INSTANCE_PIXMAP_HEIGHT (p)); - if (offset_bitmap) + while (xdga.height > 0) { - pheight = min (pheight, IMAGE_INSTANCE_PIXMAP_HEIGHT (p) - - y % IMAGE_INSTANCE_PIXMAP_HEIGHT (p)); - } - - while (pheight > 0) - { - if (offset_bitmap) + xdga.width = min (min (db->width, IMAGE_INSTANCE_PIXMAP_WIDTH (p)), + IMAGE_INSTANCE_PIXMAP_WIDTH (p) - + db->xpos % IMAGE_INSTANCE_PIXMAP_WIDTH (p)); + pxoffset = 0; + while (xdga.width > 0) { - pwidth = min (min (width, IMAGE_INSTANCE_PIXMAP_WIDTH (p)), - IMAGE_INSTANCE_PIXMAP_WIDTH (p) - - x % IMAGE_INSTANCE_PIXMAP_WIDTH (p)); - pxoffset = 0; + xdb.xpos = db->xpos + pxoffset; + xdb.ypos = db->ypos + pyoffset; + /* do we need to offset the pixmap vertically? this is necessary + for background pixmaps. */ + xdga.yoffset = xdb.ypos % IMAGE_INSTANCE_PIXMAP_HEIGHT (p); + xdga.xoffset = xdb.xpos % IMAGE_INSTANCE_PIXMAP_WIDTH (p); + /* the width is handled by mswindows_output_pixmap_region */ + mswindows_output_dibitmap (f, p, &xdb, &xdga); + pxoffset += xdga.width; + xdga.width = min ((db->width - pxoffset), + IMAGE_INSTANCE_PIXMAP_WIDTH (p)); } - while (pwidth > 0) - { - mswindows_output_dibitmap (f, p, - x + pxoffset, y + pyoffset, - clip_x, clip_y, - clip_width, clip_height, - pwidth, pheight, pixmap_offset, - offset_bitmap); - pxoffset += pwidth; - pwidth = min ((width-pxoffset), - IMAGE_INSTANCE_PIXMAP_WIDTH (p)); - } - pyoffset += pheight; - pheight = min ((height-pyoffset), - IMAGE_INSTANCE_PIXMAP_HEIGHT (p)); + pyoffset += xdga.height; + xdga.height = min ((db->height - pyoffset), + IMAGE_INSTANCE_PIXMAP_HEIGHT (p)); } } +/* Output a pixmap at the desired location. + DB normalized display_box. + DGA normalized display_glyph_area. */ static void -mswindows_output_pixmap (struct window *w, struct display_line *dl, - Lisp_Object image_instance, int xpos, int xoffset, - int start_pixpos, int width, face_index findex, - int cursor_start, int cursor_width, int cursor_height, - int offset_bitmap) +mswindows_output_pixmap (struct window *w, Lisp_Object image_instance, + struct display_box *db, struct display_glyph_area *dga, + face_index findex, int cursor_start, int cursor_width, + int cursor_height, int bg_pixmap) { struct frame *f = XFRAME (w->frame); - HDC hdc = FRAME_MSWINDOWS_DC (f); - - struct Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance); - Lisp_Object window; + HDC hdc = get_frame_dc (f); - int lheight = DISPLAY_LINE_HEIGHT (dl); - int pheight = ((int) IMAGE_INSTANCE_PIXMAP_HEIGHT (p) > lheight ? lheight : - IMAGE_INSTANCE_PIXMAP_HEIGHT (p)); - int clip_x, clip_y, clip_width, clip_height; - - /* The pixmap_offset is used to center the pixmap on lines which are - shorter than it is. This results in odd effects when scrolling - pixmaps off of the bottom. Let's try not using it. */ -#if 0 - int pixmap_offset = (int) (IMAGE_INSTANCE_PIXMAP_HEIGHT (p) - lheight) / 2; -#else - int pixmap_offset = 0; -#endif + Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance); + Lisp_Object window; XSETWINDOW (window, w); - if ((start_pixpos >= 0 && start_pixpos > xpos) || xoffset) - { - if (start_pixpos > xpos && start_pixpos > xpos + width) - return; - - clip_x = xoffset; - clip_width = width; - if (start_pixpos > xpos) - { - clip_x += (start_pixpos - xpos); - clip_width -= (start_pixpos - xpos); - } - } - else - { - clip_x = 0; - clip_width = 0; - } - - /* Place markers for possible future functionality (clipping the top - half instead of the bottom half; think pixel scrolling). */ - clip_y = 0; - clip_height = pheight; - - /* Clear the area the pixmap is going into. The pixmap itself will - always take care of the full width. We don't want to clear where - it is going to go in order to avoid flicker. So, all we have to - take care of is any area above or below the pixmap. */ - /* #### We take a shortcut for now. We know that since we have - pixmap_offset hardwired to 0 that the pixmap is against the top - edge so all we have to worry about is below it. */ - /* #### Unless the pixmap has a mask in which case we have to clear - the whole damn thing since we can't yet clear just the area not - included in the mask. */ - if (((int) (dl->ypos - dl->ascent + pheight) < - (int) (dl->ypos + dl->descent - dl->clip)) - || IMAGE_INSTANCE_MSWINDOWS_MASK (p)) - { - int clear_x, clear_y, clear_width, clear_height; - - if (IMAGE_INSTANCE_MSWINDOWS_MASK (p)) - { - clear_y = dl->ypos - dl->ascent; - clear_height = lheight; - } - else - { - clear_y = dl->ypos - dl->ascent + pheight; - clear_height = lheight - pheight; - } - - if (start_pixpos >= 0 && start_pixpos > xpos) - { - clear_x = start_pixpos; - clear_width = xpos + width - start_pixpos; - } - else - { - clear_x = xpos; - clear_width = width; - } - - if (!offset_bitmap) /* i.e. not a bg pixmap */ - redisplay_clear_region (window, findex, clear_x, clear_y, - clear_width, clear_height); - } - /* Output the pixmap. Have to do this as many times as is required to fill the given area */ - mswindows_update_dc (hdc, Qnil, + mswindows_update_dc (hdc, WINDOW_FACE_CACHEL_FOREGROUND (w, findex), WINDOW_FACE_CACHEL_BACKGROUND (w, findex), Qnil); - mswindows_output_dibitmap_region (f, p, xpos - xoffset, - dl->ypos - dl->ascent, - clip_x, clip_y, clip_width, clip_height, - width + xoffset, pheight, pixmap_offset, - offset_bitmap); + if (bg_pixmap) + mswindows_output_dibitmap_region (f, p, db, dga); + else + mswindows_output_dibitmap (f, p, db, dga); } #ifdef HAVE_SCROLLBARS @@ -819,7 +708,7 @@ * to by PRC, and paints only the intersection */ static void -mswindows_redisplay_deadbox_maybe (struct window *w, CONST RECT* prc) +mswindows_redisplay_deadbox_maybe (struct window *w, const RECT* prc) { int sbh = window_scrollbar_height (w); int sbw = window_scrollbar_width (w); @@ -842,7 +731,7 @@ if (IntersectRect (&rect_paint, &rect_dead, prc)) { struct frame *f = XFRAME (WINDOW_FRAME (w)); - FillRect (FRAME_MSWINDOWS_DC (f), &rect_paint, + FillRect (get_frame_dc (f), &rect_paint, (HBRUSH) (COLOR_BTNFACE+1)); } } @@ -899,12 +788,11 @@ for (line = 0; line < Dynarr_length (cdla); line++) { struct display_line *cdl = Dynarr_atp (cdla, line); - int top_y = cdl->ypos - cdl->ascent; - int bottom_y = cdl->ypos + cdl->descent; - if (bottom_y >= rect_draw.top) + if (DISPLAY_LINE_YPOS (cdl) + DISPLAY_LINE_HEIGHT (cdl) + >= rect_draw.top) { - if (top_y > rect_draw.bottom) + if (DISPLAY_LINE_YPOS (cdl) > rect_draw.bottom) { if (line == 0) continue; @@ -965,6 +853,7 @@ redraw anyhow. */ MAYBE_FRAMEMETH (f, redraw_exposed_toolbars, (f, x, y, width, height)); #endif + redraw_exposed_gutters (f, x, y, width, height); if (!f->window_face_cache_reset) { @@ -977,38 +866,55 @@ /***************************************************************************** - mswindows_bevel_modeline + mswindows_bevel_area - Draw a 3d border around the modeline on window W. + Draw a 3d border around the specified area on window W. ****************************************************************************/ static void -mswindows_bevel_modeline (struct window *w, struct display_line *dl) +mswindows_bevel_area (struct window *w, face_index findex, int x, int y, + int width, int height, int thickness, + int edges, enum edge_style style) { struct frame *f = XFRAME (w->frame); - Lisp_Object color; - int shadow_width = MODELINE_SHADOW_THICKNESS (w); - RECT rect = { WINDOW_MODELINE_LEFT (w), - dl->ypos - dl->ascent - shadow_width, - WINDOW_MODELINE_RIGHT (w), - dl->ypos + dl->descent + shadow_width}; UINT edge; - - color = WINDOW_FACE_CACHEL_BACKGROUND (w, MODELINE_INDEX); - mswindows_update_dc (FRAME_MSWINDOWS_DC (f), Qnil, Qnil, color, Qnil); + UINT border = 0; - if (XINT (w->modeline_shadow_thickness) < 0) - shadow_width = -shadow_width; + if (style == EDGE_ETCHED_IN) + edge = EDGE_ETCHED; + else if (style == EDGE_ETCHED_OUT) + edge = EDGE_BUMP; + else if (style == EDGE_BEVEL_IN) + { + if (thickness == 1) + edge = BDR_SUNKENINNER; + else + edge = EDGE_SUNKEN; + } + else /* EDGE_BEVEL_OUT */ + { + if (thickness == 1) + edge = BDR_RAISEDINNER; + else + edge = EDGE_RAISED; + } - if (shadow_width < -1) - edge = EDGE_SUNKEN; - else if (shadow_width < 0) - edge = BDR_SUNKENINNER; - else if (shadow_width == 1) - edge = BDR_RAISEDINNER; - else - edge = EDGE_RAISED; - - DrawEdge (FRAME_MSWINDOWS_DC (f), &rect, edge, BF_RECT); + if (edges & EDGE_TOP) + border |= BF_TOP; + if (edges & EDGE_LEFT) + border |= BF_LEFT; + if (edges & EDGE_BOTTOM) + border |= BF_BOTTOM; + if (edges & EDGE_RIGHT) + border |= BF_RIGHT; + + { + RECT rect = { x, y, x + width, y + height }; + Lisp_Object color = WINDOW_FACE_CACHEL_BACKGROUND (w, findex); + HDC hdc = get_frame_dc (f); + + mswindows_update_dc (hdc, Qnil, color, Qnil); + DrawEdge (hdc, &rect, edge, border); + } } @@ -1063,13 +969,14 @@ mswindows_flash (struct device *d) { struct frame *f = device_selected_frame (d); + HDC hdc = get_frame_dc (f); RECT rc; GetClientRect (FRAME_MSWINDOWS_HANDLE (f), &rc); - InvertRect (FRAME_MSWINDOWS_DC (f), &rc); + InvertRect (hdc, &rc); GdiFlush (); Sleep (25); - InvertRect (FRAME_MSWINDOWS_DC (f), &rc); + InvertRect (hdc, &rc); return 1; } @@ -1110,18 +1017,14 @@ rb = Dynarr_atp (rba, start); if (!rb) - { /* Nothing to do so don't do anything. */ return; - } - else - { - findex = rb->findex; - xpos = rb->xpos; - width = 0; - if (rb->type == RUNE_CHAR) - charset = CHAR_CHARSET (rb->object.chr.ch); - } + + findex = rb->findex; + xpos = rb->xpos; + width = 0; + if (rb->type == RUNE_CHAR) + charset = CHAR_CHARSET (rb->object.chr.ch); if (end < 0) end = Dynarr_length (rba); @@ -1144,7 +1047,7 @@ if (Dynarr_length (buf)) { mswindows_output_string (w, dl, buf, xpos, 0, start_pixpos, width, - findex); + findex, 0, 0, 0, 0); xpos = rb->xpos; width = 0; } @@ -1178,10 +1081,9 @@ else if (rb->object.chr.ch == '\n') { /* Clear in case a cursor was formerly here. */ - int height = DISPLAY_LINE_HEIGHT (dl); - - redisplay_clear_region (window, findex, xpos, dl->ypos - dl->ascent, - rb->width, height); + redisplay_clear_region (window, findex, xpos, + DISPLAY_LINE_YPOS (dl), + rb->width, DISPLAY_LINE_HEIGHT (dl)); elt++; } } @@ -1217,6 +1119,11 @@ else if (rb->type == RUNE_DGLYPH) { Lisp_Object instance; + struct display_box dbox; + struct display_glyph_area dga; + redisplay_calculate_display_boxes (dl, rb->xpos, rb->object.dglyph.xoffset, + start_pixpos, rb->width, + &dbox, &dga); XSETWINDOW (window, w); instance = glyph_image_instance (rb->object.dglyph.glyph, @@ -1241,17 +1148,17 @@ else /* #### redisplay-x passes -1 as the width: why ? */ mswindows_output_string (w, dl, buf, xpos, rb->object.dglyph.xoffset, - start_pixpos, rb->width, findex); + start_pixpos, rb->width, findex, + 0, 0, 0, 0); Dynarr_reset (buf); } break; case IMAGE_MONO_PIXMAP: case IMAGE_COLOR_PIXMAP: - mswindows_output_pixmap (w, dl, instance, xpos, - rb->object.dglyph.xoffset, start_pixpos, - rb->width, findex, cursor_start, - cursor_width, cursor_height, 0); + redisplay_output_pixmap (w, instance, &dbox, &dga, findex, + cursor_start, cursor_width, + cursor_height, 0); if (rb->cursor_type == CURSOR_ON) mswindows_output_cursor (w, dl, xpos, cursor_width, findex, 0, 1); @@ -1262,10 +1169,18 @@ case IMAGE_SUBWINDOW: case IMAGE_WIDGET: - redisplay_output_subwindow (w, dl, instance, xpos, - rb->object.dglyph.xoffset, start_pixpos, - rb->width, findex, cursor_start, - cursor_width, cursor_height); + redisplay_output_subwindow (w, instance, &dbox, &dga, findex, + cursor_start, cursor_width, + cursor_height); + if (rb->cursor_type == CURSOR_ON) + mswindows_output_cursor (w, dl, xpos, cursor_width, + findex, 0, 1); + break; + + case IMAGE_LAYOUT: + redisplay_output_layout (w, instance, &dbox, &dga, findex, + cursor_start, cursor_width, + cursor_height); if (rb->cursor_type == CURSOR_ON) mswindows_output_cursor (w, dl, xpos, cursor_width, findex, 0, 1); @@ -1288,14 +1203,15 @@ } if (Dynarr_length (buf)) - mswindows_output_string (w, dl, buf, xpos, 0, start_pixpos, width, findex); + mswindows_output_string (w, dl, buf, xpos, 0, start_pixpos, width, findex, + 0, 0, 0, 0); if (dl->modeline && !EQ (Qzero, w->modeline_shadow_thickness) && (f->clear || f->windows_structure_changed || w->shadow_thickness_changed)) - mswindows_bevel_modeline (w, dl); + bevel_modeline (w, dl); Dynarr_free (buf); } @@ -1310,43 +1226,45 @@ mswindows_output_vertical_divider (struct window *w, int clear_unused) { struct frame *f = XFRAME (w->frame); + HDC hdc = get_frame_dc (f); RECT rect; int spacing = XINT (w->vertical_divider_spacing); int shadow = XINT (w->vertical_divider_shadow_thickness); int abs_shadow = abs (shadow); int line_width = XINT (w->vertical_divider_line_width); int div_left = WINDOW_RIGHT (w) - window_divider_width (w); + int y1 = WINDOW_TOP (w) + FRAME_TOP_GUTTER_BOUNDS (f); + int y2 = WINDOW_BOTTOM (w) + FRAME_BOTTOM_GUTTER_BOUNDS (f); /* Clear left and right spacing areas */ if (spacing) { - rect.top = WINDOW_TOP (w); - rect.bottom = WINDOW_BOTTOM (w); - mswindows_update_dc (FRAME_MSWINDOWS_DC (f), Qnil, Qnil, + rect.top = y1; + rect.bottom = y2; + mswindows_update_dc (hdc, Qnil, WINDOW_FACE_CACHEL_BACKGROUND (w, DEFAULT_INDEX), Qnil); rect.right = WINDOW_RIGHT (w); rect.left = rect.right - spacing; - ExtTextOut (FRAME_MSWINDOWS_DC (f), 0, 0, ETO_OPAQUE, + ExtTextOut (hdc, 0, 0, ETO_OPAQUE, &rect, NULL, 0, NULL); rect.left = div_left; rect.right = div_left + spacing; - ExtTextOut (FRAME_MSWINDOWS_DC (f), 0, 0, ETO_OPAQUE, + ExtTextOut (hdc, 0, 0, ETO_OPAQUE, &rect, NULL, 0, NULL); } /* Clear divider face */ - rect.top = WINDOW_TOP (w) + abs_shadow; - rect.bottom = WINDOW_BOTTOM (w) - abs_shadow; + rect.top = y1 + abs_shadow; + rect.bottom = y2 - abs_shadow; rect.left = div_left + spacing + abs_shadow; rect.right = rect.left + line_width; if (rect.left < rect.right) { face_index div_face = get_builtin_face_cache_index (w, Vvertical_divider_face); - mswindows_update_dc (FRAME_MSWINDOWS_DC (f), Qnil, Qnil, + mswindows_update_dc (hdc, Qnil, WINDOW_FACE_CACHEL_BACKGROUND (w, div_face), Qnil); - ExtTextOut (FRAME_MSWINDOWS_DC (f), 0, 0, ETO_OPAQUE, - &rect, NULL, 0, NULL); + ExtTextOut (hdc, 0, 0, ETO_OPAQUE, &rect, NULL, 0, NULL); } /* Draw a shadow around the divider */ @@ -1354,7 +1272,7 @@ { /* #### This will be fixed to support arbitrary thickness */ InflateRect (&rect, abs_shadow, abs_shadow); - DrawEdge (FRAME_MSWINDOWS_DC (f), &rect, + DrawEdge (hdc, &rect, shadow > 0 ? EDGE_RAISED : EDGE_SUNKEN, BF_RECT); } } @@ -1367,8 +1285,9 @@ ****************************************************************************/ static int mswindows_text_width (struct frame *f, struct face_cachel *cachel, - CONST Emchar *str, Charcount len) + const Emchar *str, Charcount len) { + HDC hdc = get_frame_dc (f); int width_so_far = 0; unsigned char *text_storage = (unsigned char *) alloca (2 * len); textual_run *runs = alloca_array (textual_run, len); @@ -1378,7 +1297,7 @@ nruns = separate_textual_runs (text_storage, runs, str, len); for (i = 0; i < nruns; i++) - width_so_far += mswindows_text_width_single_run (FRAME_MSWINDOWS_DC (f), + width_so_far += mswindows_text_width_single_run (hdc, cachel, runs + i); return width_so_far; @@ -1398,20 +1317,20 @@ Lisp_Object background_pixmap) { RECT rect = { x, y, x+width, y+height }; + HDC hdc = get_frame_dc (f); if (!NILP (background_pixmap)) { - mswindows_update_dc (FRAME_MSWINDOWS_DC (f), - Qnil, fcolor, bcolor, background_pixmap); - + struct display_box db = { x, y, width, height }; + mswindows_update_dc (hdc, + fcolor, bcolor, background_pixmap); mswindows_output_dibitmap_region - ( f, XIMAGE_INSTANCE (background_pixmap), - x, y, 0, 0, 0, 0, width, height, 0, TRUE); + ( f, XIMAGE_INSTANCE (background_pixmap), &db, 0); } else { - mswindows_update_dc (FRAME_MSWINDOWS_DC (f), Qnil, Qnil, fcolor, Qnil); - ExtTextOut (FRAME_MSWINDOWS_DC (f), 0, 0, ETO_OPAQUE, + mswindows_update_dc (hdc, Qnil, fcolor, Qnil); + ExtTextOut (hdc, 0, 0, ETO_OPAQUE, &rect, NULL, 0, NULL); } @@ -1421,56 +1340,6 @@ #endif } -/***************************************************************************** - mswindows_clear_to_window_end - - Clear the area between ypos1 and ypos2. Each margin area and the - text area is handled separately since they may each have their own - background color. - ****************************************************************************/ -static void -mswindows_clear_to_window_end (struct window *w, int ypos1, int ypos2) -{ - int height = ypos2 - ypos1; - - if (height) - { - struct frame *f = XFRAME (w->frame); - Lisp_Object window; - int bflag = (window_needs_vertical_divider (w) ? 0 : 1); - layout_bounds bounds; - - bounds = calculate_display_line_boundaries (w, bflag); - XSETWINDOW (window, w); - - if (window_is_leftmost (w)) - redisplay_clear_region (window, DEFAULT_INDEX, FRAME_LEFT_BORDER_START (f), - ypos1, FRAME_BORDER_WIDTH (f), height); - - if (bounds.left_in - bounds.left_out > 0) - redisplay_clear_region (window, - get_builtin_face_cache_index (w, Vleft_margin_face), - bounds.left_out, ypos1, - bounds.left_in - bounds.left_out, height); - - if (bounds.right_in - bounds.left_in > 0) - redisplay_clear_region (window, DEFAULT_INDEX, bounds.left_in, ypos1, - bounds.right_in - bounds.left_in, height); - - if (bounds.right_out - bounds.right_in > 0) - redisplay_clear_region (window, - get_builtin_face_cache_index (w, Vright_margin_face), - bounds.right_in, ypos1, - bounds.right_out - bounds.right_in, height); - - if (window_is_rightmost (w)) - redisplay_clear_region (window, DEFAULT_INDEX, FRAME_RIGHT_BORDER_START (f), - ypos1, FRAME_BORDER_WIDTH (f), height); - } - -} - - /* XXX Implement me! */ static void mswindows_clear_frame (struct frame *f) @@ -1487,17 +1356,33 @@ void console_type_create_redisplay_mswindows (void) { - /* redisplay methods */ + /* redisplay methods - display*/ CONSOLE_HAS_METHOD (mswindows, text_width); CONSOLE_HAS_METHOD (mswindows, output_display_block); CONSOLE_HAS_METHOD (mswindows, divider_height); CONSOLE_HAS_METHOD (mswindows, eol_cursor_width); CONSOLE_HAS_METHOD (mswindows, output_vertical_divider); - CONSOLE_HAS_METHOD (mswindows, clear_to_window_end); CONSOLE_HAS_METHOD (mswindows, clear_region); CONSOLE_HAS_METHOD (mswindows, clear_frame); CONSOLE_HAS_METHOD (mswindows, output_begin); CONSOLE_HAS_METHOD (mswindows, output_end); CONSOLE_HAS_METHOD (mswindows, flash); CONSOLE_HAS_METHOD (mswindows, ring_bell); + CONSOLE_HAS_METHOD (mswindows, bevel_area); + CONSOLE_HAS_METHOD (mswindows, output_string); + CONSOLE_HAS_METHOD (mswindows, output_pixmap); + + /* redisplay methods - printer */ + CONSOLE_INHERITS_METHOD (msprinter, mswindows, text_width); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, output_display_block); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, divider_height); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, eol_cursor_width); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, output_vertical_divider); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, clear_region); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, clear_frame); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, output_begin); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, output_end); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, bevel_area); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, output_string); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, output_pixmap); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/redisplay-output.c --- a/src/redisplay-output.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/redisplay-output.c Mon Aug 13 11:13:30 2007 +0200 @@ -2,6 +2,7 @@ Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. Copyright (C) 1995, 1996 Ben Wing. Copyright (C) 1996 Chuck Thompson. + Copyright (C) 1999 Andy Piper. This file is part of XEmacs. @@ -26,6 +27,9 @@ /* Author: Chuck Thompson */ +/* Heavily hacked for modularity, gutter and subwindow support by Andy + Piper. */ + #include <config.h> #include "lisp.h" @@ -43,8 +47,17 @@ int run_end_begin_glyphs); static void redisplay_output_display_block (struct window *w, struct display_line *dl, int block, int start, int end, int start_pixpos, - int cursor_start, int cursor_width, + int cursor_start, int cursor_width, int cursor_height); +static void redisplay_normalize_display_box (struct display_box* dest, + struct display_glyph_area* src); +static int redisplay_display_boxes_in_window_p (struct window* w, + struct display_box* db, + struct display_glyph_area* dga); +static void redisplay_clear_clipped_region (Lisp_Object locale, face_index findex, + struct display_box* dest, + struct display_glyph_area* glyphsrc, + int fullheight_p, Lisp_Object); /***************************************************************************** sync_rune_structs @@ -177,6 +190,27 @@ /* Do not compare the values of bufpos and endpos. They do not affect the display characteristics. */ + /* Note: (hanoi 6) spends 95% of its time in redisplay, and about + 30% here. Not using bitfields for rune.type alone gives a redisplay + speed up of 10%. + + #### In profile arcs run of a normal Gnus session this function + is run 6.76 million times, only to return 1 in 6.73 million of + those. + + In addition a quick look GCC sparc assembly shows that GCC is not + doing a good job here. + 1. The function is not inlined (too complicated?) + 2. It seems to be reloading the crb and drb variables all the + time. + 3. It doesn't seem to notice that the second half of these if's + are really a switch statement. + + So I (JV) conjecture + + #### It would really be worth it to arrange for this function to + be (almost) a single call to memcmp. */ + if ((crb->findex != drb->findex) || (WINDOW_FACE_CACHEL_DIRTY (w, drb->findex))) return 0; @@ -191,15 +225,28 @@ else if (crb->type == RUNE_CHAR && (crb->object.chr.ch != drb->object.chr.ch)) return 0; + else if (crb->type == RUNE_HLINE && + (crb->object.hline.thickness != drb->object.hline.thickness || + crb->object.hline.yoffset != drb->object.hline.yoffset)) + return 0; else if (crb->type == RUNE_DGLYPH && (!EQ (crb->object.dglyph.glyph, drb->object.dglyph.glyph) || !EQ (crb->object.dglyph.extent, drb->object.dglyph.extent) || crb->object.dglyph.xoffset != drb->object.dglyph.xoffset)) return 0; - else if (crb->type == RUNE_HLINE && - (crb->object.hline.thickness != drb->object.hline.thickness || - crb->object.hline.yoffset != drb->object.hline.yoffset)) - return 0; + /* Only check dirtiness if we know something has changed. */ + else if (crb->type == RUNE_DGLYPH && + XFRAME (w->frame)->glyphs_changed) + { + glyph_index gindex = get_glyph_cachel_index (w, drb->object.dglyph.glyph); + /* Although doing the cachel lookup for every comparison is + very expensive.we have to do it to make sure the cache is + up-to-date. */ + if (GLYPH_CACHEL_DIRTYP (w, gindex)) + return 0; + else + return 1; + } else return 1; } @@ -351,8 +398,14 @@ force = 1; if (f->windows_structure_changed || + /* #### Why is this so? We have face cachels so that we don't + have to recalculate all the display blocks when faces + change. I have fixed this for glyphs and am inclined to think + that faces should "Just Work", but I'm not feeling brave + today. Maybe its because the face cachels represent merged + faces rather than simply instantiations in a particular + domain. */ f->faces_changed || - f->glyphs_changed || cdl->ypos != ddl->ypos || cdl->ascent != ddl->ascent || cdl->descent != ddl->descent || @@ -589,35 +642,46 @@ (cdl && (cdl->ypos != ddl->ypos || cdl->ascent != ddl->ascent || cdl->descent != ddl->descent || + cdl->top_clip != ddl->top_clip || cdl->clip != ddl->clip))) { int x, y, width, height; - Lisp_Object face; + face_index findex; must_sync = 1; x = start_pixpos; - y = ddl->ypos - ddl->ascent; + y = DISPLAY_LINE_YPOS (ddl); width = min (next_start_pixpos, block_end) - x; - height = ddl->ascent + ddl->descent - ddl->clip; + height = DISPLAY_LINE_HEIGHT (ddl); if (x < ddl->bounds.left_in) - face = Vleft_margin_face; + { + findex = ddl->left_margin_findex ? + ddl->left_margin_findex + : get_builtin_face_cache_index (w, Vleft_margin_face); + } else if (x < ddl->bounds.right_in) - face = Vdefault_face; + { + /* no check here because DEFAULT_INDEX == 0 anyway */ + findex = ddl->default_findex; + } else if (x < ddl->bounds.right_out) - face = Vright_margin_face; + { + findex = ddl->right_margin_findex ? + ddl->right_margin_findex + : get_builtin_face_cache_index (w, Vright_margin_face); + } else - face = Qnil; + findex = (face_index) -1; - if (!NILP (face)) + if (findex != (face_index) -1) { Lisp_Object window; XSETWINDOW (window, w); /* Clear the empty area. */ - redisplay_clear_region (window, get_builtin_face_cache_index (w, face), - x, y, width, height); + redisplay_clear_region (window, findex, x, y, width, height); /* Mark that we should clear the border. This is necessary because italic fonts may leave @@ -648,7 +712,11 @@ region or if it was a block of a different type, then output the entire ddb. Otherwise, compare cdb and ddb and output only the changed region. */ - if (!force && cdb && ddb->type == cdb->type && b == old_b) + if (!force && cdb && ddb->type == cdb->type + /* If there was no buffer being display before the + compare anyway as we might be outputting a gutter. */ + && + (b == old_b || !old_b)) { must_sync |= compare_display_blocks (w, cdl, ddl, old_block, block, start_pixpos, @@ -686,7 +754,7 @@ cursor_start, cursor_width, cursor_height); } - + start_pixpos = next_start_pixpos; } } @@ -699,19 +767,23 @@ if (f->windows_structure_changed || f->faces_changed || clear_border || f->clear) { - int y = ddl->ypos - ddl->ascent; - int height = ddl->ascent + ddl->descent - ddl->clip; + int y = DISPLAY_LINE_YPOS (ddl); + int height = DISPLAY_LINE_HEIGHT (ddl); - if (ddl->modeline) + /* If we are in the gutter then we musn't clear the borders. */ + if (y >= WINDOW_TEXT_TOP (w) && (y + height) <= WINDOW_TEXT_BOTTOM (w)) { - y -= MODELINE_SHADOW_THICKNESS (w); - height += (2 * MODELINE_SHADOW_THICKNESS (w)); - } + if (ddl->modeline) + { + y -= MODELINE_SHADOW_THICKNESS (w); + height += (2 * MODELINE_SHADOW_THICKNESS (w)); + } - if (window_is_leftmost (w)) - clear_left_border (w, y, height); - if (window_is_rightmost (w)) - clear_right_border (w, y, height); + if (window_is_leftmost (w)) + clear_left_border (w, y, height); + if (window_is_rightmost (w)) + clear_right_border (w, y, height); + } } if (cdla) @@ -852,7 +924,7 @@ } } - while ((up ? (cur_dl < Dynarr_length (cla)) : (cur_dl >= 0))) + while (up ? (cur_dl < Dynarr_length (cla)) : (cur_dl >= 0)) { dl = Dynarr_atp (cla, cur_dl); db = get_display_block_from_line (dl, TEXT); @@ -995,20 +1067,38 @@ { struct frame *f = XFRAME (w->frame); struct device *d = XDEVICE (f->device); + struct display_block *db = Dynarr_atp (dl->display_blocks, block); + rune_dynarr *rba = db->runes; + struct rune *rb; + int xpos, width; + rb = Dynarr_atp (rba, start); + if (!rb) + /* Nothing to do so don't do anything. */ + return; + + xpos = max (start_pixpos, rb->xpos); + + if (end < 0) + end = Dynarr_length (rba); + + rb = Dynarr_atp (rba, end - 1); + width = rb->xpos + rb->width - xpos; + /* now actually output the block. */ DEVMETH (d, output_display_block, (w, dl, block, start, end, start_pixpos, cursor_start, cursor_width, cursor_height)); } - + /**************************************************************************** redisplay_unmap_subwindows Remove subwindows from the area in the box defined by the given parameters. ****************************************************************************/ -static void redisplay_unmap_subwindows (struct frame* f, int x, int y, int width, int height) +static void redisplay_unmap_subwindows (struct frame* f, int x, int y, int width, int height, + Lisp_Object ignored_window) { int elt; @@ -1021,7 +1111,9 @@ && cachel->x + cachel->width > x && cachel->x < x + width && - cachel->y + cachel->height > y && cachel->y < y + height) + cachel->y + cachel->height > y && cachel->y < y + height + && + !EQ (cachel->subwindow, ignored_window)) { unmap_subwindow (cachel->subwindow); } @@ -1038,79 +1130,372 @@ { if (Dynarr_length (FRAME_SUBWINDOW_CACHE (f))) { - redisplay_unmap_subwindows (f, x, y, width, height); + redisplay_unmap_subwindows (f, x, y, width, height, Qnil); + } +} + +static void redisplay_unmap_subwindows_except_us (struct frame* f, int x, int y, int width, + int height, Lisp_Object subwindow) +{ + if (Dynarr_length (FRAME_SUBWINDOW_CACHE (f))) + { + redisplay_unmap_subwindows (f, x, y, width, height, subwindow); } } /**************************************************************************** redisplay_output_subwindow - output a subwindow. This code borrows heavily from the pixmap stuff, although is much simpler not needing to account for partial pixmaps, backgrounds etc. ****************************************************************************/ void -redisplay_output_subwindow (struct window *w, struct display_line *dl, - Lisp_Object image_instance, int xpos, int xoffset, - int start_pixpos, int width, face_index findex, - int cursor_start, int cursor_width, int cursor_height) +redisplay_output_subwindow (struct window *w, + Lisp_Object image_instance, + struct display_box* db, struct display_glyph_area* dga, + face_index findex, int cursor_start, int cursor_width, + int cursor_height) { - struct Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance); Lisp_Object window; + struct display_glyph_area sdga; + + dga->height = IMAGE_INSTANCE_HEIGHT (p); + dga->width = IMAGE_INSTANCE_WIDTH (p); + + /* The first thing we are going to do is update the display + characteristics of the subwindow. This also clears the dirty + flags as a side effect. */ + update_subwindow (image_instance); + + /* This makes the glyph area fit into the display area. */ + if (!redisplay_normalize_glyph_area (db, dga)) + return; + + XSETWINDOW (window, w); + + /* Clear the area the subwindow is going into. */ + redisplay_clear_clipped_region (window, findex, + db, dga, 0, image_instance); + + /* This shrinks the display box to exactly enclose the glyph + area. */ + redisplay_normalize_display_box (db, dga); + + /* if we can't view the whole window we can't view any of it. We + have to be careful here since we may be being asked to display + part of a subwindow, the rest of which is on-screen as well. We + need to allow this case and map the entire subwindow. We also + need to be careful since the subwindow could be outside the + window in the gutter or modeline - we also need to allow these + cases.*/ + sdga.xoffset = -dga->xoffset; + sdga.yoffset = -dga->yoffset; + sdga.height = IMAGE_INSTANCE_HEIGHT (p); + sdga.width = IMAGE_INSTANCE_WIDTH (p); - int lheight = dl->ascent + dl->descent - dl->clip; - int pheight = ((int) IMAGE_INSTANCE_SUBWINDOW_HEIGHT (p) > lheight ? lheight : - IMAGE_INSTANCE_SUBWINDOW_HEIGHT (p)); + if (redisplay_display_boxes_in_window_p (w, db, &sdga) < 0) + { + map_subwindow (image_instance, db->xpos, db->ypos, dga); + } + else + { + sdga.xoffset = sdga.yoffset = 0; + map_subwindow (image_instance, db->xpos - dga->xoffset, + db->ypos - dga->yoffset, &sdga); + } +} + +/**************************************************************************** + redisplay_output_layout + + Output a widget hierarchy. This can safely call itself recursively. + + The complexity of outputting layouts is deciding whether to do it or + not. Consider a layout enclosing some text, the text changes and is + marked as dirty, but the enclosing layout has not been marked as + dirty so no updates occur and the text will potentially be truncated. + Alternatively we hold a back pointer in the image instance to the + parent and mark the parent as dirty. But the layout code assumes that + if the layout is dirty then the whole layout should be redisplayed, + so we then get lots of flashing even though only the text has changed + size. Of course if the text shrinks in size then we do actually need + to redisplay the layout to repaint the exposed area. So what happens + if we make a non-structural change like changing color? Either we + redisplay everything, or we redisplay nothing. These are exactly the + issues lwlib has to grapple with. We really need to know what has + actually changed and make a layout decision based on that. We also + really need to know what has changed so that we can only make the + neccessary changes in update_subwindow. This has all now been + implemented, Viva la revolution! + ****************************************************************************/ +void +redisplay_output_layout (struct window *w, + Lisp_Object image_instance, + struct display_box* db, struct display_glyph_area* dga, + face_index findex, int cursor_start, int cursor_width, + int cursor_height) +{ + Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance); + Lisp_Object window, rest; + Emchar_dynarr *buf = Dynarr_new (Emchar); + struct frame *f = XFRAME (w->frame); + struct device *d = XDEVICE (f->device); + int layout_height, layout_width; + /* We bogusly don't take f->extents_changed and f->glyphs_changed + into account. This is because if we do we always redisplay the + entire layout. So far I have seen no ill effects so we'll see. */ + int frame_really_changed = (f->buffers_changed || + f->clip_changed || + f->faces_changed || + f->frame_changed || + f->modeline_changed || + f->subwindows_changed || + f->windows_changed || + f->windows_structure_changed); XSETWINDOW (window, w); - /* Clear the area the subwindow is going into. The subwindow itself - will always take care of the full width. We don't want to clear - where it is going to go in order to avoid flicker. So, all we - have to take care of is any area above or below the subwindow. Of - course this is rubbish if the subwindow has transparent areas - (for instance with frames). */ - /* #### We take a shortcut for now. We know that since we have - subwindow_offset hardwired to 0 that the subwindow is against the top - edge so all we have to worry about is below it. */ - if ((int) (dl->ypos - dl->ascent + pheight) < - (int) (dl->ypos + dl->descent - dl->clip)) + layout_height = glyph_height (image_instance, window); + layout_width = glyph_width (image_instance, window); + + dga->height = layout_height; + dga->width = layout_width; + + /* This makes the glyph area fit into the display area. */ + if (!redisplay_normalize_glyph_area (db, dga)) + return; + + /* Highly dodgy optimization. We want to only output the whole + layout if we really have to. */ + if (frame_really_changed + || IMAGE_INSTANCE_LAYOUT_CHANGED (p) + || IMAGE_INSTANCE_WIDGET_FACE_CHANGED (p) + || IMAGE_INSTANCE_SIZE_CHANGED (p) + || IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p)) { - int clear_x, clear_width; + /* First clear the area we are drawing into. This is the easiest + thing to do since we have many gaps that we have to make sure are + filled in. */ + redisplay_clear_clipped_region (window, findex, db, dga, 1, Qnil); - int clear_y = dl->ypos - dl->ascent + pheight; - int clear_height = lheight - pheight; + /* Output a border if required */ + if (!NILP (IMAGE_INSTANCE_LAYOUT_BORDER (p))) + { + int edges = 0; + enum edge_style style; + int ypos = db->ypos; + int height = dga->height; + + if (dga->xoffset >= 0) + edges |= EDGE_LEFT; + if (dga->width - dga->xoffset == layout_width) + edges |= EDGE_RIGHT; + if (dga->yoffset >= 0) + edges |= EDGE_TOP; + if (dga->height - dga->yoffset == layout_height) + edges |= EDGE_BOTTOM; - if (start_pixpos >= 0 && start_pixpos > xpos) - { - clear_x = start_pixpos; - clear_width = xpos + width - start_pixpos; + if (EQ (IMAGE_INSTANCE_LAYOUT_BORDER (p), Qetched_in)) + style = EDGE_ETCHED_IN; + else if (EQ (IMAGE_INSTANCE_LAYOUT_BORDER (p), Qetched_out)) + style = EDGE_ETCHED_OUT; + else if (EQ (IMAGE_INSTANCE_LAYOUT_BORDER (p), Qbevel_in)) + style = EDGE_BEVEL_IN; + else if (INTP (IMAGE_INSTANCE_LAYOUT_BORDER (p))) + { + style = EDGE_ETCHED_IN; + if (edges & EDGE_TOP) + { + ypos += XINT (IMAGE_INSTANCE_LAYOUT_BORDER (p)); + height -= XINT (IMAGE_INSTANCE_LAYOUT_BORDER (p)); + } + } + else + style = EDGE_BEVEL_OUT; + + MAYBE_DEVMETH (d, bevel_area, + (w, findex, db->xpos, + ypos, + dga->width, height, 2, edges, style)); } - else - { - clear_x = xpos; - clear_width = width; - } - - redisplay_clear_region (window, findex, clear_x, clear_y, - clear_width, clear_height); } -#if 0 - redisplay_clear_region (window, findex, xpos - xoffset, dl->ypos - dl->ascent, - width, lheight); -#endif - /* if we can't view the whole window we can't view any of it */ - if (IMAGE_INSTANCE_SUBWINDOW_HEIGHT (p) > lheight - || - IMAGE_INSTANCE_SUBWINDOW_WIDTH (p) > width) + + /* This shrinks the display box to exactly enclose the glyph + area. */ + redisplay_normalize_display_box (db, dga); + + /* Flip through the widgets in the layout displaying as necessary */ + LIST_LOOP (rest, IMAGE_INSTANCE_LAYOUT_CHILDREN (p)) { - redisplay_clear_region (window, findex, xpos - xoffset, dl->ypos - dl->ascent, - width, lheight); - unmap_subwindow (image_instance); + Lisp_Object child = XCAR (rest); + + struct display_box cdb; + /* For losing HP-UX */ + cdb.xpos = db->xpos; + cdb.ypos = db->ypos; + cdb.width = db->width; + cdb.height = db->height; + + /* First determine if the image is visible at all */ + if (IMAGE_INSTANCEP (child)) + { + Lisp_Image_Instance* childii = XIMAGE_INSTANCE (child); + /* The enclosing layout offsets are +ve at this point */ + struct display_glyph_area cdga; + cdga.xoffset = IMAGE_INSTANCE_XOFFSET (childii) - dga->xoffset; + cdga.yoffset = IMAGE_INSTANCE_YOFFSET (childii) - dga->yoffset; + cdga.width = glyph_width (child, window); + cdga.height = glyph_height (child, window); + + /* Although normalization is done by the output routines + we have to do it here so that they don't try and + clear all of db. This is true below also. */ + if (redisplay_normalize_glyph_area (&cdb, &cdga)) + { + redisplay_normalize_display_box (&cdb, &cdga); + /* Since the display boxes will now be totally in the + window if they are visible at all we can now check this easily. */ + if (cdb.xpos < db->xpos || cdb.ypos < db->ypos + || cdb.xpos + cdb.width > db->xpos + db->width + || cdb.ypos + cdb.height > db->ypos + db->height) + continue; + /* We have to invert the offset here as normalization + will have made them positive which the output + routines will treat as a truely +ve offset. */ + cdga.xoffset = -cdga.xoffset; + cdga.yoffset = -cdga.yoffset; + + switch (IMAGE_INSTANCE_TYPE (childii)) + { + case IMAGE_TEXT: + { + /* #### This is well hacked and could use some + generalisation.*/ + if (redisplay_normalize_glyph_area (&cdb, &cdga) + && + (frame_really_changed || IMAGE_INSTANCE_DIRTYP (childii))) + { + struct display_line dl; /* this is fake */ + Lisp_Object string = + IMAGE_INSTANCE_TEXT_STRING (childii); + convert_bufbyte_string_into_emchar_dynarr + (XSTRING_DATA (string), XSTRING_LENGTH (string), buf); + + redisplay_normalize_display_box (&cdb, &cdga); + /* Offsets are now +ve again so be careful + when fixing up the display line. */ + xzero (dl); + /* Munge boxes into display lines. */ + dl.ypos = (cdb.ypos - cdga.yoffset) + + glyph_ascent (child, window); + dl.ascent = glyph_ascent (child, window); + dl.descent = glyph_descent (child, window); + dl.top_clip = cdga.yoffset; + dl.clip = (dl.ypos + dl.descent) - (cdb.ypos + cdb.height); + /* output_string doesn't understand offsets in + the same way as other routines - we have to + add the offset to the width so that we + output the full string. */ + MAYBE_DEVMETH (d, output_string, (w, &dl, buf, cdb.xpos, + cdga.xoffset, cdb.xpos, + cdga.width + cdga.xoffset, + findex, 0, 0, 0, 0)); + Dynarr_reset (buf); + } + } + break; + + case IMAGE_MONO_PIXMAP: + case IMAGE_COLOR_PIXMAP: + if (frame_really_changed || IMAGE_INSTANCE_DIRTYP (childii)) + redisplay_output_pixmap (w, child, &cdb, &cdga, findex, + 0, 0, 0, 0); + break; + + case IMAGE_WIDGET: + case IMAGE_SUBWINDOW: + if (frame_really_changed || IMAGE_INSTANCE_DIRTYP (childii)) + redisplay_output_subwindow (w, child, &cdb, &cdga, findex, + 0, 0, 0); + break; + + case IMAGE_LAYOUT: + redisplay_output_layout (w, child, &cdb, &cdga, findex, + 0, 0, 0); + break; + + case IMAGE_NOTHING: + /* nothing is as nothing does */ + break; + + case IMAGE_POINTER: + default: + abort (); + } + } + } } - else - map_subwindow (image_instance, xpos - xoffset, dl->ypos - dl->ascent); + + /* Update any display properties. I'm not sure whether this actually + does anything for layouts except clear the changed flags. */ + update_subwindow (image_instance); + + Dynarr_free (buf); +} + +/**************************************************************************** + redisplay_output_pixmap + + + output a pixmap. + ****************************************************************************/ +void +redisplay_output_pixmap (struct window *w, + Lisp_Object image_instance, + struct display_box* db, struct display_glyph_area* dga, + face_index findex, int cursor_start, int cursor_width, + int cursor_height, int offset_bitmap) +{ + struct frame *f = XFRAME (w->frame); + struct device *d = XDEVICE (f->device); + Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance); + Lisp_Object window; + XSETWINDOW (window, w); + + dga->height = IMAGE_INSTANCE_PIXMAP_HEIGHT (p); + dga->width = IMAGE_INSTANCE_PIXMAP_WIDTH (p); + + /* This makes the glyph area fit into the display area. */ + if (!redisplay_normalize_glyph_area (db, dga)) + return; + + /* Clear the area the pixmap is going into. The pixmap itself will + always take care of the full width. We don't want to clear where + it is going to go in order to avoid flicker. So, all we have to + take care of is any area above or below the pixmap. If the pixmap + has a mask in which case we have to clear the whole damn thing + since we can't yet clear just the area not included in the + mask. */ + if (!offset_bitmap) + { + redisplay_clear_clipped_region (window, findex, + db, dga, + (int)IMAGE_INSTANCE_PIXMAP_MASK (p), + Qnil); + + /* This shrinks the display box to exactly enclose the glyph + area. */ + redisplay_normalize_display_box (db, dga); + } + assert (db->xpos >= 0 && db->ypos >= 0); + + MAYBE_DEVMETH (d, output_pixmap, (w, image_instance, + db, dga, + findex, cursor_start, + cursor_width, cursor_height, + offset_bitmap)); } /**************************************************************************** @@ -1149,14 +1534,11 @@ d = XDEVICE (f->device); /* if we have subwindows in the region we have to unmap them */ - if (Dynarr_length (FRAME_SUBWINDOW_CACHE (f))) - { - redisplay_unmap_subwindows (f, x, y, width, height); - } + redisplay_unmap_subwindows_maybe (f, x, y, width, height); /* #### This isn't quite right for when this function is called from the toolbar code. */ - + /* Don't use a backing pixmap in the border area */ if (x >= FRAME_LEFT_BORDER_END (f) && x < FRAME_RIGHT_BORDER_START (f) @@ -1164,11 +1546,11 @@ && y < FRAME_BOTTOM_BORDER_START (f)) { Lisp_Object temp; - + if (w) { temp = WINDOW_FACE_CACHEL_BACKGROUND_PIXMAP (w, findex); - + if (IMAGE_INSTANCEP (temp) && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (temp))) { @@ -1180,14 +1562,14 @@ else { temp = FACE_BACKGROUND_PIXMAP (Vdefault_face, locale); - + if (IMAGE_INSTANCEP (temp) && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (temp))) { background_pixmap = temp; } } - } + } if (!UNBOUNDP (background_pixmap) && XIMAGE_INSTANCE_PIXMAP_DEPTH (background_pixmap) == 0) @@ -1208,16 +1590,234 @@ fcolor = (w ? WINDOW_FACE_CACHEL_BACKGROUND (w, findex) : FACE_BACKGROUND (Vdefault_face, locale)); - + } - + if (UNBOUNDP (background_pixmap)) background_pixmap = Qnil; - - DEVMETH (d, clear_region, + + DEVMETH (d, clear_region, (locale, d, f, findex, x, y, width, height, fcolor, bcolor, background_pixmap)); } +/**************************************************************************** + redisplay_clear_clipped_region + + Clear the area in the dest display_box not covered by the src + display_glyph_area using the given face. This is a common occurance + for images shorter than the display line. Clipping can be played + around with by altering these. glyphsrc should be normalized. + ****************************************************************************/ +static void +redisplay_clear_clipped_region (Lisp_Object window, face_index findex, + struct display_box* dest, struct display_glyph_area* glyphsrc, + int fullheight_p, Lisp_Object ignored_subwindow) +{ + /* assume dest->xpos >= 0 */ + int clear_x; + struct frame* f = XFRAME (XWINDOW (window)->frame); + + if (glyphsrc->xoffset > 0) + { + clear_x = dest->xpos + glyphsrc->xoffset; + } + else + { + clear_x = dest->xpos; + } + + /* If we need the whole height cleared then just do it. */ + if (fullheight_p) + { + redisplay_clear_region (window, findex, clear_x, dest->ypos, + glyphsrc->width, dest->height); + } + else + { + int yoffset = (glyphsrc->yoffset > 0 ? glyphsrc->yoffset : 0); + + /* We need to make sure that subwindows are unmapped from the + whole area. */ + redisplay_unmap_subwindows_except_us (f, clear_x, dest->ypos, + glyphsrc->width, dest->height, + ignored_subwindow); + /* first the top box */ + if (yoffset > 0) + { + redisplay_clear_region (window, findex, clear_x, dest->ypos, + glyphsrc->width, yoffset); + + } + /* Then the bottom box */ + if (yoffset + glyphsrc->height < dest->height) + { + redisplay_clear_region (window, findex, clear_x, + dest->ypos + yoffset + glyphsrc->height, + glyphsrc->width, + dest->height - (yoffset + glyphsrc->height)); + + } + } +} + +/***************************************************************************** + redisplay_normalize_glyph_area + redisplay_normalize_display_box + + Calculate the visible box for displaying src in dest. + ****************************************************************************/ +int +redisplay_normalize_glyph_area (struct display_box* dest, + struct display_glyph_area* glyphsrc) +{ + if (dest->xpos + glyphsrc->xoffset > dest->xpos + dest->width + || + dest->ypos + glyphsrc->yoffset > dest->ypos + dest->height + || + -glyphsrc->xoffset >= glyphsrc->width + || + -glyphsrc->yoffset >= glyphsrc->height) + { + /* It's all clipped out */ + return 0; + } + + /* Horizontal offsets. This works because xoffset can be -ve as well as +ve */ + if (dest->xpos + glyphsrc->xoffset + glyphsrc->width > dest->xpos + dest->width) + { + if (glyphsrc->xoffset > 0) + glyphsrc->width = dest->width - glyphsrc->xoffset; + else + glyphsrc->width = dest->width; + } + + if (glyphsrc->xoffset < 0) + glyphsrc->width += glyphsrc->xoffset; + + /* Vertical offsets. This works because yoffset can be -ve as well as +ve */ + if (dest->ypos + glyphsrc->yoffset + glyphsrc->height > dest->ypos + dest->height) + { + if (glyphsrc->yoffset > 0) + glyphsrc->height = dest->height - glyphsrc->yoffset; + else + glyphsrc->height = dest->height; + } + + if (glyphsrc->yoffset < 0) + glyphsrc->height += glyphsrc->yoffset; + + return 1; +} + +static void +redisplay_normalize_display_box (struct display_box* dest, + struct display_glyph_area* glyphsrc) +{ + /* Adjust the destination area. At the end of this the destination + area will exactly enclose the glyph area. The only remaining + adjustment will be offsets into the glyph area. */ + + /* Horizontal adjustment. */ + if (glyphsrc->xoffset > 0) + { + dest->xpos += glyphsrc->xoffset; + dest->width -= glyphsrc->xoffset; + glyphsrc->xoffset = 0; + } + else + glyphsrc->xoffset = -glyphsrc->xoffset; + + if (glyphsrc->width < dest->width) + dest->width = glyphsrc->width; + + /* Vertical adjustment. */ + if (glyphsrc->yoffset > 0) + { + dest->ypos += glyphsrc->yoffset; + dest->height -= glyphsrc->yoffset; + glyphsrc->yoffset = 0; + } + else + glyphsrc->yoffset = -glyphsrc->yoffset; + + if (glyphsrc->height < dest->height) + dest->height = glyphsrc->height; +} + +/***************************************************************************** + redisplay_display_boxes_in_window_p + + Determine whether the require display_glyph_area is completely inside + the window. 0 means the display_box is not in the window. 1 means the + display_box and the display_glyph_area are in the window. -1 means + the display_box is in the window but the display_glyph_area is not. + ****************************************************************************/ +static int +redisplay_display_boxes_in_window_p (struct window* w, + struct display_box* db, + struct display_glyph_area* dga) +{ + int left = WINDOW_TEXT_LEFT (w); + int right = WINDOW_TEXT_RIGHT (w); + int top = WINDOW_TEXT_TOP (w); + int bottom = WINDOW_TEXT_BOTTOM (w); + + if (db->xpos < left || db->ypos < top + || db->xpos + db->width > right + || db->ypos + db->height > bottom) + /* We are not displaying in a window at all */ + return 0; + + if (db->xpos + dga->xoffset >= left + && + db->ypos + dga->yoffset >= top + && + db->xpos + dga->xoffset + dga->width <= right + && + db->ypos + dga->yoffset + dga->height <= bottom) + return 1; + + return -1; +} + +/***************************************************************************** + redisplay_calculate_display_boxes + + Convert from rune/display_line co-ordinates to display_box + co-ordinates. + ****************************************************************************/ +int +redisplay_calculate_display_boxes (struct display_line *dl, int xpos, + int xoffset, int start_pixpos, int width, + struct display_box* dest, + struct display_glyph_area* src) +{ + dest->xpos = xpos; + dest->ypos = DISPLAY_LINE_YPOS (dl); + dest->width = width; + dest->height = DISPLAY_LINE_HEIGHT (dl); + + src->xoffset = -xoffset; + src->yoffset = -dl->top_clip; + src->width = 0; + src->height = 0; + + if (start_pixpos >=0 && start_pixpos > xpos) + { + /* Oops, we're asking for a start outside of the displayable + area. */ + if (start_pixpos > xpos + width) + return 0; + dest->xpos = start_pixpos; + dest->width -= (start_pixpos - xpos); + /* Offsets are -ve when we want to clip pixels off the displayed + glyph. */ + src->xoffset -= (start_pixpos - xpos); + } + + return 1; +} + /***************************************************************************** redisplay_clear_top_of_window @@ -1253,6 +1853,63 @@ } /***************************************************************************** + redisplay_clear_to_window_end + + Clear the area between ypos1 and ypos2. Each margin area and the + text area is handled separately since they may each have their own + background color. + ****************************************************************************/ +void +redisplay_clear_to_window_end (struct window *w, int ypos1, int ypos2) +{ + struct frame *f = XFRAME (w->frame); + struct device *d = XDEVICE (f->device); + + if (HAS_DEVMETH_P (d, clear_to_window_end)) + DEVMETH (d, clear_to_window_end, (w, ypos1, ypos2)); + else + { + int height = ypos2 - ypos1; + + if (height) + { + Lisp_Object window; + int bflag = 0 ; /* (window_needs_vertical_divider (w) ? 0 : 1);*/ + layout_bounds bounds; + + bounds = calculate_display_line_boundaries (w, bflag); + XSETWINDOW (window, w); + + if (window_is_leftmost (w)) + redisplay_clear_region (window, DEFAULT_INDEX, FRAME_LEFT_BORDER_START (f), + ypos1, FRAME_BORDER_WIDTH (f), height); + + if (bounds.left_in - bounds.left_out > 0) + redisplay_clear_region (window, + get_builtin_face_cache_index (w, Vleft_margin_face), + bounds.left_out, ypos1, + bounds.left_in - bounds.left_out, height); + + if (bounds.right_in - bounds.left_in > 0) + redisplay_clear_region (window, + DEFAULT_INDEX, + bounds.left_in, ypos1, + bounds.right_in - bounds.left_in, height); + + if (bounds.right_out - bounds.right_in > 0) + redisplay_clear_region (window, + get_builtin_face_cache_index (w, Vright_margin_face), + bounds.right_in, ypos1, + bounds.right_out - bounds.right_in, height); + + if (window_is_rightmost (w)) + redisplay_clear_region (window, DEFAULT_INDEX, FRAME_RIGHT_BORDER_START (f), + ypos1, FRAME_BORDER_WIDTH (f), height); + } + } +} + +/***************************************************************************** redisplay_clear_bottom_of_window Clear window from right below the last display line to right above @@ -1264,7 +1921,6 @@ int min_start, int max_end) { struct frame *f = XFRAME (w->frame); - struct device *d = XDEVICE (f->device); int ypos1, ypos2; int ddla_len = Dynarr_length (ddla); @@ -1308,7 +1964,7 @@ if (ypos2 <= ypos1) return; - DEVMETH (d, clear_to_window_end, (w, ypos1, ypos2)); + redisplay_clear_to_window_end (w, ypos1, ypos2); } /***************************************************************************** @@ -1603,3 +2259,36 @@ update_window_scrollbars (w, NULL, !MINI_WINDOW_P (w), 0); #endif } + +/***************************************************************************** + bevel_modeline + + Draw a 3d border around the modeline on window W. + ****************************************************************************/ +void +bevel_modeline (struct window *w, struct display_line *dl) +{ + struct frame *f = XFRAME (w->frame); + struct device *d = XDEVICE (f->device); + int x, y, width, height; + int shadow_thickness = MODELINE_SHADOW_THICKNESS (w); + enum edge_style style; + + x = WINDOW_MODELINE_LEFT (w); + width = WINDOW_MODELINE_RIGHT (w) - x; + y = dl->ypos - dl->ascent - shadow_thickness; + height = dl->ascent + dl->descent + 2 * shadow_thickness; + + if (XINT (w->modeline_shadow_thickness) < 0) + { + style = EDGE_BEVEL_IN; + } + else + { + style = EDGE_BEVEL_OUT; + } + + MAYBE_DEVMETH (d, bevel_area, + (w, MODELINE_INDEX, x, y, width, height, shadow_thickness, + EDGE_ALL, style)); +} diff -r f4aeb21a5bad -r 74fd4e045ea6 src/redisplay-tty.c --- a/src/redisplay-tty.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/redisplay-tty.c Mon Aug 13 11:13:30 2007 +0200 @@ -56,11 +56,11 @@ #ifdef __cplusplus extern "C" { #endif -extern int tgetent (CONST char *, CONST char *); -extern int tgetflag (CONST char *); -extern int tgetnum (CONST char *); -extern char *tgetstr (CONST char *, char **); -extern void tputs (CONST char *, int, void (*)(int)); +extern int tgetent (const char *, const char *); +extern int tgetflag (const char *); +extern int tgetnum (const char *); +extern char *tgetstr (const char *, char **); +extern void tputs (const char *, int, void (*)(int)); #ifdef __cplusplus } #endif @@ -107,7 +107,7 @@ column, so we use emchar_string_displayed_columns(). ****************************************************************************/ static int -tty_text_width (struct frame *f, struct face_cachel *cachel, CONST Emchar *str, +tty_text_width (struct frame *f, struct face_cachel *cachel, const Emchar *str, Charcount len) { return emchar_string_displayed_columns (str, len); @@ -392,6 +392,7 @@ case IMAGE_COLOR_PIXMAP: case IMAGE_SUBWINDOW: case IMAGE_WIDGET: + case IMAGE_LAYOUT: /* just do nothing here */ break; @@ -464,7 +465,7 @@ static void tty_clear_region (Lisp_Object window, struct device* d, struct frame * f, face_index findex, int x, int y, - int width, int height, Lisp_Object fcolor, Lisp_Object bcolor, + int width, int height, Lisp_Object fcolor, Lisp_Object bcolor, Lisp_Object background_pixmap) { struct console *c = XCONSOLE (FRAME_CONSOLE (f)); @@ -949,11 +950,11 @@ { Lisp_Object dev = CONSOLE_SELECTED_DEVICE (c); - if (!GC_NILP (dev)) + if (!NILP (dev)) { Lisp_Object frm = DEVICE_SELECTED_FRAME (XDEVICE (dev)); - if (!GC_NILP (frm)) + if (!NILP (frm)) { struct frame *f = XFRAME (frm); @@ -1304,7 +1305,8 @@ struct fkey_table { - CONST char *cap, *name; + const char *cap; + const char *name; }; /* Termcap capability names that correspond directly to X keysyms. @@ -1436,7 +1438,7 @@ char *sequence = tgetstr (keys[i].cap, address); if (sequence) Fdefine_key (function_key_map, - build_ext_string (sequence, FORMAT_BINARY), + build_ext_string (sequence, Qbinary), vector1 (intern (keys[i].name))); } @@ -1444,22 +1446,18 @@ describes F10, whereas othertimes it describes F0 and "k;" describes F10. We will attempt to politely accommodate both systems by testing for "k;", and if it is present, assuming that "k0" denotes F0, otherwise F10. - */ + */ { - char *k_semi = tgetstr ("k;", address); - char *k0 = tgetstr ("k0", address); - CONST char *k0_name = "f10"; + const char *k_semi = tgetstr ("k;", address); + const char *k0 = tgetstr ("k0", address); if (k_semi) - { - Fdefine_key (function_key_map, build_ext_string (k_semi, FORMAT_BINARY), - vector1 (intern ("f10"))); - k0_name = "f0"; - } + Fdefine_key (function_key_map, build_ext_string (k_semi, Qbinary), + vector1 (intern ("f10"))); if (k0) - Fdefine_key (function_key_map, build_ext_string (k0, FORMAT_BINARY), - vector1 (intern (k0_name))); + Fdefine_key (function_key_map, build_ext_string (k0, Qbinary), + vector1 (intern (k_semi ? "f0" : "f10"))); } /* Set up cookies for numbered function keys above f10. */ @@ -1482,47 +1480,46 @@ { sprintf (fkey, "f%d", i); Fdefine_key (function_key_map, - build_ext_string (sequence, FORMAT_BINARY), + build_ext_string (sequence, Qbinary), vector1 (intern (fkey))); } } } - } + } /* * Various mappings to try and get a better fit. */ - { -#define CONDITIONAL_REASSIGN(cap1, cap2, sym) \ - if (!tgetstr (cap1, address)) \ - { \ - char *sequence = tgetstr (cap2, address); \ - if (sequence) \ - Fdefine_key (function_key_map, \ - build_ext_string (sequence, FORMAT_BINARY), \ - vector1 (intern (sym))); \ - } +#define CONDITIONAL_REASSIGN(cap1, cap2, keyname) do { \ + if (!tgetstr (cap1, address)) \ + { \ + char *sequence = tgetstr (cap2, address); \ + if (sequence) \ + Fdefine_key (function_key_map, \ + build_ext_string (sequence, Qbinary), \ + vector1 (intern (keyname))); \ + } \ + } while (0) - /* if there's no key_next keycap, map key_npage to `next' keysym */ - CONDITIONAL_REASSIGN ("%5", "kN", "next"); - /* if there's no key_prev keycap, map key_ppage to `previous' keysym */ - CONDITIONAL_REASSIGN ("%8", "kP", "prior"); - /* if there's no key_dc keycap, map key_ic to `insert' keysym */ - CONDITIONAL_REASSIGN ("kD", "kI", "insert"); + /* if there's no key_next keycap, map key_npage to `next' keysym */ + CONDITIONAL_REASSIGN ("%5", "kN", "next"); + /* if there's no key_prev keycap, map key_ppage to `previous' keysym */ + CONDITIONAL_REASSIGN ("%8", "kP", "prior"); + /* if there's no key_dc keycap, map key_ic to `insert' keysym */ + CONDITIONAL_REASSIGN ("kD", "kI", "insert"); - /* IBM has their own non-standard dialect of terminfo. - If the standard name isn't found, try the IBM name. */ - CONDITIONAL_REASSIGN ("kB", "KO", "backtab"); - CONDITIONAL_REASSIGN ("@4", "kJ", "execute"); /* actually "action" */ - CONDITIONAL_REASSIGN ("@4", "kc", "execute"); /* actually "command" */ - CONDITIONAL_REASSIGN ("%7", "ki", "menu"); - CONDITIONAL_REASSIGN ("@7", "kw", "end"); - CONDITIONAL_REASSIGN ("F1", "k<", "f11"); - CONDITIONAL_REASSIGN ("F2", "k>", "f12"); - CONDITIONAL_REASSIGN ("%1", "kq", "help"); - CONDITIONAL_REASSIGN ("*6", "kU", "select"); + /* IBM has their own non-standard dialect of terminfo. + If the standard name isn't found, try the IBM name. */ + CONDITIONAL_REASSIGN ("kB", "KO", "backtab"); + CONDITIONAL_REASSIGN ("@4", "kJ", "execute"); /* actually "action" */ + CONDITIONAL_REASSIGN ("@4", "kc", "execute"); /* actually "command" */ + CONDITIONAL_REASSIGN ("%7", "ki", "menu"); + CONDITIONAL_REASSIGN ("@7", "kw", "end"); + CONDITIONAL_REASSIGN ("F1", "k<", "f11"); + CONDITIONAL_REASSIGN ("F2", "k>", "f12"); + CONDITIONAL_REASSIGN ("%1", "kq", "help"); + CONDITIONAL_REASSIGN ("*6", "kU", "select"); #undef CONDITIONAL_REASSIGN - } return Qnil; } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/redisplay-x.c --- a/src/redisplay-x.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/redisplay-x.c Mon Aug 13 11:13:30 2007 +0200 @@ -40,6 +40,7 @@ #include "debug.h" #include "faces.h" #include "frame.h" +#include "gutter.h" #include "redisplay.h" #include "sysdep.h" #include "window.h" @@ -53,17 +54,10 @@ #endif /* Number of pixels below each line. */ -/* #### implement me */ -int x_interline_space; +int x_interline_space; /* #### implement me */ #define EOL_CURSOR_WIDTH 5 -static void x_output_pixmap (struct window *w, struct display_line *dl, - Lisp_Object image_instance, int xpos, - int xoffset, - int start_pixpos, int width, face_index findex, - int cursor_start, int cursor_width, - int cursor_height); static void x_output_vertical_divider (struct window *w, int clear); static void x_output_blank (struct window *w, struct display_line *dl, struct rune *rb, int start_pixpos, @@ -78,7 +72,6 @@ int xpos, face_index findex); static void x_clear_frame (struct frame *f); static void x_clear_frame_windows (Lisp_Object window); -static void x_bevel_modeline (struct window *w, struct display_line *dl); /* Note: We do not use the Xmb*() functions and XFontSets. @@ -130,7 +123,7 @@ static int separate_textual_runs (unsigned char *text_storage, struct textual_run *run_storage, - CONST Emchar *str, Charcount len) + const Emchar *str, Charcount len) { Lisp_Object prev_charset = Qunbound; /* not Qnil because that is a possible valid charset when @@ -195,7 +188,7 @@ char_converter.reg[0] = XCHARSET_ID (charset); char_converter.reg[1] = byte1; char_converter.reg[2] = byte2; - ccl_driver (&char_converter, 0, 0, 0, 0); + ccl_driver (&char_converter, 0, 0, 0, 0, CCL_MODE_ENCODING); byte1 = char_converter.reg[1]; byte2 = char_converter.reg[2]; } @@ -226,7 +219,7 @@ x_text_width_single_run (struct face_cachel *cachel, struct textual_run *run) { Lisp_Object font_inst = FACE_CACHEL_FONT (cachel, run->charset); - struct Lisp_Font_Instance *fi = XFONT_INSTANCE (font_inst); + Lisp_Font_Instance *fi = XFONT_INSTANCE (font_inst); if (!fi->proportional_p) return fi->width * run->len; else @@ -248,7 +241,7 @@ */ static int -x_text_width (struct frame *f, struct face_cachel *cachel, CONST Emchar *str, +x_text_width (struct frame *f, struct face_cachel *cachel, const Emchar *str, Charcount len) { int width_so_far = 0; @@ -334,7 +327,7 @@ int elt = start; face_index findex; - int xpos, width; + int xpos, width = 0; Lisp_Object charset = Qunbound; /* Qnil is a valid charset when MULE is not defined */ @@ -342,18 +335,13 @@ rb = Dynarr_atp (rba, start); if (!rb) - { - /* Nothing to do so don't do anything. */ - return; - } - else - { - findex = rb->findex; - xpos = rb->xpos; - width = 0; - if (rb->type == RUNE_CHAR) - charset = CHAR_CHARSET (rb->object.chr.ch); - } + /* Nothing to do so don't do anything. */ + return; + + findex = rb->findex; + xpos = rb->xpos; + if (rb->type == RUNE_CHAR) + charset = CHAR_CHARSET (rb->object.chr.ch); if (end < 0) end = Dynarr_length (rba); @@ -412,10 +400,10 @@ else if (rb->object.chr.ch == '\n') { /* Clear in case a cursor was formerly here. */ - int height = dl->ascent + dl->descent - dl->clip; - - redisplay_clear_region (window, findex, xpos, dl->ypos - dl->ascent, - rb->width, height); + redisplay_clear_region (window, findex, xpos, + DISPLAY_LINE_YPOS (dl), + rb->width, + DISPLAY_LINE_HEIGHT (dl)); elt++; } } @@ -449,6 +437,11 @@ else if (rb->type == RUNE_DGLYPH) { Lisp_Object instance; + struct display_box dbox; + struct display_glyph_area dga; + redisplay_calculate_display_boxes (dl, rb->xpos, rb->object.dglyph.xoffset, + start_pixpos, rb->width, + &dbox, &dga); XSETWINDOW (window, w); instance = glyph_image_instance (rb->object.dglyph.glyph, @@ -479,26 +472,29 @@ case IMAGE_MONO_PIXMAP: case IMAGE_COLOR_PIXMAP: - x_output_pixmap (w, dl, instance, xpos, - rb->object.dglyph.xoffset, start_pixpos, - rb->width, findex, cursor_start, - cursor_width, cursor_height); + redisplay_output_pixmap (w, instance, &dbox, &dga, findex, + cursor_start, cursor_width, + cursor_height, 0); break; - case IMAGE_POINTER: - abort (); - case IMAGE_WIDGET: case IMAGE_SUBWINDOW: - redisplay_output_subwindow (w, dl, instance, xpos, - rb->object.dglyph.xoffset, start_pixpos, - rb->width, findex, cursor_start, - cursor_width, cursor_height); + redisplay_output_subwindow (w, instance, &dbox, &dga, findex, + cursor_start, cursor_width, + cursor_height); + break; + + case IMAGE_LAYOUT: + redisplay_output_layout (w, instance, &dbox, &dga, findex, + cursor_start, cursor_width, + cursor_height); + break; case IMAGE_NOTHING: /* nothing is as nothing does */ break; + case IMAGE_POINTER: default: abort (); } @@ -522,38 +518,41 @@ && (f->clear || f->windows_structure_changed || w->shadow_thickness_changed)) - x_bevel_modeline (w, dl); + bevel_modeline (w, dl); Dynarr_free (buf); } /***************************************************************************** - x_bevel_modeline + x_bevel_area - Draw a 3d border around the modeline on window W. + Draw a shadows for the given area in the given face. ****************************************************************************/ static void -x_bevel_modeline (struct window *w, struct display_line *dl) +x_bevel_area (struct window *w, face_index findex, + int x, int y, int width, int height, + int shadow_thickness, int edges, enum edge_style style) { struct frame *f = XFRAME (w->frame); struct device *d = XDEVICE (f->device); + + EmacsFrame ef = (EmacsFrame) FRAME_X_TEXT_WIDGET (f); Display *dpy = DEVICE_X_DISPLAY (d); Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f)); - EmacsFrame ef = (EmacsFrame) FRAME_X_TEXT_WIDGET (f); - GC top_shadow_gc, bottom_shadow_gc, background_gc; Pixel top_shadow_pixel, bottom_shadow_pixel, background_pixel; + Lisp_Object tmp_pixel; XColor tmp_color; - Lisp_Object tmp_pixel; - int x, y, width, height; XGCValues gcv; - unsigned long mask; + GC top_shadow_gc, bottom_shadow_gc, background_gc; + int use_pixmap = 0; int flip_gcs = 0; - int shadow_thickness; + unsigned long mask; + assert (shadow_thickness >=0); memset (&gcv, ~0, sizeof (XGCValues)); - tmp_pixel = WINDOW_FACE_CACHEL_BACKGROUND (w, MODELINE_INDEX); + tmp_pixel = WINDOW_FACE_CACHEL_BACKGROUND (w, findex); tmp_color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (tmp_pixel)); /* First, get the GC's. */ @@ -564,12 +563,14 @@ x_generate_shadow_pixels (f, &top_shadow_pixel, &bottom_shadow_pixel, background_pixel, ef->core.background_pixel); - tmp_pixel = WINDOW_FACE_CACHEL_FOREGROUND (w, MODELINE_INDEX); + tmp_pixel = WINDOW_FACE_CACHEL_FOREGROUND (w, findex); tmp_color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (tmp_pixel)); gcv.background = tmp_color.pixel; gcv.graphics_exposures = False; mask = GCForeground | GCBackground | GCGraphicsExposures; + /* If we can't distinguish one of the shadows (the color is the same as the + background), it's better to use a pixmap to generate a dithered gray. */ if (top_shadow_pixel == background_pixel || bottom_shadow_pixel == background_pixel) use_pixmap = 1; @@ -583,15 +584,16 @@ gray_width, gray_height, 1, 0, 1); } - tmp_pixel = WINDOW_FACE_CACHEL_BACKGROUND (w, MODELINE_INDEX); + tmp_pixel = WINDOW_FACE_CACHEL_BACKGROUND (w, findex); tmp_color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (tmp_pixel)); gcv.foreground = tmp_color.pixel; + /* this is needed because the GC draws with a pixmap here */ gcv.fill_style = FillOpaqueStippled; gcv.stipple = DEVICE_X_GRAY_PIXMAP (d); top_shadow_gc = gc_cache_lookup (DEVICE_X_GC_CACHE (d), &gcv, (mask | GCStipple | GCFillStyle)); - tmp_pixel = WINDOW_FACE_CACHEL_FOREGROUND (w, MODELINE_INDEX); + tmp_pixel = WINDOW_FACE_CACHEL_FOREGROUND (w, findex); tmp_color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (tmp_pixel)); bottom_shadow_pixel = tmp_color.pixel; @@ -617,7 +619,9 @@ gcv.foreground = background_pixel; background_gc = gc_cache_lookup (DEVICE_X_GC_CACHE (d), &gcv, mask); - if (XINT (w->modeline_shadow_thickness) < 0) + /* possibly revert the GC's This will give a depressed look to the + divider */ + if (style == EDGE_ETCHED_IN || style == EDGE_BEVEL_IN) { GC temp; @@ -626,15 +630,22 @@ bottom_shadow_gc = temp; } - shadow_thickness = MODELINE_SHADOW_THICKNESS (w); + if (style == EDGE_ETCHED_IN || style == EDGE_ETCHED_OUT) + shadow_thickness /= 2; + + /* Draw the shadows around the divider line */ + x_output_shadows (f, x, y, width, height, + top_shadow_gc, bottom_shadow_gc, + background_gc, shadow_thickness, edges); - x = WINDOW_MODELINE_LEFT (w); - width = WINDOW_MODELINE_RIGHT (w) - x; - y = dl->ypos - dl->ascent - shadow_thickness; - height = dl->ascent + dl->descent + 2 * shadow_thickness; - - x_output_shadows (f, x, y, width, height, top_shadow_gc, bottom_shadow_gc, - background_gc, shadow_thickness); + if (style == EDGE_ETCHED_IN || style == EDGE_ETCHED_OUT) + { + /* Draw the shadows around the divider line */ + x_output_shadows (f, x + shadow_thickness, y + shadow_thickness, + width - 2*shadow_thickness, height - 2*shadow_thickness, + bottom_shadow_gc, top_shadow_gc, + background_gc, shadow_thickness, edges); + } } /***************************************************************************** @@ -802,7 +813,7 @@ if (width < 0) width = x_text_width (f, cachel, Dynarr_atp (buf, 0), Dynarr_length (buf)); - height = dl->ascent + dl->descent - dl->clip; + height = DISPLAY_LINE_HEIGHT (dl); /* Regularize the variables passed in. */ @@ -815,6 +826,10 @@ xpos -= xoffset; + /* make sure the area we are about to display is subwindow free. */ + redisplay_unmap_subwindows_maybe (f, clip_start, DISPLAY_LINE_YPOS (dl), + clip_end - clip_start, DISPLAY_LINE_HEIGHT (dl)); + nruns = separate_textual_runs (text_storage, runs, Dynarr_atp (buf, 0), Dynarr_length (buf)); @@ -859,13 +874,13 @@ if (bgc) XFillRectangle (dpy, x_win, bgc, clip_start, - dl->ypos - dl->ascent, clip_end - clip_start, + DISPLAY_LINE_YPOS (dl), clip_end - clip_start, height); for (i = 0; i < nruns; i++) { Lisp_Object font = FACE_CACHEL_FONT (cachel, runs[i].charset); - struct Lisp_Font_Instance *fi = XFONT_INSTANCE (font); + Lisp_Font_Instance *fi = XFONT_INSTANCE (font); int this_width; int need_clipping; @@ -880,7 +895,7 @@ the given font. It is possible that a font is being displayed on a line taller than it is, so this would cause us to fail to clear some areas. */ - if ((int) fi->height < (int) (height + dl->clip)) + if ((int) fi->height < (int) (height + dl->clip + dl->top_clip)) { int clear_start = max (xpos, clip_start); int clear_end = min (xpos + this_width, clip_end); @@ -891,8 +906,8 @@ ypos1_string = dl->ypos - fi->ascent; ypos2_string = dl->ypos + fi->descent; - ypos1_line = dl->ypos - dl->ascent; - ypos2_line = dl->ypos + dl->descent - dl->clip; + ypos1_line = DISPLAY_LINE_YPOS (dl); + ypos2_line = ypos1_line + DISPLAY_LINE_HEIGHT (dl); /* Make sure we don't clear below the real bottom of the line. */ @@ -918,7 +933,7 @@ else { redisplay_clear_region (window, findex, clear_start, - dl->ypos - dl->ascent, clear_end - clear_start, + DISPLAY_LINE_YPOS (dl), clear_end - clear_start, height); } } @@ -951,7 +966,7 @@ clip_box[0].width = clip_end - clip_start; clip_box[0].height = height; - XSetClipRectangles (dpy, gc, clip_start, dl->ypos - dl->ascent, + XSetClipRectangles (dpy, gc, clip_start, DISPLAY_LINE_YPOS (dl), clip_box, 1, Unsorted); } @@ -1051,7 +1066,7 @@ clip_box[0].width = cursor_width; clip_box[0].height = height; - XSetClipRectangles (dpy, cgc, cursor_start, dl->ypos - dl->ascent, + XSetClipRectangles (dpy, cgc, cursor_start, DISPLAY_LINE_YPOS (dl), clip_box, 1, Unsorted); if (runs[i].dimension == 1) @@ -1111,12 +1126,12 @@ tmp_y = dl->ypos - bogusly_obtained_ascent_value; tmp_height = cursor_height; - if (tmp_y + tmp_height > (int) (dl->ypos - dl->ascent + height)) + if (tmp_y + tmp_height > (int) (DISPLAY_LINE_YPOS(dl) + height)) { - tmp_y = dl->ypos - dl->ascent + height - tmp_height; - if (tmp_y < (int) (dl->ypos - dl->ascent)) - tmp_y = dl->ypos - dl->ascent; - tmp_height = dl->ypos - dl->ascent + height - tmp_y; + tmp_y = DISPLAY_LINE_YPOS (dl) + height - tmp_height; + if (tmp_y < (int) DISPLAY_LINE_YPOS (dl)) + tmp_y = DISPLAY_LINE_YPOS (dl); + tmp_height = DISPLAY_LINE_YPOS (dl) + height - tmp_y; } if (need_clipping) @@ -1151,10 +1166,10 @@ } void -x_output_x_pixmap (struct frame *f, struct Lisp_Image_Instance *p, int x, - int y, int clip_x, int clip_y, int clip_width, - int clip_height, int width, int height, int pixmap_offset, - unsigned long fg, unsigned long bg, GC override_gc) +x_output_x_pixmap (struct frame *f, Lisp_Image_Instance *p, int x, + int y, int xoffset, int yoffset, + int width, int height, unsigned long fg, unsigned long bg, + GC override_gc) { struct device *d = XDEVICE (f->device); Display *dpy = DEVICE_X_DISPLAY (d); @@ -1163,7 +1178,6 @@ GC gc; XGCValues gcv; unsigned long pixmap_mask; - int need_clipping = (clip_x || clip_y); if (!override_gc) { @@ -1177,17 +1191,16 @@ { gcv.function = GXcopy; gcv.clip_mask = IMAGE_INSTANCE_X_MASK (p); - gcv.clip_x_origin = x; - gcv.clip_y_origin = y - pixmap_offset; + gcv.clip_x_origin = x - xoffset; + gcv.clip_y_origin = y - yoffset; pixmap_mask |= (GCFunction | GCClipMask | GCClipXOrigin | GCClipYOrigin); - /* Can't set a clip rectangle below because we already have a mask. - We could conceivably create a new clipmask by zeroing out - everything outside the clip region. Is it worth it? + /* Can't set a clip rectangle because we already have a mask. Is it possible to get an equivalent effect by changing the args to XCopyArea below rather than messing with a clip box? - - dkindred@cs.cmu.edu */ - need_clipping = 0; + - dkindred@cs.cmu.edu + Yes. We don't clip at all now - andy@xemacs.org + */ } gc = gc_cache_lookup (DEVICE_X_GC_CACHE (d), &gcv, pixmap_mask); @@ -1198,19 +1211,6 @@ /* override_gc might have a mask already--we don't want to nuke it. Maybe we can insist that override_gc have no mask, or use one of the suggestions above. */ - need_clipping = 0; - } - - if (need_clipping) - { - XRectangle clip_box[1]; - - clip_box[0].x = clip_x; - clip_box[0].y = clip_y; - clip_box[0].width = clip_width; - clip_box[0].height = clip_height; - - XSetClipRectangles (dpy, gc, x, y, clip_box, 1, Unsorted); } /* depth of 0 means it's a bitmap, not a pixmap, and we should use @@ -1219,125 +1219,32 @@ pixel values, instead of symbolic of fg/bg. */ if (IMAGE_INSTANCE_PIXMAP_DEPTH (p) > 0) { - XCopyArea (dpy, IMAGE_INSTANCE_X_PIXMAP (p), x_win, gc, 0, - pixmap_offset, width, + XCopyArea (dpy, + IMAGE_INSTANCE_X_PIXMAP_SLICE + (p, IMAGE_INSTANCE_PIXMAP_SLICE (p)), x_win, gc, xoffset, + yoffset, width, height, x, y); } else { - XCopyPlane (dpy, IMAGE_INSTANCE_X_PIXMAP (p), x_win, gc, 0, - (pixmap_offset < 0 - ? 0 - : pixmap_offset), - width, height, x, - (pixmap_offset < 0 - ? y - pixmap_offset - : y), - 1L); - } - - if (need_clipping) - { - XSetClipMask (dpy, gc, None); - XSetClipOrigin (dpy, gc, 0, 0); + XCopyPlane (dpy, IMAGE_INSTANCE_X_PIXMAP_SLICE + (p, IMAGE_INSTANCE_PIXMAP_SLICE (p)), x_win, gc, + xoffset, yoffset, width, height, x, y, 1L); } } static void -x_output_pixmap (struct window *w, struct display_line *dl, - Lisp_Object image_instance, int xpos, int xoffset, - int start_pixpos, int width, face_index findex, - int cursor_start, int cursor_width, int cursor_height) +x_output_pixmap (struct window *w, Lisp_Object image_instance, + struct display_box *db, struct display_glyph_area *dga, + face_index findex, int cursor_start, int cursor_width, + int cursor_height, int bg_pixmap) { struct frame *f = XFRAME (w->frame); struct device *d = XDEVICE (f->device); - struct Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance); - Lisp_Object window; + Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance); Display *dpy = DEVICE_X_DISPLAY (d); Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f)); - int lheight = dl->ascent + dl->descent - dl->clip; - int pheight = ((int) IMAGE_INSTANCE_PIXMAP_HEIGHT (p) > lheight ? lheight : - IMAGE_INSTANCE_PIXMAP_HEIGHT (p)); - int pwidth = min (width + xoffset, (int) IMAGE_INSTANCE_PIXMAP_WIDTH (p)); - int clip_x, clip_y, clip_width, clip_height; - - /* The pixmap_offset is used to center the pixmap on lines which are - shorter than it is. This results in odd effects when scrolling - pixmaps off of the bottom. Let's try not using it. */ -#if 0 - int pixmap_offset = (int) (IMAGE_INSTANCE_PIXMAP_HEIGHT (p) - lheight) / 2; -#else - int pixmap_offset = 0; -#endif - - XSETWINDOW (window, w); - - if ((start_pixpos >= 0 && start_pixpos > xpos) || xoffset) - { - if (start_pixpos > xpos && start_pixpos > xpos + width) - return; - - clip_x = xoffset; - clip_width = width; - if (start_pixpos > xpos) - { - clip_x += (start_pixpos - xpos); - clip_width -= (start_pixpos - xpos); - } - } - else - { - clip_x = 0; - clip_width = 0; - } - - /* Place markers for possible future functionality (clipping the top - half instead of the bottom half; think pixel scrolling). */ - clip_y = 0; - clip_height = pheight; - - /* Clear the area the pixmap is going into. The pixmap itself will - always take care of the full width. We don't want to clear where - it is going to go in order to avoid flicker. So, all we have to - take care of is any area above or below the pixmap. */ - /* #### We take a shortcut for now. We know that since we have - pixmap_offset hardwired to 0 that the pixmap is against the top - edge so all we have to worry about is below it. */ - /* #### Unless the pixmap has a mask in which case we have to clear - the whole damn thing since we can't yet clear just the area not - included in the mask. */ - if (((int) (dl->ypos - dl->ascent + pheight) < - (int) (dl->ypos + dl->descent - dl->clip)) - || IMAGE_INSTANCE_X_MASK (p)) - { - int clear_x, clear_y, clear_width, clear_height; - - if (IMAGE_INSTANCE_X_MASK (p)) - { - clear_y = dl->ypos - dl->ascent; - clear_height = lheight; - } - else - { - clear_y = dl->ypos - dl->ascent + pheight; - clear_height = lheight - pheight; - } - - if (start_pixpos >= 0 && start_pixpos > xpos) - { - clear_x = start_pixpos; - clear_width = xpos + width - start_pixpos; - } - else - { - clear_x = xpos; - clear_width = width; - } - - redisplay_clear_region (window, findex, clear_x, clear_y, - clear_width, clear_height); - } /* Output the pixmap. */ { @@ -1349,20 +1256,19 @@ tmp_pixel = WINDOW_FACE_CACHEL_BACKGROUND (w, findex); tmp_bcolor = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (tmp_pixel)); - x_output_x_pixmap (f, p, xpos - xoffset, dl->ypos - dl->ascent, clip_x, - clip_y, clip_width, clip_height, - pwidth, pheight, pixmap_offset, + x_output_x_pixmap (f, p, db->xpos, db->ypos, + dga->xoffset, dga->yoffset, + dga->width, dga->height, tmp_fcolor.pixel, tmp_bcolor.pixel, 0); } /* Draw a cursor over top of the pixmap. */ - if (cursor_width && cursor_height && (cursor_start >= xpos) + if (cursor_width && cursor_height && (cursor_start >= db->xpos) && !NILP (w->text_cursor_visible_p) - && (cursor_start < xpos + pwidth)) + && (cursor_start < db->xpos + dga->width)) { GC gc; int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d)); - int y = dl->ypos - dl->ascent; struct face_cachel *cursor_cachel = WINDOW_FACE_CACHEL (w, get_builtin_face_cache_index @@ -1370,17 +1276,17 @@ gc = x_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil); - if (cursor_width > xpos + pwidth - cursor_start) - cursor_width = xpos + pwidth - cursor_start; + if (cursor_width > db->xpos + dga->width - cursor_start) + cursor_width = db->xpos + dga->width - cursor_start; if (focus) { - XFillRectangle (dpy, x_win, gc, cursor_start, y, cursor_width, + XFillRectangle (dpy, x_win, gc, cursor_start, db->ypos, cursor_width, cursor_height); } else { - XDrawRectangle (dpy, x_win, gc, cursor_start, y, cursor_width, + XDrawRectangle (dpy, x_win, gc, cursor_start, db->ypos, cursor_width, cursor_height); } } @@ -1397,17 +1303,14 @@ struct frame *f = XFRAME (w->frame); struct device *d = XDEVICE (f->device); - EmacsFrame ef = (EmacsFrame) FRAME_X_TEXT_WIDGET (f); Display *dpy = DEVICE_X_DISPLAY (d); Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f)); - Pixel top_shadow_pixel, bottom_shadow_pixel, background_pixel; Lisp_Object tmp_pixel; XColor tmp_color; XGCValues gcv; - GC top_shadow_gc, bottom_shadow_gc, background_gc; + GC background_gc; + enum edge_style style; - int use_pixmap = 0; - int flip_gcs = 0; unsigned long mask; int x, y1, y2, width, shadow_thickness, spacing, line_width; face_index div_face = get_builtin_face_cache_index (w, Vvertical_divider_face); @@ -1417,8 +1320,8 @@ spacing = XINT (w->vertical_divider_spacing); line_width = XINT (w->vertical_divider_line_width); x = WINDOW_RIGHT (w) - width; - y1 = WINDOW_TOP (w); - y2 = WINDOW_BOTTOM (w); + y1 = WINDOW_TOP (w) + FRAME_TOP_GUTTER_BOUNDS (f); + y2 = WINDOW_BOTTOM (w) + FRAME_BOTTOM_GUTTER_BOUNDS (f); memset (&gcv, ~0, sizeof (XGCValues)); @@ -1426,83 +1329,12 @@ tmp_color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (tmp_pixel)); /* First, get the GC's. */ - top_shadow_pixel = tmp_color.pixel; - bottom_shadow_pixel = tmp_color.pixel; - background_pixel = tmp_color.pixel; - - x_generate_shadow_pixels (f, &top_shadow_pixel, &bottom_shadow_pixel, - background_pixel, ef->core.background_pixel); - - tmp_pixel = WINDOW_FACE_CACHEL_FOREGROUND (w, div_face); - tmp_color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (tmp_pixel)); gcv.background = tmp_color.pixel; + gcv.foreground = tmp_color.pixel; gcv.graphics_exposures = False; mask = GCForeground | GCBackground | GCGraphicsExposures; - - /* If we can't distinguish one of the shadows (the color is the same as the - background), it's better to use a pixmap to generate a dithered gray. */ - if (top_shadow_pixel == background_pixel || - bottom_shadow_pixel == background_pixel) - use_pixmap = 1; - - if (use_pixmap) - { - if (DEVICE_X_GRAY_PIXMAP (d) == None) - { - DEVICE_X_GRAY_PIXMAP (d) = - XCreatePixmapFromBitmapData (dpy, x_win, (char *) gray_bits, - gray_width, gray_height, 1, 0, 1); - } - - tmp_pixel = WINDOW_FACE_CACHEL_BACKGROUND (w, div_face); - tmp_color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (tmp_pixel)); - gcv.foreground = tmp_color.pixel; - /* this is needed because the GC draws with a pixmap here */ - gcv.fill_style = FillOpaqueStippled; - gcv.stipple = DEVICE_X_GRAY_PIXMAP (d); - top_shadow_gc = gc_cache_lookup (DEVICE_X_GC_CACHE (d), &gcv, - (mask | GCStipple | GCFillStyle)); - - tmp_pixel = WINDOW_FACE_CACHEL_FOREGROUND (w, div_face); - tmp_color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (tmp_pixel)); - bottom_shadow_pixel = tmp_color.pixel; - - flip_gcs = (bottom_shadow_pixel == - WhitePixelOfScreen (DefaultScreenOfDisplay (dpy))); - } - else - { - gcv.foreground = top_shadow_pixel; - top_shadow_gc = gc_cache_lookup (DEVICE_X_GC_CACHE (d), &gcv, mask); - } - - gcv.foreground = bottom_shadow_pixel; - bottom_shadow_gc = gc_cache_lookup (DEVICE_X_GC_CACHE (d), &gcv, mask); - - if (use_pixmap && flip_gcs) - { - GC tmp_gc = bottom_shadow_gc; - bottom_shadow_gc = top_shadow_gc; - top_shadow_gc = tmp_gc; - } - - gcv.foreground = background_pixel; background_gc = gc_cache_lookup (DEVICE_X_GC_CACHE (d), &gcv, mask); - /* possibly revert the GC's in case the shadow thickness is < 0. - This will give a depressed look to the divider */ - if (shadow_thickness < 0) - { - GC temp; - - temp = top_shadow_gc; - top_shadow_gc = bottom_shadow_gc; - bottom_shadow_gc = temp; - - /* better avoid a Bad Address XLib error ;-) */ - shadow_thickness = - shadow_thickness; - } - /* Clear the divider area first. This needs to be done when a window split occurs. */ if (clear) @@ -1513,11 +1345,20 @@ x + spacing + shadow_thickness, y1, line_width, y2 - y1); + if (shadow_thickness < 0) + { + shadow_thickness = -shadow_thickness; + style = EDGE_BEVEL_IN; + } + else + { + style = EDGE_BEVEL_OUT; + } + /* Draw the shadows around the divider line */ - x_output_shadows (f, x + spacing, y1, - width - 2 * spacing, y2 - y1, - top_shadow_gc, bottom_shadow_gc, - background_gc, shadow_thickness); + x_bevel_area (w, div_face, x + spacing, y1, + width - 2 * spacing, y2 - y1, + shadow_thickness, EDGE_ALL, style); } /***************************************************************************** @@ -1546,9 +1387,12 @@ buffer); int x = rb->xpos; - int y = dl->ypos - dl->ascent; + int y = DISPLAY_LINE_YPOS (dl); int width = rb->width; - int height = dl->ascent + dl->descent - dl->clip; + int height = DISPLAY_LINE_HEIGHT (dl); + + /* Unmap all subwindows in the area we are going to blank. */ + redisplay_unmap_subwindows_maybe (f, x, y, width, height); if (start_pixpos > x) { @@ -1586,7 +1430,7 @@ { int cursor_height, cursor_y; int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d)); - struct Lisp_Font_Instance *fi; + Lisp_Font_Instance *fi; fi = XFONT_INSTANCE (FACE_CACHEL_FONT (WINDOW_FACE_CACHEL (w, rb->findex), @@ -1642,10 +1486,10 @@ int x = rb->xpos; int width = rb->width; - int height = dl->ascent + dl->descent - dl->clip; + int height = DISPLAY_LINE_HEIGHT (dl); int ypos1, ypos2, ypos3, ypos4; - ypos1 = dl->ypos - dl->ascent; + ypos1 = DISPLAY_LINE_YPOS (dl); ypos2 = ypos1 + rb->object.hline.yoffset; ypos3 = ypos2 + rb->object.hline.thickness; ypos4 = dl->ypos + dl->descent - dl->clip; @@ -1684,7 +1528,7 @@ void x_output_shadows (struct frame *f, int x, int y, int width, int height, GC top_shadow_gc, GC bottom_shadow_gc, GC background_gc, - int shadow_thickness) + int shadow_thickness, int edges) { struct device *d = XDEVICE (f->device); @@ -1706,28 +1550,41 @@ for (elt = 0; elt < shadow_thickness; elt++) { int seg1 = elt; - int seg2 = elt + shadow_thickness; - - top_shadow[seg1].x1 = x; - top_shadow[seg1].x2 = x + width - elt - 1; - top_shadow[seg1].y1 = top_shadow[seg1].y2 = y + elt; + int seg2 = (edges & EDGE_TOP) ? elt + shadow_thickness : elt; + int bot_seg2 = (edges & EDGE_BOTTOM) ? elt + shadow_thickness : elt; - top_shadow[seg2].x1 = top_shadow[seg2].x2 = x + elt; - top_shadow[seg2].y1 = y + shadow_thickness; - top_shadow[seg2].y2 = y + height - elt - 1; - - bottom_shadow[seg1].x1 = x + elt + 1; - bottom_shadow[seg1].x2 = x + width - 1; - bottom_shadow[seg1].y1 = bottom_shadow[seg1].y2 = y + height - elt - 1; - - bottom_shadow[seg2].x1 = bottom_shadow[seg2].x2 = x + width - elt - 1; - bottom_shadow[seg2].y1 = y + elt + 1; - bottom_shadow[seg2].y2 = y + height - shadow_thickness; + if (edges & EDGE_TOP) + { + top_shadow[seg1].x1 = x + elt; + top_shadow[seg1].x2 = x + width - elt - 1; + top_shadow[seg1].y1 = top_shadow[seg1].y2 = y + elt; + } + if (edges & EDGE_LEFT) + { + top_shadow[seg2].x1 = top_shadow[seg2].x2 = x + elt; + top_shadow[seg2].y1 = y + elt; + top_shadow[seg2].y2 = y + height - elt - 1; + } + if (edges & EDGE_BOTTOM) + { + bottom_shadow[seg1].x1 = x + elt; + bottom_shadow[seg1].x2 = x + width - elt - 1; + bottom_shadow[seg1].y1 = bottom_shadow[seg1].y2 = y + height - elt - 1; + } + if (edges & EDGE_RIGHT) + { + bottom_shadow[bot_seg2].x1 = bottom_shadow[bot_seg2].x2 = x + width - elt - 1; + bottom_shadow[bot_seg2].y1 = y + elt; + bottom_shadow[bot_seg2].y2 = y + height - elt - 1; + } } - XDrawSegments (dpy, x_win, top_shadow_gc, top_shadow, shadow_thickness * 2); + XDrawSegments (dpy, x_win, top_shadow_gc, top_shadow, + ((edges & EDGE_TOP) ? shadow_thickness : 0) + + ((edges & EDGE_LEFT) ? shadow_thickness : 0)); XDrawSegments (dpy, x_win, bottom_shadow_gc, bottom_shadow, - shadow_thickness * 2); + ((edges & EDGE_BOTTOM) ? shadow_thickness : 0) + + ((edges & EDGE_RIGHT) ? shadow_thickness : 0)); } /***************************************************************************** @@ -1815,54 +1672,6 @@ } /***************************************************************************** - x_clear_to_window_end - - Clear the area between ypos1 and ypos2. Each margin area and the - text area is handled separately since they may each have their own - background color. - ****************************************************************************/ -static void -x_clear_to_window_end (struct window *w, int ypos1, int ypos2) -{ - int height = ypos2 - ypos1; - - if (height) - { - struct frame *f = XFRAME (w->frame); - Lisp_Object window; - int bflag = (window_needs_vertical_divider (w) ? 0 : 1); - layout_bounds bounds; - - bounds = calculate_display_line_boundaries (w, bflag); - XSETWINDOW (window, w); - - if (window_is_leftmost (w)) - redisplay_clear_region (window, DEFAULT_INDEX, FRAME_LEFT_BORDER_START (f), - ypos1, FRAME_BORDER_WIDTH (f), height); - - if (bounds.left_in - bounds.left_out > 0) - redisplay_clear_region (window, - get_builtin_face_cache_index (w, Vleft_margin_face), - bounds.left_out, ypos1, - bounds.left_in - bounds.left_out, height); - - if (bounds.right_in - bounds.left_in > 0) - redisplay_clear_region (window, DEFAULT_INDEX, bounds.left_in, ypos1, - bounds.right_in - bounds.left_in, height); - - if (bounds.right_out - bounds.right_in > 0) - redisplay_clear_region (window, - get_builtin_face_cache_index (w, Vright_margin_face), - bounds.right_in, ypos1, - bounds.right_out - bounds.right_in, height); - - if (window_is_rightmost (w)) - redisplay_clear_region (window, DEFAULT_INDEX, FRAME_RIGHT_BORDER_START (f), - ypos1, FRAME_BORDER_WIDTH (f), height); - } -} - -/***************************************************************************** x_redraw_exposed_window Given a bounding box for an area that needs to be redrawn, determine @@ -1979,6 +1788,7 @@ redraw anyhow. */ MAYBE_FRAMEMETH (f, redraw_exposed_toolbars, (f, x, y, width, height)); #endif + redraw_exposed_gutters (f, x, y, width, height); if (!f->window_face_cache_reset) { @@ -2045,9 +1855,9 @@ WINDOW_BUFFER (w)); int x = xpos; - int y = dl->ypos - dl->ascent; + int y = DISPLAY_LINE_YPOS (dl); int width = EOL_CURSOR_WIDTH; - int height = dl->ascent + dl->descent - dl->clip; + int height = DISPLAY_LINE_HEIGHT (dl); int cursor_height, cursor_y; int defheight, defascent; @@ -2110,7 +1920,8 @@ return; } - x_clear_to_window_end (w, WINDOW_TEXT_TOP (w), WINDOW_TEXT_BOTTOM (w)); + redisplay_clear_to_window_end (w, WINDOW_TEXT_TOP (w), + WINDOW_TEXT_BOTTOM (w)); } static void @@ -2267,11 +2078,13 @@ CONSOLE_HAS_METHOD (x, divider_height); CONSOLE_HAS_METHOD (x, eol_cursor_width); CONSOLE_HAS_METHOD (x, output_vertical_divider); - CONSOLE_HAS_METHOD (x, clear_to_window_end); CONSOLE_HAS_METHOD (x, clear_region); CONSOLE_HAS_METHOD (x, clear_frame); CONSOLE_HAS_METHOD (x, output_begin); CONSOLE_HAS_METHOD (x, output_end); CONSOLE_HAS_METHOD (x, flash); CONSOLE_HAS_METHOD (x, ring_bell); + CONSOLE_HAS_METHOD (x, bevel_area); + CONSOLE_HAS_METHOD (x, output_string); + CONSOLE_HAS_METHOD (x, output_pixmap); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/redisplay.c --- a/src/redisplay.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/redisplay.c Mon Aug 13 11:13:30 2007 +0200 @@ -51,6 +51,7 @@ #include "faces.h" #include "frame.h" #include "glyphs.h" +#include "gutter.h" #include "insdel.h" #include "menubar.h" #include "objects.h" @@ -107,6 +108,9 @@ /* This information is normally filled in by the create_*_block routines and is used by the add_*_rune routines. */ Lisp_Object window; + /* if we are working with strings rather than buffers we need a + handle to the string */ + Lisp_Object string; struct device *d; struct display_block *db; struct display_line *dl; @@ -150,6 +154,10 @@ (those off the left side of the screen) need to be skipped before anything is displayed. */ Bytind bi_start_col_enabled; + int start_col_xoffset; /* Number of pixels that still need to + be skipped. This is used for + horizontal scrolling of glyphs, where we want + to be able to scroll over part of the glyph. */ int hscroll_glyph_width_adjust; /* how much the width of the hscroll glyph differs from space_width (w). @@ -238,25 +246,19 @@ } prop_block_dynarr; -static void generate_formatted_string_db (Lisp_Object format_str, - Lisp_Object result_str, - struct window *w, - struct display_line *dl, - struct display_block *db, - face_index findex, int min_pixpos, - int max_pixpos, int type); static Charcount generate_fstring_runes (struct window *w, pos_data *data, Charcount pos, Charcount min_pos, Charcount max_pos, Lisp_Object elt, int depth, int max_pixsize, - face_index findex, int type); + face_index findex, int type, + Charcount *offset, + Lisp_Object cur_ext); static prop_block_dynarr *add_glyph_rune (pos_data *data, struct glyph_block *gb, int pos_type, int allow_cursor, struct glyph_cachel *cachel); static Bytind create_text_block (struct window *w, struct display_line *dl, - Bytind bi_start_pos, int start_col, - prop_block_dynarr **prop, + Bytind bi_start_pos, prop_block_dynarr **prop, int type); static int create_overlay_glyph_block (struct window *w, struct display_line *dl); @@ -293,10 +295,6 @@ isn't any reason we need more than a single set. */ display_line_dynarr *cmotion_display_lines; -/* Used by generate_formatted_string. Global because they get used so - much that the dynamic allocation time adds up. */ -Emchar_dynarr *formatted_string_emchar_dynarr; -struct display_line formatted_string_display_line; /* We store the extents that we need to generate in a Dynarr and then frob them all on at the end of generating the string. We do it this way rather than adding them as we generate the string because @@ -304,9 +302,9 @@ (to avoid having to resize the string multiple times), and we don't want to go around adding extents to a string when the extents might stretch off the end of the string. */ -EXTENT_dynarr *formatted_string_extent_dynarr; -Bytecount_dynarr *formatted_string_extent_start_dynarr; -Bytecount_dynarr *formatted_string_extent_end_dynarr; +static EXTENT_dynarr *formatted_string_extent_dynarr; +static Bytecount_dynarr *formatted_string_extent_start_dynarr; +static Bytecount_dynarr *formatted_string_extent_end_dynarr; /* #### probably temporary */ @@ -331,7 +329,7 @@ int horizontal_clip; /* Set if currently inside update_line_start_cache. */ -int updating_line_start_cache; +static int updating_line_start_cache; /* Nonzero means reading single-character input with prompt so put cursor on minibuffer after the prompt. */ @@ -371,6 +369,11 @@ int subwindows_changed; int subwindows_changed_set; +/* non-zero if any displayed subwindow is in need of updating + somewhere. */ +int subwindows_state_changed; +int subwindows_state_changed_set; + /* This variable is 1 if the icon has to be updated. It is set to 1 when `frame-icon-glyph' changes. */ int icon_changed; @@ -401,6 +404,10 @@ int toolbar_changed; int toolbar_changed_set; +/* non-nil if any gutter has changed */ +int gutter_changed; +int gutter_changed_set; + /* non-nil if any window has changed since the last time redisplay completed */ int windows_changed; @@ -412,7 +419,6 @@ Lisp_Object Vbar_cursor; Lisp_Object Qbar_cursor; - int visible_bell; /* If true and the terminal will support it then the frame will flash instead of beeping when an error occurs */ @@ -442,7 +448,7 @@ Lisp_Object Voverlay_arrow_string; Lisp_Object Vwindow_size_change_functions; -Lisp_Object Qwindow_scroll_functions, Vwindow_scroll_functions; +Lisp_Object Vwindow_scroll_functions; Lisp_Object Qredisplay_end_trigger_functions, Vredisplay_end_trigger_functions; #define INHIBIT_REDISPLAY_HOOKS /* #### Until we've thought about @@ -454,7 +460,7 @@ Lisp_Object Qpre_redisplay_hook, Qpost_redisplay_hook; #endif /* INHIBIT_REDISPLAY_HOOKS */ -int last_display_warning_tick, display_warning_tick; +static int last_display_warning_tick, display_warning_tick; Lisp_Object Qdisplay_warning_buffer; int inhibit_warning_display; @@ -464,6 +470,10 @@ Lisp_Object Vtext_cursor_visible_p; int column_number_start_at_one; + +#define WINDOW_SCROLLED(w) \ +(w->hscroll > 0 || w->left_xoffset) + /***************************************************************************/ /* */ @@ -633,8 +643,8 @@ int pix_tab_width = tab_pix_width (w); /* Adjust n_pos for any hscrolling which has happened. */ - if (w->hscroll > 1) - n_pos -= space_width (w) * (w->hscroll - 1); + if (WINDOW_SCROLLED (w)) + n_pos -= space_width (w) * (w->hscroll - 1) + w->left_xoffset; while (n_pos <= start_pixpos) n_pos += pix_tab_width; @@ -686,8 +696,7 @@ static Bufpos generate_display_line (struct window *w, struct display_line *dl, int bounds, - Bufpos start_pos, int start_col, - prop_block_dynarr **prop, + Bufpos start_pos, prop_block_dynarr **prop, int type) { Bufpos ret_bufpos; @@ -720,7 +729,7 @@ /* #### urk urk urk!!! Chuck fix this shit! */ Bytind hacked_up_bytind = create_text_block (w, dl, bufpos_to_bytind (b, start_pos), - start_col, prop, type); + prop, type); if (hacked_up_bytind > BI_BUF_ZV (b)) ret_bufpos = BUF_ZV (b) + 1; else @@ -850,7 +859,7 @@ Lisp_Object font_instance = ensure_face_cachel_contains_charset (cachel, data->window, charset); - struct Lisp_Font_Instance *fi; + Lisp_Font_Instance *fi; if (EQ (font_instance, Vthe_null_font_instance)) { @@ -902,9 +911,15 @@ crb->xpos = data->pixpos; crb->width = width; if (data->bi_bufpos) - crb->bufpos = - bytind_to_bufpos (XBUFFER (WINDOW_BUFFER (XWINDOW (data->window))), - data->bi_bufpos); + { + if (NILP (data->string)) + crb->bufpos = + bytind_to_bufpos (XBUFFER (WINDOW_BUFFER (XWINDOW (data->window))), + data->bi_bufpos); + else + crb->bufpos = + bytecount_to_charcount (XSTRING_DATA (data->string), data->bi_bufpos); + } else if (data->is_modeline) crb->bufpos = data->modeline_charpos; else @@ -1326,7 +1341,7 @@ prop_block_dynarr *prop = NULL; if (VECTORP (entry)) { - struct Lisp_Vector *de = XVECTOR (entry); + Lisp_Vector *de = XVECTOR (entry); EMACS_INT len = vector_length (de); int elt; @@ -1509,6 +1524,16 @@ { struct window *w = XWINDOW (data->window); + /* If window faces changed, and glyph instance is text, then + glyph sizes might have changed too */ + invalidate_glyph_geometry_maybe (gb->glyph, w); + + /* This makes sure the glyph is in the cachels. + + #### We need to change this so that we hold onto the glyph_index + here, not the glyph itself. */ + get_glyph_cachel_index (w, gb->glyph); + /* A nil extent indicates a special glyph (ex. truncator). */ if (NILP (gb->extent) || (pos_type == BEGIN_GLYPHS && @@ -1526,12 +1551,12 @@ if (cachel) width = cachel->width; else - width = glyph_width (gb->glyph, Qnil, data->findex, data->window); + width = glyph_width (gb->glyph, data->window); if (!width) return NULL; - if (data->start_col) + if (data->start_col || data->start_col_xoffset) { prop_block_dynarr *retval; int glyph_char_width = width / space_width (w); @@ -1589,9 +1614,8 @@ } else { - ascent = glyph_ascent (gb->glyph, Qnil, data->findex, data->window); - descent = glyph_descent (gb->glyph, Qnil, data->findex, - data->window); + ascent = glyph_ascent (gb->glyph, data->window); + descent = glyph_descent (gb->glyph, data->window); } baseline = glyph_baseline (gb->glyph, data->window); @@ -1765,8 +1789,7 @@ static Bytind create_text_block (struct window *w, struct display_line *dl, - Bytind bi_start_pos, int start_col, - prop_block_dynarr **prop, + Bytind bi_start_pos, prop_block_dynarr **prop, int type) { struct frame *f = XFRAME (w->frame); @@ -1791,7 +1814,7 @@ after a ^M is invisible. */ int selective = (INTP (b->selective_display) ? XINT (b->selective_display) - : ((!NILP (b->selective_display) ? -1 : 0))); + : (!NILP (b->selective_display) ? -1 : 0)); /* The variable ctl-arrow allows the user to specify what characters can actually be displayed and which octal should be used for. @@ -1866,6 +1889,7 @@ them to this structure for ease of passing. */ data.d = d; XSETWINDOW (data.window, w); + data.string = Qnil; data.db = db; data.dl = dl; @@ -1909,6 +1933,7 @@ data.cursor_x = -1; data.start_col = w->hscroll; + data.start_col_xoffset = w->left_xoffset; data.bi_start_col_enabled = (w->hscroll ? bi_start_pos : 0); data.hscroll_glyph_width_adjust = 0; @@ -2228,6 +2253,7 @@ data.blank_width = DEVMETH (d, eol_cursor_width, ()); data.findex = DEFAULT_INDEX; data.start_col = 0; + data.start_col_xoffset = 0; data.bi_start_col_enabled = 0; add_emchar_rune (&data); @@ -2261,7 +2287,8 @@ int prop_width = 0; if (data.start_col > 1) - tab_start_pixpos -= (space_width (w) * (data.start_col - 1)); + tab_start_pixpos -= (space_width (w) * (data.start_col - 1)) + + data.start_col_xoffset; next_tab_start = next_tab_position (w, tab_start_pixpos, @@ -2468,6 +2495,7 @@ data.blank_width = DEVMETH (d, eol_cursor_width, ()); data.findex = DEFAULT_INDEX; data.start_col = 0; + data.start_col_xoffset = 0; data.bi_start_col_enabled = 0; data.max_pixpos += data.blank_width; @@ -2643,6 +2671,7 @@ data.last_charset = Qunbound; data.last_findex = DEFAULT_INDEX; data.result_str = Qnil; + data.string = Qnil; Dynarr_reset (data.db->runes); @@ -2747,8 +2776,8 @@ unsigned short ascent, descent; Lisp_Object baseline = glyph_baseline (gb->glyph, window); - ascent = glyph_ascent (gb->glyph, Qnil, gb->findex, window); - descent = glyph_descent (gb->glyph, Qnil, gb->findex, window); + ascent = glyph_ascent (gb->glyph, window); + descent = glyph_descent (gb->glyph, window); /* A pixmap that has not had a baseline explicitly set. We use the existing ascent / descent ratio of the @@ -2862,7 +2891,7 @@ { int width; - width = glyph_width (gb->glyph, Qnil, gb->findex, window); + width = glyph_width (gb->glyph, window); if (white_in_start - width >= left_in_end) { @@ -2913,7 +2942,7 @@ if (extent_begin_glyph_layout (XEXTENT (gb->extent)) == GL_INSIDE_MARGIN) { - gb->width = glyph_width (gb->glyph, Qnil, gb->findex, window); + gb->width = glyph_width (gb->glyph, window); used_in += gb->width; Dynarr_add (ib, *gb); } @@ -2982,7 +3011,7 @@ if (extent_begin_glyph_layout (XEXTENT (gb->extent)) == GL_INSIDE_MARGIN) { - int width = glyph_width (gb->glyph, Qnil, gb->findex, window); + int width = glyph_width (gb->glyph, window); if (used_out) { @@ -3024,7 +3053,7 @@ if (extent_begin_glyph_layout (XEXTENT (gb->extent)) == GL_OUTSIDE_MARGIN) { - int width = glyph_width (gb->glyph, Qnil, gb->findex, window); + int width = glyph_width (gb->glyph, window); if (out_end + width <= in_out_start) { @@ -3181,7 +3210,7 @@ if (extent_end_glyph_layout (XEXTENT (gb->extent)) == GL_WHITESPACE) { - int width = glyph_width (gb->glyph, Qnil, gb->findex, window); + int width = glyph_width (gb->glyph, window); if (white_in_end + width <= dl->bounds.right_in) { @@ -3231,7 +3260,7 @@ if (extent_end_glyph_layout (XEXTENT (gb->extent)) == GL_INSIDE_MARGIN) { - gb->width = glyph_width (gb->glyph, Qnil, gb->findex, window); + gb->width = glyph_width (gb->glyph, window); used_in += gb->width; Dynarr_add (ib, *gb); } @@ -3295,7 +3324,7 @@ if (extent_end_glyph_layout (XEXTENT (gb->extent)) == GL_INSIDE_MARGIN) { - int width = glyph_width (gb->glyph, Qnil, gb->findex, window); + int width = glyph_width (gb->glyph, window); if (used_out) { @@ -3336,7 +3365,7 @@ if (extent_end_glyph_layout (XEXTENT (gb->extent)) == GL_OUTSIDE_MARGIN) { - int width = glyph_width (gb->glyph, Qnil, gb->findex, window); + int width = glyph_width (gb->glyph, window); if (out_start - width >= in_out_end) { @@ -3452,103 +3481,8 @@ /* */ /***************************************************************************/ -/* Ensure that the given display line DL accurately represents the - modeline for the given window. */ - -static void -generate_modeline (struct window *w, struct display_line *dl, int type) -{ - struct buffer *b = XBUFFER (w->buffer); - struct frame *f = XFRAME (w->frame); - struct device *d = XDEVICE (f->device); - - /* Unlike display line and rune pointers, this one can't change underneath - our feet. */ - struct display_block *db = get_display_block_from_line (dl, TEXT); - int max_pixpos, min_pixpos, ypos_adj; - Lisp_Object font_inst; - - /* This will actually determine incorrect inside boundaries for the - modeline since it ignores the margins. However being aware of this fact - we never use those values anywhere so it doesn't matter. */ - dl->bounds = calculate_display_line_boundaries (w, 1); - - /* We are generating a modeline. */ - dl->modeline = 1; - dl->cursor_elt = -1; - - /* Reset the runes on the modeline. */ - Dynarr_reset (db->runes); - - if (!WINDOW_HAS_MODELINE_P (w)) - { - struct rune rb; - - /* If there is a horizontal scrollbar, don't add anything. */ - if (window_scrollbar_height (w)) - return; - - dl->ascent = DEVMETH (d, divider_height, ()); - dl->descent = 0; - /* The modeline is at the bottom of the gutters. */ - dl->ypos = WINDOW_BOTTOM (w); - - rb.findex = MODELINE_INDEX; - rb.xpos = dl->bounds.left_out; - rb.width = dl->bounds.right_out - dl->bounds.left_out; - rb.bufpos = 0; - rb.endpos = 0; - rb.type = RUNE_HLINE; - rb.object.hline.thickness = 1; - rb.object.hline.yoffset = 0; - rb.cursor_type = NO_CURSOR; - - if (!EQ (Qzero, w->modeline_shadow_thickness) - && FRAME_WIN_P (f)) - { - int shadow_thickness = MODELINE_SHADOW_THICKNESS (w); - - dl->ypos -= shadow_thickness; - rb.xpos += shadow_thickness; - rb.width -= 2 * shadow_thickness; - } - - Dynarr_add (db->runes, rb); - return; - } - - /* !!#### not right; needs to compute the max height of - all the charsets */ - font_inst = WINDOW_FACE_CACHEL_FONT (w, MODELINE_INDEX, Vcharset_ascii); - - dl->ascent = XFONT_INSTANCE (font_inst)->ascent; - dl->descent = XFONT_INSTANCE (font_inst)->descent; - - min_pixpos = dl->bounds.left_out; - max_pixpos = dl->bounds.right_out; - - if (!EQ (Qzero, w->modeline_shadow_thickness) && FRAME_WIN_P (f)) - { - int shadow_thickness = MODELINE_SHADOW_THICKNESS (w); - - ypos_adj = shadow_thickness; - min_pixpos += shadow_thickness; - max_pixpos -= shadow_thickness; - } - else - ypos_adj = 0; - - generate_formatted_string_db (b->modeline_format, - b->generated_modeline_string, w, dl, db, - MODELINE_INDEX, min_pixpos, max_pixpos, type); - - /* The modeline is at the bottom of the gutters. We have to wait to - set this until we've generated the modeline in order to account - for any embedded faces. */ - dl->ypos = WINDOW_BOTTOM (w) - dl->descent - ypos_adj; -} - -static void +/* This function is also used in frame.c by `generate_title_string' */ +void generate_formatted_string_db (Lisp_Object format_str, Lisp_Object result_str, struct window *w, struct display_line *dl, struct display_block *db, face_index findex, @@ -3559,6 +3493,7 @@ pos_data data; int c_pixpos; + Charcount offset = 0; xzero (data); data.d = d; @@ -3572,15 +3507,21 @@ data.last_findex = DEFAULT_INDEX; data.result_str = result_str; data.is_modeline = 1; + data.string = Qnil; XSETWINDOW (data.window, w); Dynarr_reset (formatted_string_extent_dynarr); Dynarr_reset (formatted_string_extent_start_dynarr); Dynarr_reset (formatted_string_extent_end_dynarr); - /* This recursively builds up the modeline. */ + /* result_str is nil when we're building a frame or icon title. Otherwise, + we're building a modeline, so the offset starts at the modeline + horizontal scrolling ammount */ + if (! NILP (result_str)) + offset = w->modeline_hscroll; generate_fstring_runes (w, &data, 0, 0, -1, format_str, 0, - max_pixpos - min_pixpos, findex, type); + max_pixpos - min_pixpos, findex, type, &offset, + Qnil); if (Dynarr_length (db->runes)) { @@ -3651,13 +3592,115 @@ } } +/* Ensure that the given display line DL accurately represents the + modeline for the given window. */ +static void +generate_modeline (struct window *w, struct display_line *dl, int type) +{ + struct buffer *b = XBUFFER (w->buffer); + struct frame *f = XFRAME (w->frame); + struct device *d = XDEVICE (f->device); + + /* Unlike display line and rune pointers, this one can't change underneath + our feet. */ + struct display_block *db = get_display_block_from_line (dl, TEXT); + int max_pixpos, min_pixpos, ypos_adj; + Lisp_Object font_inst; + + /* This will actually determine incorrect inside boundaries for the + modeline since it ignores the margins. However being aware of this fact + we never use those values anywhere so it doesn't matter. */ + dl->bounds = calculate_display_line_boundaries (w, 1); + + /* We are generating a modeline. */ + dl->modeline = 1; + dl->cursor_elt = -1; + + /* Reset the runes on the modeline. */ + Dynarr_reset (db->runes); + + if (!WINDOW_HAS_MODELINE_P (w)) + { + struct rune rb; + + /* If there is a horizontal scrollbar, don't add anything. */ + if (window_scrollbar_height (w)) + return; + + dl->ascent = DEVMETH (d, divider_height, ()); + dl->descent = 0; + /* The modeline is at the bottom of the gutters. */ + dl->ypos = WINDOW_BOTTOM (w); + + /* adjust for the bottom gutter */ + if (window_is_lowest (w)) + dl->ypos -= FRAME_BOTTOM_GUTTER_BOUNDS (f); + + rb.findex = MODELINE_INDEX; + rb.xpos = dl->bounds.left_out; + rb.width = dl->bounds.right_out - dl->bounds.left_out; + rb.bufpos = 0; + rb.endpos = 0; + rb.type = RUNE_HLINE; + rb.object.hline.thickness = 1; + rb.object.hline.yoffset = 0; + rb.cursor_type = NO_CURSOR; + + if (!EQ (Qzero, w->modeline_shadow_thickness) + && FRAME_WIN_P (f)) + { + int shadow_thickness = MODELINE_SHADOW_THICKNESS (w); + + dl->ypos -= shadow_thickness; + rb.xpos += shadow_thickness; + rb.width -= 2 * shadow_thickness; + } + + Dynarr_add (db->runes, rb); + return; + } + + /* !!#### not right; needs to compute the max height of + all the charsets */ + font_inst = WINDOW_FACE_CACHEL_FONT (w, MODELINE_INDEX, Vcharset_ascii); + + dl->ascent = XFONT_INSTANCE (font_inst)->ascent; + dl->descent = XFONT_INSTANCE (font_inst)->descent; + + min_pixpos = dl->bounds.left_out; + max_pixpos = dl->bounds.right_out; + + if (!EQ (Qzero, w->modeline_shadow_thickness) && FRAME_WIN_P (f)) + { + int shadow_thickness = MODELINE_SHADOW_THICKNESS (w); + + ypos_adj = shadow_thickness; + min_pixpos += shadow_thickness; + max_pixpos -= shadow_thickness; + } + else + ypos_adj = 0; + + generate_formatted_string_db (b->modeline_format, + b->generated_modeline_string, w, dl, db, + MODELINE_INDEX, min_pixpos, max_pixpos, type); + + /* The modeline is at the bottom of the gutters. We have to wait to + set this until we've generated the modeline in order to account + for any embedded faces. */ + dl->ypos = WINDOW_BOTTOM (w) - dl->descent - ypos_adj; + /* adjust for the bottom gutter */ + if (window_is_lowest (w)) + dl->ypos -= FRAME_BOTTOM_GUTTER_BOUNDS (f); +} + static Charcount -add_string_to_fstring_db_runes (pos_data *data, CONST Bufbyte *str, +add_string_to_fstring_db_runes (pos_data *data, const Bufbyte *str, Charcount pos, Charcount min_pos, Charcount max_pos) { /* This function has been Mule-ized. */ Charcount end; - CONST Bufbyte *cur_pos = str; + const Bufbyte *cur_pos = str; struct display_block *db = data->db; data->blank_width = space_width (XWINDOW (data->window)); @@ -3665,13 +3708,13 @@ add_blank_rune (data, NULL, 0); end = (Dynarr_length (db->runes) + - bytecount_to_charcount (str, strlen ((CONST char *) str))); + bytecount_to_charcount (str, strlen ((const char *) str))); if (max_pos != -1) end = min (max_pos, end); while (pos < end && *cur_pos) { - CONST Bufbyte *old_cur_pos = cur_pos; + const Bufbyte *old_cur_pos = cur_pos; int succeeded; data->ch = charptr_emchar (cur_pos); @@ -3696,7 +3739,8 @@ modeline extents. */ static Charcount add_glyph_to_fstring_db_runes (pos_data *data, Lisp_Object glyph, - Charcount pos, Charcount min_pos, Charcount max_pos) + Charcount pos, Charcount min_pos, + Charcount max_pos, Lisp_Object extent) { /* This function has been Mule-ized. */ Charcount end; @@ -3712,7 +3756,7 @@ end = min (max_pos, end); gb.glyph = glyph; - gb.extent = Qnil; + gb.extent = extent; add_glyph_rune (data, &gb, BEGIN_GLYPHS, 0, 0); pos++; @@ -3739,7 +3783,8 @@ generate_fstring_runes (struct window *w, pos_data *data, Charcount pos, Charcount min_pos, Charcount max_pos, Lisp_Object elt, int depth, int max_pixsize, - face_index findex, int type) + face_index findex, int type, Charcount *offset, + Lisp_Object cur_ext) { /* This function has been Mule-ized. */ /* #### The other losing things in this function are: @@ -3771,13 +3816,22 @@ if (this != last) { - /* The string is just a string. */ + /* No %-construct */ Charcount size = - bytecount_to_charcount (last, this - last) + pos; - Charcount tmp_max = (max_pos == -1 ? size : min (size, max_pos)); - - pos = add_string_to_fstring_db_runes (data, last, pos, pos, - tmp_max); + bytecount_to_charcount (last, this - last); + + if (size <= *offset) + *offset -= size; + else + { + Charcount tmp_max = (max_pos == -1 ? pos + size - *offset : + min (pos + size - *offset, max_pos)); + const Bufbyte *tmp_last = charptr_n_addr (last, *offset); + + pos = add_string_to_fstring_db_runes (data, tmp_last, + pos, pos, tmp_max); + *offset = 0; + } } else /* *this == '%' */ { @@ -3802,7 +3856,7 @@ pos = generate_fstring_runes (w, data, pos, spec_width, max_pos, Vglobal_mode_string, depth, max_pixsize, findex, - type); + type, offset, cur_ext); } else if (*this == '-') { @@ -3829,17 +3883,35 @@ while (num_to_add--) pos = add_string_to_fstring_db_runes - (data, (CONST Bufbyte *) "-", pos, pos, max_pos); + (data, (const Bufbyte *) "-", pos, pos, max_pos); } else if (*this != 0) { + Emchar ch = charptr_emchar (this); Bufbyte *str; - Emchar ch = charptr_emchar (this); + Charcount size; + decode_mode_spec (w, ch, type); str = Dynarr_atp (mode_spec_bufbyte_string, 0); - pos = add_string_to_fstring_db_runes (data,str, pos, pos, - max_pos); + size = bytecount_to_charcount + /* Skip the null character added by `decode_mode_spec' */ + (str, Dynarr_length (mode_spec_bufbyte_string)) - 1; + + if (size <= *offset) + *offset -= size; + else + { + const Bufbyte *tmp_str = charptr_n_addr (str, *offset); + + /* #### NOTE: I don't understand why a tmp_max is not + computed and used here as in the plain string case + above. -- dv */ + pos = add_string_to_fstring_db_runes (data, tmp_str, + pos, pos, + max_pos); + *offset = 0; + } } /* NOT this++. There could be any sort of character at @@ -3865,13 +3937,26 @@ if (!UNBOUNDP (tem)) { - /* If value is a string, output that string literally: + /* If value is a string, output that string literally: don't check for % within it. */ if (STRINGP (tem)) { - pos = - add_string_to_fstring_db_runes - (data, XSTRING_DATA (tem), pos, min_pos, max_pos); + Bufbyte *str = XSTRING_DATA (tem); + Charcount size = XSTRING_CHAR_LENGTH (tem); + + if (size <= *offset) + *offset -= size; + else + { + const Bufbyte *tmp_str = charptr_n_addr (str, *offset); + + /* #### NOTE: I don't understand why a tmp_max is not + computed and used here as in the plain string case + above. -- dv */ + pos = add_string_to_fstring_db_runes (data, tmp_str, pos, + min_pos, max_pos); + *offset = 0; + } } /* Give up right away for nil or t. */ else if (!EQ (tem, elt)) @@ -3896,50 +3981,53 @@ else if (CONSP (elt)) { /* A cons cell: four distinct cases. - * If first element is a string or a cons, process all the elements - * and effectively concatenate them. - * If first element is a negative number, truncate displaying cdr to - * at most that many characters. If positive, pad (with spaces) - * to at least that many characters. - * If first element is a symbol, process the cadr or caddr recursively - * according to whether the symbol's value is non-nil or nil. - * If first element is a face, process the cdr recursively - * without altering the depth. + * - If first element is a string or a cons, process all the elements + * and effectively concatenate them. + * - If first element is a negative number, truncate displaying cdr to + * at most that many characters. If positive, pad (with spaces) + * to at least that many characters. + * - If first element is another symbol, process the cadr or caddr + * recursively according to whether the symbol's value is non-nil or + * nil. + * - If first element is a face, process the cdr recursively + * without altering the depth. */ + Lisp_Object car, tem; car = XCAR (elt); if (SYMBOLP (car)) - { - elt = XCDR (elt); - if (!CONSP (elt)) - goto invalid; - tem = symbol_value_in_buffer (car, w->buffer); - /* elt is now the cdr, and we know it is a cons cell. - Use its car if CAR has a non-nil value. */ - if (!UNBOUNDP (tem)) - { - if (!NILP (tem)) - { - elt = XCAR (elt); - goto tail_recurse; - } - } - /* Symbol's value is nil (or symbol is unbound) - * Get the cddr of the original list - * and if possible find the caddr and use that. - */ - elt = XCDR (elt); - if (NILP (elt)) - ; - else if (!CONSP (elt)) - goto invalid; - else - { - elt = XCAR (elt); - goto tail_recurse; - } - } + { + elt = XCDR (elt); + if (!CONSP (elt)) + goto invalid; + + tem = symbol_value_in_buffer (car, w->buffer); + /* elt is now the cdr, and we know it is a cons cell. + Use its car if CAR has a non-nil value. */ + if (!UNBOUNDP (tem)) + { + if (!NILP (tem)) + { + elt = XCAR (elt); + goto tail_recurse; + } + } + /* Symbol's value is nil (or symbol is unbound) + * Get the cddr of the original list + * and if possible find the caddr and use that. + */ + elt = XCDR (elt); + if (NILP (elt)) + ; + else if (!CONSP (elt)) + goto invalid; + else + { + elt = XCAR (elt); + goto tail_recurse; + } + } else if (INTP (car)) { Charcount lim = XINT (car); @@ -3978,13 +4066,14 @@ else if (STRINGP (car) || CONSP (car)) { int limit = 50; + /* LIMIT is to protect against circular lists. */ while (CONSP (elt) && --limit > 0 && (pos < max_pos || max_pos == -1)) { pos = generate_fstring_runes (w, data, pos, pos, max_pos, - XCAR (elt), depth, - max_pixsize, findex, type); + XCAR (elt), depth, max_pixsize, + findex, type, offset, cur_ext); elt = XCDR (elt); } } @@ -4023,7 +4112,8 @@ data->findex = new_findex; pos = generate_fstring_runes (w, data, pos, pos, max_pos, XCDR (elt), depth - 1, - max_pixsize, new_findex, type); + max_pixsize, new_findex, type, + offset, car); data->findex = old_findex; Dynarr_add (formatted_string_extent_dynarr, ext); Dynarr_add (formatted_string_extent_start_dynarr, start); @@ -4033,57 +4123,46 @@ } else if (GLYPHP (elt)) { - pos = add_glyph_to_fstring_db_runes (data, elt, pos, pos, max_pos); + /* Glyphs are considered as one character with respect to the modeline + horizontal scrolling facility. -- dv */ + if (*offset > 0) + *offset -= 1; + else + pos = add_glyph_to_fstring_db_runes (data, elt, pos, pos, max_pos, + cur_ext); } else { invalid: - pos = - add_string_to_fstring_db_runes - (data, (CONST Bufbyte *) GETTEXT ("*invalid*"), pos, min_pos, - max_pos); + { + char *str = GETTEXT ("*invalid*"); + Charcount size = (Charcount) strlen (str); /* is this ok ?? -- dv */ + + if (size <= *offset) + *offset -= size; + else + { + const Bufbyte *tmp_str = + charptr_n_addr ((const Bufbyte *) str, *offset); + + /* #### NOTE: I don't understand why a tmp_max is not computed and + used here as in the plain string case above. -- dv */ + pos = add_string_to_fstring_db_runes (data, tmp_str, pos, + min_pos, max_pos); + *offset = 0; + } + } } if (min_pos > pos) { - add_string_to_fstring_db_runes (data, (CONST Bufbyte *) "", pos, min_pos, - -1); + add_string_to_fstring_db_runes (data, (const Bufbyte *) "", pos, + min_pos, -1); } return pos; } -/* The caller is responsible for freeing the returned string. */ -Bufbyte * -generate_formatted_string (struct window *w, Lisp_Object format_str, - Lisp_Object result_str, face_index findex, int type) -{ - struct display_line *dl; - struct display_block *db; - int elt = 0; - - dl = &formatted_string_display_line; - db = get_display_block_from_line (dl, TEXT); - Dynarr_reset (db->runes); - - generate_formatted_string_db (format_str, result_str, w, dl, db, findex, 0, - -1, type); - - Dynarr_reset (formatted_string_emchar_dynarr); - while (elt < Dynarr_length (db->runes)) - { - if (Dynarr_atp (db->runes, elt)->type == RUNE_CHAR) - Dynarr_add (formatted_string_emchar_dynarr, - Dynarr_atp (db->runes, elt)->object.chr.ch); - elt++; - } - - return - convert_emchar_string_into_malloced_string - ( Dynarr_atp (formatted_string_emchar_dynarr, 0), - Dynarr_length (formatted_string_emchar_dynarr), 0); -} - /* Update just the modeline. Assumes the desired display structs. If they do not have a modeline block, it does nothing. */ static void @@ -4178,6 +4257,834 @@ /***************************************************************************/ +/* */ +/* displayable string routines */ +/* */ +/***************************************************************************/ + +/* Given a position for a string in a window, ensure that the given + display line DL accurately represents the text on a line starting + at the given position. + + Yes, this is duplicating the code of create_text_block, but it + looked just too hard to change create_text_block to handle strings + *and* buffers. We already make a distinction between the two + elsewhere in the code so I think unifying them would require a + complete MULE rewrite. Besides, the other distinction is that these + functions cover text that the user *cannot edit* so we can remove + everything to do with cursors, minibuffers etc. Eventually the + modeline routines should be modified to use this code as it copes + with many more types of display situation. */ + +static Bufpos +create_string_text_block (struct window *w, Lisp_Object disp_string, + struct display_line *dl, + Bufpos start_pos, + prop_block_dynarr **prop, + face_index default_face) +{ + struct frame *f = XFRAME (w->frame); + /* Note that a lot of the buffer controlled stuff has been left in + because you might well want to make use of it (selective display + etc), its just the buffer text that we do not use. However, it + seems to be possible for buffer to be nil sometimes so protect + against this case. */ + struct buffer *b = BUFFERP (w->buffer) ? XBUFFER (w->buffer) : 0; + struct device *d = XDEVICE (f->device); + Lisp_String* s = XSTRING (disp_string); + + /* we're working with these a lot so precalculate them */ + Bytecount slen = XSTRING_LENGTH (disp_string); + Bytecount bi_string_zv = slen; + Bytind bi_start_pos = charcount_to_bytecount (string_data (s), start_pos); + + pos_data data; + + int truncate_win = b ? window_truncation_on (w) : 0; + int end_glyph_width = 0; + + /* we're going to ditch selective display for static text, its an + FSF thing and invisble extents are the way to go + here. Implementing it also relies on a number of buffer-specific + functions that we don't have the luxury of being able to use + here. */ + + /* The variable ctl-arrow allows the user to specify what characters + can actually be displayed and which octal should be used for. + #### This variable should probably have some rethought done to + it. + + #### It would also be really nice if you could specify that + the characters come out in hex instead of in octal. Mule + does that by adding a ctl-hexa variable similar to ctl-arrow, + but that's bogus -- we need a more general solution. I + think you need to extend the concept of display tables + into a more general conversion mechanism. Ideally you + could specify a Lisp function that converts characters, + but this violates the Second Golden Rule and besides would + make things way way way way slow. + + So instead, we extend the display-table concept, which was + historically limited to 256-byte vectors, to one of the + following: + + a) A 256-entry vector, for backward compatibility; + b) char-table, mapping characters to values; + c) range-table, mapping ranges of characters to values; + d) a list of the above. + + The (d) option allows you to specify multiple display tables + instead of just one. Each display table can specify conversions + for some characters and leave others unchanged. The way the + character gets displayed is determined by the first display table + with a binding for that character. This way, you could call a + function `enable-hex-display' that adds a hex display-table to + the list of display tables for the current buffer. + + #### ...not yet implemented... Also, we extend the concept of + "mapping" to include a printf-like spec. Thus you can make all + extended characters show up as hex with a display table like + this: + + #s(range-table data ((256 524288) (format "%x"))) + + Since more than one display table is possible, you have + great flexibility in mapping ranges of characters. */ + Emchar printable_min = b ? (CHAR_OR_CHAR_INTP (b->ctl_arrow) + ? XCHAR_OR_CHAR_INT (b->ctl_arrow) + : ((EQ (b->ctl_arrow, Qt) || EQ (b->ctl_arrow, Qnil)) + ? 255 : 160)) : 255; + + Lisp_Object face_dt, window_dt; + + /* The text display block for this display line. */ + struct display_block *db = get_display_block_from_line (dl, TEXT); + + /* The first time through the main loop we need to force the glyph + data to be updated. */ + int initial = 1; + + /* Apparently the new extent_fragment_update returns an end position + equal to the position passed in if there are no more runs to be + displayed. */ + int no_more_frags = 0; + + dl->used_prop_data = 0; + dl->num_chars = 0; + + /* set up faces to use for clearing areas, used by + output_display_line */ + dl->default_findex = default_face; + if (default_face) + { + dl->left_margin_findex = default_face; + dl->right_margin_findex = default_face; + } + else + { + dl->left_margin_findex = + get_builtin_face_cache_index (w, Vleft_margin_face); + dl->right_margin_findex = + get_builtin_face_cache_index (w, Vright_margin_face); + } + + xzero (data); + data.ef = extent_fragment_new (disp_string, f); + + /* These values are used by all of the rune addition routines. We add + them to this structure for ease of passing. */ + data.d = d; + XSETWINDOW (data.window, w); + data.db = db; + data.dl = dl; + + data.bi_bufpos = bi_start_pos; + data.pixpos = dl->bounds.left_in; + data.last_charset = Qunbound; + data.last_findex = default_face; + data.result_str = Qnil; + data.string = disp_string; + + /* Set the right boundary adjusting it to take into account any end + glyph. Save the width of the end glyph for later use. */ + data.max_pixpos = dl->bounds.right_in; +#if 0 + if (truncate_win) + end_glyph_width = GLYPH_CACHEL_WIDTH (w, TRUN_GLYPH_INDEX); + else + end_glyph_width = GLYPH_CACHEL_WIDTH (w, CONT_GLYPH_INDEX); +#endif + data.max_pixpos -= end_glyph_width; + + data.cursor_type = NO_CURSOR; + data.cursor_x = -1; + + data.start_col = 0; + /* I don't think we want this, string areas should not scroll with + the window + data.start_col = w->hscroll; + data.bi_start_col_enabled = (w->hscroll ? bi_start_pos : 0); + */ + data.bi_start_col_enabled = 0; + data.hscroll_glyph_width_adjust = 0; + + /* We regenerate the line from the very beginning. */ + Dynarr_reset (db->runes); + + /* Why is this less than or equal and not just less than? If the + starting position is already equal to the maximum we can't add + anything else, right? Wrong. We might still have a newline to + add. A newline can use the room allocated for an end glyph since + if we add it we know we aren't going to be adding any end + glyph. */ + + /* #### Chuck -- I think this condition should be while (1). + Otherwise if (e.g.) there is one begin-glyph and one end-glyph + and the begin-glyph ends exactly at the end of the window, the + end-glyph and text might not be displayed. while (1) ensures + that the loop terminates only when either (a) there is + propagation data or (b) the end-of-line or end-of-buffer is hit. + + #### Also I think you need to ensure that the operation + "add begin glyphs; add end glyphs; add text" is atomic and + can't get interrupted in the middle. If you run off the end + of the line during that operation, then you keep accumulating + propagation data until you're done. Otherwise, if the (e.g.) + there's a begin glyph at a particular position and attempting + to display that glyph results in window-end being hit and + propagation data being generated, then the character at that + position won't be displayed. + + #### See also the comment after the end of this loop, below. + */ + while (data.pixpos <= data.max_pixpos) + { + /* #### This check probably should not be necessary. */ + if (data.bi_bufpos > bi_string_zv) + { + /* #### urk! More of this lossage! */ + data.bi_bufpos--; + goto done; + } + + /* Check for face changes. */ + if (initial || (!no_more_frags && data.bi_bufpos == data.ef->end)) + { + /* Now compute the face and begin/end-glyph information. */ + data.findex = + /* Remember that the extent-fragment routines deal in Bytind's. */ + extent_fragment_update (w, data.ef, data.bi_bufpos); + /* This is somewhat cheesy but the alternative is to + propagate default_face into extent_fragment_update. */ + if (data.findex == DEFAULT_INDEX) + data.findex = default_face; + + get_display_tables (w, data.findex, &face_dt, &window_dt); + + if (data.bi_bufpos == data.ef->end) + no_more_frags = 1; + } + initial = 0; + + /* Determine what is next to be displayed. We first handle any + glyphs returned by glyphs_at_bufpos. If there are no glyphs to + display then we determine what to do based on the character at the + current buffer position. */ + + /* If the current position is covered by an invisible extent, do + nothing (except maybe add some ellipses). + + #### The behavior of begin and end-glyphs at the edge of an + invisible extent should be investigated further. This is + fairly low priority though. */ + if (data.ef->invisible) + { + /* #### Chuck, perhaps you could look at this code? I don't + really know what I'm doing. */ + if (*prop) + { + Dynarr_free (*prop); + *prop = 0; + } + + /* The extent fragment code only sets this when we should + really display the ellipses. It makes sure the ellipses + don't get displayed more than once in a row. */ + if (data.ef->invisible_ellipses) + { + struct glyph_block gb; + + data.ef->invisible_ellipses_already_displayed = 1; + data.ef->invisible_ellipses = 0; + gb.extent = Qnil; + gb.glyph = Vinvisible_text_glyph; + *prop = add_glyph_rune (&data, &gb, BEGIN_GLYPHS, 0, + GLYPH_CACHEL (w, INVIS_GLYPH_INDEX)); + /* Perhaps they shouldn't propagate if the very next thing + is to display a newline (for compatibility with + selective-display-ellipses)? Maybe that's too + abstruse. */ + if (*prop) + goto done; + } + + /* #### What if we we're dealing with a display table? */ + if (data.start_col) + data.start_col--; + + if (data.bi_bufpos == bi_string_zv) + goto done; + else + INC_CHARBYTIND (string_data (s), data.bi_bufpos); + } + + /* If there is propagation data, then it represents the current + buffer position being displayed. Add them and advance the + position counter. This might also add the minibuffer + prompt. */ + else if (*prop) + { + dl->used_prop_data = 1; + *prop = add_propagation_runes (prop, &data); + + if (*prop) + goto done; /* gee, a really narrow window */ + else if (data.bi_bufpos == bi_string_zv) + goto done; + else if (data.bi_bufpos < 0) + /* #### urk urk urk! Aborts are not very fun! Fix this please! */ + data.bi_bufpos = 0; + else + INC_CHARBYTIND (string_data (s), data.bi_bufpos); + } + + /* If there are end glyphs, add them to the line. These are + the end glyphs for the previous run of text. We add them + here rather than doing them at the end of handling the + previous run so that glyphs at the beginning and end of + a line are handled correctly. */ + else if (Dynarr_length (data.ef->end_glyphs) > 0) + { + *prop = add_glyph_runes (&data, END_GLYPHS); + if (*prop) + goto done; + } + + /* If there are begin glyphs, add them to the line. */ + else if (Dynarr_length (data.ef->begin_glyphs) > 0) + { + *prop = add_glyph_runes (&data, BEGIN_GLYPHS); + if (*prop) + goto done; + } + + /* If at end-of-buffer, we've already processed begin and + end-glyphs at this point and there's no text to process, + so we're done. */ + else if (data.bi_bufpos == bi_string_zv) + goto done; + + else + { + Lisp_Object entry = Qnil; + /* Get the character at the current buffer position. */ + data.ch = string_char (s, data.bi_bufpos); + if (!NILP (face_dt) || !NILP (window_dt)) + entry = display_table_entry (data.ch, face_dt, window_dt); + + /* If there is a display table entry for it, hand it off to + add_disp_table_entry_runes and let it worry about it. */ + if (!NILP (entry) && !EQ (entry, make_char (data.ch))) + { + *prop = add_disp_table_entry_runes (&data, entry); + + if (*prop) + goto done; + } + + /* Check if we have hit a newline character. If so, add a marker + to the line and end this loop. */ + else if (data.ch == '\n') + { + /* We aren't going to be adding an end glyph so give its + space back in order to make sure that the cursor can + fit. */ + data.max_pixpos += end_glyph_width; + goto done; + } + + /* If the current character is considered to be printable, then + just add it. */ + else if (data.ch >= printable_min) + { + *prop = add_emchar_rune (&data); + if (*prop) + goto done; + } + + /* If the current character is a tab, determine the next tab + starting position and add a blank rune which extends from the + current pixel position to that starting position. */ + else if (data.ch == '\t') + { + int tab_start_pixpos = data.pixpos; + int next_tab_start; + int char_tab_width; + int prop_width = 0; + + if (data.start_col > 1) + tab_start_pixpos -= (space_width (w) * (data.start_col - 1)); + + next_tab_start = + next_tab_position (w, tab_start_pixpos, + dl->bounds.left_in + + data.hscroll_glyph_width_adjust); + if (next_tab_start > data.max_pixpos) + { + prop_width = next_tab_start - data.max_pixpos; + next_tab_start = data.max_pixpos; + } + data.blank_width = next_tab_start - data.pixpos; + char_tab_width = + (next_tab_start - tab_start_pixpos) / space_width (w); + + *prop = add_blank_rune (&data, w, char_tab_width); + + /* add_blank_rune is only supposed to be called with + sizes guaranteed to fit in the available space. */ + assert (!(*prop)); + + if (prop_width) + { + struct prop_block pb; + *prop = Dynarr_new (prop_block); + + pb.type = PROP_BLANK; + pb.data.p_blank.width = prop_width; + pb.data.p_blank.findex = data.findex; + Dynarr_add (*prop, pb); + + goto done; + } + } + + /* If character is a control character, pass it off to + add_control_char_runes. + + The is_*() routines have undefined results on + arguments outside of the range [-1, 255]. (This + often bites people who carelessly use `char' instead + of `unsigned char'.) + */ + else if (data.ch < 0x100 && iscntrl ((Bufbyte) data.ch)) + { + *prop = add_control_char_runes (&data, b); + + if (*prop) + goto done; + } + + /* If the character is above the ASCII range and we have not + already handled it, then print it as an octal number. */ + else if (data.ch >= 0200) + { + *prop = add_octal_runes (&data); + + if (*prop) + goto done; + } + + /* Assume the current character is considered to be printable, + then just add it. */ + else + { + *prop = add_emchar_rune (&data); + if (*prop) + goto done; + } + + INC_CHARBYTIND (string_data (s), data.bi_bufpos); + } + } + +done: + + /* Determine the starting point of the next line if we did not hit the + end of the buffer. */ + if (data.bi_bufpos < bi_string_zv) + { + /* #### This check is not correct. If the line terminated + due to a begin-glyph or end-glyph hitting window-end, then + data.ch will not point to the character at data.bi_bufpos. If + you make the two changes mentioned at the top of this loop, + you should be able to say '(if (*prop))'. That should also + make it possible to eliminate the data.bi_bufpos < BI_BUF_ZV (b) + check. */ + + /* The common case is that the line ended because we hit a newline. + In that case, the next character is just the next buffer + position. */ + if (data.ch == '\n') + { + INC_CHARBYTIND (string_data (s), data.bi_bufpos); + } + + /* Otherwise we have a buffer line which cannot fit on one display + line. */ + else + { + struct glyph_block gb; + struct glyph_cachel *cachel; + + /* If the line is to be truncated then we actually have to look + for the next newline. We also add the end-of-line glyph which + we know will fit because we adjusted the right border before + we starting laying out the line. */ + data.max_pixpos += end_glyph_width; + data.findex = default_face; + gb.extent = Qnil; + + if (truncate_win) + { + Bytind bi_pos; + + /* Now find the start of the next line. */ + bi_pos = bi_find_next_emchar_in_string (s, '\n', data.bi_bufpos, 1); + + data.cursor_type = NO_CURSOR; + data.bi_bufpos = bi_pos; + gb.glyph = Vtruncation_glyph; + cachel = GLYPH_CACHEL (w, TRUN_GLYPH_INDEX); + } + else + { + /* The cursor can never be on the continuation glyph. */ + data.cursor_type = NO_CURSOR; + + /* data.bi_bufpos is already at the start of the next line. */ + + gb.glyph = Vcontinuation_glyph; + cachel = GLYPH_CACHEL (w, CONT_GLYPH_INDEX); + } + + if (end_glyph_width) + add_glyph_rune (&data, &gb, BEGIN_GLYPHS, 0, cachel); + + if (truncate_win && data.bi_bufpos == bi_string_zv) + { + const Bufbyte* endb = charptr_n_addr (string_data (s), bi_string_zv); + DEC_CHARPTR (endb); + if (charptr_emchar (endb) != '\n') + { + /* #### Damn this losing shit. */ + data.bi_bufpos++; + } + } + } + } + else if (data.bi_bufpos == bi_string_zv) + { + /* create_text_block () adds a bogus \n marker here which screws + up subwindow display. Since we never have a cursor in the + gutter we can safely ignore it. */ + } + /* Calculate left whitespace boundary. */ + { + int elt = 0; + + /* Whitespace past a newline is considered right whitespace. */ + while (elt < Dynarr_length (db->runes)) + { + struct rune *rb = Dynarr_atp (db->runes, elt); + + if ((rb->type == RUNE_CHAR && rb->object.chr.ch == ' ') + || rb->type == RUNE_BLANK) + { + dl->bounds.left_white += rb->width; + elt++; + } + else + elt = Dynarr_length (db->runes); + } + } + + /* Calculate right whitespace boundary. */ + { + int elt = Dynarr_length (db->runes) - 1; + int done = 0; + + while (!done && elt >= 0) + { + struct rune *rb = Dynarr_atp (db->runes, elt); + + if (!(rb->type == RUNE_CHAR && rb->object.chr.ch < 0x100 + && isspace (rb->object.chr.ch)) + && !rb->type == RUNE_BLANK) + { + dl->bounds.right_white = rb->xpos + rb->width; + done = 1; + } + + elt--; + + } + + /* The line is blank so everything is considered to be right + whitespace. */ + if (!done) + dl->bounds.right_white = dl->bounds.left_in; + } + + /* Set the display blocks bounds. */ + db->start_pos = dl->bounds.left_in; + if (Dynarr_length (db->runes)) + { + struct rune *rb = Dynarr_atp (db->runes, Dynarr_length (db->runes) - 1); + + db->end_pos = rb->xpos + rb->width; + } + else + db->end_pos = dl->bounds.right_white; + + /* update line height parameters */ + if (!data.new_ascent && !data.new_descent) + { + /* We've got a blank line so initialize these values from the default + face. */ + default_face_font_info (data.window, &data.new_ascent, + &data.new_descent, 0, 0, 0); + } + + if (data.max_pixmap_height) + { + int height = data.new_ascent + data.new_descent; + int pix_ascent, pix_descent; + + pix_descent = data.max_pixmap_height * data.new_descent / height; + pix_ascent = data.max_pixmap_height - pix_descent; + + data.new_ascent = max (data.new_ascent, pix_ascent); + data.new_descent = max (data.new_descent, pix_descent); + } + + dl->ascent = data.new_ascent; + dl->descent = data.new_descent; + + { + unsigned short ascent = (unsigned short) XINT (w->minimum_line_ascent); + + if (dl->ascent < ascent) + dl->ascent = ascent; + } + { + unsigned short descent = (unsigned short) XINT (w->minimum_line_descent); + + if (dl->descent < descent) + dl->descent = descent; + } + + dl->cursor_elt = data.cursor_x; + /* #### lossage lossage lossage! Fix this shit! */ + if (data.bi_bufpos > bi_string_zv) + dl->end_bufpos = buffer_or_string_bytind_to_bufpos (disp_string, bi_string_zv); + else + dl->end_bufpos = buffer_or_string_bytind_to_bufpos (disp_string, data.bi_bufpos) - 1; + if (truncate_win) + data.dl->num_chars = + string_column_at_point (s, dl->end_bufpos, b ? XINT (b->tab_width) : 8); + else + /* This doesn't correctly take into account tabs and control + characters but if the window isn't being truncated then this + value isn't going to end up being used anyhow. */ + data.dl->num_chars = dl->end_bufpos - dl->bufpos; + + /* #### handle horizontally scrolled line with text none of which + was actually laid out. */ + + /* #### handle any remainder of overlay arrow */ + + if (*prop == ADD_FAILED) + *prop = NULL; + + if (truncate_win && *prop) + { + Dynarr_free (*prop); + *prop = NULL; + } + + extent_fragment_delete (data.ef); + + /* #### If we started at EOB, then make sure we return a value past + it so that regenerate_window will exit properly. This is bogus. + The main loop should get fixed so that it isn't necessary to call + this function if we are already at EOB. */ + + if (data.bi_bufpos == bi_string_zv && bi_start_pos == bi_string_zv) + return bytecount_to_charcount (string_data (s), data.bi_bufpos) + 1; /* Yuck! */ + else + return bytecount_to_charcount (string_data (s), data.bi_bufpos); +} + +/* Given a display line and a starting position, ensure that the + contents of the display line accurately represent the visual + representation of the buffer contents starting from the given + position when displayed in the given window. The display line ends + when the contents of the line reach the right boundary of the given + window. + + This is very similar to generate_display_line but with the same + limitations as create_string_text_block. I have taken the liberty + of fixing the bytind stuff though.*/ + +static Bufpos +generate_string_display_line (struct window *w, Lisp_Object disp_string, + struct display_line *dl, + Bufpos start_pos, + prop_block_dynarr **prop, + face_index default_face) +{ + Bufpos ret_bufpos; + + /* you must set bounds before calling this. */ + + /* Reset what this line is using. */ + if (dl->display_blocks) + Dynarr_reset (dl->display_blocks); + if (dl->left_glyphs) + { + Dynarr_free (dl->left_glyphs); + dl->left_glyphs = 0; + } + if (dl->right_glyphs) + { + Dynarr_free (dl->right_glyphs); + dl->right_glyphs = 0; + } + + /* We aren't generating a modeline at the moment. */ + dl->modeline = 0; + + /* Create a display block for the text region of the line. */ + ret_bufpos = create_string_text_block (w, disp_string, dl, start_pos, + prop, default_face); + dl->bufpos = start_pos; + if (dl->end_bufpos < dl->bufpos) + dl->end_bufpos = dl->bufpos; + + /* If there are left glyphs associated with any character in the + text block, then create a display block to handle them. */ + if (dl->left_glyphs != NULL && Dynarr_length (dl->left_glyphs)) + create_left_glyph_block (w, dl, 0); + + /* If there are right glyphs associated with any character in the + text block, then create a display block to handle them. */ + if (dl->right_glyphs != NULL && Dynarr_length (dl->right_glyphs)) + create_right_glyph_block (w, dl); + + return ret_bufpos; +} + +/* This is ripped off from regenerate_window. All we want to do is + loop through elements in the string creating display lines until we + have covered the provided area. Simple really. */ +void +generate_displayable_area (struct window *w, Lisp_Object disp_string, + int xpos, int ypos, int width, int height, + display_line_dynarr* dla, + Bufpos start_pos, + face_index default_face) +{ + int yend = ypos + height; + Charcount s_zv; + + prop_block_dynarr *prop = 0; + layout_bounds bounds; + assert (dla); + + Dynarr_reset (dla); + /* if there's nothing to do then do nothing. code after this assumes + there is something to do. */ + if (NILP (disp_string)) + return; + + s_zv = XSTRING_CHAR_LENGTH (disp_string); + + bounds.left_out = xpos; + bounds.right_out = xpos + width; + /* The inner boundaries mark where the glyph margins are located. */ + bounds.left_in = bounds.left_out + window_left_margin_width (w); + bounds.right_in = bounds.right_out - window_right_margin_width (w); + /* We cannot fully calculate the whitespace boundaries as they + depend on the contents of the line being displayed. */ + bounds.left_white = bounds.left_in; + bounds.right_white = bounds.right_in; + + while (ypos < yend) + { + struct display_line dl; + struct display_line *dlp; + Bufpos next_pos; + int local; + + if (Dynarr_length (dla) < Dynarr_largest (dla)) + { + dlp = Dynarr_atp (dla, Dynarr_length (dla)); + local = 0; + } + else + { + + xzero (dl); + dlp = &dl; + local = 1; + } + + dlp->bounds = bounds; + dlp->offset = 0; + next_pos = generate_string_display_line (w, disp_string, dlp, start_pos, + &prop, default_face); + /* we need to make sure that we continue along the line if there + is more left to display otherwise we just end up redisplaying + the same chunk over and over again. */ + if (next_pos == start_pos && next_pos < s_zv) + start_pos++; + else + start_pos = next_pos; + + dlp->ypos = ypos + dlp->ascent; + ypos = dlp->ypos + dlp->descent; + + if (ypos > yend) + { + int visible_height = dlp->ascent + dlp->descent; + + dlp->clip = (ypos - yend); + visible_height -= dlp->clip; + + if (visible_height < VERTICAL_CLIP (w, 1)) + { + if (local) + free_display_line (dlp); + break; + } + } + else + dlp->clip = 0; + + Dynarr_add (dla, *dlp); + + /* #### This type of check needs to be done down in the + generate_display_line call. */ + if (start_pos >= s_zv) + break; + } + + if (prop) + Dynarr_free (prop); +} + + +/***************************************************************************/ /* */ /* window-regeneration routines */ /* */ @@ -4196,6 +5103,7 @@ struct buffer *b = XBUFFER (w->buffer); int ypos = WINDOW_TEXT_TOP (w); int yend; /* set farther down */ + int yclip = WINDOW_TEXT_TOP_CLIP (w); prop_block_dynarr *prop; layout_bounds bounds; @@ -4262,6 +5170,7 @@ } else { + xzero (dl); dlp = &dl; local = 1; @@ -4269,17 +5178,37 @@ dlp->bounds = bounds; dlp->offset = 0; - start_pos = generate_display_line (w, dlp, 1, start_pos, - w->hscroll, &prop, type); - dlp->ypos = ypos + dlp->ascent; + start_pos = generate_display_line (w, dlp, 1, start_pos, &prop, type); + + if (yclip > dlp->ascent) + { + /* this should never happen, but if it does just display the + whole line */ + yclip = 0; + } + + dlp->ypos = (ypos + dlp->ascent) - yclip; ypos = dlp->ypos + dlp->descent; + /* See if we've been asked to start midway through a line, for + partial display line scrolling. */ + if (yclip) + { + dlp->top_clip = yclip; + yclip = 0; + } + else + dlp->top_clip = 0; + if (ypos > yend) { int visible_height = dlp->ascent + dlp->descent; dlp->clip = (ypos - yend); - visible_height -= dlp->clip; + /* Although this seems strange we could have a single very + tall line visible for which we need to account for both + the top clip and the bottom clip. */ + visible_height -= (dlp->clip + dlp->top_clip); if (visible_height < VERTICAL_CLIP (w, 1)) { @@ -4522,7 +5451,7 @@ return 0; new_start = generate_display_line (w, ddl, 0, ddl->bufpos + ddl->offset, - w->hscroll, &prop, DESIRED_DISP); + &prop, DESIRED_DISP); ddl->offset = 0; /* #### If there is propagated stuff the fail. We could @@ -4541,6 +5470,7 @@ if (cdl->ypos != ddl->ypos || cdl->ascent != ddl->ascent || cdl->descent != ddl->descent + || cdl->top_clip != ddl->top_clip || (cdl->cursor_elt != -1 && ddl->cursor_elt == -1) || (cdl->cursor_elt == -1 && ddl->cursor_elt != -1) || old_start != ddl->bufpos @@ -4684,7 +5614,7 @@ return 0; new_start = generate_display_line (w, ddl, 0, ddl->bufpos + ddl->offset, - w->hscroll, &prop, DESIRED_DISP); + &prop, DESIRED_DISP); ddl->offset = 0; /* If there is propagated stuff then it is pretty much a @@ -4714,6 +5644,7 @@ if (cdl->ypos != ddl->ypos || cdl->ascent != ddl->ascent || cdl->descent != ddl->descent + || cdl->top_clip != ddl->top_clip || (cdl->cursor_elt != -1 && ddl->cursor_elt == -1) || (cdl->cursor_elt == -1 && ddl->cursor_elt != -1)) { @@ -4997,7 +5928,7 @@ } Fset_marker (w->pointm[DESIRED_DISP], make_int (pointm), the_buffer); - /* If the buffer has changed we have to invalid all of our face + /* If the buffer has changed we have to invalidate all of our face cache elements. */ if ((!echo_active && b != window_display_buffer (w)) || !Dynarr_length (w->face_cachels) @@ -5006,10 +5937,11 @@ else mark_face_cachels_as_not_updated (w); - /* Ditto the glyph cache elements. */ + /* Ditto the glyph cache elements, although we do *not* invalidate + the cache purely because glyphs have changed - this is now + handled by the dirty flag.*/ if ((!echo_active && b != window_display_buffer (w)) - || !Dynarr_length (w->glyph_cachels) - || f->glyphs_changed) + || !Dynarr_length (w->glyph_cachels) || f->faces_changed) reset_glyph_cachels (w); else mark_glyph_cachels_as_not_updated (w); @@ -5095,6 +6027,7 @@ && !f->faces_changed && !f->glyphs_changed && !f->subwindows_changed + && !f->subwindows_state_changed && !f->point_changed && !f->windows_structure_changed) { @@ -5116,6 +6049,7 @@ && !f->faces_changed && !f->glyphs_changed && !f->subwindows_changed + && !f->subwindows_state_changed && !f->windows_structure_changed) { if (point_visible (w, pointm, CURRENT_DISP) @@ -5174,6 +6108,7 @@ && !f->faces_changed && !f->glyphs_changed && !f->subwindows_changed + && !f->subwindows_state_changed && !f->windows_structure_changed && !f->frame_changed && !truncation_changed @@ -5253,8 +6188,9 @@ Bufpos end = (w->window_end_pos[DESIRED_DISP] == -1 ? BUF_ZV (b) : BUF_Z (b) - w->window_end_pos[DESIRED_DISP] - 1); - - update_line_start_cache (w, start, end, pointm, 1); + /* Don't pollute the cache if not sure if we are correct */ + if (w->start_at_line_beg) + update_line_start_cache (w, start, end, pointm, 1); redisplay_output_window (w); /* * If we just displayed the echo area, the line start cache is @@ -5269,6 +6205,12 @@ somewhere else once tty updates occur on a per-frame basis. */ mark_face_cachels_as_clean (w); + /* The glyph cachels only get dirty if someone changed something. + Since redisplay has now effectively ended we can reset the dirty + flag since everything must be up-to-date. */ + if (glyphs_changed) + mark_glyph_cachels_as_clean (w); + w->windows_changed = 0; } @@ -5400,6 +6342,31 @@ update_frame_toolbars (f); #endif /* HAVE_TOOLBARS */ + /* If we clear the frame we have to force its contents to be redrawn. */ + if (f->clear) + f->frame_changed = 1; + + /* invalidate the subwindow cache. We use subwindows_changed here to + cause subwindows to get instantiated. This is because + subwindows_state_changed is less strict - dealing with things + like the clicked state of button. We have to do this before + redisplaying the gutters as subwindows get unmapped in the + process.*/ + if (!Dynarr_length (f->subwindow_cachels) + || f->subwindows_changed + || f->faces_changed + || f->frame_changed) + { + reset_subwindow_cachels (f); + /* we have to do this so the gutter gets regenerated. */ + reset_gutter_display_lines (f); + } + else + mark_subwindow_cachels_as_not_updated (f); + /* We can now update the gutters, safe in the knowledge that our + efforts won't get undone. */ + update_frame_gutters (f); + hold_frame_size_changes (); /* ----------------- BEGIN CRITICAL REDISPLAY SECTION ---------------- */ @@ -5426,27 +6393,12 @@ #### If a frame-size change does occur we should probably actually be preempting redisplay. */ - /* If we clear the frame we have to force its contents to be redrawn. */ - if (f->clear) - f->frame_changed = 1; - /* Erase the frame before outputting its contents. */ if (f->clear) { DEVMETH (d, clear_frame, (f)); } - /* invalidate the subwindow cache. we are going to reuse the glyphs - flag here to cause subwindows to get instantiated. This is - because subwindows changed is less strict - dealing with things - like the clicked state of button. */ - if (!Dynarr_length (f->subwindow_cachels) - || f->glyphs_changed - || f->frame_changed) - reset_subwindow_cachels (f); - else - mark_subwindow_cachels_as_not_updated (f); - /* Do the selected window first. */ redisplay_window (FRAME_SELECTED_WINDOW (f), 0); @@ -5461,23 +6413,9 @@ update_frame_title (f); - f->buffers_changed = 0; - f->clip_changed = 0; - f->extents_changed = 0; - f->faces_changed = 0; - f->frame_changed = 0; - f->glyphs_changed = 0; - f->subwindows_changed = 0; - f->icon_changed = 0; - f->menubar_changed = 0; - f->modeline_changed = 0; - f->point_changed = 0; - f->toolbar_changed = 0; - f->windows_changed = 0; - f->windows_structure_changed = 0; + CLASS_RESET_CHANGED_FLAGS (f); f->window_face_cache_reset = 0; f->echo_area_garbaged = 0; - f->clear = 0; if (!f->size_change_pending) @@ -5494,16 +6432,27 @@ return 0; } -/* Ensure that all frames on the given device are correctly displayed. */ +/* Ensure that all frames on the given device are correctly displayed. + If AUTOMATIC is non-zero, and the device implementation indicates + no automatic redisplay, as printers do, then the device is not + redisplayed. AUTOMATIC is set to zero when called from lisp + functions (redraw-device) and (redisplay-device), and to non-zero + when called from "lazy" redisplay(); +*/ static int -redisplay_device (struct device *d) +redisplay_device (struct device *d, int automatic) { Lisp_Object frame, frmcons; int preempted = 0; int size_change_failed = 0; struct frame *f; + if (automatic + && (MAYBE_INT_DEVMETH (d, device_implementation_flags, ()) + & XDEVIMPF_NO_AUTO_REDISPLAY)) + return 0; + if (DEVICE_STREAM_P (d)) /* nothing to do */ return 0; @@ -5527,11 +6476,7 @@ if (FRAME_REPAINT_P (f)) { - if (f->buffers_changed || f->clip_changed || f->extents_changed || - f->faces_changed || f->frame_changed || f->menubar_changed || - f->modeline_changed || f->point_changed || f->size_changed || - f->toolbar_changed || f->windows_changed || f->size_slipped || - f->windows_structure_changed || f->glyphs_changed || f->subwindows_changed) + if (CLASS_REDISPLAY_FLAGS_CHANGEDP(f)) { preempted = redisplay_frame (f, 0); } @@ -5561,12 +6506,7 @@ if (FRAME_REPAINT_P (f)) { - if (f->buffers_changed || f->clip_changed || f->extents_changed || - f->faces_changed || f->frame_changed || f->menubar_changed || - f->modeline_changed || f->point_changed || f->size_changed || - f->toolbar_changed || f->windows_changed || - f->windows_structure_changed || - f->glyphs_changed || f->subwindows_changed) + if (CLASS_REDISPLAY_FLAGS_CHANGEDP (f)) { preempted = redisplay_frame (f, 0); } @@ -5581,20 +6521,7 @@ /* If we get here then we redisplayed all of our frames without getting preempted so mark ourselves as clean. */ - d->buffers_changed = 0; - d->clip_changed = 0; - d->extents_changed = 0; - d->faces_changed = 0; - d->frame_changed = 0; - d->glyphs_changed = 0; - d->subwindows_changed = 0; - d->icon_changed = 0; - d->menubar_changed = 0; - d->modeline_changed = 0; - d->point_changed = 0; - d->toolbar_changed = 0; - d->windows_changed = 0; - d->windows_structure_changed = 0; + CLASS_RESET_CHANGED_FLAGS (d); if (!size_change_failed) d->size_changed = 0; @@ -5629,13 +6556,8 @@ if (asynch_device_change_pending) handle_asynch_device_change (); - if (!buffers_changed && !clip_changed && !extents_changed && - !faces_changed && !frame_changed && !icon_changed && - !menubar_changed && !modeline_changed && !point_changed && - !size_changed && !toolbar_changed && !windows_changed && - !glyphs_changed && !subwindows_changed && - !windows_structure_changed && !disable_preemption && - preemption_count < max_preempts) + if (!GLOBAL_REDISPLAY_FLAGS_CHANGEDP && + !disable_preemption && preemption_count < max_preempts) goto done; DEVICE_LOOP_NO_BREAK (devcons, concons) @@ -5643,14 +6565,9 @@ struct device *d = XDEVICE (XCAR (devcons)); int preempted; - if (d->buffers_changed || d->clip_changed || d->extents_changed || - d->faces_changed || d->frame_changed || d->icon_changed || - d->menubar_changed || d->modeline_changed || d->point_changed || - d->size_changed || d->toolbar_changed || d->windows_changed || - d->windows_structure_changed || - d->glyphs_changed || d->subwindows_changed) - { - preempted = redisplay_device (d); + if (CLASS_REDISPLAY_FLAGS_CHANGEDP (d)) + { + preempted = redisplay_device (d, 1); if (preempted) { @@ -5667,19 +6584,7 @@ preemption_count = 0; /* Mark redisplay as accurate */ - buffers_changed = 0; - clip_changed = 0; - extents_changed = 0; - frame_changed = 0; - glyphs_changed = 0; - subwindows_changed = 0; - icon_changed = 0; - menubar_changed = 0; - modeline_changed = 0; - point_changed = 0; - toolbar_changed = 0; - windows_changed = 0; - windows_structure_changed = 0; + GLOBAL_RESET_CHANGED_FLAGS; RESET_CHANGED_SET_FLAGS; if (faces_changed) @@ -5776,7 +6681,7 @@ decode_mode_spec (struct window *w, Emchar spec, int type) { Lisp_Object obj = Qnil; - CONST char *str = NULL; + const char *str = NULL; struct buffer *b = XBUFFER (w->buffer); Dynarr_reset (mode_spec_bufbyte_string); @@ -5805,7 +6710,7 @@ long_to_string (buf, col); Dynarr_add_many (mode_spec_bufbyte_string, - (CONST Bufbyte *) buf, strlen (buf)); + (const Bufbyte *) buf, strlen (buf)); goto decode_mode_spec_done; } @@ -5910,7 +6815,6 @@ case 'p': { Bufpos pos = marker_position (w->start[type]); - Charcount total = BUF_ZV (b) - BUF_BEGV (b); /* This had better be while the desired lines are being done. */ if (w->window_end_pos[type] <= BUF_Z (b) - BUF_ZV (b)) @@ -5927,15 +6831,20 @@ /* This hard limit is ok since the string it will hold has a fixed maximum length of 3. But just to be safe... */ char buf[10]; - - total = ((pos - BUF_BEGV (b)) * 100 + total - 1) / total; + Charcount chars = pos - BUF_BEGV (b); + Charcount total = BUF_ZV (b) - BUF_BEGV (b); + + /* Avoid overflow on big buffers */ + int percent = total > LONG_MAX/200 ? + (chars + total/200) / (total / 100) : + (chars * 100 + total/2) / total; /* We can't normally display a 3-digit number, so get us a 2-digit number that is close. */ - if (total == 100) - total = 99; - - sprintf (buf, "%2d%%", total); + if (percent == 100) + percent = 99; + + sprintf (buf, "%d%%", percent); Dynarr_add_many (mode_spec_bufbyte_string, (Bufbyte *) buf, strlen (buf)); @@ -5950,7 +6859,6 @@ { Bufpos toppos = marker_position (w->start[type]); Bufpos botpos = BUF_Z (b) - w->window_end_pos[type]; - Charcount total = BUF_ZV (b) - BUF_BEGV (b); /* botpos is only accurate as of the last redisplay, so we can only treat it as a hint. In particular, after erase-buffer, @@ -5970,18 +6878,23 @@ /* This hard limit is ok since the string it will hold has a fixed maximum length of around 6. But just to be safe... */ char buf[10]; - - total = ((botpos - BUF_BEGV (b)) * 100 + total - 1) / total; + Charcount chars = botpos - BUF_BEGV (b); + Charcount total = BUF_ZV (b) - BUF_BEGV (b); + + /* Avoid overflow on big buffers */ + int percent = total > LONG_MAX/200 ? + (chars + total/200) / (total / 100) : + (chars * 100 + total/2) / max (total, 1); /* We can't normally display a 3-digit number, so get us a 2-digit number that is close. */ - if (total == 100) - total = 99; + if (percent == 100) + percent = 99; if (toppos <= BUF_BEGV (b)) - sprintf (buf, "Top%2d%%", total); + sprintf (buf, "Top%d%%", percent); else - sprintf (buf, "%2d%%", total); + sprintf (buf, "%d%%", percent); Dynarr_add_many (mode_spec_bufbyte_string, (Bufbyte *) buf, strlen (buf)); @@ -6084,7 +6997,7 @@ /* Given an array of display lines, free them and all data structures contained within them. */ -static void +void free_display_lines (display_line_dynarr *dla) { int line; @@ -6117,7 +7030,7 @@ static void -mark_glyph_block_dynarr (glyph_block_dynarr *gba, void (*markobj) (Lisp_Object)) +mark_glyph_block_dynarr (glyph_block_dynarr *gba) { if (gba) { @@ -6127,15 +7040,15 @@ for (; gb < gb_last; gb++) { if (!NILP (gb->glyph)) - markobj (gb->glyph); + mark_object (gb->glyph); if (!NILP (gb->extent)) - markobj (gb->extent); + mark_object (gb->extent); } } } static void -mark_redisplay_structs (display_line_dynarr *dla, void (*markobj) (Lisp_Object)) +mark_redisplay_structs (display_line_dynarr *dla) { display_line *dl = Dynarr_atp (dla, 0); display_line *dl_last = Dynarr_atp (dla, Dynarr_length (dla)); @@ -6157,35 +7070,35 @@ if (r->type == RUNE_DGLYPH) { if (!NILP (r->object.dglyph.glyph)) - markobj (r->object.dglyph.glyph); + mark_object (r->object.dglyph.glyph); if (!NILP (r->object.dglyph.extent)) - markobj (r->object.dglyph.extent); + mark_object (r->object.dglyph.extent); } } } - mark_glyph_block_dynarr (dl->left_glyphs, markobj); - mark_glyph_block_dynarr (dl->right_glyphs, markobj); + mark_glyph_block_dynarr (dl->left_glyphs); + mark_glyph_block_dynarr (dl->right_glyphs); } } static void -mark_window_mirror (struct window_mirror *mir, void (*markobj)(Lisp_Object)) -{ - mark_redisplay_structs (mir->current_display_lines, markobj); - mark_redisplay_structs (mir->desired_display_lines, markobj); +mark_window_mirror (struct window_mirror *mir) +{ + mark_redisplay_structs (mir->current_display_lines); + mark_redisplay_structs (mir->desired_display_lines); if (mir->next) - mark_window_mirror (mir->next, markobj); + mark_window_mirror (mir->next); if (mir->hchild) - mark_window_mirror (mir->hchild, markobj); + mark_window_mirror (mir->hchild); else if (mir->vchild) - mark_window_mirror (mir->vchild, markobj); + mark_window_mirror (mir->vchild); } void -mark_redisplay (void (*markobj)(Lisp_Object)) +mark_redisplay (void) { Lisp_Object frmcons, devcons, concons; @@ -6193,7 +7106,7 @@ { struct frame *f = XFRAME (XCAR (frmcons)); update_frame_window_mirror (f); - mark_window_mirror (f->root_mirror, markobj); + mark_window_mirror (f->root_mirror); } } @@ -6257,7 +7170,7 @@ /* This will get used quite a bit so we don't want to be constantly allocating and freeing it. */ -line_start_cache_dynarr *internal_cache; +static line_start_cache_dynarr *internal_cache; /* Makes internal_cache represent the TYPE display structs and only the TYPE display structs. */ @@ -6551,7 +7464,7 @@ point_would_be_visible (struct window *w, Bufpos startp, Bufpos point) { struct buffer *b = XBUFFER (w->buffer); - int pixpos = 0; + int pixpos = -WINDOW_TEXT_TOP_CLIP(w); int bottom = WINDOW_TEXT_HEIGHT (w); int start_elt; @@ -6776,7 +7689,7 @@ } cur_elt--; - if (cur_elt < 0) + while (cur_elt < 0) { Bufpos from, to; int win_char_height; @@ -6796,7 +7709,20 @@ update_line_start_cache (w, from, to, point, 0); cur_elt = point_in_line_start_cache (w, cur_pos, 2) - 1; - assert (cur_elt >= 0); + assert (cur_elt >= -1); + /* This used to be cur_elt>=0 under the assumption that if + point is in the top line and not at BUF_BEGV, then + setting the window_start to a newline before the start of + the first line will always cause scrolling. + + However in my (jv) opinion this is wrong. That new line + can be hidden in various ways: invisible extents, an + explicit window-start not at a newline character etc. + The existence of those are indeed known to create crashes + on that assert. So we have no option but to continue the + search if we found point at the top of the line_start_cache + again. */ + cur_pos = Dynarr_atp (w->line_start_cache,0)->start; } prev_pos = cur_pos; } @@ -8013,7 +8939,7 @@ { XFRAME (XCAR (frmcons))->clear = 1; } - redisplay_device (d); + redisplay_device (d, 0); return unbind_to (count, Qnil); } @@ -8040,7 +8966,7 @@ disable_preemption++; } - redisplay_device (d); + redisplay_device (d, 0); return unbind_to (count, Qnil); } @@ -8092,6 +9018,8 @@ return 0; } +/* This is called if the built-in glyphs have their properties + changed. */ void redisplay_glyph_changed (Lisp_Object glyph, Lisp_Object property, Lisp_Object locale) @@ -8214,16 +9142,22 @@ preemption_count = 0; max_preempts = INIT_MAX_PREEMPTS; +#ifndef PDUMP if (!initialized) - { - cmotion_display_lines = Dynarr_new (display_line); - mode_spec_bufbyte_string = Dynarr_new (Bufbyte); - formatted_string_emchar_dynarr = Dynarr_new (Emchar); - formatted_string_extent_dynarr = Dynarr_new (EXTENT); - formatted_string_extent_start_dynarr = Dynarr_new (Bytecount); - formatted_string_extent_end_dynarr = Dynarr_new (Bytecount); - internal_cache = Dynarr_new (line_start_cache); - xzero (formatted_string_display_line); +#endif + { + if (!cmotion_display_lines) + cmotion_display_lines = Dynarr_new (display_line); + if (!mode_spec_bufbyte_string) + mode_spec_bufbyte_string = Dynarr_new (Bufbyte); + if (!formatted_string_extent_dynarr) + formatted_string_extent_dynarr = Dynarr_new (EXTENT); + if (!formatted_string_extent_start_dynarr) + formatted_string_extent_start_dynarr = Dynarr_new (Bytecount); + if (!formatted_string_extent_end_dynarr) + formatted_string_extent_end_dynarr = Dynarr_new (Bytecount); + if (!internal_cache) + internal_cache = Dynarr_new (line_start_cache); } /* window system is nil when in -batch mode */ @@ -8294,7 +9228,6 @@ #endif /* INHIBIT_REDISPLAY_HOOKS */ defsymbol (&Qdisplay_warning_buffer, "display-warning-buffer"); defsymbol (&Qbar_cursor, "bar-cursor"); - defsymbol (&Qwindow_scroll_functions, "window-scroll-functions"); defsymbol (&Qredisplay_end_trigger_functions, "redisplay-end-trigger-functions"); @@ -8308,8 +9241,16 @@ } void +reinit_vars_of_redisplay (void) +{ + updating_line_start_cache = 0; +} + +void vars_of_redisplay (void) { + reinit_vars_of_redisplay (); + #if 0 staticpro (&last_arrow_position); staticpro (&last_arrow_string); @@ -8317,8 +9258,6 @@ last_arrow_string = Qnil; #endif /* 0 */ - updating_line_start_cache = 0; - /* #### Probably temporary */ DEFVAR_INT ("redisplay-cache-adjustment", &cache_adjustment /* \(Temporary) Setting this will impact the performance of the internal @@ -8403,7 +9342,7 @@ Vwindow_system = Qnil; /* #### Temporary shit until window-system is eliminated. */ - DEFVAR_LISP ("initial-window-system", &Vinitial_window_system /* + DEFVAR_CONST_LISP ("initial-window-system", &Vinitial_window_system /* DON'T TOUCH */ ); Vinitial_window_system = Qnil; @@ -8502,9 +9441,9 @@ Vleft_margin_width = Fmake_specifier (Qnatnum); set_specifier_fallback (Vleft_margin_width, list1 (Fcons (Qnil, Qzero))); set_specifier_caching (Vleft_margin_width, - slot_offset (struct window, left_margin_width), + offsetof (struct window, left_margin_width), some_window_value_changed, - slot_offset (struct frame, left_margin_width), + offsetof (struct frame, left_margin_width), margin_width_changed_in_frame); DEFVAR_SPECIFIER ("right-margin-width", &Vright_margin_width /* @@ -8514,9 +9453,9 @@ Vright_margin_width = Fmake_specifier (Qnatnum); set_specifier_fallback (Vright_margin_width, list1 (Fcons (Qnil, Qzero))); set_specifier_caching (Vright_margin_width, - slot_offset (struct window, right_margin_width), + offsetof (struct window, right_margin_width), some_window_value_changed, - slot_offset (struct frame, right_margin_width), + offsetof (struct frame, right_margin_width), margin_width_changed_in_frame); DEFVAR_SPECIFIER ("minimum-line-ascent", &Vminimum_line_ascent /* @@ -8526,7 +9465,7 @@ Vminimum_line_ascent = Fmake_specifier (Qnatnum); set_specifier_fallback (Vminimum_line_ascent, list1 (Fcons (Qnil, Qzero))); set_specifier_caching (Vminimum_line_ascent, - slot_offset (struct window, minimum_line_ascent), + offsetof (struct window, minimum_line_ascent), some_window_value_changed, 0, 0); @@ -8537,7 +9476,7 @@ Vminimum_line_descent = Fmake_specifier (Qnatnum); set_specifier_fallback (Vminimum_line_descent, list1 (Fcons (Qnil, Qzero))); set_specifier_caching (Vminimum_line_descent, - slot_offset (struct window, minimum_line_descent), + offsetof (struct window, minimum_line_descent), some_window_value_changed, 0, 0); @@ -8549,7 +9488,7 @@ Vuse_left_overflow = Fmake_specifier (Qboolean); set_specifier_fallback (Vuse_left_overflow, list1 (Fcons (Qnil, Qnil))); set_specifier_caching (Vuse_left_overflow, - slot_offset (struct window, use_left_overflow), + offsetof (struct window, use_left_overflow), some_window_value_changed, 0, 0); @@ -8561,7 +9500,7 @@ Vuse_right_overflow = Fmake_specifier (Qboolean); set_specifier_fallback (Vuse_right_overflow, list1 (Fcons (Qnil, Qnil))); set_specifier_caching (Vuse_right_overflow, - slot_offset (struct window, use_right_overflow), + offsetof (struct window, use_right_overflow), some_window_value_changed, 0, 0); @@ -8572,7 +9511,7 @@ Vtext_cursor_visible_p = Fmake_specifier (Qboolean); set_specifier_fallback (Vtext_cursor_visible_p, list1 (Fcons (Qnil, Qt))); set_specifier_caching (Vtext_cursor_visible_p, - slot_offset (struct window, text_cursor_visible_p), + offsetof (struct window, text_cursor_visible_p), text_cursor_visible_p_changed, 0, 0); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/redisplay.h --- a/src/redisplay.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/redisplay.h Mon Aug 13 11:13:30 2007 +0200 @@ -22,8 +22,8 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_REDISPLAY_H_ -#define _XEMACS_REDISPLAY_H_ +#ifndef INCLUDED_redisplay_h_ +#define INCLUDED_redisplay_h_ /* Redisplay DASSERT types */ #define DB_DISP_POS 1 @@ -91,6 +91,13 @@ but control characters have two -- a ^ and a letter -- and other non-printing characters (those displayed in octal) have four. */ +/* WARNING! In compare_runes (one of the most heavily used functions) + two runes are compared. So please be careful with changes to this + structure. See comments in compare_runes. + + #### This should really be made smaller. +*/ + typedef struct rune rune; struct rune { @@ -105,10 +112,6 @@ each of the face properties in this particular window. */ - short xpos; /* horizontal starting position in pixels */ - short width; /* pixel width of rune */ - - Bufpos bufpos; /* buffer position this rune is displaying; for the modeline, the value here is a Charcount, but who's looking? */ @@ -116,11 +119,26 @@ /* #### Chuck, what does it mean for a rune to cover a range of pos? I don't get this. */ - unsigned int cursor_type :3; /* is this rune covered by the cursor? */ - unsigned int type :3; /* type of rune object */ + /* #### This isn't used as an rvalue anywhere! + remove! */ + + + short xpos; /* horizontal starting position in pixels */ + short width; /* pixel width of rune */ + + + unsigned char cursor_type; /* is this rune covered by the cursor? */ + unsigned char type; /* type of rune object */ + /* We used to do bitfields here, but if I + (JV) count correctly that doesn't matter + for the size of the structure. All the bit + fiddling _does_ slow down redisplay by + about 10%. So don't do that */ union /* Information specific to the type of rune */ { + /* #### GLyps are are. Is it really necessary to waste 8 bytes on every + rune for that?! */ /* DGLYPH */ struct { @@ -145,8 +163,8 @@ /* HLINE */ struct { - int thickness; /* how thick to make hline */ - int yoffset; /* how far down from top of line to put top */ + short thickness; /* how thick to make hline */ + short yoffset; /* how far down from top of line to put top */ } hline; } object; /* actual rune object */ }; @@ -233,6 +251,32 @@ Dynarr_declare (glyph_block); } glyph_block_dynarr; +/*************************************************************************/ +/* display lines */ +/*************************************************************************/ + +/* Modeline commentary: IMO the modeline is handled very badly, we + special case virtually *everything* in the redisplay routines for + the modeline. The fact that dl->bufpos can be either a buffer + position or a char count highlights this. There is no abstraction at + all that I can find and it means that the code is made very ugly as + a result. Either we should treat the modeline *entirely* separately, + or we should abstract to something that applies equally well to the + modeline and to buffer text, the things are not enormously different + after all and handling them identically at some level would + eliminate some bugs that still exist (mainly to do with modeline + handling). This problem doesn't help trying to implement gutters + which are somewhere in between buffer text and modeline text. + + Redisplay commentary: Everything in redisplay is tied very tightly + to the things that are being displayed, and the context, + e.g. buffers and windows. According to Chuck this is so that we can + get speed, which seems fine to me, however this usage is extended + too far down the redispay routines IMO. At some level there should + be functions that know how to display strings with extents and + faces, regardless of buffer etc. After all the window system does + not care. <andy@xemacs.org> */ + typedef struct display_line display_line; struct display_line { @@ -247,6 +291,8 @@ pixel-row itself, I think. */ unsigned short clip; /* amount of bottom of line to clip in pixels.*/ + unsigned short top_clip; /* amount of top of line to clip + in pixels.*/ Bufpos bufpos; /* first buffer position on line */ Bufpos end_bufpos; /* last buffer position on line */ Charcount offset; /* adjustment to bufpos vals */ @@ -268,18 +314,52 @@ /* Dynamic arrays of left and right glyph blocks */ glyph_block_dynarr *left_glyphs; glyph_block_dynarr *right_glyphs; + + face_index left_margin_findex; + face_index right_margin_findex; + face_index default_findex; }; #define DISPLAY_LINE_HEIGHT(dl) \ -(dl->ascent + dl->descent - dl->clip) +(dl->ascent + dl->descent - (dl->clip + dl->top_clip)) #define DISPLAY_LINE_YPOS(dl) \ -(dl->ypos - dl->ascent) +(dl->ypos - (dl->ascent - dl->top_clip)) +#define DISPLAY_LINE_YEND(dl) \ +((dl->ypos + dl->descent) - dl->clip) typedef struct { Dynarr_declare (display_line); } display_line_dynarr; +/* The following two structures are used to represent an area to +displayed and where to display it. Using these two structures all +combinations of clipping and position can be accommodated. */ + +/* This represents an area to be displayed into. */ +typedef struct display_box display_box; +struct display_box +{ + int xpos; /* absolute horizontal position of area */ + int ypos; /* absolute vertical position of area */ + int width, height; +}; + +/* This represents the area from a glyph to be displayed. */ +typedef struct display_glyph_area display_glyph_area; +struct display_glyph_area +{ + int xoffset; /* horizontal offset of the glyph, +ve means + display the glyph with x offset by xoffset, + -ve means display starting xoffset into the + glyph. */ + int yoffset; /* vertical offset of the glyph, +ve means + display the glyph with y offset by yoffset, + -ve means display starting xoffset into the + glyph. */ + int width, height; /* width and height of glyph to display. */ +}; + /* It could be argued that the following two structs belong in extents.h, but they're only used by redisplay and it simplifies the header files to put them here. */ @@ -315,6 +395,12 @@ unsigned int invisible_ellipses_already_displayed:1; }; +#define EDGE_TOP 1 +#define EDGE_LEFT 2 +#define EDGE_BOTTOM 4 +#define EDGE_RIGHT 8 +#define EDGE_ALL (EDGE_TOP | EDGE_LEFT | EDGE_BOTTOM | EDGE_RIGHT) + /*************************************************************************/ /* change flags */ @@ -360,6 +446,11 @@ extern int subwindows_changed; extern int subwindows_changed_set; +/* True if any displayed subwindow is in need of updating + somewhere. */ +extern int subwindows_state_changed; +extern int subwindows_state_changed_set; + /* True if an icon is in need of updating somewhere. */ extern int icon_changed; extern int icon_changed_set; @@ -387,6 +478,10 @@ extern int toolbar_changed; extern int toolbar_changed_set; +/* non-nil if any gutter has changed */ +extern int gutter_changed; +extern int gutter_changed_set; + /* non-nil if any window has changed since the last time redisplay completed */ extern int windows_changed; @@ -426,24 +521,105 @@ #define MARK_MODELINE_CHANGED MARK_TYPE_CHANGED (modeline) #define MARK_POINT_CHANGED MARK_TYPE_CHANGED (point) #define MARK_TOOLBAR_CHANGED MARK_TYPE_CHANGED (toolbar) +#define MARK_GUTTER_CHANGED MARK_TYPE_CHANGED (gutter) #define MARK_GLYPHS_CHANGED MARK_TYPE_CHANGED (glyphs) #define MARK_SUBWINDOWS_CHANGED MARK_TYPE_CHANGED (subwindows) +#define MARK_SUBWINDOWS_STATE_CHANGED MARK_TYPE_CHANGED (subwindows_state) + + +#define CLASS_RESET_CHANGED_FLAGS(p) do { \ + (p)->buffers_changed = 0; \ + (p)->clip_changed = 0; \ + (p)->extents_changed = 0; \ + (p)->faces_changed = 0; \ + (p)->frame_changed = 0; \ + (p)->icon_changed = 0; \ + (p)->menubar_changed = 0; \ + (p)->modeline_changed = 0; \ + (p)->point_changed = 0; \ + (p)->toolbar_changed = 0; \ + (p)->gutter_changed = 0; \ + (p)->glyphs_changed = 0; \ + (p)->subwindows_changed = 0; \ + (p)->subwindows_state_changed = 0; \ + (p)->windows_changed = 0; \ + (p)->windows_structure_changed = 0; \ +} while (0) + +#define GLOBAL_RESET_CHANGED_FLAGS do { \ + buffers_changed = 0; \ + clip_changed = 0; \ + extents_changed = 0; \ + faces_changed = 0; \ + frame_changed = 0; \ + icon_changed = 0; \ + menubar_changed = 0; \ + modeline_changed = 0; \ + point_changed = 0; \ + toolbar_changed = 0; \ + gutter_changed = 0; \ + glyphs_changed = 0; \ + subwindows_changed = 0; \ + subwindows_state_changed = 0; \ + windows_changed = 0; \ + windows_structure_changed = 0; \ +} while (0) + +#define CLASS_REDISPLAY_FLAGS_CHANGEDP(p) \ + ( (p)->buffers_changed || \ + (p)->clip_changed || \ + (p)->extents_changed || \ + (p)->faces_changed || \ + (p)->frame_changed || \ + (p)->icon_changed || \ + (p)->menubar_changed || \ + (p)->modeline_changed || \ + (p)->point_changed || \ + (p)->toolbar_changed || \ + (p)->gutter_changed || \ + (p)->glyphs_changed || \ + (p)->size_changed || \ + (p)->subwindows_changed || \ + (p)->subwindows_state_changed || \ + (p)->windows_changed || \ + (p)->windows_structure_changed ) + +#define GLOBAL_REDISPLAY_FLAGS_CHANGEDP \ + ( buffers_changed || \ + clip_changed || \ + extents_changed || \ + faces_changed || \ + frame_changed || \ + icon_changed || \ + menubar_changed || \ + modeline_changed || \ + point_changed || \ + toolbar_changed || \ + gutter_changed || \ + glyphs_changed || \ + size_changed || \ + subwindows_changed || \ + subwindows_state_changed || \ + windows_changed || \ + windows_structure_changed ) + /* Anytime a console, device or frame is added or deleted we need to reset these flags. */ -#define RESET_CHANGED_SET_FLAGS \ - do { \ - buffers_changed_set = 0; \ - clip_changed_set = 0; \ - extents_changed_set = 0; \ - icon_changed_set = 0; \ - menubar_changed_set = 0; \ - modeline_changed_set = 0; \ - point_changed_set = 0; \ - toolbar_changed_set = 0; \ - glyphs_changed_set = 0; \ - subwindows_changed_set = 0; \ - } while (0) +#define RESET_CHANGED_SET_FLAGS do { \ + buffers_changed_set = 0; \ + clip_changed_set = 0; \ + extents_changed_set = 0; \ + icon_changed_set = 0; \ + menubar_changed_set = 0; \ + modeline_changed_set = 0; \ + point_changed_set = 0; \ + toolbar_changed_set = 0; \ + gutter_changed_set = 0; \ + glyphs_changed_set = 0; \ + subwindows_changed_set = 0; \ + subwindows_state_changed_set = 0; \ +} while (0) /*************************************************************************/ @@ -485,7 +661,7 @@ extern int display_arg; /* Type of display specified. Defined in emacs.c. */ -extern CONST char *display_use; +extern const char *display_use; /* Nonzero means reading single-character input with prompt so put cursor on minibuffer after the prompt. */ @@ -519,9 +695,19 @@ int window_half_pixpos (struct window *w); void redisplay_echo_area (void); void free_display_structs (struct window_mirror *mir); -Bufbyte *generate_formatted_string (struct window *w, Lisp_Object format_str, - Lisp_Object result_str, face_index findex, - int type); +void free_display_lines (display_line_dynarr *dla); +void generate_displayable_area (struct window *w, Lisp_Object disp_string, + int xpos, int ypos, int width, int height, + display_line_dynarr* dl, + Bufpos start_pos, face_index default_face); +/* `generate_title_string' in frame.c needs this */ +void generate_formatted_string_db (Lisp_Object format_str, + Lisp_Object result_str, + struct window *w, + struct display_line *dl, + struct display_block *db, + face_index findex, + int min_pixpos, int max_pixpos, int type); int real_current_modeline_height (struct window *w); int pixel_to_glyph_translation (struct frame *f, int x_coord, int y_coord, int *col, int *row, @@ -531,7 +717,7 @@ Lisp_Object *obj1, Lisp_Object *obj2); void glyph_to_pixel_translation (struct window *w, int char_x, int char_y, int *pix_x, int *pix_y); -void mark_redisplay (void (*) (Lisp_Object)); +void mark_redisplay (void); int point_in_line_start_cache (struct window *w, Bufpos point, int min_past); int point_would_be_visible (struct window *w, Bufpos startp, @@ -559,12 +745,29 @@ int get_next_display_block (layout_bounds bounds, display_block_dynarr *dba, int start_pos, int *next_start); -void redisplay_output_subwindow (struct window *w, struct display_line *dl, - Lisp_Object image_instance, int xpos, - int xoffset, int start_pixpos, int width, - face_index findex, int cursor_start, - int cursor_width, int cursor_height); +void redisplay_output_layout (struct window *w, + Lisp_Object image_instance, + struct display_box* db, struct display_glyph_area* dga, + face_index findex, int cursor_start, int cursor_width, + int cursor_height); +void redisplay_output_subwindow (struct window *w, + Lisp_Object image_instance, + struct display_box* db, struct display_glyph_area* dga, + face_index findex, int cursor_start, int cursor_width, + int cursor_height); void redisplay_unmap_subwindows_maybe (struct frame* f, int x, int y, int width, int height); +void redisplay_output_pixmap (struct window *w, + Lisp_Object image_instance, + struct display_box* db, struct display_glyph_area* dga, + face_index findex, int cursor_start, int cursor_width, + int cursor_height, int offset_bitmap); +int redisplay_calculate_display_boxes (struct display_line *dl, int xpos, + int xoffset, int start_pixpos, int width, + struct display_box* dest, + struct display_glyph_area* src); +int redisplay_normalize_glyph_area (struct display_box* dest, + struct display_glyph_area* glyphsrc); +void redisplay_clear_to_window_end (struct window *w, int ypos1, int ypos2); void redisplay_clear_region (Lisp_Object window, face_index findex, int x, int y, int width, int height); void redisplay_clear_bottom_of_window (struct window *w, @@ -573,6 +776,7 @@ void redisplay_update_line (struct window *w, int first_line, int last_line, int update_values); void redisplay_output_window (struct window *w); +void bevel_modeline (struct window *w, struct display_line *dl); int redisplay_move_cursor (struct window *w, Bufpos new_point, int no_output_end); void redisplay_redraw_cursor (struct frame *f, int run_begin_end_meths); @@ -580,4 +784,4 @@ display_line_dynarr *ddla, int line, int force_start, int force_end); -#endif /* _XEMACS_REDISPLAY_H_ */ +#endif /* INCLUDED_redisplay_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/regex.c --- a/src/regex.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/regex.c Mon Aug 13 11:13:30 2007 +0200 @@ -161,7 +161,7 @@ if (!done) { - CONST char *word_syntax_chars = + const char *word_syntax_chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_"; memset (re_syntax_table, 0, sizeof (re_syntax_table)); @@ -352,7 +352,7 @@ #define BYTEWIDTH 8 /* In bits. */ -#define STREQ(s1, s2) ((strcmp (s1, s2) == 0)) +#define STREQ(s1, s2) (strcmp (s1, s2) == 0) #undef MAX #undef MIN @@ -965,8 +965,8 @@ static void -print_double_string (CONST char *where, CONST char *string1, int size1, - CONST char *string2, int size2) +print_double_string (const char *where, const char *string1, int size1, + const char *string2, int size2) { if (where == NULL) printf ("(null)"); @@ -1031,7 +1031,7 @@ POSIX doesn't require that we do anything for REG_NOERROR, but why not be nice? */ -static CONST char *re_error_msgid[] = +static const char *re_error_msgid[] = { "Success", /* REG_NOERROR */ "No match", /* REG_NOMATCH */ @@ -1365,7 +1365,7 @@ { \ DEBUG_STATEMENT (fail_stack_elt_t ffailure_id;) \ int this_reg; \ - CONST unsigned char *string_temp; \ + const unsigned char *string_temp; \ \ assert (!FAIL_STACK_EMPTY ()); \ \ @@ -1385,7 +1385,7 @@ saved NULL, thus retaining our current position in the string. */ \ string_temp = POP_FAILURE_POINTER (); \ if (string_temp != NULL) \ - str = (CONST char *) string_temp; \ + str = (const char *) string_temp; \ \ DEBUG_PRINT2 (" Popping string 0x%lx: `", (long) str); \ DEBUG_PRINT_DOUBLE_STRING (str, string1, size1, string2, size2); \ @@ -1410,10 +1410,10 @@ DEBUG_PRINT2 (" info: 0x%lx\n", \ * (long *) ®_info[this_reg]); \ \ - regend[this_reg] = (CONST char *) POP_FAILURE_POINTER (); \ + regend[this_reg] = (const char *) POP_FAILURE_POINTER (); \ DEBUG_PRINT2 (" end: 0x%lx\n", (long) regend[this_reg]); \ \ - regstart[this_reg] = (CONST char *) POP_FAILURE_POINTER (); \ + regstart[this_reg] = (const char *) POP_FAILURE_POINTER (); \ DEBUG_PRINT2 (" start: 0x%lx\n", (long) regstart[this_reg]); \ } \ \ @@ -1509,7 +1509,7 @@ #define PATFETCH_EXTENDED(emch) \ do {if (p == pend) return REG_EEND; \ assert (p < pend); \ - emch = charptr_emchar ((CONST Bufbyte *) p); \ + emch = charptr_emchar ((const Bufbyte *) p); \ INC_CHARPTR (p); \ if (translate && emch < 0x80) \ emch = (Emchar) (unsigned char) translate[emch]; \ @@ -1518,7 +1518,7 @@ #define PATFETCH_RAW_EXTENDED(emch) \ do {if (p == pend) return REG_EEND; \ assert (p < pend); \ - emch = charptr_emchar ((CONST Bufbyte *) p); \ + emch = charptr_emchar ((const Bufbyte *) p); \ INC_CHARPTR (p); \ } while (0) @@ -1762,17 +1762,17 @@ unsigned char *end); static void insert_op2 (re_opcode_t op, unsigned char *loc, int arg1, int arg2, unsigned char *end); -static boolean at_begline_loc_p (CONST char *pattern, CONST char *p, +static boolean at_begline_loc_p (const char *pattern, const char *p, reg_syntax_t syntax); -static boolean at_endline_loc_p (CONST char *p, CONST char *pend, int syntax); +static boolean at_endline_loc_p (const char *p, const char *pend, int syntax); static boolean group_in_compile_stack (compile_stack_type compile_stack, regnum_t regnum); -static reg_errcode_t compile_range (CONST char **p_ptr, CONST char *pend, +static reg_errcode_t compile_range (const char **p_ptr, const char *pend, char *translate, reg_syntax_t syntax, unsigned char *b); #ifdef MULE -static reg_errcode_t compile_extended_range (CONST char **p_ptr, - CONST char *pend, +static reg_errcode_t compile_extended_range (const char **p_ptr, + const char *pend, char *translate, reg_syntax_t syntax, Lisp_Object rtab); @@ -1785,11 +1785,11 @@ static boolean common_op_match_null_string_p (unsigned char **p, unsigned char *end, register_info_type *reg_info); -static int bcmp_translate (CONST unsigned char *s1, CONST unsigned char *s2, +static int bcmp_translate (const unsigned char *s1, const unsigned char *s2, REGISTER int len, char *translate); static int re_match_2_internal (struct re_pattern_buffer *bufp, - CONST char *string1, int size1, - CONST char *string2, int size2, int pos, + const char *string1, int size1, + const char *string2, int size2, int pos, struct re_registers *regs, int stop); #ifndef MATCH_MAY_ALLOCATE @@ -1808,11 +1808,11 @@ but never make them smaller. */ static int regs_allocated_size; -static CONST char ** regstart, ** regend; -static CONST char ** old_regstart, ** old_regend; -static CONST char **best_regstart, **best_regend; +static const char ** regstart, ** regend; +static const char ** old_regstart, ** old_regend; +static const char **best_regstart, **best_regend; static register_info_type *reg_info; -static CONST char **reg_dummy; +static const char **reg_dummy; static register_info_type *reg_info_dummy; /* Make the register vectors big enough for NUM_REGS registers, @@ -1823,14 +1823,14 @@ { if (num_regs > regs_allocated_size) { - RETALLOC_IF (regstart, num_regs, CONST char *); - RETALLOC_IF (regend, num_regs, CONST char *); - RETALLOC_IF (old_regstart, num_regs, CONST char *); - RETALLOC_IF (old_regend, num_regs, CONST char *); - RETALLOC_IF (best_regstart, num_regs, CONST char *); - RETALLOC_IF (best_regend, num_regs, CONST char *); + RETALLOC_IF (regstart, num_regs, const char *); + RETALLOC_IF (regend, num_regs, const char *); + RETALLOC_IF (old_regstart, num_regs, const char *); + RETALLOC_IF (old_regend, num_regs, const char *); + RETALLOC_IF (best_regstart, num_regs, const char *); + RETALLOC_IF (best_regend, num_regs, const char *); RETALLOC_IF (reg_info, num_regs, register_info_type); - RETALLOC_IF (reg_dummy, num_regs, CONST char *); + RETALLOC_IF (reg_dummy, num_regs, const char *); RETALLOC_IF (reg_info_dummy, num_regs, register_info_type); regs_allocated_size = num_regs; @@ -1862,7 +1862,7 @@ return (free (compile_stack.stack), value) static reg_errcode_t -regex_compile (CONST char *pattern, int size, reg_syntax_t syntax, +regex_compile (const char *pattern, int size, reg_syntax_t syntax, struct re_pattern_buffer *bufp) { /* We fetch characters from PATTERN here. We declare these as int @@ -1874,7 +1874,7 @@ REGISTER EMACS_INT c, c1; /* A random temporary spot in PATTERN. */ - CONST char *p1; + const char *p1; /* Points to the end of the buffer, where we should append. */ REGISTER unsigned char *b; @@ -1883,8 +1883,8 @@ compile_stack_type compile_stack; /* Points to the current (ending) position in the pattern. */ - CONST char *p = pattern; - CONST char *pend = pattern + size; + const char *p = pattern; + const char *pend = pattern + size; /* How to translate the characters in the pattern. */ char *translate = bufp->translate; @@ -1905,7 +1905,7 @@ /* Place in the uncompiled pattern (i.e., the {) to which to go back if the interval is invalid. */ - CONST char *beg_interval; + const char *beg_interval; /* Address of the place where a forward jump should go to the end of the containing expression. Each alternative of an `or' -- except the @@ -2070,9 +2070,9 @@ /* If we get here, we found another repeat character. */ if (!(syntax & RE_NO_MINIMAL_MATCHING)) { - /* `*?' and `+?' and `??' are okay (and mean match - minimally), but other sequences (such as `*??' and - `+++') are rejected (reserved for future use). */ + /* "*?" and "+?" and "??" are okay (and mean match + minimally), but other sequences (such as "*??" and + "+++") are rejected (reserved for future use). */ if (minimal || c != '?') FREE_STACK_RETURN (REG_BADRPT); minimal = true; @@ -3008,7 +3008,7 @@ { /* XEmacs: modifications here for Mule. */ /* `q' points to the beginning of the next char. */ - CONST char *q = p - 1; + const char *q = p - 1; INC_CHARPTR (q); /* If no exactn currently being built. */ @@ -3184,9 +3184,9 @@ least one character before the ^. */ static boolean -at_begline_loc_p (CONST char *pattern, CONST char *p, reg_syntax_t syntax) +at_begline_loc_p (const char *pattern, const char *p, reg_syntax_t syntax) { - CONST char *prev = p - 2; + const char *prev = p - 2; boolean prev_prev_backslash = prev > pattern && prev[-1] == '\\'; return @@ -3201,11 +3201,11 @@ at least one character after the $, i.e., `P < PEND'. */ static boolean -at_endline_loc_p (CONST char *p, CONST char *pend, int syntax) +at_endline_loc_p (const char *p, const char *pend, int syntax) { - CONST char *next = p; + const char *next = p; boolean next_backslash = *next == '\\'; - CONST char *next_next = p + 1 < pend ? p + 1 : 0; + const char *next_next = p + 1 < pend ? p + 1 : 0; return /* Before a subexpression? */ @@ -3247,12 +3247,12 @@ `regex_compile' itself. */ static reg_errcode_t -compile_range (CONST char **p_ptr, CONST char *pend, char *translate, +compile_range (const char **p_ptr, const char *pend, char *translate, reg_syntax_t syntax, unsigned char *b) { unsigned this_char; - CONST char *p = *p_ptr; + const char *p = *p_ptr; int range_start, range_end; if (p == pend) @@ -3265,9 +3265,9 @@ We also want to fetch the endpoints without translating them; the appropriate translation is done in the bit-setting loop below. */ - /* The SVR4 compiler on the 3B2 had trouble with unsigned CONST char *. */ - range_start = ((CONST unsigned char *) p)[-2]; - range_end = ((CONST unsigned char *) p)[0]; + /* The SVR4 compiler on the 3B2 had trouble with unsigned const char *. */ + range_start = ((const unsigned char *) p)[-2]; + range_end = ((const unsigned char *) p)[0]; /* Have to increment the pointer into the pattern string, so the caller isn't still at the ending character. */ @@ -3292,16 +3292,16 @@ #ifdef MULE static reg_errcode_t -compile_extended_range (CONST char **p_ptr, CONST char *pend, char *translate, +compile_extended_range (const char **p_ptr, const char *pend, char *translate, reg_syntax_t syntax, Lisp_Object rtab) { Emchar this_char, range_start, range_end; - CONST Bufbyte *p; + const Bufbyte *p; if (*p_ptr == pend) return REG_ERANGE; - p = (CONST Bufbyte *) *p_ptr; + p = (const Bufbyte *) *p_ptr; range_end = charptr_emchar (p); p--; /* back to '-' */ DEC_CHARPTR (p); /* back to start of range */ @@ -3858,7 +3858,7 @@ doesn't let you say where to stop matching. */ int -re_search (struct re_pattern_buffer *bufp, CONST char *string, int size, +re_search (struct re_pattern_buffer *bufp, const char *string, int size, int startpos, int range, struct re_registers *regs) { return re_search_2 (bufp, NULL, 0, string, size, startpos, range, @@ -3901,8 +3901,8 @@ stack overflow). */ int -re_search_2 (struct re_pattern_buffer *bufp, CONST char *string1, - int size1, CONST char *string2, int size2, int startpos, +re_search_2 (struct re_pattern_buffer *bufp, const char *string1, + int size1, const char *string2, int size2, int startpos, int range, struct re_registers *regs, int stop) { int val; @@ -3913,7 +3913,7 @@ #ifdef REGEX_BEGLINE_CHECK int anchored_at_begline = 0; #endif - CONST unsigned char *d; + const unsigned char *d; Charcount d_size; /* Check for out-of-range STARTPOS. */ @@ -3935,7 +3935,7 @@ return -1; else { - d = ((CONST unsigned char *) + d = ((const unsigned char *) (startpos >= size1 ? string2 - size1 : string1) + startpos); range = charcount_to_bytecount (d, 1); } @@ -3980,7 +3980,7 @@ if (startpos < size1 && startpos + range >= size1) lim = range - (size1 - startpos); - d = ((CONST unsigned char *) + d = ((const unsigned char *) (startpos >= size1 ? string2 - size1 : string1) + startpos); DEC_CHARPTR(d); /* Ok, since startpos != size1. */ d_size = charcount_to_bytecount (d, 1); @@ -4022,7 +4022,7 @@ if (startpos < size1 && startpos + range >= size1) lim = range - (size1 - startpos); - d = ((CONST unsigned char *) + d = ((const unsigned char *) (startpos >= size1 ? string2 - size1 : string1) + startpos); /* Written out as an if-else to avoid testing `translate' @@ -4090,7 +4090,7 @@ break; else if (range > 0) { - d = ((CONST unsigned char *) + d = ((const unsigned char *) (startpos >= size1 ? string2 - size1 : string1) + startpos); d_size = charcount_to_bytecount (d, 1); range -= d_size; @@ -4100,7 +4100,7 @@ { /* Note startpos > size1 not >=. If we are on the string1/string2 boundary, we want to backup into string1. */ - d = ((CONST unsigned char *) + d = ((const unsigned char *) (startpos > size1 ? string2 - size1 : string1) + startpos); DEC_CHARPTR(d); d_size = charcount_to_bytecount (d, 1); @@ -4191,7 +4191,7 @@ /* re_match is like re_match_2 except it takes only a single string. */ int -re_match (struct re_pattern_buffer *bufp, CONST char *string, int size, +re_match (struct re_pattern_buffer *bufp, const char *string, int size, int pos, struct re_registers *regs) { int result = re_match_2_internal (bufp, NULL, 0, string, size, @@ -4216,8 +4216,8 @@ matched substring. */ int -re_match_2 (struct re_pattern_buffer *bufp, CONST char *string1, - int size1, CONST char *string2, int size2, int pos, +re_match_2 (struct re_pattern_buffer *bufp, const char *string1, + int size1, const char *string2, int size2, int pos, struct re_registers *regs, int stop) { int result = re_match_2_internal (bufp, string1, size1, string2, size2, @@ -4229,8 +4229,8 @@ /* This is a separate function so that we can force an alloca cleanup afterwards. */ static int -re_match_2_internal (struct re_pattern_buffer *bufp, CONST char *string1, - int size1, CONST char *string2, int size2, int pos, +re_match_2_internal (struct re_pattern_buffer *bufp, const char *string1, + int size1, const char *string2, int size2, int pos, struct re_registers *regs, int stop) { /* General temporaries. */ @@ -4239,14 +4239,14 @@ int should_succeed; /* XEmacs change */ /* Just past the end of the corresponding string. */ - CONST char *end1, *end2; + const char *end1, *end2; /* Pointers into string1 and string2, just past the last characters in each to consider matching. */ - CONST char *end_match_1, *end_match_2; + const char *end_match_1, *end_match_2; /* Where we are in the data, and the end of the current string. */ - CONST char *d, *dend; + const char *d, *dend; /* Where we are in the pattern, and the end of the pattern. */ unsigned char *p = bufp->buffer; @@ -4299,7 +4299,7 @@ stopped matching the regnum-th subexpression. (The zeroth register keeps track of what the whole pattern matches.) */ #ifdef MATCH_MAY_ALLOCATE /* otherwise, these are global. */ - CONST char **regstart, **regend; + const char **regstart, **regend; #endif /* If a group that's operated upon by a repetition operator fails to @@ -4308,7 +4308,7 @@ are when we last see its open-group operator. Similarly for a register's end. */ #ifdef MATCH_MAY_ALLOCATE /* otherwise, these are global. */ - CONST char **old_regstart, **old_regend; + const char **old_regstart, **old_regend; #endif /* The is_active field of reg_info helps us keep track of which (possibly @@ -4327,7 +4327,7 @@ turn happens only if we have not yet matched the entire string. */ unsigned best_regs_set = false; #ifdef MATCH_MAY_ALLOCATE /* otherwise, these are global. */ - CONST char **best_regstart, **best_regend; + const char **best_regstart, **best_regend; #endif /* Logically, this is `best_regend[0]'. But we don't want to have to @@ -4338,14 +4338,14 @@ the end of the best match so far in a separate variable. We initialize this to NULL so that when we backtrack the first time and need to test it, it's not garbage. */ - CONST char *match_end = NULL; + const char *match_end = NULL; /* This helps SET_REGS_MATCHED avoid doing redundant work. */ int set_regs_matched_done = 0; /* Used when we pop values we don't care about. */ #ifdef MATCH_MAY_ALLOCATE /* otherwise, these are global. */ - CONST char **reg_dummy; + const char **reg_dummy; register_info_type *reg_info_dummy; #endif @@ -4373,14 +4373,14 @@ array indexing. We should fix this. */ if (bufp->re_nsub) { - regstart = REGEX_TALLOC (num_regs, CONST char *); - regend = REGEX_TALLOC (num_regs, CONST char *); - old_regstart = REGEX_TALLOC (num_regs, CONST char *); - old_regend = REGEX_TALLOC (num_regs, CONST char *); - best_regstart = REGEX_TALLOC (num_regs, CONST char *); - best_regend = REGEX_TALLOC (num_regs, CONST char *); + regstart = REGEX_TALLOC (num_regs, const char *); + regend = REGEX_TALLOC (num_regs, const char *); + old_regstart = REGEX_TALLOC (num_regs, const char *); + old_regend = REGEX_TALLOC (num_regs, const char *); + best_regstart = REGEX_TALLOC (num_regs, const char *); + best_regend = REGEX_TALLOC (num_regs, const char *); reg_info = REGEX_TALLOC (num_regs, register_info_type); - reg_dummy = REGEX_TALLOC (num_regs, CONST char *); + reg_dummy = REGEX_TALLOC (num_regs, const char *); reg_info_dummy = REGEX_TALLOC (num_regs, register_info_type); if (!(regstart && regend && old_regstart && old_regend && reg_info @@ -4735,7 +4735,7 @@ DEBUG_PRINT2 ("EXECUTING charset_mule%s.\n", not ? "_not" : ""); PREFETCH (); - c = charptr_emchar ((CONST Bufbyte *) d); + c = charptr_emchar ((const Bufbyte *) d); c = TRANSLATE_EXTENDED_UNSAFE (c); /* The character to match. */ if (EQ (Qt, unified_range_table_lookup (p, c, Qnil))) @@ -4950,7 +4950,7 @@ followed by the numeric value of <digit> as the register number. */ case duplicate: { - REGISTER CONST char *d2, *dend2; + REGISTER const char *d2, *dend2; int regno = *p++; /* Get which register to match against. */ DEBUG_PRINT2 ("EXECUTING duplicate %d.\n", regno); @@ -5306,7 +5306,7 @@ `pop_failure_point'. */ unsigned dummy_low_reg, dummy_high_reg; unsigned char *pdummy; - CONST char *sdummy = NULL; + const char *sdummy = NULL; DEBUG_PRINT1 ("EXECUTING pop_failure_jump.\n"); POP_FAILURE_POINT (sdummy, pdummy, @@ -5422,10 +5422,10 @@ result = 1; else { - CONST unsigned char *d_before = - (CONST unsigned char *) POS_BEFORE_GAP_UNSAFE (d); - CONST unsigned char *d_after = - (CONST unsigned char *) POS_AFTER_GAP_UNSAFE (d); + const unsigned char *d_before = + (const unsigned char *) POS_BEFORE_GAP_UNSAFE (d); + const unsigned char *d_after = + (const unsigned char *) POS_AFTER_GAP_UNSAFE (d); Emchar emch1, emch2; DEC_CHARPTR (d_before); @@ -5453,14 +5453,14 @@ break; */ - CONST unsigned char *dtmp = - (CONST unsigned char *) POS_AFTER_GAP_UNSAFE (d); + const unsigned char *dtmp = + (const unsigned char *) POS_AFTER_GAP_UNSAFE (d); Emchar emch = charptr_emchar (dtmp); if (!WORDCHAR_P_UNSAFE (emch)) goto fail; if (AT_STRINGS_BEG (d)) break; - dtmp = (CONST unsigned char *) POS_BEFORE_GAP_UNSAFE (d); + dtmp = (const unsigned char *) POS_BEFORE_GAP_UNSAFE (d); DEC_CHARPTR (dtmp); emch = charptr_emchar (dtmp); if (!WORDCHAR_P_UNSAFE (emch)) @@ -5479,18 +5479,18 @@ The or condition is incorrect (reversed). */ - CONST unsigned char *dtmp; + const unsigned char *dtmp; Emchar emch; if (AT_STRINGS_BEG (d)) goto fail; - dtmp = (CONST unsigned char *) POS_BEFORE_GAP_UNSAFE (d); + dtmp = (const unsigned char *) POS_BEFORE_GAP_UNSAFE (d); DEC_CHARPTR (dtmp); emch = charptr_emchar (dtmp); if (!WORDCHAR_P_UNSAFE (emch)) goto fail; if (AT_STRINGS_END (d)) break; - dtmp = (CONST unsigned char *) POS_AFTER_GAP_UNSAFE (d); + dtmp = (const unsigned char *) POS_AFTER_GAP_UNSAFE (d); emch = charptr_emchar (dtmp); if (!WORDCHAR_P_UNSAFE (emch)) break; @@ -5543,7 +5543,7 @@ Emchar emch; PREFETCH (); - emch = charptr_emchar ((CONST Bufbyte *) d); + emch = charptr_emchar ((const Bufbyte *) d); matches = (SYNTAX_UNSAFE (XCHAR_TABLE (regex_emacs_buffer->mirror_syntax_table), emch) == (enum syntaxcode) mcnt); @@ -5576,7 +5576,7 @@ mcnt = *p++; PREFETCH (); - emch = charptr_emchar ((CONST Bufbyte *) d); + emch = charptr_emchar ((const Bufbyte *) d); INC_CHARPTR (d); if (check_category_char(emch, regex_emacs_buffer->category_table, mcnt, should_succeed)) @@ -5918,10 +5918,10 @@ bytes; nonzero otherwise. */ static int -bcmp_translate (CONST unsigned char *s1, CONST unsigned char *s2, +bcmp_translate (const unsigned char *s1, const unsigned char *s2, REGISTER int len, char *translate) { - REGISTER CONST unsigned char *p1 = s1, *p2 = s2; + REGISTER const unsigned char *p1 = s1, *p2 = s2; while (len) { if (translate[*p1++] != translate[*p2++]) return 1; @@ -5941,8 +5941,8 @@ We call regex_compile to do the actual compilation. */ -CONST char * -re_compile_pattern (CONST char *pattern, int length, +const char * +re_compile_pattern (const char *pattern, int length, struct re_pattern_buffer *bufp) { reg_errcode_t ret; @@ -5975,7 +5975,7 @@ static struct re_pattern_buffer re_comp_buf; char * -re_comp (CONST char *s) +re_comp (const char *s) { reg_errcode_t ret; @@ -6009,15 +6009,15 @@ if (!ret) return NULL; - /* Yes, we're discarding `CONST' here if !HAVE_LIBINTL. */ + /* Yes, we're discarding `const' here if !HAVE_LIBINTL. */ return (char *) gettext (re_error_msgid[(int) ret]); } int -re_exec (CONST char *s) +re_exec (const char *s) { - CONST int len = strlen (s); + const int len = strlen (s); return 0 <= re_search (&re_comp_buf, s, len, 0, len, (struct re_registers *) 0); } @@ -6062,7 +6062,7 @@ the return codes and their meanings.) */ int -regcomp (regex_t *preg, CONST char *pattern, int cflags) +regcomp (regex_t *preg, const char *pattern, int cflags) { reg_errcode_t ret; unsigned syntax @@ -6135,7 +6135,7 @@ We return 0 if we find a match and REG_NOMATCH if not. */ int -regexec (CONST regex_t *preg, CONST char *string, size_t nmatch, +regexec (const regex_t *preg, const char *string, size_t nmatch, regmatch_t pmatch[], int eflags) { int ret; @@ -6196,9 +6196,9 @@ from either regcomp or regexec. We don't use PREG here. */ size_t -regerror (int errcode, CONST regex_t *preg, char *errbuf, size_t errbuf_size) +regerror (int errcode, const regex_t *preg, char *errbuf, size_t errbuf_size) { - CONST char *msg; + const char *msg; size_t msg_size; if (errcode < 0 diff -r f4aeb21a5bad -r 74fd4e045ea6 src/regex.h --- a/src/regex.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/regex.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,8 +20,8 @@ /* Synched up with: FSF 19.29. */ -#ifndef __REGEXP_LIBRARY_H__ -#define __REGEXP_LIBRARY_H__ +#ifndef INCLUDED_regex_h_ +#define INCLUDED_regex_h_ /* POSIX says that <sys/types.h> must be included (by the caller) before <regex.h>. */ @@ -413,7 +413,7 @@ /* Compile the regular expression PATTERN, with length LENGTH and syntax given by the global `re_syntax_options', into the buffer BUFFER. Return NULL if successful, and an error string if not. */ -CONST char *re_compile_pattern (CONST char *pattern, int length, +const char *re_compile_pattern (const char *pattern, int length, struct re_pattern_buffer *buffer); @@ -428,27 +428,27 @@ characters. Return the starting position of the match, -1 for no match, or -2 for an internal error. Also return register information in REGS (if REGS and BUFFER->no_sub are nonzero). */ -int re_search (struct re_pattern_buffer *buffer, CONST char *string, +int re_search (struct re_pattern_buffer *buffer, const char *string, int length, int start, int range, struct re_registers *regs); /* Like `re_search', but search in the concatenation of STRING1 and STRING2. Also, stop searching at index START + STOP. */ -int re_search_2 (struct re_pattern_buffer *buffer, CONST char *string1, - int length1, CONST char *string2, int length2, int start, +int re_search_2 (struct re_pattern_buffer *buffer, const char *string1, + int length1, const char *string2, int length2, int start, int range, struct re_registers *regs, int stop); /* Like `re_search', but return how many characters in STRING the regexp in BUFFER matched, starting at position START. */ -int re_match (struct re_pattern_buffer *buffer, CONST char *string, +int re_match (struct re_pattern_buffer *buffer, const char *string, int length, int start, struct re_registers *regs); /* Relates to `re_match' as `re_search_2' relates to `re_search'. */ -int re_match_2 (struct re_pattern_buffer *buffer, CONST char *string1, - int length1, CONST char *string2, int length2, +int re_match_2 (struct re_pattern_buffer *buffer, const char *string1, + int length1, const char *string2, int length2, int start, struct re_registers *regs, int stop); @@ -470,16 +470,16 @@ #ifdef _REGEX_RE_COMP /* 4.2 bsd compatibility. */ -char *re_comp (CONST char *); -int re_exec (CONST char *); +char *re_comp (const char *); +int re_exec (const char *); #endif /* POSIX compatibility. */ -int regcomp (regex_t *preg, CONST char *pattern, int cflags); -int regexec (CONST regex_t *preg, CONST char *string, size_t nmatch, +int regcomp (regex_t *preg, const char *pattern, int cflags); +int regexec (const regex_t *preg, const char *string, size_t nmatch, regmatch_t pmatch[], int eflags); -size_t regerror (int errcode, CONST regex_t *preg, char *errbuf, +size_t regerror (int errcode, const regex_t *preg, char *errbuf, size_t errbuf_size); void regfree (regex_t *preg); -#endif /* not __REGEXP_LIBRARY_H__ */ +#endif /* INCLUDED_regex_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/s/aix3-2.h --- a/src/s/aix3-2.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/s/aix3-2.h Mon Aug 13 11:13:30 2007 +0200 @@ -32,8 +32,6 @@ #endif #endif -#define HAVE_FSYNC - /* With this defined, a gcc-compiled Emacs crashed in realloc under AIX 3.2, and a cc-compiled Emacs works with this undefined. --karl@cs.umb.edu. */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/s/aix4.h --- a/src/s/aix4.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/s/aix4.h Mon Aug 13 11:13:30 2007 +0200 @@ -7,7 +7,20 @@ #ifndef NOT_C_CODE #define _XFUNCS_H_ 1 + +/* AIX is happier when bzero and strcasecmp are declared */ +#include "strings.h" + +/* AIX 4.2's sys/mman.h doesn't seem to define MAP_FAILED, + although Unix98 claims it must. */ +#ifdef HAVE_MMAP +#include <sys/mman.h> +# ifndef MAP_FAILED +# define MAP_FAILED ((void *) -1) +# endif +#endif + /* Forward declarations for xlc warning suppressions */ struct ether_addr; struct sockaddr_dl; -#endif +#endif /* C code */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/s/cygwin32.h --- a/src/s/cygwin32.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/s/cygwin32.h Mon Aug 13 11:13:30 2007 +0200 @@ -38,7 +38,7 @@ * YMMV. I build with NT4 SP3. * * Andy Piper <andy@xemacs.org> 8/1/98 - * http://www.parallax.co.uk/~andyp */ + * http://www.xemacs.freeserve.co.uk/ */ /* cheesy way to determine cygwin version */ #ifndef NOT_C_CODE @@ -47,8 +47,12 @@ #include <cygwin/version.h> #else #ifdef SIGIO +#define CYGWIN_VERSION_DLL_MAJOR 19 +#define CYGWIN_VERSION_DLL_MINOR 0 #define CYGWIN_B19 #else +#define CYGWIN_VERSION_DLL_MAJOR 18 +#define CYGWIN_VERSION_DLL_MINOR 0 #define BROKEN_CYGWIN #endif #endif @@ -57,7 +61,7 @@ extern int cygwin32_win32_to_posix_path_list_buf_size(const char*); extern void cygwin32_posix_to_win32_path_list(const char*, char*); extern int cygwin32_posix_to_win32_path_list_buf_size(const char*); -#ifndef CYGWIN_VERSION_DLL_MAJOR +#if CYGWIN_VERSION_DLL_MAJOR < 20 struct timeval; struct timezone; struct itimerval; @@ -105,6 +109,38 @@ #endif #endif +#ifndef SPI_GETWHEELSCROLLLINES +#define SPI_GETWHEELSCROLLLINES 104 +#endif +#ifndef WHEEL_PAGESCROLL +#define WHEEL_PAGESCROLL (UINT_MAX) +#endif +#ifndef WHEEL_DELTA +#define WHEEL_DELTA 120 +#endif +#ifndef WM_MOUSEWHEEL +#define WM_MOUSEWHEEL 0x20A +#endif +#ifndef TCS_BOTTOM +#define TCS_BOTTOM 0x0002 +#endif +#ifndef TCS_VERTICAL +#define TCS_VERTICAL 0x0080 +#endif +#ifndef PHYSICALWIDTH +#define PHYSICALWIDTH 110 +#endif +#ifndef PHYSICALHEIGHT +#define PHYSICALHEIGHT 111 +#endif +#ifndef PHYSICALOFFSETX +#define PHYSICALOFFSETX 112 +#endif +#ifndef PHYSICALOFFSETY +#define PHYSICALOFFSETY 113 +#endif + + #define PBS_SMOOTH 0x01 #ifdef HAVE_MS_WINDOWS @@ -128,7 +164,7 @@ #ifdef CYGWIN_VERSION_DLL_MAJOR #if 0 -/* ### FIXME: although defining BROKEN_SIGIO is correct for proper ^G +/* #### FIXME: although defining BROKEN_SIGIO is correct for proper ^G behavior, bugs in cygwin mean that xemacs locks up frequently if this is defined. */ #define BROKEN_SIGIO diff -r f4aeb21a5bad -r 74fd4e045ea6 src/s/decosf4-0.h --- a/src/s/decosf4-0.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/s/decosf4-0.h Mon Aug 13 11:13:30 2007 +0200 @@ -24,13 +24,13 @@ #define regoff_t sys_regoff_t #define regmatch_t sys_regmatch_t -/* A perfectly ordinary link wins again - martin */ +/* A perfectly ordinary link wins again - martin #undef C_SWITCH_SYSTEM #undef LIBS_SYSTEM #undef LIBS_DEBUG -#define ORDINARY_LINK +#define ORDINARY_LINK */ -#define SYSTEM_MALLOC +#undef SYSTEM_MALLOC #if 0 /* martin */ /* Some V4.0* versions before V4.0B don't detect rename properly. */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/s/linux.h --- a/src/s/linux.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/s/linux.h Mon Aug 13 11:13:30 2007 +0200 @@ -26,6 +26,12 @@ #define USG #define LINUX +/* powerpc gcc 2.8.0 doesn't define __ELF__, but it is */ + +#if defined(__ELF__) || defined(powerpc) +#define LINUX_ELF +#endif + /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ @@ -81,7 +87,7 @@ /* Ask GCC where to find libgcc.a. */ #define LIB_GCC "`$(CC) $(C_SWITCH_X_SITE) -print-libgcc-file-name`" -#ifndef __ELF__ +#ifndef LINUX_ELF /* Linux has crt0.o in a non-standard place */ #define START_FILES "pre-crt0.o /usr/lib/crt0.o" #else @@ -106,7 +112,7 @@ /* Best not to include -lg, unless it is last on the command line */ #define LIBS_DEBUG #define LIBS_TERMCAP "-ltermcap -lcurses" /* save some space with shared libs*/ -#ifndef __ELF__ +#ifndef LINUX_ELF #define LIB_STANDARD "-lc" /* avoid -lPW */ #else /*#undef LIB_GCC @@ -124,7 +130,7 @@ #define LIBS_SYSTEM #endif -#ifdef __ELF__ +#ifdef LINUX_ELF #define UNEXEC "unexelf.o" #define UNEXEC_USE_MAP_PRIVATE #if 0 @@ -142,7 +148,7 @@ #undef START_FILES #undef LIB_GCC #endif -#endif /* __ELF__ */ +#endif /* LINUX_ELF */ #ifdef LINUX_QMAGIC diff -r f4aeb21a5bad -r 74fd4e045ea6 src/s/mingw32.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/s/mingw32.h Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,300 @@ +/* system description file for mingw32. + Copyright (C) 1993, 1994, 1995, 1999 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* based on cygwin32.h by Andy Piper <andy@xemacs.org> */ + +#ifndef WINDOWSNT +#define WINDOWSNT +#endif + +#ifndef DOS_NT +#define DOS_NT /* MSDOS or WINDOWSNT */ +#endif + +#define PBS_SMOOTH 0x01 + +#ifdef HAVE_MS_WINDOWS +#define HAVE_NTGUI +#define HAVE_FACES +#endif + +#ifndef ORDINARY_LINK +#define ORDINARY_LINK +#endif + +#define C_SWITCH_SYSTEM "-mno-cygwin -Wno-sign-compare -fno-caller-saves -Int/inc -I../nt/inc -DWINDOWSNT" +#define LIBS_SYSTEM "-mno-cygwin -lwinmm -lwsock32" + +#define TEXT_START -1 +#define TEXT_END -1 +#define DATA_END -1 +#define HEAP_IN_DATA +#define UNEXEC "unexcw.o" + +#define TIME_ONESHOT 0 +#define TIME_PERIODIC 1 +#define LOCALE_USE_CP_ACP 0x40000000 +#define SHGFI_EXETYPE 0x2000 +#define NSIG 23 + +#ifndef SPI_GETWHEELSCROLLLINES +#define SPI_GETWHEELSCROLLLINES 104 +#endif +#ifndef WHEEL_PAGESCROLL +#define WHEEL_PAGESCROLL (UINT_MAX) +#endif +#ifndef WHEEL_DELTA +#define WHEEL_DELTA 120 +#endif +#ifndef WM_MOUSEWHEEL +#define WM_MOUSEWHEEL 0x20A +#endif + +/* translate NT world unexec stuff to our a.out definitions */ + +#define strnicmp strncasecmp +/* #ifndef HAVE_SOCKETS */ +#define HAVE_SOCKETS +/* #endif */ +#define OBJECTS_SYSTEM ntplay.o nt.o ntheap.o ntproc.o dired-msw.o +#define HAVE_NATIVE_SOUND + +#undef MAIL_USE_SYSTEM_LOCK +#define MAIL_USE_POP +#define HAVE_MSW_C_DIRED + +/* Define NO_ARG_ARRAY if you cannot take the address of the first of a + * group of arguments and treat it as an array of the arguments. */ + +#define NO_ARG_ARRAY + +/* Define WORD_MACHINE if addresses and such have + * to be corrected before they can be used as byte counts. */ + +#define WORD_MACHINE + +/* Define EXPLICIT_SIGN_EXTEND if XINT must explicitly sign-extend + the 24-bit bit field into an int. In other words, if bit fields + are always unsigned. + + If you use NO_UNION_TYPE, this flag does not matter. */ + +#define EXPLICIT_SIGN_EXTEND +/* System calls that are encapsulated */ +#define ENCAPSULATE_RENAME +#define ENCAPSULATE_OPEN +#define ENCAPSULATE_FOPEN +#define ENCAPSULATE_MKDIR + +/* Data type of load average, as read out of kmem. */ + +#define LOAD_AVE_TYPE long + +/* Convert that into an integer that is 100 for a load average of 1.0 */ + +#define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) + +/* Define VIRT_ADDR_VARIES if the virtual addresses of + pure and impure space as loaded can vary, and even their + relative order cannot be relied on. + + Otherwise Emacs assumes that text space precedes data space, + numerically. */ + +/* Text does precede data space, but this is never a safe assumption. */ +#define VIRT_ADDR_VARIES + +/* set this if you have a new version of cygwin +#define DATA_SEG_BITS 0x10000000 +*/ + +/* If you are compiling with a non-C calling convention but need to + declare vararg routines differently, put it here */ +#define _VARARGS_ __cdecl + +/* If you are providing a function to something that will call the + function back (like a signal handler and signal, or main) its calling + convention must be whatever standard the libraries expect */ +#define _CALLBACK_ __cdecl + +/* SYSTEM_TYPE should indicate the kind of system you are using. + It sets the Lisp variable system-type. */ + +#define SYSTEM_TYPE "windows-nt" + +#define NO_MATHERR + +/* define MAIL_USE_FLOCK if the mailer uses flock + to interlock access to /usr/spool/mail/$USER. + The alternative is that a lock file named + /usr/spool/mail/$USER.lock. */ + +/* If the character used to separate elements of the executable path + is not ':', #define this to be the appropriate character constant. */ +#define SEPCHAR ';' + +/* ============================================================ */ + +/* Here, add any special hacks needed + to make Emacs work on this system. For example, + you might define certain system call names that don't + exist on your system, or that do different things on + your system and must be used only through an encapsulation + (Which you should place, by convention, in sysdep.c). */ + +/* Define this to be the separator between devices and paths */ +#define DEVICE_SEP ':' + +#define DIRECTORY_SEP '\\' + +/* The null device on Windows NT. */ +#define NULL_DEVICE "NUL:" +#define EXEC_SUFFIXES ".exe:.com:.bat:.cmd:" +/* We'll support either convention on NT. */ +#define IS_DIRECTORY_SEP(_c_) ((_c_) == '/' || (_c_) == '\\') +#define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_) || IS_DEVICE_SEP (_c_)) +#define EXEC_SUFFIXES ".exe:.com:.bat:.cmd:" + +/* We need a little extra space, see ../../lisp/loadup.el */ +#define SYSTEM_PURESIZE_EXTRA 15000 + +#ifndef NOT_C_CODE +#include <stdlib.h> +#include <mingw32/process.h> +#define mkdir __mkdir +#include <dir.h> +#undef mkdir +#ifdef HAVE_CYGWIN_VERSION_H +#include <cygwin/version.h> +#endif + +typedef unsigned int MMRESULT; +typedef struct timecaps_tag { + unsigned int wPeriodMin; + unsigned int wPeriodMax; +} TIMECAPS; + +/* IO calls that are emulated or shadowed */ +#define pipe sys_pipe +int sys_pipe (int * phandles); + +#ifndef HAVE_X_WINDOWS +#define sleep sys_sleep +void sleep (int seconds); +#endif + +/* subprocess calls that are emulated */ +#define spawnve sys_spawnve +int spawnve (int mode, const char *cmdname, + const char * const *argv, const char *const *envp); + +#define wait sys_wait +int wait (int *status); + +#define kill sys_kill +int kill (int pid, int sig); + +/* map to MSVC names */ +#define popen _popen +#define pclose _pclose + +typedef int uid_t; +typedef int gid_t; +typedef int pid_t; +typedef int ssize_t; + +/* Encapsulation of system calls */ +#ifndef DONT_ENCAPSULATE +#define getpid sys_getpid +pid_t getpid (void); +#endif + +#define DONT_USE_LITOUT + +/* Random global functions called everywhere. Implemented in nt.c */ +/* #### Most of these are FSFisms and must be avoided */ +/* #### All of these are FSFisms and must be avoided */ +void dostounix_filename (char *p); +void unixtodos_filename (char *p); +int crlf_to_lf (int n, unsigned char *buf, unsigned int *lf_count); + +char *getwd (char *dir); + +void *sbrk (unsigned long increment); + +struct passwd; +struct passwd *getpwuid (uid_t uid); +struct passwd *getpwnam (const char *name); +uid_t getuid (void); +uid_t geteuid (void); +gid_t getgid (void); +gid_t getegid (void); +#define _timeb timeb + +/* Stuff that gets set wrongly or otherwise */ +#define HAVE_SETITIMER +#define HAVE_GETTIMEOFDAY +#define HAVE_SELECT +/*#define HAVE_STRUCT_UTIMBUF*/ + +#undef GETTIMEOFDAY_ONE_ARGUMENT +#undef HAVE_SYS_WAIT_H +#undef HAVE_TERMIOS +#undef SYSV_SYSTEM_DIR + +/* We now have emulation for some signals */ +#define HAVE_SIGHOLD +#define sigset(s,h) msw_sigset(s,h) +#define sighold(s) msw_sighold(s) +#define sigrelse(s) msw_sigrelse(s) +#define sigpause(s) msw_sigpause(s) +#define signal sigset + +/* Defines that we need that aren't in the standard signal.h */ +#define SIGHUP 1 /* Hang up */ +#define SIGQUIT 3 /* Quit process */ +#define SIGKILL 9 /* Die, die die */ +#define SIGALRM 14 /* Alarm */ +#define SIGPROF 29 /* Profiling timer exp */ + +#ifndef MAXPATHLEN +#define MAXPATHLEN _MAX_PATH +#endif + +/* For integration with MSDOS support. */ +#define getdisk() (_getdrive () - 1) +#define getdefdir(_drv, _buf) _getdcwd (_drv, _buf, MAXPATHLEN) +#endif + +/* Define for those source files that do not include enough NT + system files. */ +#ifndef NULL +#ifdef __cplusplus +#define NULL 0 +#else +#define NULL ((void *)0) +#endif +#endif + +/* Define process implementation */ +#define HAVE_WIN32_PROCESSES + +/* ============================================================ */ + diff -r f4aeb21a5bad -r 74fd4e045ea6 src/s/msdos.h --- a/src/s/msdos.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/s/msdos.h Mon Aug 13 11:13:30 2007 +0200 @@ -189,11 +189,6 @@ #define tzset init_gettimeofday #endif -/* bcopy under djgpp is quite safe */ -#define GAP_USE_BCOPY -#define BCOPY_UPWARD_SAFE 1 -#define BCOPY_DOWNWARD_SAFE 1 - /* Mode line description of a buffer's type. */ #define MODE_LINE_BINARY_TEXT(buf) (NILP(buf->buffer_file_type) ? "T" : "B") diff -r f4aeb21a5bad -r 74fd4e045ea6 src/s/sco7.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/s/sco7.h Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,14 @@ +/* Synched up with: FSF 19.31. */ + +/* s/ file for System V release 4.2. */ + +#include "usg5-4.h" + +/* Motif needs -lgen. */ +#undef LIBS_SYSTEM +#define LIBS_SYSTEM "-lsocket -lnsl -lelf -lgen" + +#define VFORK_RETURN_TYPE pid_t + +/* XEmacs change: communicate to m/intel386.h */ +#define USG5_4_2 diff -r f4aeb21a5bad -r 74fd4e045ea6 src/s/sol2.h --- a/src/s/sol2.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/s/sol2.h Mon Aug 13 11:13:30 2007 +0200 @@ -10,20 +10,6 @@ #define USG5_4 #endif -#undef _POSIX_C_SOURCE - -#if OS_RELEASE > 54 -/* There were some bugs with preprocessor symbol interaction, which - were not fixed until 2.5. */ -#define __EXTENSIONS__ 1 - -#undef _XOPEN_SOURCE -#define _XOPEN_SOURCE 1 - -#undef _XOPEN_SOURCE_EXTENDED -#define _XOPEN_SOURCE_EXTENDED 1 -#endif /* > Solaris 2.4 */ - #if OS_RELEASE >= 57 #define HAVE_GETLOADAVG #endif diff -r f4aeb21a5bad -r 74fd4e045ea6 src/s/windowsnt.h --- a/src/s/windowsnt.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/s/windowsnt.h Mon Aug 13 11:13:30 2007 +0200 @@ -105,9 +105,9 @@ The alternative is that a lock file named /usr/spool/mail/$USER.lock. */ -/* #define MAIL_USE_FLOCK */ #define MAIL_USE_POP -#define MAIL_USE_SYSTEM_LOCK +#define HAVE_LOCKING +#define MAIL_USE_LOCKING /* If the character used to separate elements of the executable path is not ':', #define this to be the appropriate character constant. */ @@ -125,7 +125,7 @@ /* XEmacs file I/O for DOS text files requires FILE_CODING */ #define FILE_CODING -#define DIRECTORY_SEP '\\' +#define DIRECTORY_SEP ((char)XCHAR(Vdirectory_sep_char)) /* Define this to be the separator between devices and paths */ #define DEVICE_SEP ':' @@ -182,49 +182,15 @@ #define MODE_LINE_BINARY_TEXT(_b_) (NILP ((_b_)->buffer_file_type) ? "T" : "B") -/* get some redefinitions in place */ - -#if 0 -/* IO calls that are emulated or shadowed */ -#define access sys_access -#define chdir sys_chdir -#define chmod sys_chmod -#define close sys_close -#define creat sys_creat -#define ctime sys_ctime -#define dup sys_dup -#define dup2 sys_dup2 -#define fopen sys_fopen -#define link sys_link -#define mktemp sys_mktemp -#define open sys_open -#define read sys_read -#define rename sys_rename -#define unlink sys_unlink -#define write sys_write -#define mkdir sys_mkdir -#define rmdir sys_rmdir - -#endif - -#if 0 -/* this is hacky, but is necessary to avoid warnings about macro - redefinitions using the SDK compilers */ -#ifndef __STDC__ -#define __STDC__ 1 -#define MUST_UNDEF__STDC__ -#endif -#include <direct.h> -#include <io.h> -#include <stdio.h> -#ifdef MUST_UNDEF__STDC__ -#undef __STDC__ -#undef MUST_UNDEF__STDC__ -#endif -#endif #include <stdio.h> +/* subprocess calls that are emulated */ +#ifndef DONT_ENCAPSULATE +#define spawnve sys_spawnve +int spawnve (int mode, const char *cmdname, + const char * const *argv, const char *const *envp); +#endif /* IO calls that are emulated or shadowed */ #define pipe sys_pipe @@ -235,11 +201,6 @@ void sleep (int seconds); #endif -/* subprocess calls that are emulated */ -#define spawnve sys_spawnve -int spawnve (int mode, CONST char *cmdname, - CONST char * CONST *argv, CONST char *CONST *envp); - #define wait sys_wait int wait (int *status); @@ -250,41 +211,15 @@ #define popen _popen #define pclose _pclose -#if 0 -#define chdir _chdir -#define execlp _execlp -#define execvp _execvp -#define fcloseall _fcloseall -#define fdopen _fdopen -#define fgetchar _fgetchar -#define fileno _fileno -#define flushall _flushall -#define fputchar _fputchar -#define getw _getw -#define getpid _getpid -#define isatty _isatty -#define logb _logb -#define _longjmp longjmp -#define lseek _lseek -#define putw _putw -#define umask _umask -/* #define utime _utime */ -/* #define index strchr */ -/* #define rindex strrchr */ -#define read _read -#define write _write -#define getcwd _getcwd - -#ifdef HAVE_NTGUI -#define abort win32_abort -#endif - -#endif /* 0 */ +typedef int uid_t; +typedef int gid_t; +typedef int pid_t; +typedef int ssize_t; /* Encapsulation of system calls */ #ifndef DONT_ENCAPSULATE #define getpid sys_getpid -int getpid (void); +pid_t getpid (void); #endif /* Random global functions called everywhere. Implemented in nt.c */ @@ -299,12 +234,12 @@ void *sbrk (unsigned long increment); struct passwd; -struct passwd *getpwuid (int uid); +struct passwd *getpwuid (uid_t uid); struct passwd *getpwnam (const char *name); -int getuid (); -int geteuid (); -int getgid (void); -int getegid (); +uid_t getuid (void); +uid_t geteuid (void); +gid_t getgid (void); +gid_t getegid (void); /* Setitimer is emulated */ #define HAVE_SETITIMER @@ -315,7 +250,6 @@ #define sighold(s) msw_sighold(s) #define sigrelse(s) msw_sigrelse(s) #define sigpause(s) msw_sigpause(s) -#define signal sigset /* Defines that we need that aren't in the standard signal.h */ #define SIGHUP 1 /* Hang up */ @@ -328,13 +262,6 @@ #define getdisk() (_getdrive () - 1) #define getdefdir(_drv, _buf) _getdcwd (_drv, _buf, MAXPATHLEN) -#if 0 /* they do. -kkm */ -/* Define this so that winsock.h definitions don't get included when windows.h - is... I don't know if they do the right thing for emacs. For this to - have proper effect, config.h must always be included before windows.h. */ -#define _WINSOCKAPI_ 1 -#endif /* 0 */ - /* Defines size_t and alloca (). */ #include <malloc.h> @@ -370,3 +297,10 @@ #pragma data_seg("xdata") #pragma bss_seg("xdata") #endif + +#ifdef HAVE_SCROLLBARS +/* Ensure the NT 4 mouse definitions in winuser.h are available */ + #ifndef _WIN32_WINNT + #define _WIN32_WINNT 0x0400 + #endif +#endif diff -r f4aeb21a5bad -r 74fd4e045ea6 src/scrollbar-msw.c --- a/src/scrollbar-msw.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/scrollbar-msw.c Mon Aug 13 11:13:30 2007 +0200 @@ -24,6 +24,7 @@ /* Synched up with: Not in FSF. */ #include <config.h> +#include <limits.h> #include "lisp.h" #include "console-msw.h" @@ -265,6 +266,69 @@ } } +static int +can_scroll(struct scrollbar_instance* scrollbar) +{ + return scrollbar != NULL + && IsWindowVisible (SCROLLBAR_MSW_HANDLE (scrollbar)) + && IsWindowEnabled (SCROLLBAR_MSW_HANDLE (scrollbar)); +} + +int +mswindows_handle_mousewheel_event (Lisp_Object frame, int keys, int delta) +{ + int hasVertBar, hasHorzBar; /* Indicates prescence of scroll bars */ + unsigned wheelScrollLines = 0; /* Number of lines per wheel notch */ + + /* Find the currently selected window */ + Lisp_Object win = FRAME_SELECTED_WINDOW (XFRAME (frame)); + struct window* w = XWINDOW (win); + struct window_mirror* mirror = find_window_mirror (w); + + /* Check that there is something to scroll */ + hasVertBar = can_scroll (mirror->scrollbar_vertical_instance); + hasHorzBar = can_scroll (mirror->scrollbar_horizontal_instance); + if (!hasVertBar && !hasHorzBar) + return FALSE; + + /* No support for panning and zooming, so ignore */ + if (keys & (MK_SHIFT | MK_CONTROL)) + return FALSE; + + /* Get the number of lines per wheel delta */ + SystemParametersInfo (SPI_GETWHEELSCROLLLINES, 0, &wheelScrollLines, 0); + + /* Calculate the amount to scroll */ + if (wheelScrollLines == WHEEL_PAGESCROLL) + { + /* Scroll by a page */ + Lisp_Object function; + if (hasVertBar) + function = delta > 0 ? Qscrollbar_page_up : Qscrollbar_page_down; + else + function = delta > 0 ? Qscrollbar_page_left : Qscrollbar_page_right; + mswindows_enqueue_misc_user_event (frame, function, Fcons (win, Qnil)); + } + else /* Scroll by a number of lines */ + { + /* Calc the number of lines to scroll */ + int toScroll = MulDiv (delta, wheelScrollLines, WHEEL_DELTA); + + /* Do the scroll */ + Lisp_Object function; + if (hasVertBar) + function = delta > 0 ? Qscrollbar_line_up : Qscrollbar_line_down; + else + function = delta > 0 ? Qscrollbar_char_left : Qscrollbar_char_right; + if (toScroll < 0) + toScroll = -toScroll; + while (toScroll--) + mswindows_enqueue_misc_user_event (frame, function, win); + } + + return TRUE; +} + #ifdef MEMORY_USAGE_STATS static int diff -r f4aeb21a5bad -r 74fd4e045ea6 src/scrollbar-msw.h --- a/src/scrollbar-msw.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/scrollbar-msw.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,8 +20,8 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_SCROLLBAR_MSW_H_ -#define _XEMACS_SCROLLBAR_MSW_H_ +#ifndef INCLUDED_scrollbar_msw_h_ +#define INCLUDED_scrollbar_msw_h_ #if defined (HAVE_MS_WINDOWS) && defined (HAVE_SCROLLBARS) @@ -57,6 +57,7 @@ */ void mswindows_handle_scrollbar_event (HWND hwnd, int code, int pos); +int mswindows_handle_mousewheel_event (Lisp_Object frame, int keys, int delta); #endif /* HAVE_MS_WINDOWS and HAVE_SCROLLBARS */ -#endif /* _XEMACS_SCROLLBAR_MSW_H_ */ +#endif /* INCLUDED_scrollbar_msw_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/scrollbar-x.c --- a/src/scrollbar-x.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/scrollbar-x.c Mon Aug 13 11:13:30 2007 +0200 @@ -27,6 +27,7 @@ #include "lisp.h" #include "console-x.h" +#include "EmacsFrame.h" #include "glyphs-x.h" #include "gui-x.h" #include "scrollbar-x.h" @@ -214,6 +215,7 @@ wv->scrollbar_data = xnew (scrollbar_values); wv->name = SCROLLBAR_X_NAME (instance); + wv->name = xstrdup (wv->name); wv->value = 0; wv->key = 0; wv->enabled = instance->scrollbar_is_active; @@ -277,9 +279,7 @@ } if (!wv->scrollbar_data) abort (); - xfree (wv->scrollbar_data); - wv->scrollbar_data = 0; - free_widget_value (wv); + free_widget_value_tree (wv); } else if (managed) { @@ -672,19 +672,6 @@ 0, (Window) NULL); } -/* Called directly from x_any_window_to_frame in frame-x.c */ -EMACS_INT -x_window_is_scrollbar (struct frame *f, Window win) -{ - if (!FRAME_X_P (f)) - return 0; - - if (f->mirror_dirty) - update_frame_window_mirror (f); - return (EMACS_INT) x_scrollbar_loop (X_WINDOW_IS_SCROLLBAR, f->root_window, - f->root_mirror, 0, win); -} - /* Make sure that all scrollbars on frame are up-to-date. Called directly from x_set_frame_properties in frame-x.c*/ void @@ -745,8 +732,16 @@ } void +reinit_vars_of_scrollbar_x (void) +{ + stupid_vertical_scrollbar_drag_hack = 1; +} + +void vars_of_scrollbar_x (void) { + reinit_vars_of_scrollbar_x (); + #if defined (LWLIB_SCROLLBARS_LUCID) Fprovide (intern ("lucid-scrollbars")); #elif defined (LWLIB_SCROLLBARS_MOTIF) @@ -754,5 +749,4 @@ #elif defined (LWLIB_SCROLLBARS_ATHENA) Fprovide (intern ("athena-scrollbars")); #endif - stupid_vertical_scrollbar_drag_hack = 1; } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/scrollbar-x.h --- a/src/scrollbar-x.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/scrollbar-x.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,8 +20,8 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_SCROLLBAR_X_H_ -#define _XEMACS_SCROLLBAR_X_H_ +#ifndef INCLUDED_scrollbar_x_h_ +#define INCLUDED_scrollbar_x_h_ #if defined (HAVE_X_WINDOWS) && defined (HAVE_SCROLLBARS) @@ -69,7 +69,7 @@ void x_update_frame_scrollbars (struct frame *f); void x_set_scrollbar_pointer (struct frame *f, Lisp_Object cursor); -EMACS_INT x_window_is_scrollbar (struct frame *f, Window win); #endif /* HAVE_X_WINDOWS and HAVE_SCROLLBARS */ -#endif /* _XEMACS_SCROLLBAR_H_ */ + +#endif /* INCLUDED_scrollbar_x_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/scrollbar.c --- a/src/scrollbar.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/scrollbar.c Mon Aug 13 11:13:30 2007 +0200 @@ -34,6 +34,7 @@ #include "device.h" #include "frame.h" #include "glyphs.h" +#include "gutter.h" #include "window.h" Lisp_Object Qinit_scrollbar_from_resources; @@ -452,23 +453,41 @@ { int x_offset, y_offset; - /* Scrollbars are always the farthest from the text area. */ + /* Scrollbars are always the farthest from the text area, barring + gutters. */ if (vertical) { - x_offset = (!NILP (w->scrollbar_on_left_p) - ? WINDOW_LEFT (w) - : (WINDOW_RIGHT (w) - scrollbar_width - - (window_needs_vertical_divider (w) - ? window_divider_width (w) : 0))); + if (!NILP (w->scrollbar_on_left_p)) + { + x_offset = WINDOW_LEFT (w); + if (window_is_leftmost (w)) + x_offset += FRAME_LEFT_GUTTER_BOUNDS (f); + } + else + { + x_offset = WINDOW_RIGHT (w) - scrollbar_width; + if (window_is_rightmost (w)) + x_offset -= FRAME_RIGHT_GUTTER_BOUNDS (f); + if (window_needs_vertical_divider (w)) + x_offset -= window_divider_width (w); + } y_offset = WINDOW_TEXT_TOP (w) + f->scrollbar_y_offset; } else { x_offset = WINDOW_TEXT_LEFT (w); - y_offset = f->scrollbar_y_offset + - (!NILP (w->scrollbar_on_top_p) - ? WINDOW_TOP (w) - : WINDOW_TEXT_BOTTOM (w) + window_bottom_toolbar_height (w)); + y_offset = f->scrollbar_y_offset; + + if (!NILP (w->scrollbar_on_top_p)) + { + y_offset += WINDOW_TOP (w); + if (window_is_highest (w)) + y_offset += FRAME_TOP_GUTTER_BOUNDS (f); + } + else + { + y_offset += WINDOW_TEXT_BOTTOM (w); + } } new_x = x_offset; @@ -850,7 +869,7 @@ w = XWINDOW (window); wcw = window_char_width (w, 0) - 1; - /* ### We should be able to scroll further right as long as there is + /* #### We should be able to scroll further right as long as there is a visible truncation glyph. This calculation for max is bogus. */ max_len = w->max_line_len + 2; @@ -937,11 +956,9 @@ (Vscrollbar_width, list1 (Fcons (Qnil, make_int (DEFAULT_SCROLLBAR_WIDTH)))); set_specifier_caching (Vscrollbar_width, - slot_offset (struct window, - scrollbar_width), + offsetof (struct window, scrollbar_width), vertical_scrollbar_changed_in_window, - slot_offset (struct frame, - scrollbar_width), + offsetof (struct frame, scrollbar_width), frame_size_slipped); DEFVAR_SPECIFIER ("scrollbar-height", &Vscrollbar_height /* @@ -953,11 +970,9 @@ (Vscrollbar_height, list1 (Fcons (Qnil, make_int (DEFAULT_SCROLLBAR_HEIGHT)))); set_specifier_caching (Vscrollbar_height, - slot_offset (struct window, - scrollbar_height), + offsetof (struct window, scrollbar_height), some_window_value_changed, - slot_offset (struct frame, - scrollbar_height), + offsetof (struct frame, scrollbar_height), frame_size_slipped); DEFVAR_SPECIFIER ("horizontal-scrollbar-visible-p", &Vhorizontal_scrollbar_visible_p /* @@ -968,11 +983,11 @@ set_specifier_fallback (Vhorizontal_scrollbar_visible_p, list1 (Fcons (Qnil, Qt))); set_specifier_caching (Vhorizontal_scrollbar_visible_p, - slot_offset (struct window, - horizontal_scrollbar_visible_p), + offsetof (struct window, + horizontal_scrollbar_visible_p), some_window_value_changed, - slot_offset (struct frame, - horizontal_scrollbar_visible_p), + offsetof (struct frame, + horizontal_scrollbar_visible_p), frame_size_slipped); DEFVAR_SPECIFIER ("vertical-scrollbar-visible-p", &Vvertical_scrollbar_visible_p /* @@ -983,11 +998,11 @@ set_specifier_fallback (Vvertical_scrollbar_visible_p, list1 (Fcons (Qnil, Qt))); set_specifier_caching (Vvertical_scrollbar_visible_p, - slot_offset (struct window, - vertical_scrollbar_visible_p), + offsetof (struct window, + vertical_scrollbar_visible_p), vertical_scrollbar_changed_in_window, - slot_offset (struct frame, - vertical_scrollbar_visible_p), + offsetof (struct frame, + vertical_scrollbar_visible_p), frame_size_slipped); DEFVAR_SPECIFIER ("scrollbar-on-left-p", &Vscrollbar_on_left_p /* @@ -1011,11 +1026,9 @@ } set_specifier_caching (Vscrollbar_on_left_p, - slot_offset (struct window, - scrollbar_on_left_p), + offsetof (struct window, scrollbar_on_left_p), vertical_scrollbar_changed_in_window, - slot_offset (struct frame, - scrollbar_on_left_p), + offsetof (struct frame, scrollbar_on_left_p), frame_size_slipped); DEFVAR_SPECIFIER ("scrollbar-on-top-p", &Vscrollbar_on_top_p /* @@ -1026,11 +1039,9 @@ set_specifier_fallback (Vscrollbar_on_top_p, list1 (Fcons (Qnil, Qnil))); set_specifier_caching (Vscrollbar_on_top_p, - slot_offset (struct window, - scrollbar_on_top_p), + offsetof (struct window, scrollbar_on_top_p), some_window_value_changed, - slot_offset (struct frame, - scrollbar_on_top_p), + offsetof (struct frame, scrollbar_on_top_p), frame_size_slipped); } @@ -1040,8 +1051,7 @@ Vscrollbar_pointer_glyph = Fmake_glyph_internal (Qpointer); set_specifier_caching (XGLYPH (Vscrollbar_pointer_glyph)->image, - slot_offset (struct window, - scrollbar_pointer), + offsetof (struct window, scrollbar_pointer), scrollbar_pointer_changed_in_window, 0, 0); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/scrollbar.h --- a/src/scrollbar.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/scrollbar.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,8 +20,8 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_SCROLLBAR_H_ -#define _XEMACS_SCROLLBAR_H_ +#ifndef INCLUDED_scrollbar_h_ +#define INCLUDED_scrollbar_h_ #ifdef HAVE_SCROLLBARS @@ -81,4 +81,4 @@ #endif /* HAVE_SCROLLBARS */ -#endif /* _XEMACS_SCROLLBAR_H_ */ +#endif /* INCLUDED_scrollbar_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/search.c --- a/src/search.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/search.c Mon Aug 13 11:13:30 2007 +0200 @@ -54,10 +54,10 @@ }; /* The instances of that struct. */ -struct regexp_cache searchbufs[REGEXP_CACHE_SIZE]; +static struct regexp_cache searchbufs[REGEXP_CACHE_SIZE]; /* The head of the linked list; points to the most recently used buffer. */ -struct regexp_cache *searchbuf_head; +static struct regexp_cache *searchbuf_head; /* Every call to re_match, etc., must pass &search_regs as the regs @@ -131,7 +131,7 @@ char *translate, struct re_registers *regp, int posix, Error_behavior errb) { - CONST char *val; + const char *val; reg_syntax_t old; cp->regexp = Qnil; @@ -139,7 +139,7 @@ cp->posix = posix; old = re_set_syntax (RE_SYNTAX_EMACS | (posix ? 0 : RE_NO_POSIX_BACKTRACKING)); - val = (CONST char *) + val = (const char *) re_compile_pattern ((char *) XSTRING_DATA (pattern), XSTRING_LENGTH (pattern), &cp->buf); re_set_syntax (old); @@ -442,7 +442,7 @@ This does not clobber the match data. */ Bytecount -fast_string_match (Lisp_Object regexp, CONST Bufbyte *nonreloc, +fast_string_match (Lisp_Object regexp, const Bufbyte *nonreloc, Lisp_Object reloc, Bytecount offset, Bytecount length, int case_fold_search, Error_behavior errb, int no_quit) @@ -700,6 +700,50 @@ return scan_buffer (buf, '\n', from, 0, count, 0, 1); } +Bytind +bi_find_next_emchar_in_string (Lisp_String* str, Emchar target, Bytind st, + EMACS_INT count) +{ + /* This function has been Mule-ized. */ + Bytind lim = string_length (str) -1; + Bufbyte* s = string_data (str); + + assert (count >= 0); + +#ifdef MULE + /* Due to the Mule representation of characters in a buffer, + we can simply search for characters in the range 0 - 127 + directly. For other characters, we do it the "hard" way. + Note that this way works for all characters but the other + way is faster. */ + if (target >= 0200) + { + while (st < lim && count > 0) + { + if (string_char (str, st) == target) + count--; + INC_CHARBYTIND (s, st); + } + } + else +#endif + { + while (st < lim && count > 0) + { + Bufbyte *bufptr = (Bufbyte *) memchr (charptr_n_addr (s, st), + (int) target, lim - st); + if (bufptr) + { + count--; + st = (Bytind)(bufptr - s) + 1; + } + else + st = lim; + } + } + return st; +} + /* Like find_next_newline, but returns position before the newline, not after, and only search up to TO. This isn't just find_next_newline (...)-1, because you might hit TO. */ @@ -727,8 +771,7 @@ unsigned char fastmap[0400]; int negate = 0; REGISTER int i; - struct Lisp_Char_Table *syntax_table = - XCHAR_TABLE (buf->mirror_syntax_table); + Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table); Bufpos limit; if (NILP (lim)) @@ -1540,8 +1583,7 @@ Charcount i, len; EMACS_INT punct_count = 0, word_count = 0; struct buffer *buf = decode_buffer (buffer, 0); - struct Lisp_Char_Table *syntax_table = - XCHAR_TABLE (buf->mirror_syntax_table); + Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table); CHECK_STRING (string); len = XSTRING_CHAR_LENGTH (string); @@ -1801,7 +1843,7 @@ Emchar c, prevc; Charcount inslen; struct buffer *buf; - struct Lisp_Char_Table *syntax_table; + Lisp_Char_Table *syntax_table; int mc_count; Lisp_Object buffer; int_dynarr *ul_action_dynarr = 0; @@ -2530,9 +2572,12 @@ } void -vars_of_search (void) +reinit_vars_of_search (void) { - REGISTER int i; + int i; + + last_thing_searched = Qnil; + staticpro_nodump (&last_thing_searched); for (i = 0; i < REGEXP_CACHE_SIZE; ++i) { @@ -2540,13 +2585,16 @@ searchbufs[i].buf.buffer = (unsigned char *) xmalloc (100); searchbufs[i].buf.fastmap = searchbufs[i].fastmap; searchbufs[i].regexp = Qnil; - staticpro (&searchbufs[i].regexp); + staticpro_nodump (&searchbufs[i].regexp); searchbufs[i].next = (i == REGEXP_CACHE_SIZE-1 ? 0 : &searchbufs[i+1]); } searchbuf_head = &searchbufs[0]; +} - last_thing_searched = Qnil; - staticpro (&last_thing_searched); +void +vars_of_search (void) +{ + reinit_vars_of_search (); DEFVAR_LISP ("forward-word-regexp", &Vforward_word_regexp /* *Regular expression to be used in `forward-word'. diff -r f4aeb21a5bad -r 74fd4e045ea6 src/select-msw.c --- a/src/select-msw.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/select-msw.c Mon Aug 13 11:13:30 2007 +0200 @@ -29,6 +29,8 @@ #include <config.h> #include "lisp.h" +#include "frame.h" +#include "select.h" #include "console-msw.h" @@ -40,6 +42,7 @@ int rawsize, size, i; unsigned char *src, *dst, *next; HGLOBAL h = NULL; + struct frame *f = NULL; CHECK_STRING (string); @@ -51,7 +54,8 @@ if (src[i] == '\n') size++; - if (!OpenClipboard (NULL)) + f = selected_frame (); + if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f))) return Qnil; if (!EmptyClipboard () || @@ -87,11 +91,27 @@ i = (SetClipboardData (CF_TEXT, h) != NULL); CloseClipboard (); - GlobalFree (h); return i ? Qt : Qnil; } +/* Do protocol to assert ourself as a selection owner. Under mswindows +this is easy, we just set the clipboard. */ +static Lisp_Object +mswindows_own_selection (Lisp_Object selection_name, Lisp_Object selection_value) +{ + Lisp_Object converted_value = get_local_selection (selection_name, QSTRING); + if (!NILP (converted_value) && + CONSP (converted_value) && + EQ (XCAR (converted_value), QSTRING) && + /* pure mswindows behaviour only says we can own the selection + if it is the clipboard */ + EQ (selection_name, QCLIPBOARD)) + Fmswindows_set_clipboard (XCDR (converted_value)); + + return Qnil; +} + DEFUN ("mswindows-get-clipboard", Fmswindows_get_clipboard, 0, 0, 0, /* Return the contents of the mswindows clipboard. */ @@ -144,6 +164,15 @@ return ret; } +static Lisp_Object +mswindows_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type) +{ + if (EQ (selection_symbol, QCLIPBOARD)) + return Fmswindows_get_clipboard (); + else + return Qnil; +} + DEFUN ("mswindows-selection-exists-p", Fmswindows_selection_exists_p, 0, 0, 0, /* Whether there is an MS-Windows selection. */ @@ -157,7 +186,23 @@ */ ()) { - return EmptyClipboard () ? Qt : Qnil; + BOOL success = OpenClipboard (NULL); + if (success) + { + success = EmptyClipboard (); + /* Close it regardless of whether empty worked. */ + if (!CloseClipboard ()) + success = FALSE; + } + + return success ? Qt : Qnil; +} + +static void +mswindows_disown_selection (Lisp_Object selection, Lisp_Object timeval) +{ + if (EQ (selection, QCLIPBOARD)) + Fmswindows_delete_selection (); } @@ -166,6 +211,14 @@ /************************************************************************/ void +console_type_create_select_mswindows (void) +{ + CONSOLE_HAS_METHOD (mswindows, own_selection); + CONSOLE_HAS_METHOD (mswindows, disown_selection); + CONSOLE_HAS_METHOD (mswindows, get_foreign_selection); +} + +void syms_of_select_mswindows (void) { DEFSUBR (Fmswindows_set_clipboard); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/select-x.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/select-x.c Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,1771 @@ +/* X Selection processing for XEmacs + Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not synched with FSF. */ + +/* Rewritten by jwz */ + +#include <config.h> +#include "lisp.h" + +#include "buffer.h" +#include "console-x.h" +#include "objects-x.h" + +#include "frame.h" +#include "opaque.h" +#include "systime.h" +#include "select.h" + +int lisp_to_time (Lisp_Object, time_t *); +Lisp_Object time_to_lisp (time_t); + +#ifdef LWLIB_USES_MOTIF +# define MOTIF_CLIPBOARDS +#endif + +#ifdef MOTIF_CLIPBOARDS +# include <Xm/CutPaste.h> +static void hack_motif_clipboard_selection (Atom selection_atom, + Lisp_Object selection_value, + Time thyme, Display *display, + Window selecting_window); +#endif + +#define CUT_BUFFER_SUPPORT + +#ifdef CUT_BUFFER_SUPPORT +Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3, + QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7; +#endif + +Lisp_Object Vx_sent_selection_hooks; + +/* If this is a smaller number than the max-request-size of the display, + emacs will use INCR selection transfer when the selection is larger + than this. The max-request-size is usually around 64k, so if you want + emacs to use incremental selection transfers when the selection is + smaller than that, set this. I added this mostly for debugging the + incremental transfer stuff, but it might improve server performance. + */ +#define MAX_SELECTION_QUANTUM 0xFFFFFF + +#define SELECTION_QUANTUM(dpy) ((XMaxRequestSize (dpy) << 2) - 100) + +/* If the selection owner takes too long to reply to a selection request, + we give up on it. This is in seconds (0 = no timeout). + */ +int x_selection_timeout; + + +/* Utility functions */ + +static void lisp_data_to_selection_data (struct device *, + Lisp_Object obj, + unsigned char **data_ret, + Atom *type_ret, + unsigned int *size_ret, + int *format_ret); +static Lisp_Object selection_data_to_lisp_data (struct device *, + unsigned char *data, + size_t size, + Atom type, + int format); +static Lisp_Object x_get_window_property_as_lisp_data (Display *, + Window, + Atom property, + Lisp_Object target_type, + Atom selection_atom); + +static int expect_property_change (Display *, Window, Atom prop, int state); +static void wait_for_property_change (long); +static void unexpect_property_change (int); +static int waiting_for_other_props_on_window (Display *, Window); + +/* This converts a Lisp symbol to a server Atom, avoiding a server + roundtrip whenever possible. + */ +static Atom +symbol_to_x_atom (struct device *d, Lisp_Object sym, int only_if_exists) +{ + Display *display = DEVICE_X_DISPLAY (d); + + if (NILP (sym)) return XA_PRIMARY; + if (EQ (sym, Qt)) return XA_SECONDARY; + if (EQ (sym, QPRIMARY)) return XA_PRIMARY; + if (EQ (sym, QSECONDARY)) return XA_SECONDARY; + if (EQ (sym, QSTRING)) return XA_STRING; + if (EQ (sym, QINTEGER)) return XA_INTEGER; + if (EQ (sym, QATOM)) return XA_ATOM; + if (EQ (sym, QCLIPBOARD)) return DEVICE_XATOM_CLIPBOARD (d); + if (EQ (sym, QTIMESTAMP)) return DEVICE_XATOM_TIMESTAMP (d); + if (EQ (sym, QTEXT)) return DEVICE_XATOM_TEXT (d); + if (EQ (sym, QDELETE)) return DEVICE_XATOM_DELETE (d); + if (EQ (sym, QMULTIPLE)) return DEVICE_XATOM_MULTIPLE (d); + if (EQ (sym, QINCR)) return DEVICE_XATOM_INCR (d); + if (EQ (sym, QEMACS_TMP)) return DEVICE_XATOM_EMACS_TMP (d); + if (EQ (sym, QTARGETS)) return DEVICE_XATOM_TARGETS (d); + if (EQ (sym, QNULL)) return DEVICE_XATOM_NULL (d); + if (EQ (sym, QATOM_PAIR)) return DEVICE_XATOM_ATOM_PAIR (d); + if (EQ (sym, QCOMPOUND_TEXT)) return DEVICE_XATOM_COMPOUND_TEXT (d); + +#ifdef CUT_BUFFER_SUPPORT + if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0; + if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1; + if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2; + if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3; + if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4; + if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5; + if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6; + if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7; +#endif /* CUT_BUFFER_SUPPORT */ + + { + const char *nameext; + TO_EXTERNAL_FORMAT (LISP_STRING, Fsymbol_name (sym), + C_STRING_ALLOCA, nameext, + Qctext); + return XInternAtom (display, nameext, only_if_exists ? True : False); + } +} + + +/* This converts a server Atom to a Lisp symbol, avoiding server roundtrips + and calls to intern whenever possible. + */ +static Lisp_Object +x_atom_to_symbol (struct device *d, Atom atom) +{ + Display *display = DEVICE_X_DISPLAY (d); + + if (! atom) return Qnil; + if (atom == XA_PRIMARY) return QPRIMARY; + if (atom == XA_SECONDARY) return QSECONDARY; + if (atom == XA_STRING) return QSTRING; + if (atom == XA_INTEGER) return QINTEGER; + if (atom == XA_ATOM) return QATOM; + if (atom == DEVICE_XATOM_CLIPBOARD (d)) return QCLIPBOARD; + if (atom == DEVICE_XATOM_TIMESTAMP (d)) return QTIMESTAMP; + if (atom == DEVICE_XATOM_TEXT (d)) return QTEXT; + if (atom == DEVICE_XATOM_DELETE (d)) return QDELETE; + if (atom == DEVICE_XATOM_MULTIPLE (d)) return QMULTIPLE; + if (atom == DEVICE_XATOM_INCR (d)) return QINCR; + if (atom == DEVICE_XATOM_EMACS_TMP (d)) return QEMACS_TMP; + if (atom == DEVICE_XATOM_TARGETS (d)) return QTARGETS; + if (atom == DEVICE_XATOM_NULL (d)) return QNULL; + if (atom == DEVICE_XATOM_ATOM_PAIR (d)) return QATOM_PAIR; + if (atom == DEVICE_XATOM_COMPOUND_TEXT (d)) return QCOMPOUND_TEXT; + +#ifdef CUT_BUFFER_SUPPORT + if (atom == XA_CUT_BUFFER0) return QCUT_BUFFER0; + if (atom == XA_CUT_BUFFER1) return QCUT_BUFFER1; + if (atom == XA_CUT_BUFFER2) return QCUT_BUFFER2; + if (atom == XA_CUT_BUFFER3) return QCUT_BUFFER3; + if (atom == XA_CUT_BUFFER4) return QCUT_BUFFER4; + if (atom == XA_CUT_BUFFER5) return QCUT_BUFFER5; + if (atom == XA_CUT_BUFFER6) return QCUT_BUFFER6; + if (atom == XA_CUT_BUFFER7) return QCUT_BUFFER7; +#endif + + { + char *intstr; + char *str = XGetAtomName (display, atom); + + if (! str) return Qnil; + + TO_INTERNAL_FORMAT (C_STRING, str, + C_STRING_ALLOCA, intstr, + Qctext); + XFree (str); + return intern (intstr); + } +} + + +/* Do protocol to assert ourself as a selection owner. + Update the Vselection_alist so that we can reply to later requests for + our selection. + */ +static Lisp_Object +x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value) +{ + struct device *d = decode_x_device (Qnil); + Display *display = DEVICE_X_DISPLAY (d); + struct frame *sel_frame = selected_frame (); + Window selecting_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame)); + Lisp_Object selection_time; + /* Use the time of the last-read mouse or keyboard event. + For selection purposes, we use this as a sleazy way of knowing what the + current time is in server-time. This assumes that the most recently read + mouse or keyboard event has something to do with the assertion of the + selection, which is probably true. + */ + Time thyme = DEVICE_X_MOUSE_TIMESTAMP (d); + Atom selection_atom; + + CHECK_SYMBOL (selection_name); + selection_atom = symbol_to_x_atom (d, selection_name, 0); + + XSetSelectionOwner (display, selection_atom, selecting_window, thyme); + + /* We do NOT use time_to_lisp() here any more, like we used to. + That assumed equivalence of time_t and Time, which is not + necessarily the case (e.g. under OSF on the Alphas, where + Time is a 64-bit quantity and time_t is a 32-bit quantity). + + Opaque pointers are the clean way to go here. + */ + selection_time = make_opaque (&thyme, sizeof (thyme)); + +#ifdef MOTIF_CLIPBOARDS + hack_motif_clipboard_selection (selection_atom, selection_value, + thyme, display, selecting_window); +#endif + return selection_time; +} + +#ifdef MOTIF_CLIPBOARDS /* Bend over baby. Take it and like it. */ + +# ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK +static void motif_clipboard_cb (); +# endif + +static void +hack_motif_clipboard_selection (Atom selection_atom, + Lisp_Object selection_value, + Time thyme, + Display *display, + Window selecting_window) + /* Bool owned_p)*/ +{ + struct device *d = get_device_from_display (display); + /* Those Motif wankers can't be bothered to follow the ICCCM, and do + their own non-Xlib non-Xt clipboard processing. So we have to do + this so that linked-in Motif widgets don't get themselves wedged. + */ + if (selection_atom == DEVICE_XATOM_CLIPBOARD (d) + && STRINGP (selection_value) + + /* If we already own the clipboard, don't own it again in the Motif + way. This might lose in some subtle way, since the timestamp won't + be current, but owning the selection on the Motif way does a + SHITLOAD of X protocol, and it makes killing text be incredibly + slow when using an X terminal. ARRRRGGGHHH!!!! + */ + /* No, this is no good, because then Motif text fields don't bother + to look up the new value, and you can't Copy from a buffer, Paste + into a text field, then Copy something else from the buffer and + paste it into the text field -- it pastes the first thing again. */ +/* && !owned_p */ + ) + { +#ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK + Widget widget = FRAME_X_TEXT_WIDGET (selected_frame()); +#endif + long itemid; +#if XmVersion >= 1002 + long dataid; +#else + int dataid; /* 1.2 wants long, but 1.1.5 wants int... */ +#endif + XmString fmh; + String encoding = "STRING"; + const Extbyte *data = XSTRING_DATA (selection_value); + Extcount bytes = XSTRING_LENGTH (selection_value); + +#ifdef MULE + { + enum { ASCII, LATIN_1, WORLD } chartypes = ASCII; + const Bufbyte *ptr = data, *end = ptr + bytes; + /* Optimize for the common ASCII case */ + while (ptr <= end) + { + if (BYTE_ASCII_P (*ptr)) + { + ptr++; + continue; + } + + if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 || + (*ptr) == LEADING_BYTE_CONTROL_1) + { + chartypes = LATIN_1; + ptr += 2; + continue; + } + + chartypes = WORLD; + break; + } + + if (chartypes == LATIN_1) + TO_EXTERNAL_FORMAT (LISP_STRING, selection_value, + ALLOCA, (data, bytes), + Qbinary); + else if (chartypes == WORLD) + { + TO_EXTERNAL_FORMAT (LISP_STRING, selection_value, + ALLOCA, (data, bytes), + Qctext); + encoding = "COMPOUND_TEXT"; + } + } +#endif /* MULE */ + + fmh = XmStringCreateLtoR ("Clipboard", XmSTRING_DEFAULT_CHARSET); + while (ClipboardSuccess != + XmClipboardStartCopy (display, selecting_window, fmh, thyme, +#ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK + widget, motif_clipboard_cb, +#else + 0, NULL, +#endif + &itemid)) + ; + XmStringFree (fmh); + while (ClipboardSuccess != + XmClipboardCopy (display, selecting_window, itemid, encoding, +#ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK + /* O'Reilly examples say size can be 0, + but this clearly is not the case. */ + 0, bytes, (int) selecting_window, /* private id */ +#else /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */ + (XtPointer) data, bytes, 0, +#endif /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */ + &dataid)) + ; + while (ClipboardSuccess != + XmClipboardEndCopy (display, selecting_window, itemid)) + ; + } +} + +# ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK +/* I tried to treat the clipboard like a real selection, and not send + the data until it was requested, but it looks like that just doesn't + work at all unless the selection owner and requestor are in different + processes. From reading the Motif source, it looks like they never + even considered having two widgets in the same application transfer + data between each other using "by-name" clipboard values. What a + bunch of fuckups. + */ +static void +motif_clipboard_cb (Widget widget, int *data_id, int *private_id, int *reason) +{ + switch (*reason) + { + case XmCR_CLIPBOARD_DATA_REQUEST: + { + Display *dpy = XtDisplay (widget); + Window window = (Window) *private_id; + Lisp_Object selection = assq_no_quit (QCLIPBOARD, Vselection_alist); + if (NILP (selection)) abort (); + selection = XCDR (selection); + if (!STRINGP (selection)) abort (); + XmClipboardCopyByName (dpy, window, *data_id, + (char *) XSTRING_DATA (selection), + XSTRING_LENGTH (selection) + 1, + 0); + } + break; + case XmCR_CLIPBOARD_DATA_DELETE: + default: + /* don't need to free anything */ + break; + } +} +# endif /* MOTIF_INCREMENTAL_CLIPBOARDS_WORK */ +#endif /* MOTIF_CLIPBOARDS */ + + + + +/* Send a SelectionNotify event to the requestor with property=None, meaning + we were unable to do what they wanted. + */ +static void +x_decline_selection_request (XSelectionRequestEvent *event) +{ + XSelectionEvent reply; + reply.type = SelectionNotify; + reply.display = event->display; + reply.requestor = event->requestor; + reply.selection = event->selection; + reply.time = event->time; + reply.target = event->target; + reply.property = None; + + XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply); + XFlush (reply.display); +} + + +/* Used as an unwind-protect clause so that, if a selection-converter signals + an error, we tell the requestor that we were unable to do what they wanted + before we throw to top-level or go into the debugger or whatever. + */ +static Lisp_Object +x_selection_request_lisp_error (Lisp_Object closure) +{ + XSelectionRequestEvent *event = (XSelectionRequestEvent *) + get_opaque_ptr (closure); + + free_opaque_ptr (closure); + if (event->type == 0) /* we set this to mean "completed normally" */ + return Qnil; + x_decline_selection_request (event); + return Qnil; +} + + +/* Convert our selection to the requested type, and put that data where the + requestor wants it. Then tell them whether we've succeeded. + */ +static void +x_reply_selection_request (XSelectionRequestEvent *event, int format, + unsigned char *data, int size, Atom type) +{ + /* This function can GC */ + XSelectionEvent reply; + Display *display = event->display; + struct device *d = get_device_from_display (display); + Window window = event->requestor; + int bytes_remaining; + int format_bytes = format/8; + int max_bytes = SELECTION_QUANTUM (display); + if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM; + + reply.type = SelectionNotify; + reply.display = display; + reply.requestor = window; + reply.selection = event->selection; + reply.time = event->time; + reply.target = event->target; + reply.property = (event->property == None ? event->target : event->property); + + /* #### XChangeProperty can generate BadAlloc, and we must handle it! */ + + /* Store the data on the requested property. + If the selection is large, only store the first N bytes of it. + */ + bytes_remaining = size * format_bytes; + if (bytes_remaining <= max_bytes) + { + /* Send all the data at once, with minimal handshaking. */ +#if 0 + stderr_out ("\nStoring all %d\n", bytes_remaining); +#endif + XChangeProperty (display, window, reply.property, type, format, + PropModeReplace, data, size); + /* At this point, the selection was successfully stored; ack it. */ + XSendEvent (display, window, False, 0L, (XEvent *) &reply); + XFlush (display); + } + else + { + /* Send an INCR selection. */ + int prop_id; + + if (x_window_to_frame (d, window)) /* #### debug */ + error ("attempt to transfer an INCR to ourself!"); +#if 0 + stderr_out ("\nINCR %d\n", bytes_remaining); +#endif + prop_id = expect_property_change (display, window, reply.property, + PropertyDelete); + + XChangeProperty (display, window, reply.property, DEVICE_XATOM_INCR (d), + 32, PropModeReplace, (unsigned char *) + &bytes_remaining, 1); + XSelectInput (display, window, PropertyChangeMask); + /* Tell 'em the INCR data is there... */ + XSendEvent (display, window, False, 0L, (XEvent *) &reply); + XFlush (display); + + /* First, wait for the requestor to ack by deleting the property. + This can run random lisp code (process handlers) or signal. + */ + wait_for_property_change (prop_id); + + while (bytes_remaining) + { + int i = ((bytes_remaining < max_bytes) + ? bytes_remaining + : max_bytes); + prop_id = expect_property_change (display, window, reply.property, + PropertyDelete); +#if 0 + stderr_out (" INCR adding %d\n", i); +#endif + /* Append the next chunk of data to the property. */ + XChangeProperty (display, window, reply.property, type, format, + PropModeAppend, data, i / format_bytes); + bytes_remaining -= i; + data += i; + + /* Now wait for the requestor to ack this chunk by deleting the + property. This can run random lisp code or signal. + */ + wait_for_property_change (prop_id); + } + /* Now write a zero-length chunk to the property to tell the requestor + that we're done. */ +#if 0 + stderr_out (" INCR done\n"); +#endif + if (! waiting_for_other_props_on_window (display, window)) + XSelectInput (display, window, 0L); + + XChangeProperty (display, window, reply.property, type, format, + PropModeReplace, data, 0); + } +} + + + +/* Called from the event-loop in response to a SelectionRequest event. + */ +void +x_handle_selection_request (XSelectionRequestEvent *event) +{ + /* This function can GC */ + struct gcpro gcpro1, gcpro2, gcpro3; + Lisp_Object local_selection_data = Qnil; + Lisp_Object selection_symbol; + Lisp_Object target_symbol = Qnil; + Lisp_Object converted_selection = Qnil; + Time local_selection_time; + Lisp_Object successful_p = Qnil; + int count; + struct device *d = get_device_from_display (event->display); + + GCPRO3 (local_selection_data, converted_selection, target_symbol); + + selection_symbol = x_atom_to_symbol (d, event->selection); + + local_selection_data = assq_no_quit (selection_symbol, Vselection_alist); + +#if 0 + /* This list isn't user-visible, so it can't "go bad." */ + assert (CONSP (local_selection_data)); + assert (CONSP (XCDR (local_selection_data))); + assert (CONSP (XCDR (XCDR (local_selection_data)))); + assert (NILP (XCDR (XCDR (XCDR (local_selection_data))))); + assert (CONSP (XCAR (XCDR (XCDR (local_selection_data))))); + assert (INTP (XCAR (XCAR (XCDR (XCDR (local_selection_data)))))); + assert (INTP (XCDR (XCAR (XCDR (XCDR (local_selection_data)))))); +#endif + + if (NILP (local_selection_data)) + { + /* Someone asked for the selection, but we don't have it any more. */ + x_decline_selection_request (event); + goto DONE_LABEL; + } + + local_selection_time = + * (Time *) XOPAQUE_DATA (XCAR (XCDR (XCDR (local_selection_data)))); + + if (event->time != CurrentTime && + local_selection_time > event->time) + { + /* Someone asked for the selection, and we have one, but not the one + they're looking for. */ + x_decline_selection_request (event); + goto DONE_LABEL; + } + + count = specpdl_depth (); + record_unwind_protect (x_selection_request_lisp_error, + make_opaque_ptr (event)); + target_symbol = x_atom_to_symbol (d, event->target); + +#if 0 /* #### MULTIPLE doesn't work yet */ + if (EQ (target_symbol, QMULTIPLE)) + target_symbol = fetch_multiple_target (event); +#endif + + /* Convert lisp objects back into binary data */ + + converted_selection = + get_local_selection (selection_symbol, target_symbol); + + if (! NILP (converted_selection)) + { + unsigned char *data; + unsigned int size; + int format; + Atom type; + lisp_data_to_selection_data (d, converted_selection, + &data, &type, &size, &format); + + x_reply_selection_request (event, format, data, size, type); + successful_p = Qt; + /* Tell x_selection_request_lisp_error() it's cool. */ event->type = 0; + xfree (data); + } + unbind_to (count, Qnil); + + DONE_LABEL: + + UNGCPRO; + + /* Let random lisp code notice that the selection has been asked for. */ + { + Lisp_Object rest; + Lisp_Object val = Vx_sent_selection_hooks; + if (!UNBOUNDP (val) && !NILP (val)) + { + if (CONSP (val) && !EQ (XCAR (val), Qlambda)) + for (rest = val; !NILP (rest); rest = Fcdr (rest)) + call3 (Fcar(rest), selection_symbol, target_symbol, + successful_p); + else + call3 (val, selection_symbol, target_symbol, + successful_p); + } + } +} + + +/* Called from the event-loop in response to a SelectionClear event. + */ +void +x_handle_selection_clear (XSelectionClearEvent *event) +{ + Display *display = event->display; + struct device *d = get_device_from_display (display); + Atom selection = event->selection; + Time changed_owner_time = event->time; + + Lisp_Object selection_symbol, local_selection_data; + Time local_selection_time; + + selection_symbol = x_atom_to_symbol (d, selection); + + local_selection_data = assq_no_quit (selection_symbol, Vselection_alist); + + /* Well, we already believe that we don't own it, so that's just fine. */ + if (NILP (local_selection_data)) return; + + local_selection_time = + * (Time *) XOPAQUE_DATA (XCAR (XCDR (XCDR (local_selection_data)))); + + /* This SelectionClear is for a selection that we no longer own, so we can + disregard it. (That is, we have reasserted the selection since this + request was generated.) + */ + if (changed_owner_time != CurrentTime && + local_selection_time > changed_owner_time) + return; + + handle_selection_clear (selection_symbol); +} + + +/* This stuff is so that INCR selections are reentrant (that is, so we can + be servicing multiple INCR selection requests simultaneously). I haven't + actually tested that yet. + */ + +static int prop_location_tick; + +static struct prop_location { + int tick; + Display *display; + Window window; + Atom property; + int desired_state; + struct prop_location *next; +} *for_whom_the_bell_tolls; + + +static int +property_deleted_p (void *tick) +{ + struct prop_location *rest = for_whom_the_bell_tolls; + while (rest) + if (rest->tick == (long) tick) + return 0; + else + rest = rest->next; + return 1; +} + +static int +waiting_for_other_props_on_window (Display *display, Window window) +{ + struct prop_location *rest = for_whom_the_bell_tolls; + while (rest) + if (rest->display == display && rest->window == window) + return 1; + else + rest = rest->next; + return 0; +} + + +static int +expect_property_change (Display *display, Window window, + Atom property, int state) +{ + struct prop_location *pl = xnew (struct prop_location); + pl->tick = ++prop_location_tick; + pl->display = display; + pl->window = window; + pl->property = property; + pl->desired_state = state; + pl->next = for_whom_the_bell_tolls; + for_whom_the_bell_tolls = pl; + return pl->tick; +} + +static void +unexpect_property_change (int tick) +{ + struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls; + while (rest) + { + if (rest->tick == tick) + { + if (prev) + prev->next = rest->next; + else + for_whom_the_bell_tolls = rest->next; + xfree (rest); + return; + } + prev = rest; + rest = rest->next; + } +} + +static void +wait_for_property_change (long tick) +{ + /* This function can GC */ + wait_delaying_user_input (property_deleted_p, (void *) tick); +} + + +/* Called from the event-loop in response to a PropertyNotify event. + */ +void +x_handle_property_notify (XPropertyEvent *event) +{ + struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls; + while (rest) + { + if (rest->property == event->atom && + rest->window == event->window && + rest->display == event->display && + rest->desired_state == event->state) + { +#if 0 + stderr_out ("Saw expected prop-%s on %s\n", + (event->state == PropertyDelete ? "delete" : "change"), + (char *) string_data (XSYMBOL (x_atom_to_symbol (get_device_from_display (event->display), event->atom))->name); +#endif + if (prev) + prev->next = rest->next; + else + for_whom_the_bell_tolls = rest->next; + xfree (rest); + return; + } + prev = rest; + rest = rest->next; + } +#if 0 + stderr_out ("Saw UNexpected prop-%s on %s\n", + (event->state == PropertyDelete ? "delete" : "change"), + (char *) string_data (XSYMBOL (x_atom_to_symbol (get_device_from_display (event->display), event->atom))->name)); +#endif +} + + + +#if 0 /* #### MULTIPLE doesn't work yet */ + +static Lisp_Object +fetch_multiple_target (XSelectionRequestEvent *event) +{ + /* This function can GC */ + Display *display = event->display; + Window window = event->requestor; + Atom target = event->target; + Atom selection_atom = event->selection; + int result; + + return + Fcons (QMULTIPLE, + x_get_window_property_as_lisp_data (display, window, target, + QMULTIPLE, + selection_atom)); +} + +static Lisp_Object +copy_multiple_data (Lisp_Object obj) +{ + Lisp_Object vec; + int i; + int len; + if (CONSP (obj)) + return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj))); + + CHECK_VECTOR (obj); + len = XVECTOR_LENGTH (obj); + vec = make_vector (len, Qnil); + for (i = 0; i < len; i++) + { + Lisp_Object vec2 = XVECTOR_DATA (obj) [i]; + CHECK_VECTOR (vec2); + if (XVECTOR_LENGTH (vec2) != 2) + signal_error (Qerror, list2 (build_string + ("vectors must be of length 2"), + vec2)); + XVECTOR_DATA (vec) [i] = make_vector (2, Qnil); + XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [0] = XVECTOR_DATA (vec2) [0]; + XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [1] = XVECTOR_DATA (vec2) [1]; + } + return vec; +} + +#endif /* 0 */ + + +static Window reading_selection_reply; +static Atom reading_which_selection; +static int selection_reply_timed_out; + +static int +selection_reply_done (void *ignore) +{ + return !reading_selection_reply; +} + +static Lisp_Object Qx_selection_reply_timeout_internal; + +DEFUN ("x-selection-reply-timeout-internal", Fx_selection_reply_timeout_internal, + 1, 1, 0, /* +*/ + (arg)) +{ + selection_reply_timed_out = 1; + reading_selection_reply = 0; + return Qnil; +} + + +/* Do protocol to read selection-data from the server. + Converts this to lisp data and returns it. + */ +static Lisp_Object +x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type) +{ + /* This function can GC */ + struct device *d = decode_x_device (Qnil); + Display *display = DEVICE_X_DISPLAY (d); + struct frame *sel_frame = selected_frame (); + Window requestor_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame)); + Time requestor_time = DEVICE_X_MOUSE_TIMESTAMP (d); + Atom target_property = DEVICE_XATOM_EMACS_TMP (d); + Atom selection_atom = symbol_to_x_atom (d, selection_symbol, 0); + int speccount; + Atom type_atom = symbol_to_x_atom (d, (CONSP (target_type) ? + XCAR (target_type) : target_type), 0); + + XConvertSelection (display, selection_atom, type_atom, target_property, + requestor_window, requestor_time); + + /* Block until the reply has been read. */ + reading_selection_reply = requestor_window; + reading_which_selection = selection_atom; + selection_reply_timed_out = 0; + + speccount = specpdl_depth (); + + /* add a timeout handler */ + if (x_selection_timeout > 0) + { + Lisp_Object id = Fadd_timeout (make_int (x_selection_timeout), + Qx_selection_reply_timeout_internal, + Qnil, Qnil); + record_unwind_protect (Fdisable_timeout, id); + } + + /* This is ^Gable */ + wait_delaying_user_input (selection_reply_done, 0); + + if (selection_reply_timed_out) + error ("timed out waiting for reply from selection owner"); + + unbind_to (speccount, Qnil); + + /* otherwise, the selection is waiting for us on the requested property. */ + return + x_get_window_property_as_lisp_data (display, requestor_window, + target_property, target_type, + selection_atom); +} + + +static void +x_get_window_property (Display *display, Window window, Atom property, + unsigned char **data_ret, int *bytes_ret, + Atom *actual_type_ret, int *actual_format_ret, + unsigned long *actual_size_ret, int delete_p) +{ + int total_size; + unsigned long bytes_remaining; + int offset = 0; + unsigned char *tmp_data = 0; + int result; + int buffer_size = SELECTION_QUANTUM (display); + if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM; + + /* First probe the thing to find out how big it is. */ + result = XGetWindowProperty (display, window, property, + 0, 0, False, AnyPropertyType, + actual_type_ret, actual_format_ret, + actual_size_ret, + &bytes_remaining, &tmp_data); + if (result != Success) + { + *data_ret = 0; + *bytes_ret = 0; + return; + } + XFree ((char *) tmp_data); + + if (*actual_type_ret == None || *actual_format_ret == 0) + { + if (delete_p) XDeleteProperty (display, window, property); + *data_ret = 0; + *bytes_ret = 0; + return; + } + + total_size = bytes_remaining + 1; + *data_ret = (unsigned char *) xmalloc (total_size); + + /* Now read, until we've gotten it all. */ + while (bytes_remaining) + { +#if 0 + int last = bytes_remaining; +#endif + result = + XGetWindowProperty (display, window, property, + offset/4, buffer_size/4, + (delete_p ? True : False), + AnyPropertyType, + actual_type_ret, actual_format_ret, + actual_size_ret, &bytes_remaining, &tmp_data); +#if 0 + stderr_out ("<< read %d\n", last-bytes_remaining); +#endif + /* If this doesn't return Success at this point, it means that + some clod deleted the selection while we were in the midst of + reading it. Deal with that, I guess.... + */ + if (result != Success) break; + *actual_size_ret *= *actual_format_ret / 8; + memcpy ((*data_ret) + offset, tmp_data, *actual_size_ret); + offset += *actual_size_ret; + XFree ((char *) tmp_data); + } + *bytes_ret = offset; +} + + +static void +receive_incremental_selection (Display *display, Window window, Atom property, + /* this one is for error messages only */ + Lisp_Object target_type, + unsigned int min_size_bytes, + unsigned char **data_ret, int *size_bytes_ret, + Atom *type_ret, int *format_ret, + unsigned long *size_ret) +{ + /* This function can GC */ + int offset = 0; + int prop_id; + *size_bytes_ret = min_size_bytes; + *data_ret = (unsigned char *) xmalloc (*size_bytes_ret); +#if 0 + stderr_out ("\nread INCR %d\n", min_size_bytes); +#endif + /* At this point, we have read an INCR property, and deleted it (which + is how we ack its receipt: the sending window will be selecting + PropertyNotify events on our window to notice this). + + Now, we must loop, waiting for the sending window to put a value on + that property, then reading the property, then deleting it to ack. + We are done when the sender places a property of length 0. + */ + prop_id = expect_property_change (display, window, property, + PropertyNewValue); + while (1) + { + unsigned char *tmp_data; + int tmp_size_bytes; + wait_for_property_change (prop_id); + /* expect it again immediately, because x_get_window_property may + .. no it won't, I don't get it. + .. Ok, I get it now, the Xt code that implements INCR is broken. + */ + prop_id = expect_property_change (display, window, property, + PropertyNewValue); + x_get_window_property (display, window, property, + &tmp_data, &tmp_size_bytes, + type_ret, format_ret, size_ret, 1); + + if (tmp_size_bytes == 0) /* we're done */ + { +#if 0 + stderr_out (" read INCR done\n"); +#endif + unexpect_property_change (prop_id); + if (tmp_data) xfree (tmp_data); + break; + } +#if 0 + stderr_out (" read INCR %d\n", tmp_size_bytes); +#endif + if (*size_bytes_ret < offset + tmp_size_bytes) + { +#if 0 + stderr_out (" read INCR realloc %d -> %d\n", + *size_bytes_ret, offset + tmp_size_bytes); +#endif + *size_bytes_ret = offset + tmp_size_bytes; + *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret); + } + memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes); + offset += tmp_size_bytes; + xfree (tmp_data); + } +} + + +static Lisp_Object +x_get_window_property_as_lisp_data (Display *display, + Window window, + Atom property, + /* next two for error messages only */ + Lisp_Object target_type, + Atom selection_atom) +{ + /* This function can GC */ + Atom actual_type; + int actual_format; + unsigned long actual_size; + unsigned char *data = NULL; + int bytes = 0; + Lisp_Object val; + struct device *d = get_device_from_display (display); + + x_get_window_property (display, window, property, &data, &bytes, + &actual_type, &actual_format, &actual_size, 1); + if (! data) + { + if (XGetSelectionOwner (display, selection_atom)) + /* there is a selection owner */ + signal_error + (Qselection_conversion_error, + Fcons (build_string ("selection owner couldn't convert"), + Fcons (x_atom_to_symbol (d, selection_atom), + actual_type ? + list2 (target_type, x_atom_to_symbol (d, actual_type)) : + list1 (target_type)))); + else + signal_error (Qerror, + list2 (build_string ("no selection"), + x_atom_to_symbol (d, selection_atom))); + } + + if (actual_type == DEVICE_XATOM_INCR (d)) + { + /* Ok, that data wasn't *the* data, it was just the beginning. */ + + unsigned int min_size_bytes = * ((unsigned int *) data); + xfree (data); + receive_incremental_selection (display, window, property, target_type, + min_size_bytes, &data, &bytes, + &actual_type, &actual_format, + &actual_size); + } + + /* It's been read. Now convert it to a lisp object in some semi-rational + manner. */ + val = selection_data_to_lisp_data (d, data, bytes, + actual_type, actual_format); + + xfree (data); + return val; +} + +/* These functions convert from the selection data read from the server into + something that we can use from elisp, and vice versa. + + Type: Format: Size: Elisp Type: + ----- ------- ----- ----------- + * 8 * String + ATOM 32 1 Symbol + ATOM 32 > 1 Vector of Symbols + * 16 1 Integer + * 16 > 1 Vector of Integers + * 32 1 if <=16 bits: Integer + if > 16 bits: Cons of top16, bot16 + * 32 > 1 Vector of the above + + When converting a Lisp number to C, it is assumed to be of format 16 if + it is an integer, and of format 32 if it is a cons of two integers. + + When converting a vector of numbers from Elisp to C, it is assumed to be + of format 16 if every element in the vector is an integer, and is assumed + to be of format 32 if any element is a cons of two integers. + + When converting an object to C, it may be of the form (SYMBOL . <data>) + where SYMBOL is what we should claim that the type is. Format and + representation are as above. + + NOTE: Under Mule, when someone shoves us a string without a type, we + set the type to 'COMPOUND_TEXT and automatically convert to Compound + Text. If the string has a type, we assume that the user wants the + data sent as-is so we just do "binary" conversion. + */ + + +static Lisp_Object +selection_data_to_lisp_data (struct device *d, + unsigned char *data, + size_t size, + Atom type, + int format) +{ + if (type == DEVICE_XATOM_NULL (d)) + return QNULL; + + /* Convert any 8-bit data to a string, for compactness. */ + else if (format == 8) + return make_ext_string (data, size, + type == DEVICE_XATOM_TEXT (d) || + type == DEVICE_XATOM_COMPOUND_TEXT (d) + ? Qctext : Qbinary); + + /* Convert a single atom to a Lisp Symbol. + Convert a set of atoms to a vector of symbols. */ + else if (type == XA_ATOM) + { + if (size == sizeof (Atom)) + return x_atom_to_symbol (d, *((Atom *) data)); + else + { + int i; + int len = size / sizeof (Atom); + Lisp_Object v = Fmake_vector (make_int (len), Qzero); + for (i = 0; i < len; i++) + Faset (v, make_int (i), x_atom_to_symbol (d, ((Atom *) data) [i])); + return v; + } + } + + /* Convert a single 16 or small 32 bit number to a Lisp Int. + If the number is > 16 bits, convert it to a cons of integers, + 16 bits in each half. + */ + else if (format == 32 && size == sizeof (long)) + return word_to_lisp (((unsigned long *) data) [0]); + else if (format == 16 && size == sizeof (short)) + return make_int ((int) (((unsigned short *) data) [0])); + + /* Convert any other kind of data to a vector of numbers, represented + as above (as an integer, or a cons of two 16 bit integers). + + #### Perhaps we should return the actual type to lisp as well. + + (x-get-selection-internal 'PRIMARY 'LINE_NUMBER) + ==> [4 4] + + and perhaps it should be + + (x-get-selection-internal 'PRIMARY 'LINE_NUMBER) + ==> (SPAN . [4 4]) + + Right now the fact that the return type was SPAN is discarded before + lisp code gets to see it. + */ + else if (format == 16) + { + int i; + Lisp_Object v = make_vector (size / 4, Qzero); + for (i = 0; i < (int) size / 4; i++) + { + int j = (int) ((unsigned short *) data) [i]; + Faset (v, make_int (i), make_int (j)); + } + return v; + } + else + { + int i; + Lisp_Object v = make_vector (size / 4, Qzero); + for (i = 0; i < (int) size / 4; i++) + { + unsigned long j = ((unsigned long *) data) [i]; + Faset (v, make_int (i), word_to_lisp (j)); + } + return v; + } +} + + +static void +lisp_data_to_selection_data (struct device *d, + Lisp_Object obj, + unsigned char **data_ret, + Atom *type_ret, + unsigned int *size_ret, + int *format_ret) +{ + Lisp_Object type = Qnil; + + if (CONSP (obj) && SYMBOLP (XCAR (obj))) + { + type = XCAR (obj); + obj = XCDR (obj); + if (CONSP (obj) && NILP (XCDR (obj))) + obj = XCAR (obj); + } + + if (EQ (obj, QNULL) || (EQ (type, QNULL))) + { /* This is not the same as declining */ + *format_ret = 32; + *size_ret = 0; + *data_ret = 0; + type = QNULL; + } + else if (STRINGP (obj)) + { + const Extbyte *extval; + Extcount extvallen; + + TO_EXTERNAL_FORMAT (LISP_STRING, obj, + ALLOCA, (extval, extvallen), + (NILP (type) ? Qctext : Qbinary)); + *format_ret = 8; + *size_ret = extvallen; + *data_ret = (unsigned char *) xmalloc (*size_ret); + memcpy (*data_ret, extval, *size_ret); +#ifdef MULE + if (NILP (type)) type = QCOMPOUND_TEXT; +#else + if (NILP (type)) type = QSTRING; +#endif + } + else if (CHARP (obj)) + { + Bufbyte buf[MAX_EMCHAR_LEN]; + Bytecount len; + const Extbyte *extval; + Extcount extvallen; + + *format_ret = 8; + len = set_charptr_emchar (buf, XCHAR (obj)); + TO_EXTERNAL_FORMAT (DATA, (buf, len), + ALLOCA, (extval, extvallen), + Qctext); + *size_ret = extvallen; + *data_ret = (unsigned char *) xmalloc (*size_ret); + memcpy (*data_ret, extval, *size_ret); +#ifdef MULE + if (NILP (type)) type = QCOMPOUND_TEXT; +#else + if (NILP (type)) type = QSTRING; +#endif + } + else if (SYMBOLP (obj)) + { + *format_ret = 32; + *size_ret = 1; + *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1); + (*data_ret) [sizeof (Atom)] = 0; + (*(Atom **) data_ret) [0] = symbol_to_x_atom (d, obj, 0); + if (NILP (type)) type = QATOM; + } + else if (INTP (obj) && + XINT (obj) <= 0x7FFF && + XINT (obj) >= -0x8000) + { + *format_ret = 16; + *size_ret = 1; + *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1); + (*data_ret) [sizeof (short)] = 0; + (*(short **) data_ret) [0] = (short) XINT (obj); + if (NILP (type)) type = QINTEGER; + } + else if (INTP (obj) || CONSP (obj)) + { + *format_ret = 32; + *size_ret = 1; + *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1); + (*data_ret) [sizeof (long)] = 0; + (*(unsigned long **) data_ret) [0] = lisp_to_word (obj); + if (NILP (type)) type = QINTEGER; + } + else if (VECTORP (obj)) + { + /* Lisp Vectors may represent a set of ATOMs; + a set of 16 or 32 bit INTEGERs; + or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...] + */ + int i; + + if (SYMBOLP (XVECTOR_DATA (obj) [0])) + /* This vector is an ATOM set */ + { + if (NILP (type)) type = QATOM; + *size_ret = XVECTOR_LENGTH (obj); + *format_ret = 32; + *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom)); + for (i = 0; i < (int) (*size_ret); i++) + if (SYMBOLP (XVECTOR_DATA (obj) [i])) + (*(Atom **) data_ret) [i] = + symbol_to_x_atom (d, XVECTOR_DATA (obj) [i], 0); + else + signal_error (Qerror, /* Qselection_error */ + list2 (build_string + ("all elements of the vector must be of the same type"), + obj)); + } +#if 0 /* #### MULTIPLE doesn't work yet */ + else if (VECTORP (XVECTOR_DATA (obj) [0])) + /* This vector is an ATOM_PAIR set */ + { + if (NILP (type)) type = QATOM_PAIR; + *size_ret = XVECTOR_LENGTH (obj); + *format_ret = 32; + *data_ret = (unsigned char *) + xmalloc ((*size_ret) * sizeof (Atom) * 2); + for (i = 0; i < *size_ret; i++) + if (VECTORP (XVECTOR_DATA (obj) [i])) + { + Lisp_Object pair = XVECTOR_DATA (obj) [i]; + if (XVECTOR_LENGTH (pair) != 2) + signal_error (Qerror, + list2 (build_string + ("elements of the vector must be vectors of exactly two elements"), + pair)); + + (*(Atom **) data_ret) [i * 2] = + symbol_to_x_atom (d, XVECTOR_DATA (pair) [0], 0); + (*(Atom **) data_ret) [(i * 2) + 1] = + symbol_to_x_atom (d, XVECTOR_DATA (pair) [1], 0); + } + else + signal_error (Qerror, + list2 (build_string + ("all elements of the vector must be of the same type"), + obj)); + } +#endif + else + /* This vector is an INTEGER set, or something like it */ + { + *size_ret = XVECTOR_LENGTH (obj); + if (NILP (type)) type = QINTEGER; + *format_ret = 16; + for (i = 0; i < (int) (*size_ret); i++) + if (CONSP (XVECTOR_DATA (obj) [i])) + *format_ret = 32; + else if (!INTP (XVECTOR_DATA (obj) [i])) + signal_error (Qerror, /* Qselection_error */ + list2 (build_string + ("all elements of the vector must be integers or conses of integers"), + obj)); + + *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8)); + for (i = 0; i < (int) (*size_ret); i++) + if (*format_ret == 32) + (*((unsigned long **) data_ret)) [i] = + lisp_to_word (XVECTOR_DATA (obj) [i]); + else + (*((unsigned short **) data_ret)) [i] = + (unsigned short) lisp_to_word (XVECTOR_DATA (obj) [i]); + } + } + else + signal_error (Qerror, /* Qselection_error */ + list2 (build_string ("unrecognized selection data"), + obj)); + + *type_ret = symbol_to_x_atom (d, type, 0); +} + + + +/* Called from the event loop to handle SelectionNotify events. + I don't think this needs to be reentrant. + */ +void +x_handle_selection_notify (XSelectionEvent *event) +{ + if (! reading_selection_reply) + message ("received an unexpected SelectionNotify event"); + else if (event->requestor != reading_selection_reply) + message ("received a SelectionNotify event for the wrong window"); + else if (event->selection != reading_which_selection) + message ("received the wrong selection type in SelectionNotify!"); + else + reading_selection_reply = 0; /* we're done now. */ +} + +static void +x_disown_selection (Lisp_Object selection, Lisp_Object timeval) +{ + struct device *d = decode_x_device (Qnil); + Display *display = DEVICE_X_DISPLAY (d); + Time timestamp; + Atom selection_atom; + + CHECK_SYMBOL (selection); + if (NILP (timeval)) + timestamp = DEVICE_X_MOUSE_TIMESTAMP (d); + else + { + /* #### This is bogus. See the comment above about problems + on OSF/1 and DEC Alphas. Yet another reason why it sucks + to have the implementation (i.e. cons of two 16-bit + integers) exposed. */ + time_t the_time; + lisp_to_time (timeval, &the_time); + timestamp = (Time) the_time; + } + + selection_atom = symbol_to_x_atom (d, selection, 0); + + XSetSelectionOwner (display, selection_atom, None, timestamp); +} + +static Lisp_Object +x_selection_exists_p (Lisp_Object selection) +{ + struct device *d = decode_x_device (Qnil); + Display *dpy = DEVICE_X_DISPLAY (d); + return XGetSelectionOwner (dpy, symbol_to_x_atom (d, selection, 0)) != None ? + Qt : Qnil; +} + + +#ifdef CUT_BUFFER_SUPPORT + +static int cut_buffers_initialized; /* Whether we're sure they all exist */ + +/* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */ +static void +initialize_cut_buffers (Display *display, Window window) +{ + static unsigned const char * const data = (unsigned const char *) ""; +#define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \ + PropModeAppend, data, 0) + FROB (XA_CUT_BUFFER0); + FROB (XA_CUT_BUFFER1); + FROB (XA_CUT_BUFFER2); + FROB (XA_CUT_BUFFER3); + FROB (XA_CUT_BUFFER4); + FROB (XA_CUT_BUFFER5); + FROB (XA_CUT_BUFFER6); + FROB (XA_CUT_BUFFER7); +#undef FROB + cut_buffers_initialized = 1; +} + +#define CHECK_CUTBUFFER(symbol) do { \ + CHECK_SYMBOL (symbol); \ + if (! (EQ (symbol, QCUT_BUFFER0) || \ + EQ (symbol, QCUT_BUFFER1) || \ + EQ (symbol, QCUT_BUFFER2) || \ + EQ (symbol, QCUT_BUFFER3) || \ + EQ (symbol, QCUT_BUFFER4) || \ + EQ (symbol, QCUT_BUFFER5) || \ + EQ (symbol, QCUT_BUFFER6) || \ + EQ (symbol, QCUT_BUFFER7))) \ + signal_simple_error ("Doesn't name a cutbuffer", symbol); \ +} while (0) + +DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal, 1, 1, 0, /* +Return the value of the named CUTBUFFER (typically CUT_BUFFER0). +*/ + (cutbuffer)) +{ + struct device *d = decode_x_device (Qnil); + Display *display = DEVICE_X_DISPLAY (d); + Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */ + Atom cut_buffer_atom; + unsigned char *data; + int bytes; + Atom type; + int format; + unsigned long size; + Lisp_Object ret; + + CHECK_CUTBUFFER (cutbuffer); + cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0); + + x_get_window_property (display, window, cut_buffer_atom, &data, &bytes, + &type, &format, &size, 0); + if (!data) return Qnil; + + if (format != 8 || type != XA_STRING) + signal_simple_error_2 ("Cut buffer doesn't contain 8-bit STRING data", + x_atom_to_symbol (d, type), + make_int (format)); + + /* We cheat - if the string contains an ESC character, that's + technically not allowed in a STRING, so we assume it's + COMPOUND_TEXT that we stored there ourselves earlier, + in x-store-cutbuffer-internal */ + ret = (bytes ? + make_ext_string (data, bytes, + memchr (data, 0x1b, bytes) ? + Qctext : Qbinary) + : Qnil); + xfree (data); + return ret; +} + + +DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal, 2, 2, 0, /* +Set the value of the named CUTBUFFER (typically CUT_BUFFER0) to STRING. +*/ + (cutbuffer, string)) +{ + struct device *d = decode_x_device (Qnil); + Display *display = DEVICE_X_DISPLAY (d); + Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */ + Atom cut_buffer_atom; + const Extbyte *data = XSTRING_DATA (string); + Extcount bytes = XSTRING_LENGTH (string); + Extcount bytes_remaining; + int max_bytes = SELECTION_QUANTUM (display); +#ifdef MULE + const Bufbyte *ptr, *end; + enum { ASCII, LATIN_1, WORLD } chartypes = ASCII; +#endif + + if (max_bytes > MAX_SELECTION_QUANTUM) + max_bytes = MAX_SELECTION_QUANTUM; + + CHECK_CUTBUFFER (cutbuffer); + CHECK_STRING (string); + cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0); + + if (! cut_buffers_initialized) + initialize_cut_buffers (display, window); + + /* We use the STRING encoding (Latin-1 only) if we can, else COMPOUND_TEXT. + We cheat and use type = `STRING' even when using COMPOUND_TEXT. + The ICCCM requires that this be so, and other clients assume it, + as we do ourselves in initialize_cut_buffers. */ + +#ifdef MULE + /* Optimize for the common ASCII case */ + for (ptr = data, end = ptr + bytes; ptr <= end; ) + { + if (BYTE_ASCII_P (*ptr)) + { + ptr++; + continue; + } + + if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 || + (*ptr) == LEADING_BYTE_CONTROL_1) + { + chartypes = LATIN_1; + ptr += 2; + continue; + } + + chartypes = WORLD; + break; + } + + if (chartypes == LATIN_1) + TO_EXTERNAL_FORMAT (LISP_STRING, string, + ALLOCA, (data, bytes), + Qbinary); + else if (chartypes == WORLD) + TO_EXTERNAL_FORMAT (LISP_STRING, string, + ALLOCA, (data, bytes), + Qctext); +#endif /* MULE */ + + bytes_remaining = bytes; + + while (bytes_remaining) + { + int chunk = bytes_remaining < max_bytes ? bytes_remaining : max_bytes; + XChangeProperty (display, window, cut_buffer_atom, XA_STRING, 8, + (bytes_remaining == bytes + ? PropModeReplace : PropModeAppend), + data, chunk); + data += chunk; + bytes_remaining -= chunk; + } + return string; +} + + +DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal, 1, 1, 0, /* +Rotate the values of the cutbuffers by the given number of steps; +positive means move values forward, negative means backward. +*/ + (n)) +{ + struct device *d = decode_x_device (Qnil); + Display *display = DEVICE_X_DISPLAY (d); + Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */ + Atom props [8]; + + CHECK_INT (n); + if (XINT (n) == 0) + return n; + if (! cut_buffers_initialized) + initialize_cut_buffers (display, window); + props[0] = XA_CUT_BUFFER0; + props[1] = XA_CUT_BUFFER1; + props[2] = XA_CUT_BUFFER2; + props[3] = XA_CUT_BUFFER3; + props[4] = XA_CUT_BUFFER4; + props[5] = XA_CUT_BUFFER5; + props[6] = XA_CUT_BUFFER6; + props[7] = XA_CUT_BUFFER7; + XRotateWindowProperties (display, window, props, 8, XINT (n)); + return n; +} + +#endif /* CUT_BUFFER_SUPPORT */ + + + +/************************************************************************/ +/* initialization */ +/************************************************************************/ + +void +syms_of_select_x (void) +{ + +#ifdef CUT_BUFFER_SUPPORT + DEFSUBR (Fx_get_cutbuffer_internal); + DEFSUBR (Fx_store_cutbuffer_internal); + DEFSUBR (Fx_rotate_cutbuffers_internal); +#endif /* CUT_BUFFER_SUPPORT */ + + /* Unfortunately, timeout handlers must be lisp functions. */ + defsymbol (&Qx_selection_reply_timeout_internal, + "x-selection-reply-timeout-internal"); + DEFSUBR (Fx_selection_reply_timeout_internal); + +#ifdef CUT_BUFFER_SUPPORT + defsymbol (&QCUT_BUFFER0, "CUT_BUFFER0"); + defsymbol (&QCUT_BUFFER1, "CUT_BUFFER1"); + defsymbol (&QCUT_BUFFER2, "CUT_BUFFER2"); + defsymbol (&QCUT_BUFFER3, "CUT_BUFFER3"); + defsymbol (&QCUT_BUFFER4, "CUT_BUFFER4"); + defsymbol (&QCUT_BUFFER5, "CUT_BUFFER5"); + defsymbol (&QCUT_BUFFER6, "CUT_BUFFER6"); + defsymbol (&QCUT_BUFFER7, "CUT_BUFFER7"); +#endif /* CUT_BUFFER_SUPPORT */ +} + +void +console_type_create_select_x (void) +{ + CONSOLE_HAS_METHOD (x, own_selection); + CONSOLE_HAS_METHOD (x, disown_selection); + CONSOLE_HAS_METHOD (x, get_foreign_selection); + CONSOLE_HAS_METHOD (x, selection_exists_p); +} + +void +reinit_vars_of_select_x (void) +{ + reading_selection_reply = 0; + reading_which_selection = 0; + selection_reply_timed_out = 0; + for_whom_the_bell_tolls = 0; + prop_location_tick = 0; +} + +void +vars_of_select_x (void) +{ + reinit_vars_of_select_x (); + +#ifdef CUT_BUFFER_SUPPORT + cut_buffers_initialized = 0; + Fprovide (intern ("cut-buffer")); +#endif + + DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks /* +A function or functions to be called after we have responded to some +other client's request for the value of a selection that we own. The +function(s) will be called with four arguments: + - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD); + - the name of the selection-type which we were requested to convert the + selection into before sending (for example, STRING or LENGTH); + - and whether we successfully transmitted the selection. +We might have failed (and declined the request) for any number of reasons, +including being asked for a selection that we no longer own, or being asked +to convert into a type that we don't know about or that is inappropriate. +This hook doesn't let you change the behavior of emacs's selection replies, +it merely informs you that they have happened. +*/ ); + Vx_sent_selection_hooks = Qunbound; + + DEFVAR_INT ("x-selection-timeout", &x_selection_timeout /* +If the selection owner doesn't reply in this many seconds, we give up. +A value of 0 means wait as long as necessary. This is initialized from the +\"*selectionTimeout\" resource (which is expressed in milliseconds). +*/ ); + x_selection_timeout = 0; +} + +void +Xatoms_of_select_x (struct device *d) +{ + Display *D = DEVICE_X_DISPLAY (d); + + /* Non-predefined atoms that we might end up using a lot */ + DEVICE_XATOM_CLIPBOARD (d) = XInternAtom (D, "CLIPBOARD", False); + DEVICE_XATOM_TIMESTAMP (d) = XInternAtom (D, "TIMESTAMP", False); + DEVICE_XATOM_TEXT (d) = XInternAtom (D, "TEXT", False); + DEVICE_XATOM_DELETE (d) = XInternAtom (D, "DELETE", False); + DEVICE_XATOM_MULTIPLE (d) = XInternAtom (D, "MULTIPLE", False); + DEVICE_XATOM_INCR (d) = XInternAtom (D, "INCR", False); + DEVICE_XATOM_TARGETS (d) = XInternAtom (D, "TARGETS", False); + DEVICE_XATOM_NULL (d) = XInternAtom (D, "NULL", False); + DEVICE_XATOM_ATOM_PAIR (d) = XInternAtom (D, "ATOM_PAIR", False); + DEVICE_XATOM_COMPOUND_TEXT (d) = XInternAtom (D, "COMPOUND_TEXT", False); + DEVICE_XATOM_EMACS_TMP (d) = XInternAtom (D, "_EMACS_TMP_", False); +} diff -r f4aeb21a5bad -r 74fd4e045ea6 src/select.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/select.c Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,493 @@ +/* Generic selection processing for XEmacs + Copyright (C) 1999 Free Software Foundation, Inc. + Copyright (C) 1999 Andy Piper. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not synched with FSF. */ + +#include <config.h> +#include "lisp.h" + +#include "buffer.h" +#include "device.h" +#include "console.h" +#include "objects.h" + +#include "frame.h" +#include "opaque.h" +#include "select.h" + +Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP, + QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL, + QATOM_PAIR, QCOMPOUND_TEXT; + +/* "Selection owner couldn't convert selection" */ +Lisp_Object Qselection_conversion_error; + +/* This is an alist whose CARs are selection-types (whose names are the same + as the names of X Atoms) and whose CDRs are the names of Lisp functions to + call to convert the given Emacs selection value to a string representing + the given selection type. This is for elisp-level extension of the emacs + selection handling. + */ +Lisp_Object Vselection_converter_alist; + +Lisp_Object Vlost_selection_hooks; + +/* This is an association list whose elements are of the form + ( selection-name selection-value selection-timestamp ) + selection-name is a lisp symbol, whose name is the name of an X Atom. + selection-value is the value that emacs owns for that selection. + It may be any kind of Lisp object. + selection-timestamp is the time at which emacs began owning this selection, + as a cons of two 16-bit numbers (making a 32 bit time). + If there is an entry in this alist, then it can be assumed that emacs owns + that selection. + The only (eq) parts of this list that are visible from elisp are the + selection-values. + */ +Lisp_Object Vselection_alist; + +static Lisp_Object +clean_local_selection_data (Lisp_Object obj) +{ + if (CONSP (obj) && + INTP (XCAR (obj)) && + CONSP (XCDR (obj)) && + INTP (XCAR (XCDR (obj))) && + NILP (XCDR (XCDR (obj)))) + obj = Fcons (XCAR (obj), XCDR (obj)); + + if (CONSP (obj) && + INTP (XCAR (obj)) && + INTP (XCDR (obj))) + { + if (XINT (XCAR (obj)) == 0) + return XCDR (obj); + if (XINT (XCAR (obj)) == -1) + return make_int (- XINT (XCDR (obj))); + } + if (VECTORP (obj)) + { + int i; + int len = XVECTOR_LENGTH (obj); + Lisp_Object copy; + if (len == 1) + return clean_local_selection_data (XVECTOR_DATA (obj) [0]); + copy = make_vector (len, Qnil); + for (i = 0; i < len; i++) + XVECTOR_DATA (copy) [i] = + clean_local_selection_data (XVECTOR_DATA (obj) [i]); + return copy; + } + return obj; +} + +/* Given a selection-name and desired type, this looks up our local copy of + the selection value and converts it to the type. It returns nil or a + string. This calls random elisp code, and may signal or gc. + */ +Lisp_Object +get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type) +{ + /* This function can GC */ + Lisp_Object handler_fn, value, check; + Lisp_Object local_value = assq_no_quit (selection_symbol, Vselection_alist); + + if (NILP (local_value)) return Qnil; + + /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */ + if (EQ (target_type, QTIMESTAMP)) + { + handler_fn = Qnil; + value = XCAR (XCDR (XCDR (local_value))); + } + +#if 0 /* #### MULTIPLE doesn't work yet and probably never will */ + else if (CONSP (target_type) && + XCAR (target_type) == QMULTIPLE) + { + Lisp_Object pairs = XCDR (target_type); + int len = XVECTOR_LENGTH (pairs); + int i; + /* If the target is MULTIPLE, then target_type looks like + (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ]) + We modify the second element of each pair in the vector and + return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ] + */ + for (i = 0; i < len; i++) + { + Lisp_Object pair = XVECTOR_DATA (pairs) [i]; + XVECTOR_DATA (pair) [1] = + x_get_local_selection (XVECTOR_DATA (pair) [0], + XVECTOR_DATA (pair) [1]); + } + return pairs; + } +#endif + else + { + CHECK_SYMBOL (target_type); + handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist)); + if (NILP (handler_fn)) return Qnil; + value = call3 (handler_fn, + selection_symbol, target_type, + XCAR (XCDR (local_value))); + } + + /* This lets the selection function to return (TYPE . VALUE). For example, + when the selected type is LINE_NUMBER, the returned type is SPAN, not + INTEGER. + */ + check = value; + if (CONSP (value) && SYMBOLP (XCAR (value))) + check = XCDR (value); + + /* Strings, vectors, and symbols are converted to selection data format in + the obvious way. Integers are converted to 16 bit quantities if they're + small enough, otherwise 32 bits are used. + */ + if (STRINGP (check) || + VECTORP (check) || + SYMBOLP (check) || + INTP (check) || + CHARP (check) || + NILP (value)) + return value; + + /* (N . M) or (N M) get turned into a 32 bit quantity. So if you want to + always return a small quantity as 32 bits, your converter routine needs + to return a cons. + */ + else if (CONSP (check) && + INTP (XCAR (check)) && + (INTP (XCDR (check)) || + (CONSP (XCDR (check)) && + INTP (XCAR (XCDR (check))) && + NILP (XCDR (XCDR (check)))))) + return value; + /* Otherwise the lisp converter function returned something unrecognized. + */ + else + signal_error (Qerror, + list3 (build_string + ("unrecognized selection-conversion type"), + handler_fn, + value)); + + return Qnil; /* suppress compiler warning */ +} + +DEFUN ("own-selection-internal", Fown_selection_internal, 2, 3, 0, /* +Assert a selection of the given TYPE with the given VALUE. +TYPE is a symbol, typically PRIMARY, SECONDARY, or CLIPBOARD. +VALUE is typically a string, or a cons of two markers, but may be +anything that the functions on selection-converter-alist know about. +*/ + (selection_name, selection_value, device)) +{ + Lisp_Object selection_time, selection_data, prev_value; + struct gcpro gcpro1; + + CHECK_SYMBOL (selection_name); + if (NILP (selection_value)) error ("selection-value may not be nil."); + + if (NILP (device)) + device = Fselected_device (Qnil); + + /* Now update the local cache */ + selection_data = list3 (selection_name, + selection_value, + Qnil); + GCPRO1 (selection_data); + + prev_value = assq_no_quit (selection_name, Vselection_alist); + Vselection_alist = Fcons (selection_data, Vselection_alist); + + /* If we already owned the selection, remove the old selection data. + Perhaps we should destructively modify it instead. + Don't use Fdelq() as that may QUIT;. + */ + if (!NILP (prev_value)) + { + Lisp_Object rest; /* we know it's not the CAR, so it's easy. */ + for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest)) + if (EQ (prev_value, Fcar (XCDR (rest)))) + { + XCDR (rest) = Fcdr (XCDR (rest)); + break; + } + } + + /* have to do device specific stuff last so that methods can access the + selection_alist */ + if (HAS_DEVMETH_P (XDEVICE (device), own_selection)) + selection_time = DEVMETH (XDEVICE (device), own_selection, + (selection_name, selection_value)); + else + selection_time = Qnil; + + Fsetcar (XCDR (XCDR (selection_data)), selection_time); + + UNGCPRO; + + return selection_value; +} + +/* remove a selection from our local copy + */ +void +handle_selection_clear (Lisp_Object selection_symbol) +{ + Lisp_Object local_selection_data = assq_no_quit (selection_symbol, Vselection_alist); + + /* Well, we already believe that we don't own it, so that's just fine. */ + if (NILP (local_selection_data)) return; + + /* Otherwise, we're really honest and truly being told to drop it. + Don't use Fdelq() as that may QUIT;. + */ + if (EQ (local_selection_data, Fcar (Vselection_alist))) + Vselection_alist = Fcdr (Vselection_alist); + else + { + Lisp_Object rest; + for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest)) + if (EQ (local_selection_data, Fcar (XCDR (rest)))) + { + XCDR (rest) = Fcdr (XCDR (rest)); + break; + } + } + + /* Let random lisp code notice that the selection has been stolen. + */ + { + Lisp_Object rest; + Lisp_Object val = Vlost_selection_hooks; + if (!UNBOUNDP (val) && !NILP (val)) + { + if (CONSP (val) && !EQ (XCAR (val), Qlambda)) + for (rest = val; !NILP (rest); rest = Fcdr (rest)) + call1 (Fcar (rest), selection_symbol); + else + call1 (val, selection_symbol); + } + } +} + +DEFUN ("disown-selection-internal", Fdisown_selection_internal, 1, 3, 0, /* +If we own the named selection, then disown it (make there be no selection). +*/ + (selection_name, selection_time, device)) +{ + if (NILP (assq_no_quit (selection_name, Vselection_alist))) + return Qnil; /* Don't disown the selection when we're not the owner. */ + + if (NILP (device)) + device = Fselected_device (Qnil); + + MAYBE_DEVMETH (XDEVICE (device), disown_selection, + (selection_name, selection_time)); + + handle_selection_clear (selection_name); + + return Qt; +} + +DEFUN ("selection-owner-p", Fselection_owner_p, 0, 1, 0, /* +Return t if current emacs process owns the given Selection. +The arg should be the name of the selection in question, typically one of +the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience, the symbol +nil is the same as PRIMARY, and t is the same as SECONDARY.) +*/ + (selection)) +{ + CHECK_SYMBOL (selection); + if (EQ (selection, Qnil)) selection = QPRIMARY; + else if (EQ (selection, Qt)) selection = QSECONDARY; + + return NILP (Fassq (selection, Vselection_alist)) ? Qnil : Qt; +} + +DEFUN ("selection-exists-p", Fselection_exists_p, 0, 2, 0, /* +Whether there is an owner for the given Selection. +The arg should be the name of the selection in question, typically one of +the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience, the symbol +nil is the same as PRIMARY, and t is the same as SECONDARY.) +*/ + (selection, device)) +{ + CHECK_SYMBOL (selection); + if (!NILP (Fselection_owner_p (selection))) + return Qt; + + if (NILP (device)) + device = Fselected_device (Qnil); + + return HAS_DEVMETH_P (XDEVICE (device), selection_exists_p) ? + DEVMETH (XDEVICE (device), selection_exists_p, (selection)) + : Qnil; +} + +/* Request the selection value from the owner. If we are the owner, + simply return our selection value. If we are not the owner, this + will block until all of the data has arrived. + */ +DEFUN ("get-selection-internal", Fget_selection_internal, 2, 3, 0, /* +Return text selected from some window-system window. +SELECTION_SYMBOL is a symbol, typically PRIMARY, SECONDARY, or CLIPBOARD. +TARGET_TYPE is the type of data desired, typically STRING or COMPOUND_TEXT. +Under Mule, if the resultant data comes back as 8-bit data in type +TEXT or COMPOUND_TEXT, it will be decoded as Compound Text. +*/ + (selection_symbol, target_type, device)) +{ + /* This function can GC */ + Lisp_Object val = Qnil; + struct gcpro gcpro1, gcpro2; + GCPRO2 (target_type, val); /* we store newly consed data into these */ + CHECK_SYMBOL (selection_symbol); + + if (NILP (device)) + device = Fselected_device (Qnil); + +#if 0 /* #### MULTIPLE doesn't work yet and probably never will */ + if (CONSP (target_type) && + XCAR (target_type) == QMULTIPLE) + { + CHECK_VECTOR (XCDR (target_type)); + /* So we don't destructively modify this... */ + target_type = copy_multiple_data (target_type); + } + else +#endif + CHECK_SYMBOL (target_type); + + val = get_local_selection (selection_symbol, target_type); + + if (NILP (val) && (HAS_DEVMETH_P (XDEVICE (device), get_foreign_selection))) + { + val = DEVMETH (XDEVICE (device), get_foreign_selection, + (selection_symbol, target_type)); + } + else + { + if (CONSP (val) && SYMBOLP (XCAR (val))) + { + val = XCDR (val); + if (CONSP (val) && NILP (XCDR (val))) + val = XCAR (val); + } + val = clean_local_selection_data (val); + } + UNGCPRO; + return val; +} + +void +syms_of_select (void) +{ + DEFSUBR (Fown_selection_internal); + DEFSUBR (Fget_selection_internal); + DEFSUBR (Fselection_exists_p); + DEFSUBR (Fdisown_selection_internal); + DEFSUBR (Fselection_owner_p); + + defsymbol (&QPRIMARY, "PRIMARY"); + defsymbol (&QSECONDARY, "SECONDARY"); + defsymbol (&QSTRING, "STRING"); + defsymbol (&QINTEGER, "INTEGER"); + defsymbol (&QCLIPBOARD, "CLIPBOARD"); + defsymbol (&QTIMESTAMP, "TIMESTAMP"); + defsymbol (&QTEXT, "TEXT"); + defsymbol (&QDELETE, "DELETE"); + defsymbol (&QMULTIPLE, "MULTIPLE"); + defsymbol (&QINCR, "INCR"); + defsymbol (&QEMACS_TMP, "_EMACS_TMP_"); + defsymbol (&QTARGETS, "TARGETS"); + defsymbol (&QATOM, "ATOM"); + defsymbol (&QATOM_PAIR, "ATOM_PAIR"); + defsymbol (&QCOMPOUND_TEXT, "COMPOUND_TEXT"); + defsymbol (&QNULL, "NULL"); + + deferror (&Qselection_conversion_error, + "selection-conversion-error", + "selection-conversion error", Qio_error); +} + +void +vars_of_select (void) +{ + Vselection_alist = Qnil; + staticpro (&Vselection_alist); + + DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist /* +An alist associating selection-types (such as STRING and TIMESTAMP) with +functions. These functions will be called with three args: the name +of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD); a +desired type to which the selection should be converted; and the local +selection value (whatever had been passed to `own-selection'). For +historical reasons these functions should return the value to send to +an X server, which should be one of: + +-- nil (the conversion could not be done) +-- a cons of a symbol and any of the following values; the symbol + explicitly specifies the type that will be sent. +-- a string (If the type is not specified, then if Mule support exists, + the string will be converted to Compound Text and sent in + the 'COMPOUND_TEXT format; otherwise (no Mule support), + the string will be left as-is and sent in the 'STRING + format. If the type is specified, the string will be + left as-is (or converted to binary format under Mule). + In all cases, 8-bit data it sent.) +-- a character (With Mule support, will be converted to Compound Text + whether or not a type is specified. If a type is not + specified, a type of 'STRING or 'COMPOUND_TEXT will be + sent, as for strings.) +-- the symbol 'NULL (Indicates that there is no meaningful return value. + Empty 32-bit data with a type of 'NULL will be sent.) +-- a symbol (Will be converted into an atom. If the type is not specified, + a type of 'ATOM will be sent.) +-- an integer (Will be converted into a 16-bit or 32-bit integer depending + on the value. If the type is not specified, a type of + 'INTEGER will be sent.) +-- a cons (HIGH . LOW) of integers (Will be converted into a 32-bit integer. + If the type is not specified, a type of + 'INTEGER will be sent.) +-- a vector of symbols (Will be converted into a list of atoms. If the type + is not specified, a type of 'ATOM will be sent.) +-- a vector of integers (Will be converted into a list of 16-bit integers. + If the type is not specified, a type of 'INTEGER + will be sent.) +-- a vector of integers and/or conses (HIGH . LOW) of integers + (Will be converted into a list of 16-bit integers. + If the type is not specified, a type of 'INTEGER + will be sent.) */ ); + Vselection_converter_alist = Qnil; + + DEFVAR_LISP ("lost-selection-hooks", &Vlost_selection_hooks /* +A function or functions to be called after we have been notified +that we have lost the selection. The function(s) will be called with one +argument, a symbol naming the selection (typically PRIMARY, SECONDARY, or +CLIPBOARD). +*/ ); + Vlost_selection_hooks = Qunbound; +} + diff -r f4aeb21a5bad -r 74fd4e045ea6 src/select.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/select.h Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,50 @@ +/* Generic select data structures functions + Copyright (C) 1999 Andy Piper + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +#ifndef INCLUDED_select_h_ +#define INCLUDED_select_h_ + +extern Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP, + QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL, + QATOM_PAIR, QCOMPOUND_TEXT; + +/* This is an association list whose elements are of the form + ( selection-name selection-value selection-timestamp ) + selection-name is a lisp symbol, whose name is the name of an X Atom. + selection-value is the value that emacs owns for that selection. + It may be any kind of Lisp object. + selection-timestamp is the time at which emacs began owning this selection, + as a cons of two 16-bit numbers (making a 32 bit time). + If there is an entry in this alist, then it can be assumed that emacs owns + that selection. + The only (eq) parts of this list that are visible from elisp are the + selection-values. + */ +extern Lisp_Object Vselection_alist; + +/* "Selection owner couldn't convert selection" */ +extern Lisp_Object Qselection_conversion_error; + +Lisp_Object get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type); +void handle_selection_clear (Lisp_Object selection_symbol); + +#endif /* INCLUDED_select_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/sgiplay.c --- a/src/sgiplay.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/sgiplay.c Mon Aug 13 11:13:30 2007 +0200 @@ -363,7 +363,7 @@ static int st_ulaw_to_linear (int u) { - static CONST short table[] = {0,132,396,924,1980,4092,8316,16764}; + static const short table[] = {0,132,396,924,1980,4092,8316,16764}; int u1 = ~u; short exponent = (u1 >> 4) & 0x07; int mantissa = u1 & 0x0f; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/sheap.c --- a/src/sheap.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/sheap.c Mon Aug 13 11:13:30 2007 +0200 @@ -21,11 +21,10 @@ #include <config.h> #include <stdio.h> #include "lisp.h" -#include <stddef.h> #include <unistd.h> #include <sheap-adjust.h> -#define STATIC_HEAP_BASE 0x600000 +#define STATIC_HEAP_BASE 0x800000 #define STATIC_HEAP_SLOP 0x40000 #define STATIC_HEAP_SIZE \ (STATIC_HEAP_BASE + SHEAP_ADJUSTMENT + STATIC_HEAP_SLOP) @@ -85,8 +84,8 @@ "\nRequested %d bytes, static heap exhausted! base is %p, current ptr is %p. You have exhausted the static heap. -If you are simply trying to compile, remove sheap-adjust.h and -puresize-adjust.h and recompile from the top level. If this doesn't +If you are simply trying to compile, remove sheap-adjust.h +and recompile from the top level. If this doesn't work then STATIC_HEAP_SLOP (defined in this file) is too small. If you want to run temacs, change SHEAP_ADJUSTMENT in sheap-adjust.h @@ -103,7 +102,7 @@ return result; } -void +static void sheap_adjust_h () { FILE *stream = fopen ("sheap-adjust.h", "w"); @@ -120,3 +119,31 @@ fclose (stream); } +void +report_sheap_usage (int die_if_pure_storage_exceeded) +{ + int rc = 0; + + size_t lost = (STATIC_HEAP_BASE + STATIC_HEAP_SLOP + SHEAP_ADJUSTMENT) + - (static_heap_ptr - static_heap_buffer); + char buf[200]; + sprintf (buf, "Static heap usage: %ld of %ld", + (long) (static_heap_ptr - static_heap_buffer), + (long) (STATIC_HEAP_BASE + STATIC_HEAP_SLOP + SHEAP_ADJUSTMENT)); + + if (lost > STATIC_HEAP_SLOP) { + sprintf (buf + strlen (buf), " -- %ldk wasted", (long)(lost/1024)); + if (die_if_pure_storage_exceeded) { + sheap_adjust_h(); + rc = -1; + } + message ("%s", buf); + } + + if (rc < 0) { + unlink("SATISFIED"); + fatal ("Static heap size adjusted, Don't Panic! I will restart the `make'"); + } +} + + diff -r f4aeb21a5bad -r 74fd4e045ea6 src/sound.c --- a/src/sound.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/sound.c Mon Aug 13 11:13:30 2007 +0200 @@ -25,6 +25,7 @@ Hacked on quite a bit by various others. */ #include <config.h> +#include <time.h> #include "lisp.h" #include "buffer.h" @@ -44,7 +45,14 @@ # include <netdb.h> #endif +#ifdef HAVE_ESD_SOUND +extern int esd_play_sound_file (char *file, int vol); +extern int esd_play_sound_data (unsigned char *data, size_t length, int vol); +# define DEVICE_CONNECTED_TO_ESD_P(x) 1 /* FIXME: better check */ +#endif + int bell_volume; +int bell_inhibit_time; Lisp_Object Vsound_alist; Lisp_Object Vsynchronous_sounds; Lisp_Object Vnative_sound_only_on_console; @@ -77,7 +85,8 @@ { /* This function can call lisp */ int vol; -#if defined (HAVE_NATIVE_SOUND) || defined (HAVE_NAS_SOUND) +#if defined (HAVE_NATIVE_SOUND) || defined (HAVE_NAS_SOUND) \ + || defined (HAVE_ESD_SOUND) struct device *d = decode_device (device); #endif struct gcpro gcpro1; @@ -117,19 +126,36 @@ { char *fileext; - GET_C_STRING_FILENAME_DATA_ALLOCA (file, fileext); + TO_EXTERNAL_FORMAT (LISP_STRING, file, + C_STRING_ALLOCA, fileext, + Qfile_name); /* #### NAS code should allow specification of a device. */ if (nas_play_sound_file (fileext, vol)) return Qnil; } #endif /* HAVE_NAS_SOUND */ +#ifdef HAVE_ESD_SOUND + if (DEVICE_CONNECTED_TO_ESD_P (d)) + { + char *fileext; + + TO_EXTERNAL_FORMAT (LISP_STRING, file, + C_STRING_ALLOCA, fileext, + Qfile_name); + if (esd_play_sound_file (fileext, vol)) + return Qnil; + } +#endif /* HAVE_ESD_SOUND */ + #ifdef HAVE_NATIVE_SOUND if (NILP (Vnative_sound_only_on_console) || DEVICE_ON_CONSOLE_P (d)) { - CONST char *fileext; + const char *fileext; - GET_C_STRING_FILENAME_DATA_ALLOCA (file, fileext); + TO_EXTERNAL_FORMAT (LISP_STRING, file, + C_STRING_ALLOCA, fileext, + Qfile_name); /* The sound code doesn't like getting SIGIO interrupts. Unix sucks! */ stop_interrupts (); @@ -291,23 +317,40 @@ #ifdef HAVE_NAS_SOUND if (DEVICE_CONNECTED_TO_NAS_P (d) && STRINGP (sound)) { - CONST Extbyte *soundext; + const Extbyte *soundext; Extcount soundextlen; - GET_STRING_BINARY_DATA_ALLOCA (sound, soundext, soundextlen); + TO_EXTERNAL_FORMAT (LISP_STRING, sound, + ALLOCA, (soundext, soundextlen), + Qbinary); if (nas_play_sound_data ((unsigned char*)soundext, soundextlen, vol)) return Qnil; } #endif /* HAVE_NAS_SOUND */ +#ifdef HAVE_ESD_SOUND + if (DEVICE_CONNECTED_TO_ESD_P (d) && STRINGP (sound)) + { + Extbyte *soundext; + Extcount soundextlen; + + TO_EXTERNAL_FORMAT (LISP_STRING, sound, ALLOCA, (soundext, soundextlen), + Qbinary); + if (esd_play_sound_data (soundext, soundextlen, vol)) + return Qnil; + } +#endif /* HAVE_ESD_SOUND */ + #ifdef HAVE_NATIVE_SOUND if ((NILP (Vnative_sound_only_on_console) || DEVICE_ON_CONSOLE_P (d)) && STRINGP (sound)) { - CONST Extbyte *soundext; + const Extbyte *soundext; Extcount soundextlen; - GET_STRING_BINARY_DATA_ALLOCA (sound, soundext, soundextlen); + TO_EXTERNAL_FORMAT (LISP_STRING, sound, + ALLOCA, (soundext, soundextlen), + Qbinary); /* The sound code doesn't like getting SIGIO interrupts. Unix sucks! */ stop_interrupts (); play_sound_data ((unsigned char*)soundext, soundextlen, vol); @@ -347,25 +390,28 @@ */ (arg, sound, device)) { - struct device *d = decode_device (device); + static time_t last_bell_time; + static struct device *last_bell_device; + time_t now; + struct device *d = decode_device (device); XSETDEVICE (device, d); + now = time (0); - /* #### This is utterly disgusting, and is probably a remnant from - legacy code that used `ding'+`message' to signal error instead - calling `error'. As a result, there is no way to beep from Lisp - directly, without also invoking this aspect. Maybe we should - define a `ring-bell' function that simply beeps on the console, - which `ding' should invoke? --hniksic */ if (NILP (arg) && !NILP (Vexecuting_macro)) /* Stop executing a keyboard macro. */ error ("Keyboard macro terminated by a command ringing the bell"); + + if (d == last_bell_device && now-last_bell_time < bell_inhibit_time) + return Qnil; else if (visible_bell && DEVMETH (d, flash, (d))) ; else Fplay_sound (sound, Qnil, device); - - return Qnil; + + last_bell_time = now; + last_bell_device = d; + return Qnil; } DEFUN ("wait-for-sounds", Fwait_for_sounds, 0, 1, 0, /* @@ -527,11 +573,19 @@ #ifdef HAVE_NAS_SOUND Fprovide (intern ("nas-sound")); #endif +#ifdef HAVE_ESD_SOUND + Fprovide (intern ("esd-sound")); +#endif DEFVAR_INT ("bell-volume", &bell_volume /* *How loud to be, from 0 to 100. */ ); bell_volume = 50; + + DEFVAR_INT ("bell-inhibit-time", &bell_inhibit_time /* +*Don't ring the bell on the same device more than once within this many seconds. +*/ ); + bell_inhibit_time = 0; DEFVAR_LISP ("sound-alist", &Vsound_alist /* An alist associating names with sounds. @@ -559,8 +613,8 @@ load-sound-file. Caveats: - - You can only play audio data if running on the console screen of a - Sun SparcStation, SGI, or HP9000s700. + - XEmacs must be built with sound support for your system. Not all + systems support sound. - The pitch, duration, and volume options are available everywhere, but many X servers ignore the `pitch' option. diff -r f4aeb21a5bad -r 74fd4e045ea6 src/specifier.c --- a/src/specifier.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/specifier.c Mon Aug 13 11:13:30 2007 +0200 @@ -64,7 +64,28 @@ Dynarr_declare (specifier_type_entry); } specifier_type_entry_dynarr; -specifier_type_entry_dynarr *the_specifier_type_entry_dynarr; +static specifier_type_entry_dynarr *the_specifier_type_entry_dynarr; + +static const struct lrecord_description ste_description_1[] = { + { XD_LISP_OBJECT, offsetof (specifier_type_entry, symbol) }, + { XD_STRUCT_PTR, offsetof (specifier_type_entry, meths), 1, &specifier_methods_description }, + { XD_END } +}; + +static const struct struct_description ste_description = { + sizeof (specifier_type_entry), + ste_description_1 +}; + +static const struct lrecord_description sted_description_1[] = { + XD_DYNARR_DESC (specifier_type_entry_dynarr, &ste_description), + { XD_END } +}; + +static const struct struct_description sted_description = { + sizeof (specifier_type_entry_dynarr), + sted_description_1 +}; static Lisp_Object Vspecifier_type_list; @@ -141,7 +162,7 @@ !NILP (rest); rest = XSPECIFIER (rest)->next_specifier) { - struct Lisp_Specifier *sp = XSPECIFIER (rest); + Lisp_Specifier *sp = XSPECIFIER (rest); /* This effectively changes the specifier specs. However, there's no need to call recompute_cached_specifier_everywhere() or the @@ -168,7 +189,7 @@ !NILP (rest); rest = XSPECIFIER (rest)->next_specifier) { - struct Lisp_Specifier *sp = XSPECIFIER (rest); + Lisp_Specifier *sp = XSPECIFIER (rest); /* Make sure we're actually going to be changing something. Fremove_specifier() always calls @@ -180,19 +201,19 @@ } static Lisp_Object -mark_specifier (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_specifier (Lisp_Object obj) { - struct Lisp_Specifier *specifier = XSPECIFIER (obj); - - markobj (specifier->global_specs); - markobj (specifier->device_specs); - markobj (specifier->frame_specs); - markobj (specifier->window_specs); - markobj (specifier->buffer_specs); - markobj (specifier->magic_parent); - markobj (specifier->fallback); + Lisp_Specifier *specifier = XSPECIFIER (obj); + + mark_object (specifier->global_specs); + mark_object (specifier->device_specs); + mark_object (specifier->frame_specs); + mark_object (specifier->window_specs); + mark_object (specifier->buffer_specs); + mark_object (specifier->magic_parent); + mark_object (specifier->fallback); if (!GHOST_SPECIFIER_P (XSPECIFIER (obj))) - MAYBE_SPECMETH (specifier, mark, (obj, markobj)); + MAYBE_SPECMETH (specifier, mark, (obj)); return Qnil; } @@ -216,24 +237,24 @@ */ void -prune_specifiers (int (*obj_marked_p) (Lisp_Object)) +prune_specifiers (void) { Lisp_Object rest, prev = Qnil; for (rest = Vall_specifiers; - !GC_NILP (rest); + !NILP (rest); rest = XSPECIFIER (rest)->next_specifier) { - if (! obj_marked_p (rest)) + if (! marked_p (rest)) { - struct Lisp_Specifier* sp = XSPECIFIER (rest); + Lisp_Specifier* sp = XSPECIFIER (rest); /* A bit of assertion that we're removing both parts of the magic one altogether */ - assert (!GC_MAGIC_SPECIFIER_P(sp) - || (GC_BODILY_SPECIFIER_P(sp) && obj_marked_p (sp->fallback)) - || (GC_GHOST_SPECIFIER_P(sp) && obj_marked_p (sp->magic_parent))); + assert (!MAGIC_SPECIFIER_P(sp) + || (BODILY_SPECIFIER_P(sp) && marked_p (sp->fallback)) + || (GHOST_SPECIFIER_P(sp) && marked_p (sp->magic_parent))); /* This specifier is garbage. Remove it from the list. */ - if (GC_NILP (prev)) + if (NILP (prev)) Vall_specifiers = sp->next_specifier; else XSPECIFIER (prev)->next_specifier = sp->next_specifier; @@ -246,7 +267,7 @@ static void print_specifier (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { - struct Lisp_Specifier *sp = XSPECIFIER (obj); + Lisp_Specifier *sp = XSPECIFIER (obj); char buf[100]; int count = specpdl_depth (); Lisp_Object the_specs; @@ -278,9 +299,9 @@ static void finalize_specifier (void *header, int for_disksave) { - struct Lisp_Specifier *sp = (struct Lisp_Specifier *) header; + Lisp_Specifier *sp = (Lisp_Specifier *) header; /* don't be snafued by the disksave finalization. */ - if (!for_disksave && !GC_GHOST_SPECIFIER_P(sp) && sp->caching) + if (!for_disksave && !GHOST_SPECIFIER_P(sp) && sp->caching) { xfree (sp->caching); sp->caching = 0; @@ -290,8 +311,8 @@ static int specifier_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { - struct Lisp_Specifier *s1 = XSPECIFIER (obj1); - struct Lisp_Specifier *s2 = XSPECIFIER (obj2); + Lisp_Specifier *s1 = XSPECIFIER (obj1); + Lisp_Specifier *s2 = XSPECIFIER (obj2); int retval; Lisp_Object old_inhibit_quit = Vinhibit_quit; @@ -319,7 +340,7 @@ static unsigned long specifier_hash (Lisp_Object obj, int depth) { - struct Lisp_Specifier *s = XSPECIFIER (obj); + Lisp_Specifier *s = XSPECIFIER (obj); /* specifier hashing is a bit problematic because there are so many places where data can be stored. We pick what are perhaps @@ -333,23 +354,61 @@ } static size_t -sizeof_specifier (CONST void *header) +sizeof_specifier (const void *header) { - if (GHOST_SPECIFIER_P ((struct Lisp_Specifier *) header)) - return sizeof (struct Lisp_Specifier); + if (GHOST_SPECIFIER_P ((Lisp_Specifier *) header)) + return offsetof (Lisp_Specifier, data); else { - CONST struct Lisp_Specifier *p = (CONST struct Lisp_Specifier *) header; - return sizeof (*p) + p->methods->extra_data_size - 1; + const Lisp_Specifier *p = (const Lisp_Specifier *) header; + return offsetof (Lisp_Specifier, data) + p->methods->extra_data_size; } } +static const struct lrecord_description specifier_methods_description_1[] = { + { XD_LISP_OBJECT, offsetof (struct specifier_methods, predicate_symbol) }, + { XD_END } +}; + +const struct struct_description specifier_methods_description = { + sizeof (struct specifier_methods), + specifier_methods_description_1 +}; + +static const struct lrecord_description specifier_caching_description_1[] = { + { XD_END } +}; + +static const struct struct_description specifier_caching_description = { + sizeof (struct specifier_caching), + specifier_caching_description_1 +}; + +static const struct lrecord_description specifier_description[] = { + { XD_STRUCT_PTR, offsetof (Lisp_Specifier, methods), 1, &specifier_methods_description }, + { XD_LO_LINK, offsetof (Lisp_Specifier, next_specifier) }, + { XD_LISP_OBJECT, offsetof (Lisp_Specifier, global_specs) }, + { XD_LISP_OBJECT, offsetof (Lisp_Specifier, device_specs) }, + { XD_LISP_OBJECT, offsetof (Lisp_Specifier, frame_specs) }, + { XD_LISP_OBJECT, offsetof (Lisp_Specifier, window_specs) }, + { XD_LISP_OBJECT, offsetof (Lisp_Specifier, buffer_specs) }, + { XD_STRUCT_PTR, offsetof (Lisp_Specifier, caching), 1, &specifier_caching_description }, + { XD_LISP_OBJECT, offsetof (Lisp_Specifier, magic_parent) }, + { XD_LISP_OBJECT, offsetof (Lisp_Specifier, fallback) }, + { XD_SPECIFIER_END } +}; + +const struct lrecord_description specifier_empty_extra_description[] = { + { XD_END } +}; + DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("specifier", specifier, mark_specifier, print_specifier, finalize_specifier, specifier_equal, specifier_hash, + specifier_description, sizeof_specifier, - struct Lisp_Specifier); + Lisp_Specifier); /************************************************************************/ /* Creating specifiers */ @@ -413,9 +472,9 @@ size_t data_size, int call_create_meth) { Lisp_Object specifier; - struct Lisp_Specifier *sp = (struct Lisp_Specifier *) - alloc_lcrecord (sizeof (struct Lisp_Specifier) + - data_size - 1, lrecord_specifier); + Lisp_Specifier *sp = (Lisp_Specifier *) + alloc_lcrecord (offsetof (Lisp_Specifier, data) + data_size, + &lrecord_specifier); sp->methods = spec_meths; sp->global_specs = Qnil; @@ -1587,17 +1646,23 @@ { /* The return value of this function must be GCPRO'd. */ Lisp_Object rest, list_to_build_up = Qnil; - struct Lisp_Specifier *sp = XSPECIFIER (specifier); + Lisp_Specifier *sp = XSPECIFIER (specifier); struct gcpro gcpro1; GCPRO1 (list_to_build_up); LIST_LOOP (rest, inst_list) { Lisp_Object tag_set = XCAR (XCAR (rest)); - Lisp_Object instantiator = Fcopy_tree (XCDR (XCAR (rest)), Qt); Lisp_Object sub_inst_list = Qnil; + Lisp_Object instantiator; struct gcpro ngcpro1, ngcpro2; + if (HAS_SPECMETH_P (sp, copy_instantiator)) + instantiator = SPECMETH (sp, copy_instantiator, + (XCDR (XCAR (rest)))); + else + instantiator = Fcopy_tree (XCDR (XCAR (rest)), Qt); + NGCPRO2 (instantiator, sub_inst_list); /* call the will-add method; it may GC */ sub_inst_list = HAS_SPECMETH_P (sp, going_to_add) ? @@ -1638,7 +1703,7 @@ specifier_add_spec (Lisp_Object specifier, Lisp_Object locale, Lisp_Object inst_list, enum spec_add_meth add_meth) { - struct Lisp_Specifier *sp = XSPECIFIER (specifier); + Lisp_Specifier *sp = XSPECIFIER (specifier); enum spec_locale_type type = locale_type_from_locale (locale); Lisp_Object *orig_inst_list, tem; Lisp_Object list_to_build_up = Qnil; @@ -2309,7 +2374,7 @@ void set_specifier_fallback (Lisp_Object specifier, Lisp_Object fallback) { - struct Lisp_Specifier *sp = XSPECIFIER (specifier); + Lisp_Specifier *sp = XSPECIFIER (specifier); assert (SPECIFIERP (fallback) || !NILP (Fvalid_inst_list_p (fallback, Fspecifier_type (specifier)))); if (SPECIFIERP (fallback)) @@ -2359,7 +2424,7 @@ Lisp_Object depth) { /* This function can GC */ - struct Lisp_Specifier *sp; + Lisp_Specifier *sp; Lisp_Object device; Lisp_Object rest; int count = specpdl_depth (); @@ -2442,7 +2507,7 @@ Lisp_Object device = Qnil; Lisp_Object tag = Qnil; struct device *d; - struct Lisp_Specifier *sp; + Lisp_Specifier *sp; sp = XSPECIFIER (specifier); @@ -2485,7 +2550,7 @@ goto do_fallback; } -retry: + retry: /* First see if we can generate one from the window specifiers. */ if (!NILP (window)) CHECK_INSTANCE_ENTRY (window, matchspec, LOCALE_WINDOW); @@ -2504,7 +2569,7 @@ /* Last and least try the global specifiers. */ CHECK_INSTANCE_ENTRY (Qglobal, matchspec, LOCALE_GLOBAL); -do_fallback: + do_fallback: /* We're out of specifiers and we still haven't generated an instance. At least try the fallback ... If this fails, then we just return Qunbound. */ @@ -2645,7 +2710,7 @@ (specifier, domain, inst_list, default_)) { Lisp_Object val = Qunbound; - struct Lisp_Specifier *sp = XSPECIFIER (specifier); + Lisp_Specifier *sp = XSPECIFIER (specifier); struct gcpro gcpro1; Lisp_Object built_up_list = Qnil; @@ -2677,7 +2742,7 @@ (specifier, matchspec, domain, inst_list, default_)) { Lisp_Object val = Qunbound; - struct Lisp_Specifier *sp = XSPECIFIER (specifier); + Lisp_Specifier *sp = XSPECIFIER (specifier); struct gcpro gcpro1; Lisp_Object built_up_list = Qnil; @@ -2717,7 +2782,7 @@ (Lisp_Object specifier, struct frame *f, Lisp_Object oldval)) { - struct Lisp_Specifier *sp = XSPECIFIER (specifier); + Lisp_Specifier *sp = XSPECIFIER (specifier); assert (!GHOST_SPECIFIER_P (sp)); if (!sp->caching) @@ -3125,6 +3190,7 @@ specifier_type_create (void) { the_specifier_type_entry_dynarr = Dynarr_new (specifier_type_entry); + dumpstruct (&the_specifier_type_entry_dynarr, &sted_description); Vspecifier_type_list = Qnil; staticpro (&Vspecifier_type_list); @@ -3149,6 +3215,16 @@ } void +reinit_specifier_type_create (void) +{ + REINITIALIZE_SPECIFIER_TYPE (generic); + REINITIALIZE_SPECIFIER_TYPE (integer); + REINITIALIZE_SPECIFIER_TYPE (natnum); + REINITIALIZE_SPECIFIER_TYPE (boolean); + REINITIALIZE_SPECIFIER_TYPE (display_table); +} + +void vars_of_specifier (void) { Vcached_specifiers = Qnil; @@ -3157,6 +3233,7 @@ /* Do NOT mark through this, or specifiers will never be GC'd. This is the same deal as for weak hash tables. */ Vall_specifiers = Qnil; + pdump_wire_list (&Vall_specifiers); Vuser_defined_tags = Qnil; staticpro (&Vuser_defined_tags); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/specifier.h --- a/src/specifier.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/specifier.h Mon Aug 13 11:13:30 2007 +0200 @@ -21,8 +21,8 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_SPECIFIER_H_ -#define _XEMACS_SPECIFIER_H_ +#ifndef INCLUDED_specifier_h_ +#define INCLUDED_specifier_h_ /* MAGIC SPECIFIERS @@ -83,9 +83,11 @@ same time. */ +extern const struct struct_description specifier_methods_description; + struct specifier_methods { - CONST char *name; + const char *name; Lisp_Object predicate_symbol; /* Implementation specific methods: */ @@ -95,7 +97,7 @@ /* Mark method: Mark any lisp object within specifier data structure. Not required if no specifier data are Lisp_Objects. */ - void (*mark_method) (Lisp_Object specifier, void (*markobj) (Lisp_Object)); + void (*mark_method) (Lisp_Object specifier); /* Equal method: Compare two specifiers. This is called after ensuring that the two specifiers are of the same type, and have @@ -122,6 +124,13 @@ valid. */ void (*validate_method) (Lisp_Object instantiator); + + /* Copy method: Given an instantiator, copy the bits that we need to + for this specifier type. + + If this function is not present, then Fcopy_tree is used. */ + Lisp_Object (*copy_instantiator_method) (Lisp_Object instantiator); + /* Validate-matchspec method: Given a matchspec, verify that it's valid for this specifier type. If not, signal an error. @@ -185,6 +194,7 @@ void (*after_change_method) (Lisp_Object specifier, Lisp_Object locale); + const struct lrecord_description *extra_description; int extra_data_size; }; @@ -227,12 +237,12 @@ /* type-specific extra data attached to a specifier */ char data[1]; }; +typedef struct Lisp_Specifier Lisp_Specifier; -DECLARE_LRECORD (specifier, struct Lisp_Specifier); -#define XSPECIFIER(x) XRECORD (x, specifier, struct Lisp_Specifier) +DECLARE_LRECORD (specifier, Lisp_Specifier); +#define XSPECIFIER(x) XRECORD (x, specifier, Lisp_Specifier) #define XSETSPECIFIER(x, p) XSETRECORD (x, p, specifier) #define SPECIFIERP(x) RECORDP (x, specifier) -#define GC_SPECIFIERP(x) GC_RECORDP (x, specifier) #define CHECK_SPECIFIER(x) CHECK_RECORD (x, specifier) #define CONCHECK_SPECIFIER(x) CONCHECK_RECORD (x, specifier) @@ -243,21 +253,24 @@ #define SPECMETH(sp, m, args) (((sp)->methods->m##_method) args) /* Call a void-returning specifier method, if it exists. */ -#define MAYBE_SPECMETH(sp, m, args) do { \ - struct Lisp_Specifier *maybe_specmeth_sp = (sp); \ - if (HAS_SPECMETH_P (maybe_specmeth_sp, m)) \ - SPECMETH (maybe_specmeth_sp, m, args); \ +#define MAYBE_SPECMETH(sp, m, args) do { \ + Lisp_Specifier *maybe_specmeth_sp = (sp); \ + if (HAS_SPECMETH_P (maybe_specmeth_sp, m)) \ + SPECMETH (maybe_specmeth_sp, m, args); \ } while (0) /***** Defining new specifier types *****/ +#define specifier_data_offset (offsetof (Lisp_Specifier, data)) +extern const struct lrecord_description specifier_empty_extra_description[]; + #ifdef ERROR_CHECK_TYPECHECK #define DECLARE_SPECIFIER_TYPE(type) \ extern struct specifier_methods * type##_specifier_methods; \ INLINE struct type##_specifier * \ -error_check_##type##_specifier_data (struct Lisp_Specifier *sp); \ +error_check_##type##_specifier_data (Lisp_Specifier *sp); \ INLINE struct type##_specifier * \ -error_check_##type##_specifier_data (struct Lisp_Specifier *sp) \ +error_check_##type##_specifier_data (Lisp_Specifier *sp) \ { \ if (SPECIFIERP (sp->magic_parent)) \ { \ @@ -269,6 +282,15 @@ assert (SPECIFIER_TYPE_P (sp, type)); \ return (struct type##_specifier *) sp->data; \ } \ +INLINE Lisp_Specifier * \ +error_check_##type##_specifier_type (Lisp_Object obj); \ +INLINE Lisp_Specifier * \ +error_check_##type##_specifier_type (Lisp_Object obj) \ +{ \ + Lisp_Specifier *sp = XSPECIFIER (obj); \ + assert (SPECIFIER_TYPE_P (sp, type)); \ + return sp; \ +} \ DECLARE_NOTHING #else #define DECLARE_SPECIFIER_TYPE(type) \ @@ -279,10 +301,17 @@ struct specifier_methods * type##_specifier_methods #define INITIALIZE_SPECIFIER_TYPE(type, obj_name, pred_sym) do { \ - type##_specifier_methods = xnew_and_zero (struct specifier_methods); \ - type##_specifier_methods->name = obj_name; \ - defsymbol (&type##_specifier_methods->predicate_symbol, pred_sym); \ - add_entry_to_specifier_type_list (Q##type, type##_specifier_methods); \ + type##_specifier_methods = xnew_and_zero (struct specifier_methods); \ + type##_specifier_methods->name = obj_name; \ + type##_specifier_methods->extra_description = \ + specifier_empty_extra_description; \ + defsymbol_nodump (&type##_specifier_methods->predicate_symbol, pred_sym); \ + add_entry_to_specifier_type_list (Q##type, type##_specifier_methods); \ + dumpstruct (&type##_specifier_methods, &specifier_methods_description); \ +} while (0) + +#define REINITIALIZE_SPECIFIER_TYPE(type) do { \ + staticpro_nodump (&type##_specifier_methods->predicate_symbol); \ } while (0) #define INITIALIZE_SPECIFIER_TYPE_WITH_DATA(type, obj_name, pred_sym) \ @@ -290,6 +319,8 @@ INITIALIZE_SPECIFIER_TYPE (type, obj_name, pred_sym); \ type##_specifier_methods->extra_data_size = \ sizeof (struct type##_specifier); \ + type##_specifier_methods->extra_description = \ + type##_specifier_description; \ } while (0) /* Declare that specifier-type TYPE has method METH; used in @@ -303,24 +334,13 @@ ((sp)->methods == type##_specifier_methods) /* Any of the two of the magic spec */ -#define MAGIC_SPECIFIER_P(sp) \ - (!NILP((sp)->magic_parent)) +#define MAGIC_SPECIFIER_P(sp) (!NILP((sp)->magic_parent)) /* Normal part of the magic specifier */ -#define BODILY_SPECIFIER_P(sp) \ - (EQ ((sp)->magic_parent, Qt)) +#define BODILY_SPECIFIER_P(sp) EQ ((sp)->magic_parent, Qt) /* Ghost part of the magic specifier */ -#define GHOST_SPECIFIER_P(sp) \ - (SPECIFIERP((sp)->magic_parent)) -/* The same three, when used in GC */ -#define GC_MAGIC_SPECIFIER_P(sp) \ - (!GC_NILP((sp)->magic_parent)) -#define GC_BODILY_SPECIFIER_P(sp) \ - (GC_EQ ((sp)->magic_parent, Qt)) -#define GC_GHOST_SPECIFIER_P(sp) \ - (GC_SPECIFIERP((sp)->magic_parent)) +#define GHOST_SPECIFIER_P(sp) SPECIFIERP((sp)->magic_parent) -#define GHOST_SPECIFIER(sp) \ - (XSPECIFIER ((sp)->fallback)) +#define GHOST_SPECIFIER(sp) XSPECIFIER ((sp)->fallback) #ifdef ERROR_CHECK_TYPECHECK # define SPECIFIER_TYPE_DATA(sp, type) \ @@ -333,10 +353,19 @@ : (sp)->data)) #endif -/* #### Need to create ERROR_CHECKING versions of these. */ +#ifdef ERROR_CHECK_TYPECHECK +# define XSPECIFIER_TYPE(x, type) \ + error_check_##type##_specifier_type (x) +# define XSETSPECIFIER_TYPE(x, p, type) do \ +{ \ + XSETSPECIFIER (x, p); \ + assert (SPECIFIER_TYPEP (XSPECIFIER(x), type)); \ +} while (0) +#else +# define XSPECIFIER_TYPE(x, type) XSPECIFIER (x) +# define XSETSPECIFIER_TYPE(x, p, type) XSETSPECIFIER (x, p) +#endif /* ERROR_CHECK_TYPE_CHECK */ -#define XSPECIFIER_TYPE(x, type) XSPECIFIER (x) -#define XSETSPECIFIER_TYPE(x, p, type) XSETSPECIFIER (x, p) #define SPECIFIER_TYPEP(x, type) \ (SPECIFIERP (x) && SPECIFIER_TYPE_P (XSPECIFIER (x), type)) #define CHECK_SPECIFIER_TYPE(x, type) do { \ @@ -425,7 +454,7 @@ int unlock_ghost_specifiers_protected (void); void cleanup_specifiers (void); -void prune_specifiers (int (*obj_marked_p) (Lisp_Object)); +void prune_specifiers (void); void setup_device_initial_specifier_tags (struct device *d); void kill_specifier_buffer_locals (Lisp_Object buffer); @@ -464,4 +493,4 @@ #define CHECK_DISPLAYTABLE_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, display_table) #define CONCHECK_DISPLAYTABLE_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, display_table) -#endif /* _XEMACS_SPECIFIER_H_ */ +#endif /* INCLUDED_specifier_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/src-headers --- a/src/src-headers Mon Aug 13 11:12:06 2007 +0200 +++ b/src/src-headers Mon Aug 13 11:13:30 2007 +0200 @@ -28,8 +28,8 @@ ($myName = $0) =~ s@.*/@@; my $usage =" Usage: $myName -Generates header file fragments from the Emacs sources. -"; +Generates header file fragments from the Emacs sources +and writes them to stdout.\n"; die $usage if @ARGV; @@ -43,7 +43,7 @@ closedir SRCDIR; { my %generated_header; - for (qw (config.h puresize-adjust.h sheap-adjust.h paths.h Emacs.ad.h)) { + for (qw (config.h sheap-adjust.h paths.h Emacs.ad.h)) { $generated_header{$_} = 1; } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/strcat.c --- a/src/strcat.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/strcat.c Mon Aug 13 11:13:30 2007 +0200 @@ -27,18 +27,17 @@ the string! This will core dump if the memory following the last byte is not mapped. - Here is a correct version from glibc 1.09. + Here is a correct version from, glibc 1.09. */ char *strcat (char *dest, const char *src); /* Append SRC on the end of DEST. */ -/* CONST IS LOSING, but const is part of the interface of strcat */ char * strcat (char *dest, const char *src) { REGISTER char *s1 = dest; - REGISTER CONST char *s2 = src; + REGISTER const char *s2 = src; char c; /* Find the end of the string. */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/strcmp.c --- a/src/strcmp.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/strcmp.c Mon Aug 13 11:13:30 2007 +0200 @@ -36,7 +36,6 @@ #define HIGH_BIT_P(c) ((c) & hi_bit) #define HAS_ZERO(c) (((((c) + magic) ^ (c)) & not_magic) != not_magic) -/* CONST IS LOSING, but const is part of the interface of strcmp */ int strcmp (const char *x, const char *y) { @@ -44,8 +43,8 @@ return 0; else if (ALIGNED (x) && ALIGNED (y)) { - CONST unsigned long *x1 = (CONST unsigned long *) x; - CONST unsigned long *y1 = (CONST unsigned long *) y; + const unsigned long *x1 = (const unsigned long *) x; + const unsigned long *y1 = (const unsigned long *) y; unsigned long c; unsigned long magic = MAGIC; unsigned long not_magic = ~magic; @@ -59,8 +58,8 @@ return 0; else { - x = (CONST char *) x1; - y = (CONST char *) y1; + x = (const char *) x1; + y = (const char *) y1; goto slow_loop; } } @@ -69,8 +68,8 @@ y1++; } - x = (CONST char *) x1; - y = (CONST char *) y1; + x = (const char *) x1; + y = (const char *) y1; goto slow_loop; } else @@ -91,14 +90,14 @@ int -strncmp (CONST char *x, CONST char *y, size_t n) +strncmp (const char *x, const char *y, size_t n) { if ((x == y) || (n <= 0)) return 0; else if (ALIGNED (x) && ALIGNED (y)) { - CONST unsigned long *x1 = (CONST unsigned long *) x; - CONST unsigned long *y1 = (CONST unsigned long *) y; + const unsigned long *x1 = (const unsigned long *) x; + const unsigned long *y1 = (const unsigned long *) y; unsigned long c; unsigned long magic = MAGIC; unsigned long not_magic = ~magic; @@ -116,8 +115,8 @@ return 0; else { - x = (CONST char *) x1; - y = (CONST char *) y1; + x = (const char *) x1; + y = (const char *) y1; goto slow_loop; } } @@ -126,8 +125,8 @@ y1++; } - x = (CONST char *) x1; - y = (CONST char *) y1; + x = (const char *) x1; + y = (const char *) y1; goto slow_loop; } else diff -r f4aeb21a5bad -r 74fd4e045ea6 src/strcpy.c --- a/src/strcpy.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/strcpy.c Mon Aug 13 11:13:30 2007 +0200 @@ -35,7 +35,6 @@ #define HIGH_BIT_P(c) ((c) & hi_bit) #define HAS_ZERO(c) (((((c) + magic) ^ (c)) & not_magic) != not_magic) -/* CONST IS LOSING, but const is part of the interface of strcpy */ char * strcpy (char *to, const char *from) { @@ -56,7 +55,7 @@ if (HAS_ZERO(c)) { to = (char *) to1; - from = (CONST char *) from1; + from = (const char *) from1; goto slow_loop; } else diff -r f4aeb21a5bad -r 74fd4e045ea6 src/strftime.c --- a/src/strftime.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/strftime.c Mon Aug 13 11:13:30 2007 +0200 @@ -112,12 +112,12 @@ none, blank, zero }; -static char CONST* CONST days[] = +static char const* const days[] = { "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday" }; -static char CONST * CONST months[] = +static char const * const months[] = { "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December" @@ -174,7 +174,7 @@ /* Like strncpy except return the number of characters copied. */ static int -add_str (char *to, CONST char *from, int max) +add_str (char *to, const char *from, int max) { int i; @@ -203,7 +203,7 @@ starting on Sundays. */ static int -sun_week (CONST struct tm *tm) +sun_week (const struct tm *tm) { int dl; @@ -220,7 +220,7 @@ starting on Mondays. */ static int -mon_week (CONST struct tm *tm) +mon_week (const struct tm *tm) { int dl, wday; @@ -234,7 +234,7 @@ #if !defined(HAVE_TM_ZONE) && !defined(HAVE_TZNAME) char * -zone_name (CONST struct tm *tp) +zone_name (const struct tm *tp) { char *timezone (); struct timeval tv; @@ -251,11 +251,11 @@ that were put into STRING, or 0 if the length would have exceeded MAX. */ -size_t strftime (char *string, size_t max, CONST char *format, - CONST struct tm *tm); +size_t strftime (char *string, size_t max, const char *format, + const struct tm *tm); size_t -strftime (char *string, size_t max, CONST char *format, CONST struct tm *tm) +strftime (char *string, size_t max, const char *format, const struct tm *tm) { enum padding pad; /* Type of padding to apply. */ size_t length = 0; /* Characters put in STRING so far. */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/sunOS-fix.c --- a/src/sunOS-fix.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/sunOS-fix.c Mon Aug 13 11:13:30 2007 +0200 @@ -36,13 +36,13 @@ #include <stdlib.h> -size_t mbstowcs (wchar_t *foo, CONST char *bar, size_t baz) +size_t mbstowcs (wchar_t *foo, const char *bar, size_t baz) { abort (); return 0; } -size_t wcstombs (char *foo, CONST wchar_t *bar, size_t baz) +size_t wcstombs (char *foo, const wchar_t *bar, size_t baz) { abort (); return 0; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/sunplay.c --- a/src/sunplay.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/sunplay.c Mon Aug 13 11:13:30 2007 +0200 @@ -33,14 +33,8 @@ #include <sys/fcntl.h> #include <sys/file.h> -/* libaudio.h includes a header which defines CONST. We temporarily - undefine it in order to eliminate a compiler warning. Yes, this is - a gross hack. */ -#undef CONST #include <multimedia/libaudio.h> #include <multimedia/audio_device.h> -#undef CONST -#define CONST const #ifdef emacs # include <config.h> @@ -312,7 +306,7 @@ /* #### sigcontext doesn't exist in Solaris. This should be updated to be correct for Solaris. */ -static void +static SIGTYPE sighandler (int sig) { if (audio_fd > 0) diff -r f4aeb21a5bad -r 74fd4e045ea6 src/symbols.c --- a/src/symbols.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/symbols.c Mon Aug 13 11:13:30 2007 +0200 @@ -63,7 +63,7 @@ Lisp_Object Qget_value, Qset_value, Qbound_predicate, Qmake_unbound; Lisp_Object Qlocal_predicate, Qmake_local; -Lisp_Object Qboundp, Qfboundp, Qglobally_boundp, Qmakunbound; +Lisp_Object Qboundp, Qglobally_boundp, Qmakunbound; Lisp_Object Qsymbol_value, Qset, Qdefault_boundp, Qdefault_value; Lisp_Object Qset_default, Qsetq_default; Lisp_Object Qmake_variable_buffer_local, Qmake_local_variable; @@ -86,25 +86,21 @@ Lisp_Object follow_past_lisp_magic); -#ifdef LRECORD_SYMBOL - static Lisp_Object -mark_symbol (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_symbol (Lisp_Object obj) { - struct Lisp_Symbol *sym = XSYMBOL (obj); + Lisp_Symbol *sym = XSYMBOL (obj); Lisp_Object pname; - markobj (sym->value); - markobj (sym->function); - /* No need to mark through ->obarray, because it only holds nil or t. */ - /* markobj (sym->obarray);*/ + mark_object (sym->value); + mark_object (sym->function); XSETSTRING (pname, sym->name); - markobj (pname); + mark_object (pname); if (!symbol_next (sym)) return sym->plist; else { - markobj (sym->plist); + mark_object (sym->plist); /* Mark the rest of the symbols in the obarray hash-chain */ sym = symbol_next (sym); XSETSYMBOL (obj, sym); @@ -112,10 +108,45 @@ } } -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("symbol", symbol, - mark_symbol, print_symbol, 0, 0, 0, - struct Lisp_Symbol); -#endif /* LRECORD_SYMBOL */ +static const struct lrecord_description symbol_description[] = { + { XD_LISP_OBJECT, offsetof (Lisp_Symbol, next) }, + { XD_LISP_OBJECT, offsetof (Lisp_Symbol, name) }, + { XD_LISP_OBJECT, offsetof (Lisp_Symbol, value) }, + { XD_LISP_OBJECT, offsetof (Lisp_Symbol, function) }, + { XD_LISP_OBJECT, offsetof (Lisp_Symbol, plist) }, + { XD_END } +}; + +/* Symbol plists are directly accessible, so we need to protect against + invalid property list structure */ + +static Lisp_Object +symbol_getprop (Lisp_Object symbol, Lisp_Object property) +{ + return external_plist_get (&XSYMBOL (symbol)->plist, property, 0, ERROR_ME); +} + +static int +symbol_putprop (Lisp_Object symbol, Lisp_Object property, Lisp_Object value) +{ + external_plist_put (&XSYMBOL (symbol)->plist, property, value, 0, ERROR_ME); + return 1; +} + +static int +symbol_remprop (Lisp_Object symbol, Lisp_Object property) +{ + return external_remprop (&XSYMBOL (symbol)->plist, property, 0, ERROR_ME); +} + +DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("symbol", symbol, + mark_symbol, print_symbol, + 0, 0, 0, symbol_description, + symbol_getprop, + symbol_putprop, + symbol_remprop, + Fsymbol_plist, + Lisp_Symbol); /**********************************************************************/ @@ -146,10 +177,10 @@ } Lisp_Object -intern (CONST char *str) +intern (const char *str) { Bytecount len = strlen (str); - CONST Bufbyte *buf = (CONST Bufbyte *) str; + const Bufbyte *buf = (const Bufbyte *) str; Lisp_Object obarray = Vobarray; if (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0) @@ -161,10 +192,7 @@ return tem; } - return Fintern ((purify_flag - ? make_pure_pname (buf, len, 0) - : make_string (buf, len)), - obarray); + return Fintern (make_string (buf, len), obarray); } DEFUN ("intern", Fintern, 1, 2, 0, /* @@ -175,7 +203,8 @@ */ (string, obarray)) { - Lisp_Object sym, *ptr; + Lisp_Object object, *ptr; + Lisp_Symbol *symbol; Bytecount len; if (NILP (obarray)) obarray = Vobarray; @@ -184,52 +213,64 @@ CHECK_STRING (string); len = XSTRING_LENGTH (string); - sym = oblookup (obarray, XSTRING_DATA (string), len); - if (!INTP (sym)) + object = oblookup (obarray, XSTRING_DATA (string), len); + if (!INTP (object)) /* Found it */ - return sym; - - ptr = &XVECTOR_DATA (obarray)[XINT (sym)]; - - if (purify_flag && ! purified (string)) - string = make_pure_pname (XSTRING_DATA (string), len, 0); - sym = Fmake_symbol (string); - /* FSFmacs places OBARRAY here, but it is pointless because we do - not mark through this slot, so it is not usable later (because - the obarray might have been collected). Marking through the - ->obarray slot is an even worse idea, because it would keep - obarrays from being collected because of symbols pointed to them. - - NOTE: We place Qt here only if OBARRAY is actually Vobarray. It - is safer to do it this way, to avoid hosing with symbols within - pure objects. */ - if (EQ (obarray, Vobarray)) - XSYMBOL (sym)->obarray = Qt; + return object; + + ptr = &XVECTOR_DATA (obarray)[XINT (object)]; + + object = Fmake_symbol (string); + symbol = XSYMBOL (object); if (SYMBOLP (*ptr)) - symbol_next (XSYMBOL (sym)) = XSYMBOL (*ptr); + symbol_next (symbol) = XSYMBOL (*ptr); else - symbol_next (XSYMBOL (sym)) = 0; - *ptr = sym; - return sym; + symbol_next (symbol) = 0; + *ptr = object; + + if (string_byte (symbol_name (symbol), 0) == ':' && EQ (obarray, Vobarray)) + { + /* The LISP way is to put keywords in their own package, but we + don't have packages, so we do something simpler. Someday, + maybe we'll have packages and then this will be reworked. + --Stig. */ + symbol_value (symbol) = object; + } + + return object; } DEFUN ("intern-soft", Fintern_soft, 1, 2, 0, /* -Return the canonical symbol whose name is STRING, or nil if none exists. +Return the canonical symbol named NAME, or nil if none exists. +NAME may be a string or a symbol. If it is a symbol, that exact +symbol is searched for. A second optional argument specifies the obarray to use; it defaults to the value of `obarray'. */ - (string, obarray)) + (name, obarray)) { + /* #### Bug! (intern-soft "nil") returns nil. Perhaps we should + add a DEFAULT-IF-NOT-FOUND arg, like in get. */ Lisp_Object tem; + Lisp_String *string; if (NILP (obarray)) obarray = Vobarray; obarray = check_obarray (obarray); - CHECK_STRING (string); - - tem = oblookup (obarray, XSTRING_DATA (string), XSTRING_LENGTH (string)); - return !INTP (tem) ? tem : Qnil; + if (!SYMBOLP (name)) + { + CHECK_STRING (name); + string = XSTRING (name); + } + else + string = symbol_name (XSYMBOL (name)); + + tem = oblookup (obarray, string_data (string), string_length (string)); + if (INTP (tem) || (SYMBOLP (name) && !EQ (name, tem))) + return Qnil; + else + return tem; } DEFUN ("unintern", Funintern, 1, 2, 0, /* @@ -241,21 +282,22 @@ */ (name, obarray)) { - Lisp_Object string, tem; + Lisp_Object tem; + Lisp_String *string; int hash; if (NILP (obarray)) obarray = Vobarray; obarray = check_obarray (obarray); if (SYMBOLP (name)) - XSETSTRING (string, XSYMBOL (name)->name); + string = symbol_name (XSYMBOL (name)); else { CHECK_STRING (name); - string = name; + string = XSTRING (name); } - tem = oblookup (obarray, XSTRING_DATA (string), XSTRING_LENGTH (string)); + tem = oblookup (obarray, string_data (string), string_length (string)); if (INTP (tem)) return Qnil; /* If arg was a symbol, don't delete anything but that symbol itself. */ @@ -287,7 +329,6 @@ } } } - XSYMBOL (tem)->obarray = Qnil; return Qt; } @@ -298,10 +339,10 @@ Also store the bucket number in oblookup_last_bucket_number. */ Lisp_Object -oblookup (Lisp_Object obarray, CONST Bufbyte *ptr, Bytecount size) +oblookup (Lisp_Object obarray, const Bufbyte *ptr, Bytecount size) { int hash, obsize; - struct Lisp_Symbol *tail; + Lisp_Symbol *tail; Lisp_Object bucket; if (!VECTORP (obarray) || @@ -310,11 +351,6 @@ obarray = check_obarray (obarray); obsize = XVECTOR_LENGTH (obarray); } -#if 0 /* FSFmacs */ - /* #### Huh? */ - /* This is sometimes needed in the middle of GC. */ - obsize &= ~ARRAY_MARK_FLAG; -#endif hash = hash_string (ptr, size) % obsize; oblookup_last_bucket_number = hash; bucket = XVECTOR_DATA (obarray)[hash]; @@ -340,10 +376,10 @@ #if 0 /* Emacs 19.34 */ int -hash_string (CONST Bufbyte *ptr, Bytecount len) +hash_string (const Bufbyte *ptr, Bytecount len) { - CONST Bufbyte *p = ptr; - CONST Bufbyte *end = p + len; + const Bufbyte *p = ptr; + const Bufbyte *end = p + len; Bufbyte c; int hash = 0; @@ -359,7 +395,7 @@ /* derived from hashpjw, Dragon Book P436. */ int -hash_string (CONST Bufbyte *ptr, Bytecount len) +hash_string (const Bufbyte *ptr, Bytecount len) { int hash = 0; @@ -389,7 +425,7 @@ if (SYMBOLP (tail)) while (1) { - struct Lisp_Symbol *next; + Lisp_Symbol *next; if ((*fn) (tail, arg)) return; next = symbol_next (XSYMBOL (tail)); @@ -558,8 +594,7 @@ sym); if (symbol_is_constant (sym, val) - || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym) - && !NILP (XSYMBOL (sym)->obarray))) + || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym))) signal_error (Qsetting_constant, UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval)); } @@ -766,8 +801,8 @@ SYMVAL_CONST_SPECIFIER_FORWARD: (declare with DEFVAR_SPECIFIER) - Exactly like SYMVAL_CONST_OBJECT_FORWARD except that error message - you get when attempting to set the value says to use + Exactly like SYMVAL_CONST_OBJECT_FORWARD except that the error + message you get when attempting to set the value says to use `set-specifier' instead. SYMVAL_CURRENT_BUFFER_FORWARD: @@ -892,8 +927,7 @@ symbol to operate on. */ static Lisp_Object -mark_symbol_value_buffer_local (Lisp_Object obj, - void (*markobj) (Lisp_Object)) +mark_symbol_value_buffer_local (Lisp_Object obj) { struct symbol_value_buffer_local *bfwd; @@ -903,15 +937,14 @@ #endif bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj); - markobj (bfwd->default_value); - markobj (bfwd->current_value); - markobj (bfwd->current_buffer); + mark_object (bfwd->default_value); + mark_object (bfwd->current_value); + mark_object (bfwd->current_buffer); return bfwd->current_alist_element; } static Lisp_Object -mark_symbol_value_lisp_magic (Lisp_Object obj, - void (*markobj) (Lisp_Object)) +mark_symbol_value_lisp_magic (Lisp_Object obj) { struct symbol_value_lisp_magic *bfwd; int i; @@ -921,22 +954,21 @@ bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj); for (i = 0; i < MAGIC_HANDLER_MAX; i++) { - markobj (bfwd->handler[i]); - markobj (bfwd->harg[i]); + mark_object (bfwd->handler[i]); + mark_object (bfwd->harg[i]); } return bfwd->shadowed; } static Lisp_Object -mark_symbol_value_varalias (Lisp_Object obj, - void (*markobj) (Lisp_Object)) +mark_symbol_value_varalias (Lisp_Object obj) { struct symbol_value_varalias *bfwd; assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS); bfwd = XSYMBOL_VALUE_VARALIAS (obj); - markobj (bfwd->shadowed); + mark_object (bfwd->shadowed); return bfwd->aliasee; } @@ -953,28 +985,53 @@ write_c_string (buf, printcharfun); } +static const struct lrecord_description symbol_value_forward_description[] = { + { XD_END } +}; + +static const struct lrecord_description symbol_value_buffer_local_description[] = { + { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, default_value) }, + { XD_LO_RESET_NIL, offsetof (struct symbol_value_buffer_local, current_value), 3 }, + { XD_END } +}; + +static const struct lrecord_description symbol_value_lisp_magic_description[] = { + { XD_LISP_OBJECT_ARRAY, offsetof (struct symbol_value_lisp_magic, handler), 2*MAGIC_HANDLER_MAX+1 }, + { XD_END } +}; + +static const struct lrecord_description symbol_value_varalias_description[] = { + { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, aliasee) }, + { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, shadowed) }, + { XD_END } +}; + DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward", symbol_value_forward, this_one_is_unmarkable, print_symbol_value_magic, 0, 0, 0, + symbol_value_forward_description, struct symbol_value_forward); DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local", symbol_value_buffer_local, mark_symbol_value_buffer_local, print_symbol_value_magic, 0, 0, 0, + symbol_value_buffer_local_description, struct symbol_value_buffer_local); DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic", symbol_value_lisp_magic, mark_symbol_value_lisp_magic, print_symbol_value_magic, 0, 0, 0, + symbol_value_lisp_magic_description, struct symbol_value_lisp_magic); DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias", symbol_value_varalias, mark_symbol_value_varalias, print_symbol_value_magic, 0, 0, 0, + symbol_value_varalias_description, struct symbol_value_varalias); @@ -999,7 +1056,7 @@ do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer, struct console *console) { - CONST struct symbol_value_forward *fwd; + const struct symbol_value_forward *fwd; if (!SYMBOL_VALUE_MAGIC_P (valcontents)) return valcontents; @@ -1067,7 +1124,7 @@ or symbol-value-buffer-local, and if there's a handler, we should have already called it. */ Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt); - CONST struct symbol_value_forward *fwd + const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (valcontents); int offset = ((char *) symbol_value_forward_forward (fwd) - (char *) &buffer_local_flags); @@ -1109,7 +1166,7 @@ or symbol-value-buffer-local, and if there's a handler, we should have already called it. */ Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt); - CONST struct symbol_value_forward *fwd + const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (valcontents); int offset = ((char *) symbol_value_forward_forward (fwd) - (char *) &console_local_flags); @@ -1175,7 +1232,7 @@ } else { - CONST struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (ovalue); + const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (ovalue); int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object, int flags) = symbol_value_forward_magicfun (fwd); @@ -1193,7 +1250,7 @@ if (magicfun) magicfun (sym, &newval, Qnil, 0); *((int *) symbol_value_forward_forward (fwd)) - = ((NILP (newval)) ? 0 : 1); + = !NILP (newval); return; case SYMVAL_OBJECT_FORWARD: @@ -1526,7 +1583,9 @@ /* This can also get called while we're preparing to shutdown. #### What should really happen in that case? Should we actually fix things so we can't get here in that case? */ +#ifndef PDUMP assert (!initialized || preparing_for_armageddon); +#endif con = 0; } @@ -1562,7 +1621,9 @@ /* This can also get called while we're preparing to shutdown. #### What should really happen in that case? Should we actually fix things so we can't get here in that case? */ +#ifndef PDUMP assert (!initialized || preparing_for_armageddon); +#endif con = 0; } @@ -1590,7 +1651,7 @@ (symbol, newval)) { REGISTER Lisp_Object valcontents; - struct Lisp_Symbol *sym; + Lisp_Symbol *sym; /* remember, we're called by Fmakunbound() as well */ CHECK_SYMBOL (symbol); @@ -1614,23 +1675,20 @@ reject_constant_symbols (symbol, newval, 0, UNBOUNDP (newval) ? Qmakunbound : Qset); - retry_2: - switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) { case SYMVAL_LISP_MAGIC: { - Lisp_Object retval; - if (UNBOUNDP (newval)) - retval = maybe_call_magic_handler (symbol, Qmakunbound, 0); + { + maybe_call_magic_handler (symbol, Qmakunbound, 0); + return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = Qunbound; + } else - retval = maybe_call_magic_handler (symbol, Qset, 1, newval); - if (!UNBOUNDP (retval)) - return newval; - valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed; - /* semi-change-o */ - goto retry_2; + { + maybe_call_magic_handler (symbol, Qset, 1, newval); + return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = newval; + } } case SYMVAL_VARALIAS: @@ -1654,7 +1712,7 @@ case SYMVAL_CURRENT_BUFFER_FORWARD: { - CONST struct symbol_value_forward *fwd + const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (valcontents); int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd))); @@ -1666,7 +1724,7 @@ case SYMVAL_SELECTED_CONSOLE_FORWARD: { - CONST struct symbol_value_forward *fwd + const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (valcontents); int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd))); @@ -1804,7 +1862,7 @@ case SYMVAL_CURRENT_BUFFER_FORWARD: { - CONST struct symbol_value_forward *fwd + const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (valcontents); return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults) + ((char *)symbol_value_forward_forward (fwd) @@ -1813,7 +1871,7 @@ case SYMVAL_SELECTED_CONSOLE_FORWARD: { - CONST struct symbol_value_forward *fwd + const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (valcontents); return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults) + ((char *)symbol_value_forward_forward (fwd) @@ -2035,7 +2093,7 @@ { struct symbol_value_buffer_local *bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local, - lrecord_symbol_value_buffer_local); + &lrecord_symbol_value_buffer_local); Lisp_Object foo; bfwd->magic.type = SYMVAL_BUFFER_LOCAL; @@ -2143,7 +2201,7 @@ /* Make sure variable is set up to hold per-buffer values */ bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local, - lrecord_symbol_value_buffer_local); + &lrecord_symbol_value_buffer_local); bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL; bfwd->current_buffer = Qnil; @@ -2253,7 +2311,7 @@ case SYMVAL_CURRENT_BUFFER_FORWARD: { - CONST struct symbol_value_forward *fwd + const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (valcontents); int offset = ((char *) symbol_value_forward_forward (fwd) - (char *) &buffer_local_flags); @@ -2347,7 +2405,7 @@ case SYMVAL_SELECTED_CONSOLE_FORWARD: { - CONST struct symbol_value_forward *fwd + const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (valcontents); int offset = ((char *) symbol_value_forward_forward (fwd) - (char *) &console_local_flags); @@ -2406,7 +2464,7 @@ case SYMVAL_CURRENT_BUFFER_FORWARD: { - CONST struct symbol_value_forward *fwd + const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (valcontents); int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd))); @@ -2816,7 +2874,7 @@ Lisp_Object legerdemain; struct symbol_value_lisp_magic *bfwd; - assert (nargs >= 0 && nargs < 20); + assert (nargs >= 0 && nargs < countof (args)); legerdemain = XSYMBOL (sym)->value; assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain)); bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain); @@ -2863,7 +2921,7 @@ if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents)) { bfwd = alloc_lcrecord_type (struct symbol_value_lisp_magic, - lrecord_symbol_value_lisp_magic); + &lrecord_symbol_value_lisp_magic); bfwd->magic.type = SYMVAL_LISP_MAGIC; for (i = 0; i < MAGIC_HANDLER_MAX; i++) { @@ -2999,7 +3057,7 @@ reject_constant_symbols (variable, Qunbound, 0, Qt); bfwd = alloc_lcrecord_type (struct symbol_value_varalias, - lrecord_symbol_value_varalias); + &lrecord_symbol_value_varalias); bfwd->magic.type = SYMVAL_VARALIAS; bfwd->aliasee = alias; bfwd->shadowed = valcontents; @@ -3076,32 +3134,30 @@ /* some losing systems can't have static vars at function scope... */ static struct symbol_value_magic guts_of_unbound_marker = - { { symbol_value_forward_lheader_initializer, 0, 69}, - SYMVAL_UNBOUND_MARKER }; - -Lisp_Object Vpure_uninterned_symbol_table; +{ /* struct symbol_value_magic */ + { /* struct lcrecord_header */ + { /* struct lrecord_header */ + 1, /* type - index into lrecord_implementations_table */ + 0, /* mark */ + 0, /* c_readonly */ + 0, /* lisp_readonly */ + }, + 0, /* next */ + 0, /* uid */ + 0, /* free */ + }, + 0, /* value */ + SYMVAL_UNBOUND_MARKER +}; void init_symbols_once_early (void) { -#ifndef Qzero - Qzero = make_int (0); /* Only used if Lisp_Object is a union type */ -#endif - -#ifndef Qnull_pointer - /* C guarantees that Qnull_pointer will be initialized to all 0 bits, - so the following is actually a no-op. */ - XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0); -#endif - - /* see comment in Fpurecopy() */ - Vpure_uninterned_symbol_table = - make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); - staticpro (&Vpure_uninterned_symbol_table); - - Qnil = Fmake_symbol (make_pure_pname ((CONST Bufbyte *) "nil", 3, 1)); - /* Bootstrapping problem: Qnil isn't set when make_pure_pname is + reinit_symbols_once_early (); + + /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is called the first time. */ + Qnil = Fmake_symbol (make_string_nocopy ((const Bufbyte *) "nil", 3)); XSYMBOL (Qnil)->name->plist = Qnil; XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */ XSYMBOL (Qnil)->plist = Qnil; @@ -3113,7 +3169,6 @@ { int hash = hash_string (string_data (XSYMBOL (Qnil)->name), 3); XVECTOR_DATA (Vobarray)[hash % OBARRAY_SIZE] = Qnil; - XSYMBOL (Qnil)->obarray = Qt; } { @@ -3123,8 +3178,8 @@ XSETSYMBOL_VALUE_MAGIC (Qunbound, tem); } - if ((CONST void *) XPNTR (Qunbound) != - (CONST void *)&guts_of_unbound_marker) + if ((const void *) XPNTR (Qunbound) != + (const void *)&guts_of_unbound_marker) { /* This might happen on DATA_SEG_BITS machines. */ /* abort (); */ @@ -3140,19 +3195,46 @@ defsymbol (&Qt, "t"); XSYMBOL (Qt)->value = Qt; /* Veritas aetera */ Vquit_flag = Qnil; + + pdump_wire (&Qnil); + pdump_wire (&Qunbound); + pdump_wire (&Vquit_flag); } void -defsymbol (Lisp_Object *location, CONST char *name) +reinit_symbols_once_early (void) { - *location = Fintern (make_pure_pname ((CONST Bufbyte *) name, - strlen (name), 1), +#ifndef Qzero + Qzero = make_int (0); /* Only used if Lisp_Object is a union type */ +#endif + +#ifndef Qnull_pointer + /* C guarantees that Qnull_pointer will be initialized to all 0 bits, + so the following is actually a no-op. */ + XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0); +#endif +} + +void +defsymbol_nodump (Lisp_Object *location, const char *name) +{ + *location = Fintern (make_string_nocopy ((const Bufbyte *) name, + strlen (name)), + Qnil); + staticpro_nodump (location); +} + +void +defsymbol (Lisp_Object *location, const char *name) +{ + *location = Fintern (make_string_nocopy ((const Bufbyte *) name, + strlen (name)), Qnil); staticpro (location); } void -defkeyword (Lisp_Object *location, CONST char *name) +defkeyword (Lisp_Object *location, const char *name) { defsymbol (location, name); Fset (*location, *location); @@ -3205,15 +3287,14 @@ * FIXME: Should newsubr be staticpro()'ed? I dont think so but I need * a guru to check. */ -#define check_module_subr() \ -do { \ - if (initialized) { \ - struct Lisp_Subr *newsubr; \ - newsubr = (Lisp_Subr *)xmalloc(sizeof(struct Lisp_Subr)); \ - memcpy (newsubr, subr, sizeof(struct Lisp_Subr)); \ - subr->doc = (CONST char *)newsubr; \ - subr = newsubr; \ - } \ +#define check_module_subr() \ +do { \ + if (initialized) { \ + Lisp_Subr *newsubr = (Lisp_Subr *) xmalloc (sizeof (Lisp_Subr)); \ + memcpy (newsubr, subr, sizeof (Lisp_Subr)); \ + subr->doc = (const char *)newsubr; \ + subr = newsubr; \ + } \ } while (0) #else /* ! HAVE_SHLIB */ #define check_module_subr() @@ -3247,7 +3328,7 @@ } void -deferror (Lisp_Object *symbol, CONST char *name, CONST char *messuhhj, +deferror (Lisp_Object *symbol, const char *name, const char *messuhhj, Lisp_Object inherits_from) { Lisp_Object conds; @@ -3255,11 +3336,11 @@ assert (SYMBOLP (inherits_from)); conds = Fget (inherits_from, Qerror_conditions, Qnil); - pure_put (*symbol, Qerror_conditions, Fcons (*symbol, conds)); + Fput (*symbol, Qerror_conditions, Fcons (*symbol, conds)); /* NOT build_translated_string (). This function is called at load time and the string needs to get translated at run time. (This happens in the function (display-error) in cmdloop.el.) */ - pure_put (*symbol, Qerror_message, build_string (messuhhj)); + Fput (*symbol, Qerror_message, build_string (messuhhj)); } void @@ -3278,7 +3359,6 @@ defsymbol (&Qmake_local, "make-local"); defsymbol (&Qboundp, "boundp"); - defsymbol (&Qfboundp, "fboundp"); defsymbol (&Qglobally_boundp, "globally-boundp"); defsymbol (&Qmakunbound, "makunbound"); defsymbol (&Qsymbol_value, "symbol-value"); @@ -3346,7 +3426,7 @@ /* Create and initialize a Lisp variable whose value is forwarded to C data */ void -defvar_magic (CONST char *symbol_name, CONST struct symbol_value_forward *magic) +defvar_magic (const char *symbol_name, const struct symbol_value_forward *magic) { Lisp_Object sym, kludge; @@ -3372,8 +3452,8 @@ sym = Fintern (build_string (symbol_name), Qnil); else #endif - sym = Fintern (make_pure_pname ((CONST Bufbyte *) symbol_name, - strlen (symbol_name), 1), Qnil); + sym = Fintern (make_string_nocopy ((const Bufbyte *) symbol_name, + strlen (symbol_name)), Qnil); XSETOBJ (XSYMBOL (sym)->value, Lisp_Type_Record, magic); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/symeval.h --- a/src/symeval.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/symeval.h Mon Aug 13 11:13:30 2007 +0200 @@ -23,8 +23,8 @@ /* Fsymbol_value checks whether XSYMBOL (sym)->value is one of these, * and does weird magic stuff if so */ -#ifndef _XEMACS_SYMEVAL_H_ -#define _XEMACS_SYMEVAL_H_ +#ifndef INCLUDED_symeval_h_ +#define INCLUDED_symeval_h_ enum symbol_value_type { @@ -72,6 +72,7 @@ struct symbol_value_magic { struct lcrecord_header lcheader; + void *value; enum symbol_value_type type; }; #define SYMBOL_VALUE_MAGIC_P(x) \ @@ -138,7 +139,7 @@ DECLARE_LRECORD (symbol_value_forward, struct symbol_value_forward); #define XSYMBOL_VALUE_FORWARD(x) \ XRECORD (x, symbol_value_forward, struct symbol_value_forward) -#define symbol_value_forward_forward(m) ((void *)((m)->magic.lcheader.next)) +#define symbol_value_forward_forward(m) ((void *)((m)->magic.value)) #define symbol_value_forward_magicfun(m) ((m)->magicfun) /* 2. symbol-value-buffer-local */ @@ -281,33 +282,47 @@ void defsubr_macro (Lisp_Subr *); #define DEFSUBR_MACRO(Fname) defsubr_macro (&S##Fname) -void defsymbol (Lisp_Object *location, CONST char *name); +void defsymbol (Lisp_Object *location, const char *name); +void defsymbol_nodump (Lisp_Object *location, const char *name); -void defkeyword (Lisp_Object *location, CONST char *name); +void defkeyword (Lisp_Object *location, const char *name); -void deferror (Lisp_Object *symbol, CONST char *name, - CONST char *message, Lisp_Object inherits_from); +void deferror (Lisp_Object *symbol, const char *name, + const char *message, Lisp_Object inherits_from); /* Macros we use to define forwarded Lisp variables. These are used in the syms_of_FILENAME functions. */ -void defvar_magic (CONST char *symbol_name, CONST struct symbol_value_forward *magic); - -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION -# define symbol_value_forward_lheader_initializer { 1, 0, 0 } -#else -# define symbol_value_forward_lheader_initializer \ - { lrecord_symbol_value_forward } -#endif +void defvar_magic (const char *symbol_name, const struct symbol_value_forward *magic); #define DEFVAR_SYMVAL_FWD(lname, c_location, forward_type, magicfun) do { \ - static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { symbol_value_forward_lheader_initializer, \ - (struct lcrecord_header *) (c_location), 69 }, \ - forward_type }, magicfun }; \ + static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C = \ + { /* struct symbol_value_forward */ \ + { /* struct symbol_value_magic */ \ + { /* struct lcrecord_header */ \ + { /* struct lrecord_header */ \ + 1, /* type - index into lrecord_implementations_table */ \ + 0, /* mark bit */ \ + 0, /* c_readonly bit */ \ + 0 /* lisp_readonly bit */ \ + }, \ + 0, /* next */ \ + 0, /* uid */ \ + 0 /* free */ \ + }, \ + c_location, \ + forward_type \ + }, \ + magicfun \ + }; \ defvar_magic ((lname), &I_hate_C); \ } while (0) +#define DEFVAR_SYMVAL_FWD_INT(lname, c_location, forward_type, magicfun) do{ \ + DEFVAR_SYMVAL_FWD (lname, c_location, forward_type, magicfun); \ + dumpopaque (c_location, sizeof(int)); \ +} while (0) + #define DEFVAR_SYMVAL_FWD_OBJECT(lname, c_location, forward_type, magicfun) do{ \ DEFVAR_SYMVAL_FWD (lname, c_location, forward_type, magicfun); \ staticpro (c_location); \ @@ -321,18 +336,18 @@ #define DEFVAR_SPECIFIER(lname, c_location) \ DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_CONST_SPECIFIER_FORWARD, 0) #define DEFVAR_INT(lname, c_location) \ - DEFVAR_SYMVAL_FWD (lname, c_location, SYMVAL_FIXNUM_FORWARD, 0) + DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_FIXNUM_FORWARD, 0) #define DEFVAR_CONST_INT(lname, c_location) \ - DEFVAR_SYMVAL_FWD (lname, c_location, SYMVAL_CONST_FIXNUM_FORWARD, 0) + DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_CONST_FIXNUM_FORWARD, 0) #define DEFVAR_BOOL(lname, c_location) \ - DEFVAR_SYMVAL_FWD (lname, c_location, SYMVAL_BOOLEAN_FORWARD, 0) + DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_BOOLEAN_FORWARD, 0) #define DEFVAR_CONST_BOOL(lname, c_location) \ - DEFVAR_SYMVAL_FWD (lname, c_location, SYMVAL_CONST_BOOLEAN_FORWARD, 0) + DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_CONST_BOOLEAN_FORWARD, 0) #define DEFVAR_LISP_MAGIC(lname, c_location, magicfun) \ - DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_OBJECT_FORWARD, magicfun); + DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_OBJECT_FORWARD, magicfun) #define DEFVAR_INT_MAGIC(lname, c_location, magicfun) \ - DEFVAR_SYMVAL_FWD (lname, c_location, SYMVAL_FIXNUM_FORWARD, magicfun); + DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_FIXNUM_FORWARD, magicfun) #define DEFVAR_BOOL_MAGIC(lname, c_location, magicfun) \ - DEFVAR_SYMVAL_FWD (lname, c_location, SYMVAL_BOOLEAN_FORWARD, magicfun); + DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_BOOLEAN_FORWARD, magicfun) -#endif /* _XEMACS_SYMEVAL_H_ */ +#endif /* INCLUDED_symeval_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/symsinit.h --- a/src/symsinit.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/symsinit.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,8 +20,8 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_SYMSINIT_H_ -#define _XEMACS_SYMSINIT_H_ +#ifndef INCLUDED_symsinit_h_ +#define INCLUDED_symsinit_h_ /* Earliest environment initializations (dump-time and run-time). */ @@ -33,11 +33,14 @@ void init_ralloc (void); void init_signals_very_early (void); -/* Early Lisp-engine initialization (dump-time only). */ +/* Early Lisp-engine initialization (dump-time for init, run-time for reinit). */ void init_alloc_once_early (void); +void reinit_alloc_once_early (void); void init_symbols_once_early (void); +void reinit_symbols_once_early (void); void init_errors_once_early (void); +void reinit_opaque_once_early (void); void init_opaque_once_early (void); /* Declare the built-in symbols and primitives (dump-time only). */ @@ -95,9 +98,12 @@ void syms_of_glyphs_widget (void); void syms_of_glyphs_mswindows (void); void syms_of_glyphs (void); +void syms_of_gui_mswindows (void); void syms_of_gui_x (void); void syms_of_gui (void); +void syms_of_gutter (void); void syms_of_indent (void); +void syms_of_input_method_xlib (void); void syms_of_intl (void); void syms_of_keymap (void); void syms_of_lread (void); @@ -113,8 +119,9 @@ void syms_of_mule_canna (void); void syms_of_mule_ccl (void); void syms_of_mule_charset (void); -void syms_of_mule_coding (void); +void syms_of_file_coding (void); void syms_of_mule_wnn (void); +void syms_of_ntproc (void); void syms_of_objects_tty (void); void syms_of_objects_x (void); void syms_of_objects_mswindows (void); @@ -129,6 +136,7 @@ void syms_of_scrollbar (void); void syms_of_scrollbar_mswindows(void); void syms_of_search (void); +void syms_of_select (void); void syms_of_select_mswindows (void); void syms_of_signal (void); void syms_of_sound (void); @@ -136,34 +144,42 @@ void syms_of_sunpro (void); void syms_of_symbols (void); void syms_of_syntax (void); +void syms_of_tests (void); void syms_of_toolbar (void); void syms_of_tooltalk (void); void syms_of_undo (void); void syms_of_widget (void); void syms_of_window (void); -void syms_of_xselect (void); +void syms_of_select_x (void); void syms_of_eldap (void); +void syms_of_gpmevent (void); -/* Initialize the console types (dump-time only). */ +/* Initialize the console types (dump-time but for reinit_). */ void console_type_create (void); void console_type_create_stream (void); +void reinit_console_type_create_stream (void); void console_type_create_tty (void); +void reinit_console_type_create_tty (void); void console_type_create_device_tty (void); void console_type_create_frame_tty (void); void console_type_create_objects_tty (void); void console_type_create_redisplay_tty (void); void console_type_create_x (void); +void reinit_console_type_create_x (void); void console_type_create_device_x (void); +void reinit_console_type_create_device_x (void); void console_type_create_frame_x (void); void console_type_create_glyphs_x (void); void console_type_create_menubar_x (void); void console_type_create_objects_x (void); void console_type_create_redisplay_x (void); void console_type_create_scrollbar_x (void); +void console_type_create_select_x (void); void console_type_create_toolbar_x (void); void console_type_create_dialog_x (void); void console_type_create_mswindows (void); +void reinit_console_type_create_mswindows (void); void console_type_create_device_mswindows (void); void console_type_create_frame_mswindows (void); void console_type_create_menubar_mswindows (void); @@ -173,13 +189,20 @@ void console_type_create_toolbar_mswindows (void); void console_type_create_glyphs_mswindows (void); void console_type_create_dialog_mswindows (void); +void console_type_create_select_mswindows (void); /* Initialize the specifier types (dump-time only). */ void specifier_type_create (void); +void reinit_specifier_type_create (void); void specifier_type_create_image (void); +void reinit_specifier_type_create_image (void); +void specifier_type_create_gutter (void); +void reinit_specifier_type_create_gutter (void); void specifier_type_create_objects (void); +void reinit_specifier_type_create_objects (void); void specifier_type_create_toolbar (void); +void reinit_specifier_type_create_toolbar (void); /* Initialize the structure types (dump-time only). */ @@ -196,11 +219,12 @@ void image_instantiator_format_create_glyphs_widget (void); void image_instantiator_format_create_glyphs_x (void); void image_instantiator_format_create_glyphs_mswindows (void); +void image_instantiator_format_create_glyphs_tty (void); /* Initialize the lstream types (dump-time only). */ void lstream_type_create (void); -void lstream_type_create_mule_coding (void); +void lstream_type_create_file_coding (void); void lstream_type_create_print (void); void lstream_type_create_mswindows_selectable (void); @@ -213,27 +237,33 @@ void init_provide_once (void); -/* Initialize most variables (dump-time only). */ +/* Initialize most variables (dump-time for vars_, run-time for reinit_vars). */ void vars_of_abbrev (void); void vars_of_alloc (void); void vars_of_balloon_x (void); void vars_of_buffer (void); +void reinit_vars_of_buffer (void); void vars_of_bytecode (void); void vars_of_callint (void); void vars_of_callproc (void); +void vars_of_chartab (void); void vars_of_cmdloop (void); void vars_of_cmds (void); void vars_of_console (void); +void reinit_vars_of_console (void); void vars_of_console_stream (void); void vars_of_console_mswindows (void); void vars_of_console_tty (void); void vars_of_data (void); void vars_of_database (void); void vars_of_debug (void); +void reinit_vars_of_debug (void); void vars_of_device (void); +void reinit_vars_of_device (void); void vars_of_device_mswindows (void); void vars_of_device_x (void); +void reinit_vars_of_device_x (void); void vars_of_dialog (void); void vars_of_dialog_x (void); void vars_of_dialog_mswindows (void); @@ -245,79 +275,113 @@ void vars_of_elhash (void); void vars_of_emacs (void); void vars_of_eval (void); +void reinit_vars_of_eval (void); void vars_of_event_stream (void); +void reinit_vars_of_event_stream (void); void vars_of_event_tty (void); +void reinit_vars_of_event_tty (void); void vars_of_event_mswindows (void); +void reinit_vars_of_event_mswindows (void); void vars_of_event_Xt (void); +void reinit_vars_of_event_Xt (void); void vars_of_events (void); +void reinit_vars_of_events (void); void vars_of_extents (void); +void reinit_vars_of_extents (void); void vars_of_faces (void); void vars_of_fileio (void); void vars_of_filelock (void); void vars_of_floatfns (void); void vars_of_font_lock (void); +void reinit_vars_of_font_lock (void); void vars_of_frame_tty (void); void vars_of_frame_mswindows (void); +void reinit_vars_of_frame_mswindows (void); void vars_of_frame_x (void); void vars_of_frame (void); void vars_of_glyphs_x (void); void vars_of_glyphs_eimage (void); void vars_of_glyphs_widget (void); +void reinit_vars_of_glyphs_widget (void); void vars_of_glyphs_mswindows (void); void vars_of_glyphs (void); +void reinit_vars_of_glyphs (void); void vars_of_gui_x (void); +void reinit_vars_of_gui_x (void); void vars_of_gui (void); +void vars_of_gutter (void); void vars_of_input_method_motif (void); void vars_of_input_method_xlib (void); void vars_of_indent (void); void vars_of_insdel (void); +void reinit_vars_of_insdel (void); void vars_of_intl (void); void vars_of_keymap (void); void vars_of_lread (void); +void reinit_vars_of_lread (void); void vars_of_lstream (void); +void reinit_vars_of_lstream (void); void vars_of_macros (void); void vars_of_md5 (void); void vars_of_menubar_x (void); +void reinit_vars_of_menubar_x (void); void vars_of_menubar (void); void vars_of_menubar_mswindows (void); void vars_of_minibuf (void); +void reinit_vars_of_minibuf (void); void vars_of_module (void); +void reinit_vars_of_module (void); void vars_of_mule (void); void vars_of_mule_canna (void); +void vars_of_mule_ccl(void); void vars_of_mule_charset (void); -void vars_of_mule_coding (void); +void vars_of_file_coding (void); void vars_of_mule_wnn (void); +void vars_of_nt (void); +void vars_of_ntproc (void); void vars_of_objects (void); +void reinit_vars_of_objects (void); void vars_of_objects_tty (void); void vars_of_objects_mswindows (void); void vars_of_objects_x (void); void vars_of_print (void); +void reinit_vars_of_print (void); void vars_of_process (void); void vars_of_process_nt (void); void vars_of_process_unix (void); void vars_of_profile (void); void vars_of_ralloc (void); void vars_of_redisplay (void); +void reinit_vars_of_redisplay (void); void vars_of_scrollbar_x (void); +void reinit_vars_of_scrollbar_x (void); void vars_of_scrollbar (void); void vars_of_scrollbar_mswindows (void); void vars_of_search (void); +void reinit_vars_of_search (void); +void vars_of_select (void); void vars_of_select_mswindows (void); void vars_of_sound (void); void vars_of_specifier (void); void vars_of_sunpro (void); void vars_of_symbols (void); void vars_of_syntax (void); +void vars_of_tests (void); void vars_of_toolbar (void); void vars_of_tooltalk (void); void vars_of_undo (void); +void reinit_vars_of_undo (void); void vars_of_window (void); -void vars_of_xselect (void); +void reinit_vars_of_window (void); +void vars_of_select_x (void); +void reinit_vars_of_select_x (void); void vars_of_eldap (void); +void vars_of_gpmevent (void); /* Initialize specifier variables (dump-time only). */ void specifier_vars_of_glyphs (void); +void specifier_vars_of_gutter (void); void specifier_vars_of_menubar (void); void specifier_vars_of_redisplay (void); void specifier_vars_of_scrollbar (void); @@ -325,7 +389,7 @@ void specifier_vars_of_window (void); /* Initialize variables with complex dependencies - on other variables (dump-time only). */ + on other variables (dump-time for complex_vars_, run-time for reinit_). */ void complex_vars_of_regex (void); void complex_vars_of_search (void); @@ -333,7 +397,7 @@ void complex_vars_of_extents (void); void complex_vars_of_faces (void); void complex_vars_of_mule_charset (void); -void complex_vars_of_mule_coding (void); +void complex_vars_of_file_coding (void); void complex_vars_of_glyphs (void); void complex_vars_of_glyphs_x (void); void complex_vars_of_glyphs_mswindows (void); @@ -345,11 +409,13 @@ void complex_vars_of_syntax (void); void complex_vars_of_chartab (void); void complex_vars_of_buffer (void); +void reinit_complex_vars_of_buffer (void); void complex_vars_of_console (void); +void reinit_complex_vars_of_console (void); void complex_vars_of_emacs (void); void complex_vars_of_minibuf (void); +void reinit_complex_vars_of_minibuf (void); void complex_vars_of_callproc (void); -void complex_vars_of_filelock (void); void complex_vars_of_keymap (void); /* Reset the Lisp engine (run-time only). */ @@ -381,4 +447,4 @@ void init_redisplay (void); void init_sunpro (void); -#endif /* _XEMACS_SYMSINIT_H_ */ +#endif /* INCLUDED_symsinit_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/syntax.c --- a/src/syntax.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/syntax.c Mon Aug 13 11:13:30 2007 +0200 @@ -53,6 +53,7 @@ two such characters. */ /* Mule 2.4 doesn't seem to have Sextword - I'm removing it -- mrb */ +/* Recovered by tomo */ Lisp_Object Qsyntax_table_p; @@ -116,7 +117,7 @@ find_defun_start (struct buffer *buf, Bufpos pos) { Bufpos tem; - struct Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table); + Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table); /* Use previous finding, if it's valid and applies to this inquiry. */ if (buf == find_start_buffer @@ -223,7 +224,7 @@ into the code it signifies. This is used by modify-syntax-entry, and other things. */ -CONST unsigned char syntax_spec_code[0400] = +const unsigned char syntax_spec_code[0400] = { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, @@ -245,7 +246,7 @@ 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377 }; -CONST unsigned char syntax_code_spec[] = " .w_()'\"$\\/<>@"; +const unsigned char syntax_code_spec[] = " .w_()'\"$\\/<>@"; DEFUN ("syntax-designator-chars", Fsyntax_designator_chars, 0, 0, 0, /* Return a string of the recognized syntax designator chars. @@ -267,7 +268,7 @@ */ (ch, table)) { - struct Lisp_Char_Table *mirrortab; + Lisp_Char_Table *mirrortab; if (NILP(ch)) { @@ -313,7 +314,7 @@ */ (ch, table)) { - struct Lisp_Char_Table *mirrortab; + Lisp_Char_Table *mirrortab; int code; CHECK_CHAR_COERCE_INT (ch); @@ -327,15 +328,17 @@ -static int -word_constituent_p (struct buffer *buf, Bufpos pos, - struct Lisp_Char_Table *tab) -{ - enum syntaxcode code = SYNTAX_UNSAFE (tab, BUF_FETCH_CHAR (buf, pos)); - return ((words_include_escapes && - (code == Sescape || code == Scharquote)) - || (code == Sword)); -} +#ifdef MULE +/* Return 1 if there is a word boundary between two word-constituent + characters C1 and C2 if they appear in this order, else return 0. + There is no word boundary between two word-constituent ASCII + characters. */ +#define WORD_BOUNDARY_P(c1, c2) \ + (!(CHAR_ASCII_P (c1) && CHAR_ASCII_P (c2)) \ + && word_boundary_p (c1, c2)) + +extern int word_boundary_p (Emchar c1, Emchar c2); +#endif /* Return the position across COUNT words from FROM. If that many words cannot be found before the end of the buffer, return 0. @@ -345,7 +348,11 @@ scan_words (struct buffer *buf, Bufpos from, int count) { Bufpos limit = count > 0 ? BUF_ZV (buf) : BUF_BEGV (buf); - struct Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table); + Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table); + Emchar ch0, ch1; + enum syntaxcode code; + + /* #### is it really worth it to hand expand both cases? JV */ while (count > 0) { QUIT; @@ -354,15 +361,35 @@ { if (from == limit) return 0; - if (word_constituent_p (buf, from, mirrortab)) + + ch0 = BUF_FETCH_CHAR (buf, from); + code = SYNTAX_UNSAFE (mirrortab, ch0); + + from++; + if (words_include_escapes + && (code == Sescape || code == Scharquote)) break; - from++; + if (code == Sword) + break; } QUIT; - while ((from != limit) && word_constituent_p (buf, from, mirrortab)) + while (from != limit) { + ch1 = BUF_FETCH_CHAR (buf, from); + code = SYNTAX_UNSAFE (mirrortab, ch1); + if (!(words_include_escapes + && (code == Sescape || code == Scharquote))) + if (code != Sword +#ifdef MULE + || WORD_BOUNDARY_P (ch0, ch1) +#endif + ) + break; +#ifdef MULE + ch0 = ch1; +#endif from++; } count--; @@ -376,15 +403,35 @@ { if (from == limit) return 0; - if (word_constituent_p (buf, from - 1, mirrortab)) + + ch1 = BUF_FETCH_CHAR (buf, from - 1); + code = SYNTAX_UNSAFE (mirrortab, ch1); + + from--; + if (words_include_escapes + && (code == Sescape || code == Scharquote)) break; - from--; + if (code == Sword) + break; } QUIT; - while ((from != limit) && word_constituent_p (buf, from - 1, mirrortab)) + while (from != limit) { + ch0 = BUF_FETCH_CHAR (buf, from - 1); + code = SYNTAX_UNSAFE (mirrortab, ch0); + if (!(words_include_escapes + && (code == Sescape || code == Scharquote))) + if (code != Sword +#ifdef MULE + || WORD_BOUNDARY_P (ch0, ch1) +#endif + ) + break; +#ifdef MULE + ch1 = ch0; +#endif from--; } count++; @@ -428,7 +475,7 @@ { Emchar c; enum syntaxcode code; - struct Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table); + Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table); /* Look back, counting the parity of string-quotes, and recording the comment-starters seen. @@ -562,7 +609,7 @@ find_end_of_comment (struct buffer *buf, Bufpos from, Bufpos stop, int mask) { int c; - struct Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table); + Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table); while (1) { @@ -613,9 +660,9 @@ Bufpos stop; Emchar c; enum syntaxcode code; - int count; + EMACS_INT count; struct buffer *buf = decode_buffer (buffer, 0); - struct Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table); + Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table); CHECK_INT (n); count = XINT (n); @@ -769,7 +816,7 @@ enum syntaxcode code; int min_depth = depth; /* Err out if depth gets less than this. */ Lisp_Object syntaxtab = buf->syntax_table; - struct Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table); + Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table); if (depth > 0) min_depth = 0; @@ -979,7 +1026,7 @@ if (SYNTAX_PREFIX_UNSAFE (mirrortab, c)) continue; - switch (((quoted) ? Sword : code)) + switch (quoted ? Sword : code) { case Sword: case Ssymbol: @@ -1088,7 +1135,7 @@ enum syntaxcode code; Bufpos beg = BUF_BEGV (buf); int quoted = 0; - struct Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table); + Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table); while (pos > beg && ((code = SYNTAX (mirrortab, BUF_FETCH_CHAR (buf, pos - 1))) @@ -1170,7 +1217,7 @@ struct buffer *buf = decode_buffer (buffer, 0); Bufpos beg = BUF_BEGV (buf); Bufpos pos = BUF_PT (buf); - struct Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table); + Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table); while (pos > beg && !char_quoted (buf, pos - 1) && (SYNTAX (mirrortab, BUF_FETCH_CHAR (buf, pos - 1)) == Squote @@ -1210,7 +1257,7 @@ Lisp_Object tem; int mask; /* comment mask */ Lisp_Object syntaxtab = buf->syntax_table; - struct Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table); + Lisp_Char_Table *mirrortab = XCHAR_TABLE (buf->mirror_syntax_table); if (NILP (oldstate)) { @@ -1563,7 +1610,7 @@ } static void -update_just_this_syntax_table (struct Lisp_Char_Table *ct) +update_just_this_syntax_table (Lisp_Char_Table *ct) { struct chartab_range range; struct cmst_arg arg; @@ -1581,7 +1628,7 @@ one. */ void -update_syntax_table (struct Lisp_Char_Table *ct) +update_syntax_table (Lisp_Char_Table *ct) { /* Don't be stymied at startup. */ if (CHAR_TABLEP (Vstandard_syntax_table) @@ -1633,18 +1680,28 @@ DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments /* Non-nil means `forward-sexp', etc., should treat comments as whitespace. */ ); + parse_sexp_ignore_comments = 0; - words_include_escapes = 0; DEFVAR_BOOL ("words-include-escapes", &words_include_escapes /* Non-nil means `forward-word', etc., should treat escape chars part of words. */ ); + words_include_escapes = 0; no_quit_in_re_search = 0; } +static void +define_standard_syntax (const char *p, enum syntaxcode syn) +{ + for (; *p; p++) + Fput_char_table (make_char (*p), make_int (syn), Vstandard_syntax_table); +} + void complex_vars_of_syntax (void) { + Emchar i; + const char *p; /* Set this now, so first buffer creation can refer to it. */ /* Make it nil before calling copy-syntax-table so that copy-syntax-table will know not to try to copy from garbage */ @@ -1652,72 +1709,35 @@ Vstandard_syntax_table = Fcopy_syntax_table (Qnil); staticpro (&Vstandard_syntax_table); - Vsyntax_designator_chars_string = make_pure_string (syntax_code_spec, - Smax, Qnil, 1); + Vsyntax_designator_chars_string = make_string_nocopy (syntax_code_spec, + Smax); staticpro (&Vsyntax_designator_chars_string); - fill_char_table (XCHAR_TABLE (Vstandard_syntax_table), - make_int (Spunct)); - - { - Emchar i; - - for (i = 0; i <= 32; i++) - Fput_char_table (make_char (i), make_int ((int) Swhitespace), - Vstandard_syntax_table); - for (i = 127; i <= 159; i++) - Fput_char_table (make_char (i), make_int ((int) Swhitespace), - Vstandard_syntax_table); + fill_char_table (XCHAR_TABLE (Vstandard_syntax_table), make_int (Spunct)); - for (i = 'a'; i <= 'z'; i++) - Fput_char_table (make_char (i), make_int ((int) Sword), - Vstandard_syntax_table); - for (i = 'A'; i <= 'Z'; i++) - Fput_char_table (make_char (i), make_int ((int) Sword), - Vstandard_syntax_table); - for (i = '0'; i <= '9'; i++) - Fput_char_table (make_char (i), make_int ((int) Sword), - Vstandard_syntax_table); - Fput_char_table (make_char ('$'), make_int ((int) Sword), + for (i = 0; i <= 32; i++) /* Control 0 plus SPACE */ + Fput_char_table (make_char (i), make_int (Swhitespace), Vstandard_syntax_table); - Fput_char_table (make_char ('%'), make_int ((int) Sword), + for (i = 127; i <= 159; i++) /* DEL plus Control 1 */ + Fput_char_table (make_char (i), make_int (Swhitespace), Vstandard_syntax_table); + define_standard_syntax ("abcdefghijklmnopqrstuvwxyz" + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "0123456789" + "$%", Sword); + define_standard_syntax ("\"", Sstring); + define_standard_syntax ("\\", Sescape); + define_standard_syntax ("_-+*/&|<>=", Ssymbol); + define_standard_syntax (".,;:?!#@~^'`", Spunct); + + for (p = "()[]{}"; *p; p+=2) { - Fput_char_table (make_char ('('), Fcons (make_int ((int) Sopen), - make_char (')')), - Vstandard_syntax_table); - Fput_char_table (make_char (')'), Fcons (make_int ((int) Sclose), - make_char ('(')), + Fput_char_table (make_char (p[0]), + Fcons (make_int (Sopen), make_char (p[1])), Vstandard_syntax_table); - Fput_char_table (make_char ('['), Fcons (make_int ((int) Sopen), - make_char (']')), - Vstandard_syntax_table); - Fput_char_table (make_char (']'), Fcons (make_int ((int) Sclose), - make_char ('[')), - Vstandard_syntax_table); - Fput_char_table (make_char ('{'), Fcons (make_int ((int) Sopen), - make_char ('}')), - Vstandard_syntax_table); - Fput_char_table (make_char ('}'), Fcons (make_int ((int) Sclose), - make_char ('{')), + Fput_char_table (make_char (p[1]), + Fcons (make_int (Sclose), make_char (p[0])), Vstandard_syntax_table); } - - Fput_char_table (make_char ('"'), make_int ((int) Sstring), - Vstandard_syntax_table); - Fput_char_table (make_char ('\\'), make_int ((int) Sescape), - Vstandard_syntax_table); - - { - CONST char *p; - for (p = "_-+*/&|<>="; *p; p++) - Fput_char_table (make_char (*p), make_int ((int) Ssymbol), - Vstandard_syntax_table); - - for (p = ".,;:?!#@~^'`"; *p; p++) - Fput_char_table (make_char (*p), make_int ((int) Spunct), - Vstandard_syntax_table); - } - } } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/syntax.h --- a/src/syntax.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/syntax.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,8 +20,8 @@ /* Synched up with: FSF 19.28. */ -#ifndef _XEMACS_SYNTAX_H_ -#define _XEMACS_SYNTAX_H_ +#ifndef INCLUDED_syntax_h_ +#define INCLUDED_syntax_h_ #include "chartab.h" @@ -72,9 +72,9 @@ #define SYNTAX_CODE_UNSAFE(table, c) \ XINT (CHAR_TABLE_VALUE_UNSAFE (table, c)) -INLINE int SYNTAX_CODE (struct Lisp_Char_Table *table, Emchar c); +INLINE int SYNTAX_CODE (Lisp_Char_Table *table, Emchar c); INLINE int -SYNTAX_CODE (struct Lisp_Char_Table *table, Emchar c) +SYNTAX_CODE (Lisp_Char_Table *table, Emchar c) { return SYNTAX_CODE_UNSAFE (table, c); } @@ -85,9 +85,9 @@ #define SYNTAX_FROM_CODE(code) ((enum syntaxcode) ((code) & 0177)) #define SYNTAX(table, c) SYNTAX_FROM_CODE (SYNTAX_CODE (table, c)) -INLINE int WORD_SYNTAX_P (struct Lisp_Char_Table *table, Emchar c); +INLINE int WORD_SYNTAX_P (Lisp_Char_Table *table, Emchar c); INLINE int -WORD_SYNTAX_P (struct Lisp_Char_Table *table, Emchar c) +WORD_SYNTAX_P (Lisp_Char_Table *table, Emchar c) { return SYNTAX (table, c) == Sword; } @@ -170,13 +170,19 @@ #define SYNTAX_SECOND_CHAR_END 0x03 #define SYNTAX_SECOND_CHAR 0x33 -#define SYNTAX_START_P(table, a, b) \ - ((SYNTAX_COMMENT_BITS (table, a) & SYNTAX_FIRST_CHAR_START) \ - && (SYNTAX_COMMENT_BITS (table, b) & SYNTAX_SECOND_CHAR_START)) -#define SYNTAX_END_P(table, a, b) \ - ((SYNTAX_COMMENT_BITS (table, a) & SYNTAX_FIRST_CHAR_END) \ - && (SYNTAX_COMMENT_BITS (table, b) & SYNTAX_SECOND_CHAR_END)) +/* #### These are now more or less equivalent to + SYNTAX_COMMENT_MATCH_START ...*/ +/* a and b must be first and second start chars for a common type */ +#define SYNTAX_START_P(table, a, b) \ + (((SYNTAX_COMMENT_BITS (table, a) & SYNTAX_FIRST_CHAR_START) >> 2) \ + & (SYNTAX_COMMENT_BITS (table, b) & SYNTAX_SECOND_CHAR_START)) + +/* ... and SYNTAX_COMMENT_MATCH_END */ +/* a and b must be first and second end chars for a common type */ +#define SYNTAX_END_P(table, a, b) \ + (((SYNTAX_COMMENT_BITS (table, a) & SYNTAX_FIRST_CHAR_END) >> 2) \ + & (SYNTAX_COMMENT_BITS (table, b) & SYNTAX_SECOND_CHAR_END)) #define SYNTAX_STYLES_MATCH_START_P(table, a, b, mask) \ ((SYNTAX_COMMENT_BITS (table, a) & SYNTAX_FIRST_CHAR_START & (mask)) \ @@ -232,15 +238,15 @@ that character signifies (as a char). For example, (enum syntaxcode) syntax_spec_code['w'] is Sword. */ -extern CONST unsigned char syntax_spec_code[0400]; +extern const unsigned char syntax_spec_code[0400]; /* Indexed by syntax code, give the letter that describes it. */ -extern CONST unsigned char syntax_code_spec[]; +extern const unsigned char syntax_code_spec[]; -Lisp_Object scan_lists (struct buffer *buf, int from, int count, +Lisp_Object scan_lists (struct buffer *buf, Bufpos from, int count, int depth, int sexpflag, int no_error); -int char_quoted (struct buffer *buf, int pos); +int char_quoted (struct buffer *buf, Bufpos pos); /* NOTE: This does not refer to the mirror table, but to the syntax table itself. */ @@ -249,6 +255,6 @@ extern int no_quit_in_re_search; extern struct buffer *regex_emacs_buffer; -void update_syntax_table (struct Lisp_Char_Table *ct); +void update_syntax_table (Lisp_Char_Table *ct); -#endif /* _XEMACS_SYNTAX_H_ */ +#endif /* INCLUDED_syntax_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/sysdep.c --- a/src/sysdep.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/sysdep.c Mon Aug 13 11:13:30 2007 +0200 @@ -33,20 +33,23 @@ #ifdef WINDOWSNT #include <direct.h> +#ifdef __MINGW32__ +#include <mingw32/process.h> +#else /* <process.h> should not conflict with "process.h", as per ANSI definition. - This is not true though with visual c though. The trick below works with - VC4.2b and with VC5.0. It assumes that VC is installed in a kind of - standard way, so include files get to what/ever/path/include. + This is not true with visual c though. The trick below works with + VC4.2b, 5.0 and 6.0. It assumes that VC is installed in a kind of + standard way, so include path ends with /include. Unfortunately, this must go before lisp.h, since process.h defines abort() which will conflict with the macro defined in lisp.h */ #include <../include/process.h> +#endif /* __MINGW32__ */ #endif /* WINDOWSNT */ #include "lisp.h" -#include <stddef.h> #include <stdlib.h> /* ------------------------------- */ @@ -87,7 +90,6 @@ #ifdef WINDOWSNT #include <sys/utime.h> -#include <windows.h> #include "ntheap.h" #endif @@ -231,8 +233,11 @@ #endif /* NO_SUBPROCESSES */ -void -wait_for_termination (int pid) +#ifdef WINDOWSNT +void wait_for_termination (HANDLE pHandle) +#else +void wait_for_termination (int pid) +#endif { /* #### With the new improved SIGCHLD handling stuff, there is much less danger of race conditions and some of the comments below @@ -342,6 +347,49 @@ Since implementations may add their own error indicators on top, we ignore it by default. */ +#elif defined (WINDOWSNT) + int ret = 0, status = 0; + if (pHandle == NULL) + { + warn_when_safe (Qprocess, Qwarning, "Cannot wait for unknown process to terminate"); + return; + } + do + { + QUIT; + ret = WaitForSingleObject(pHandle, 100); + } + while (ret == WAIT_TIMEOUT); + if (ret == WAIT_FAILED) + { + warn_when_safe (Qprocess, Qwarning, "waiting for process failed"); + } + if (ret == WAIT_ABANDONED) + { + warn_when_safe (Qprocess, Qwarning, + "process to wait for has been abandoned"); + } + if (ret == WAIT_OBJECT_0) + { + ret = GetExitCodeProcess(pHandle, &status); + if (ret) + { + synch_process_alive = 0; + synch_process_retcode = status; + } + else + { + /* GetExitCodeProcess() didn't return a valid exit status, + nothing to do. APA */ + warn_when_safe (Qprocess, Qwarning, + "failure to obtain process exit value"); + } + } + if (pHandle != NULL && !CloseHandle(pHandle)) + { + warn_when_safe (Qprocess, Qwarning, + "failure to close unknown process"); + } #elif defined (EMACS_BLOCK_SIGNAL) && !defined (BROKEN_WAIT_FOR_SIGNAL) && defined (SIGCHLD) while (1) { @@ -373,7 +421,7 @@ Try defining BROKEN_WAIT_FOR_SIGNAL. */ EMACS_WAIT_FOR_SIGNAL (SIGCHLD); } -#else /* not HAVE_WAITPID and (not EMACS_BLOCK_SIGNAL or BROKEN_WAIT_FOR_SIGNAL) */ +#else /* not HAVE_WAITPID and not WINDOWSNT and (not EMACS_BLOCK_SIGNAL or BROKEN_WAIT_FOR_SIGNAL) */ /* This approach is kind of cheesy but is guaranteed(?!) to work for all systems. */ while (1) @@ -421,7 +469,7 @@ child_setup_tty (int out) { struct emacs_tty s; - EMACS_GET_TTY (out, &s); + emacs_get_tty (out, &s); #if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS) assert (isatty(out)); @@ -490,7 +538,7 @@ #endif /* no TIOCGPGRP or no TIOCGLTC or no TIOCGETC */ s.main.c_cc[VEOL] = _POSIX_VDISABLE; #if defined (CBAUD) - /* <mdiers> ### This is not portable. ### + /* <mdiers> #### This is not portable. ### POSIX does not specify CBAUD, and 4.4BSD does not have it. Instead, POSIX suggests to use cfset{i,o}speed(). [cf. D. Lewine, POSIX Programmer's Guide, Chapter 8: Terminal @@ -513,7 +561,7 @@ s.lmode = LLITOUT | s.lmode; /* Don't strip 8th bit */ #endif /* not HAVE_TERMIO */ - EMACS_SET_TTY (out, &s, 0); + emacs_set_tty (out, &s, 0); #ifdef RTU { @@ -564,7 +612,7 @@ } #ifdef WINDOWSNT -int +pid_t sys_getpid (void) { return abs (getpid ()); @@ -575,7 +623,11 @@ static void sys_subshell (void) { +#ifdef WINDOWSNT + HANDLE pid; +#else int pid; +#endif struct save_signal saved_handlers[5]; Lisp_Object dir; unsigned char *str = 0; @@ -614,7 +666,7 @@ xyzzy: #ifdef WINDOWSNT - pid = -1; + pid = NULL; #else /* not WINDOWSNT */ pid = fork (); @@ -648,7 +700,7 @@ #ifdef WINDOWSNT /* Waits for process completion */ pid = _spawnlp (_P_WAIT, sh, sh, NULL); - if (pid == -1) + if (pid == NULL) write (1, "Can't execute subshell", 22); #else /* not WINDOWSNT */ @@ -732,7 +784,7 @@ Bufbyte get_eof_char (int fd) { - CONST Bufbyte ctrl_d = (Bufbyte) '\004'; + const Bufbyte ctrl_d = (Bufbyte) '\004'; if (!isatty (fd)) return ctrl_d; @@ -742,7 +794,7 @@ tcgetattr (fd, &t); #if 0 /* What is the following line designed to do??? -mrb */ - if (strlen ((CONST char *) t.c_cc) < (unsigned int) (VEOF + 1)) + if (strlen ((const char *) t.c_cc) < (unsigned int) (VEOF + 1)) return ctrl_d; else return (Bufbyte) t.c_cc[VEOF]; @@ -765,7 +817,7 @@ { struct termio t; ioctl (fd, TCGETA, &t); - if (strlen ((CONST char *) t.c_cc) < (unsigned int) (VINTR + 1)) + if (strlen ((const char *) t.c_cc) < (unsigned int) (VINTR + 1)) return ctrl_d; else return (Bufbyte) t.c_cc[VINTR]; @@ -1015,7 +1067,7 @@ { int filedesc = DEVICE_INFD (d); -#if defined (I_SETSIG) && !defined(HPUX10) +#if defined (I_SETSIG) && !defined(HPUX10) && !defined(LINUX) { int events=0; ioctl (filedesc, I_GETSIG, &events); @@ -1369,7 +1421,8 @@ /* Set the parameters of the tty on FD according to the contents of *SETTINGS. If FLUSHP is non-zero, we discard input. - Return 0 if all went well, and -1 if anything failed. */ + Return 0 if all went well, and -1 if anything failed. + #### All current callers use FLUSHP == 0. */ int emacs_set_tty (int fd, struct emacs_tty *settings, int flushp) @@ -1479,7 +1532,7 @@ input_fd = CONSOLE_TTY_DATA (con)->infd; output_fd = CONSOLE_TTY_DATA (con)->outfd; - EMACS_GET_TTY (input_fd, &CONSOLE_TTY_DATA (con)->old_tty); + emacs_get_tty (input_fd, &CONSOLE_TTY_DATA (con)->old_tty); tty = CONSOLE_TTY_DATA (con)->old_tty; con->tty_erase_char = Qnil; @@ -1646,7 +1699,7 @@ tty.ltchars = new_ltchars; #endif /* HAVE_LTCHARS */ - EMACS_SET_TTY (input_fd, &tty, 0); + emacs_set_tty (input_fd, &tty, 0); /* This code added to insure that, if flow-control is not to be used, we have an unlocked terminal at the start. */ @@ -1654,11 +1707,9 @@ #ifdef TCXONC if (!TTY_FLAGS (con).flow_control) ioctl (input_fd, TCXONC, 1); #endif -#ifndef APOLLO #ifdef TIOCSTART if (!TTY_FLAGS (con).flow_control) ioctl (input_fd, TIOCSTART, 0); #endif -#endif #if defined (HAVE_TERMIOS) || defined (HPUX9) #ifdef TCOON @@ -1753,7 +1804,7 @@ { struct emacs_tty tty; - EMACS_GET_TTY (DEVICE_INFD (d), &tty); + emacs_get_tty (DEVICE_INFD (d), &tty); return EMACS_TTY_TABS_OK (&tty); } #endif @@ -1826,7 +1877,7 @@ assert (DEVICE_TTY_P (d)); input_fd = DEVICE_INFD (d); - EMACS_GET_TTY (input_fd, &s); + emacs_get_tty (input_fd, &s); #if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS) eight_bit = (s.main.c_cflag & CSIZE) == CS8; @@ -1876,7 +1927,7 @@ fsync (output_fd); #endif - while (EMACS_SET_TTY (input_fd, &CONSOLE_TTY_DATA (con)->old_tty, 0) + while (emacs_set_tty (input_fd, &CONSOLE_TTY_DATA (con)->old_tty, 0) < 0 && errno == EINTR) ; @@ -2070,7 +2121,7 @@ /* limits of text/data segments */ /************************************************************************/ -#ifndef CANNOT_DUMP +#if !defined(CANNOT_DUMP) && !defined(PDUMP) #define NEED_STARTS #endif @@ -2090,13 +2141,14 @@ * */ +#if !defined(HAVE_TEXT_START) && !defined(PDUMP) + #ifdef __cplusplus - extern "C" int _start (); + extern "C" int _start (void); #else - extern int _start (); + extern int _start (void); #endif -#ifndef HAVE_TEXT_START char * start_of_text (void) { @@ -2111,7 +2163,7 @@ #endif /* GOULD */ #endif /* TEXT_START */ } -#endif /* not HAVE_TEXT_START */ +#endif /* !defined(HAVE_TEXT_START) && !defined(PDUMP) */ /* * Return the address of the start of the data segment prior to @@ -2170,7 +2222,7 @@ } #endif /* NEED_STARTS (not CANNOT_DUMP or not SYSTEM_MALLOC) */ -#ifndef CANNOT_DUMP +#if !defined(CANNOT_DUMP) && !defined(PDUMP) /* Some systems that cannot dump also cannot implement these. */ /* @@ -2205,7 +2257,7 @@ #endif } -#endif /* not CANNOT_DUMP */ +#endif /* !defined(CANNOT_DUMP) && !defined(PDUMP) */ /************************************************************************/ @@ -2227,7 +2279,7 @@ { #if defined (WINDOWSNT) char hostname [MAX_COMPUTERNAME_LENGTH + 1]; - size_t size = sizeof(hostname); + size_t size = sizeof (hostname); GetComputerName (hostname, &size); Vsystem_name = build_string (hostname); #elif !defined (HAVE_GETHOSTNAME) @@ -2261,42 +2313,60 @@ # ifndef CANNOT_DUMP if (initialized) # endif /* not CANNOT_DUMP */ - { - struct hostent *hp = NULL; - int count; -# ifdef TRY_AGAIN - for (count = 0; count < 10; count++) - { - h_errno = 0; -# endif - /* Some systems can't handle SIGALARM/SIGIO in gethostbyname(). */ - stop_interrupts (); - hp = gethostbyname (hostname); - start_interrupts (); -# ifdef TRY_AGAIN - if (! (hp == 0 && h_errno == TRY_AGAIN)) - break; - Fsleep_for (make_int (1)); - } -# endif - if (hp) - { - CONST char *fqdn = (CONST char *) hp->h_name; - - if (!strchr (fqdn, '.')) - { - /* We still don't have a fully qualified domain name. - Try to find one in the list of alternate names */ - char **alias = hp->h_aliases; - while (*alias && !strchr (*alias, '.')) - alias++; - if (*alias) - fqdn = *alias; - } - hostname = (char *) alloca (strlen (fqdn) + 1); - strcpy (hostname, fqdn); - } - } + if (!strchr (hostname, '.')) + { +# if !(defined(HAVE_GETADDRINFO) && defined(HAVE_GETNAMEINFO)) + struct hostent *hp = NULL; + int count; +# ifdef TRY_AGAIN + for (count = 0; count < 10; count++) + { + h_errno = 0; +# endif + /* Some systems can't handle SIGALARM/SIGIO in gethostbyname(). */ + stop_interrupts (); + hp = gethostbyname (hostname); + start_interrupts (); +# ifdef TRY_AGAIN + if (! (hp == 0 && h_errno == TRY_AGAIN)) + break; + Fsleep_for (make_int (1)); + } +# endif + if (hp) + { + const char *fqdn = (const char *) hp->h_name; + + if (!strchr (fqdn, '.')) + { + /* We still don't have a fully qualified domain name. + Try to find one in the list of alternate names */ + char **alias = hp->h_aliases; + while (*alias && !strchr (*alias, '.')) + alias++; + if (*alias) + fqdn = *alias; + } + hostname = (char *) alloca (strlen (fqdn) + 1); + strcpy (hostname, fqdn); + } +# else /* !(HAVE_GETADDRINFO && HAVE_GETNAMEINFO) */ + struct addrinfo hints, *res; + + xzero (hints); + hints.ai_flags = AI_CANONNAME; + hints.ai_family = AF_UNSPEC; + hints.ai_socktype = SOCK_STREAM; + hints.ai_protocol = 0; + if (!getaddrinfo (hostname, NULL, &hints, &res)) + { + hostname = (char *) alloca (strlen (res->ai_canonname) + 1); + strcpy (hostname, res->ai_canonname); + + freeaddrinfo (res); + } +# endif /* !(HAVE_GETADDRINFO && HAVE_GETNAMEINFO) */ + } # endif /* HAVE_SOCKETS */ Vsystem_name = build_string (hostname); #endif /* HAVE_GETHOSTNAME */ @@ -2425,7 +2495,7 @@ /* Linux added here by Raymond L. Toy <toy@alydar.crd.ge.com> for XEmacs. */ /* Irix added here by gparker@sni-usa.com for XEmacs. */ /* NetBSD added here by James R Grinter <jrg@doc.ic.ac.uk> for XEmacs */ -extern CONST char *sys_errlist[]; +extern const char *sys_errlist[]; extern int sys_nerr; #endif @@ -2435,12 +2505,12 @@ #endif -CONST char * +const char * strerror (int errnum) { if (errnum >= 0 && errnum < sys_nerr) return sys_errlist[errnum]; - return ((CONST char *) GETTEXT ("Unknown error")); + return ((const char *) GETTEXT ("Unknown error")); } #endif /* ! HAVE_STRERROR */ @@ -2516,7 +2586,7 @@ int i; /* check the table for the OS error code */ - for (i = 0; i < sizeof(errtable)/sizeof(errtable[0]); ++i) + for (i = 0; i < countof (errtable); ++i) { if (win32_error == errtable[i].oscode) { @@ -2550,7 +2620,7 @@ /************************************************************************/ #define PATHNAME_CONVERT_OUT(path) \ - GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA ((CONST Bufbyte *) path, path) + TO_EXTERNAL_FORMAT (C_STRING, (path), C_STRING_ALLOCA, (path), Qfile_name); /***************** low-level calls ****************/ @@ -2569,12 +2639,12 @@ /* Ben sez: read Dick Gabriel's essay about the Worse Is Better approach to programming and its connection to the silly - interruptible-system-call business. To find it, look at - Jamie's home page (http://www.netscape.com/people/jwz). */ + interruptible-system-call business. To find it, look on + Jamie's home page (http://www.jwz.org/worse-is-better.html). */ #ifdef ENCAPSULATE_OPEN int -sys_open (CONST char *path, int oflag, ...) +sys_open (const char *path, int oflag, ...) { int mode; va_list ap; @@ -2583,11 +2653,12 @@ mode = va_arg (ap, int); va_end (ap); - PATHNAME_CONVERT_OUT (path); -#if defined (WINDOWSNT) +#ifdef WINDOWSNT /* Make all handles non-inheritable */ - return open (path, oflag | _O_NOINHERIT, mode); -#elif defined (INTERRUPTIBLE_OPEN) + oflag |= _O_NOINHERIT; +#endif + +#ifdef INTERRUPTIBLE_OPEN { int rtnval; while ((rtnval = open (path, oflag, mode)) == -1 @@ -2610,7 +2681,7 @@ is not interrupted by C-g. However, the worst that can happen is the fallback to simple open(). */ int -interruptible_open (CONST char *path, int oflag, int mode) +interruptible_open (const char *path, int oflag, int mode) { /* This function can GC */ size_t len = strlen (path); @@ -2622,6 +2693,11 @@ PATHNAME_CONVERT_OUT (nonreloc); +#ifdef WINDOWSNT + /* Make all handles non-inheritable */ + oflag |= _O_NOINHERIT; +#endif + for (;;) { int rtnval = open (nonreloc, oflag, mode); @@ -2634,13 +2710,13 @@ #ifdef ENCAPSULATE_CLOSE int -sys_close (int fd) +sys_close (int filedes) { #ifdef INTERRUPTIBLE_CLOSE int did_retry = 0; REGISTER int rtnval; - while ((rtnval = close (fd)) == -1 + while ((rtnval = close (filedes)) == -1 && (errno == EINTR)) did_retry = 1; @@ -2652,15 +2728,15 @@ return rtnval; #else - return close (fd); + return close (filedes); #endif } #endif /* ENCAPSULATE_CLOSE */ -int +ssize_t sys_read_1 (int fildes, void *buf, size_t nbyte, int allow_quit) { - int rtnval; + ssize_t rtnval; /* No harm in looping regardless of the INTERRUPTIBLE_IO setting. */ while ((rtnval = read (fildes, buf, nbyte)) == -1 @@ -2673,24 +2749,23 @@ } #ifdef ENCAPSULATE_READ -int +ssize_t sys_read (int fildes, void *buf, size_t nbyte) { return sys_read_1 (fildes, buf, nbyte, 0); } #endif /* ENCAPSULATE_READ */ -int -sys_write_1 (int fildes, CONST void *buf, size_t nbyte, int allow_quit) +ssize_t +sys_write_1 (int fildes, const void *buf, size_t nbyte, int allow_quit) { - int rtnval; - int bytes_written = 0; - CONST char *b = (CONST char *) buf; + ssize_t bytes_written = 0; + const char *b = (const char *) buf; /* No harm in looping regardless of the INTERRUPTIBLE_IO setting. */ while (nbyte > 0) { - rtnval = write (fildes, b, nbyte); + ssize_t rtnval = write (fildes, b, nbyte); if (allow_quit) REALLY_QUIT; @@ -2700,18 +2775,18 @@ if (errno == EINTR) continue; else - return (bytes_written ? bytes_written : -1); + return bytes_written ? bytes_written : -1; } b += rtnval; nbyte -= rtnval; bytes_written += rtnval; } - return (bytes_written); + return bytes_written; } #ifdef ENCAPSULATE_WRITE -int -sys_write (int fildes, CONST void *buf, size_t nbyte) +ssize_t +sys_write (int fildes, const void *buf, size_t nbyte) { return sys_write_1 (fildes, buf, nbyte, 0); } @@ -2729,7 +2804,7 @@ #ifdef ENCAPSULATE_FOPEN FILE * -sys_fopen (CONST char *path, CONST char *type) +sys_fopen (const char *path, const char *type) { PATHNAME_CONVERT_OUT (path); #if defined (WINDOWSNT) @@ -2839,12 +2914,12 @@ #ifdef ENCAPSULATE_FWRITE size_t -sys_fwrite (CONST void *ptr, size_t size, size_t nitem, FILE *stream) +sys_fwrite (const void *ptr, size_t size, size_t nitem, FILE *stream) { #ifdef INTERRUPTIBLE_IO size_t rtnval; size_t items_written = 0; - CONST char *b = (CONST char *) ptr; + const char *b = (const char *) ptr; while (nitem > 0) { @@ -2872,7 +2947,7 @@ #ifdef ENCAPSULATE_CHDIR int -sys_chdir (CONST char *path) +sys_chdir (const char *path) { PATHNAME_CONVERT_OUT (path); return chdir (path); @@ -2882,7 +2957,7 @@ #ifdef ENCAPSULATE_MKDIR int -sys_mkdir (CONST char *path, mode_t mode) +sys_mkdir (const char *path, mode_t mode) { PATHNAME_CONVERT_OUT (path); #ifdef WINDOWSNT @@ -2896,7 +2971,7 @@ #ifdef ENCAPSULATE_OPENDIR DIR * -sys_opendir (CONST char *filename) +sys_opendir (const char *filename) { DIR *rtnval; PATHNAME_CONVERT_OUT (filename); @@ -2928,7 +3003,7 @@ { Extcount external_len; int ascii_filename_p = 1; - CONST Extbyte * CONST external_name = (CONST Extbyte *) rtnval->d_name; + const Extbyte * const external_name = (const Extbyte *) rtnval->d_name; /* Optimize for the common all-ASCII case, computing len en passant */ for (external_len = 0; external_name[external_len] ; external_len++) @@ -2941,7 +3016,7 @@ { /* Non-ASCII filename */ static Bufbyte_dynarr *internal_DIRENTRY; - CONST Bufbyte *internal_name; + const Bufbyte *internal_name; Bytecount internal_len; if (!internal_DIRENTRY) internal_DIRENTRY = Dynarr_new (Bufbyte); @@ -2951,9 +3026,9 @@ Dynarr_add_many (internal_DIRENTRY, (Bufbyte *) rtnval, offsetof (DIRENTRY, d_name)); - internal_name = - convert_from_external_format (external_name, external_len, - &internal_len, FORMAT_FILENAME); + TO_INTERNAL_FORMAT (DATA, (external_name, external_len), + ALLOCA, (internal_name, internal_len), + Qfile_name); Dynarr_add_many (internal_DIRENTRY, internal_name, internal_len); Dynarr_add (internal_DIRENTRY, 0); /* zero-terminate */ @@ -2981,7 +3056,7 @@ #ifdef ENCAPSULATE_RMDIR int -sys_rmdir (CONST char *path) +sys_rmdir (const char *path) { PATHNAME_CONVERT_OUT (path); return rmdir (path); @@ -2993,7 +3068,7 @@ #ifdef ENCAPSULATE_ACCESS int -sys_access (CONST char *path, int mode) +sys_access (const char *path, int mode) { PATHNAME_CONVERT_OUT (path); return access (path, mode); @@ -3004,7 +3079,7 @@ #ifdef HAVE_EACCESS #ifdef ENCAPSULATE_EACCESS int -sys_eaccess (CONST char *path, int mode) +sys_eaccess (const char *path, int mode) { PATHNAME_CONVERT_OUT (path); return eaccess (path, mode); @@ -3015,7 +3090,7 @@ #ifdef ENCAPSULATE_LSTAT int -sys_lstat (CONST char *path, struct stat *buf) +sys_lstat (const char *path, struct stat *buf) { PATHNAME_CONVERT_OUT (path); return lstat (path, buf); @@ -3025,7 +3100,7 @@ #ifdef ENCAPSULATE_READLINK int -sys_readlink (CONST char *path, char *buf, size_t bufsiz) +sys_readlink (const char *path, char *buf, size_t bufsiz) { PATHNAME_CONVERT_OUT (path); /* #### currently we don't do conversions on the incoming data */ @@ -3034,9 +3109,18 @@ #endif /* ENCAPSULATE_READLINK */ +#ifdef ENCAPSULATE_FSTAT +int +sys_fstat (int fd, struct stat *buf) +{ + return fstat (fd, buf); +} +#endif /* ENCAPSULATE_FSTAT */ + + #ifdef ENCAPSULATE_STAT int -sys_stat (CONST char *path, struct stat *buf) +sys_stat (const char *path, struct stat *buf) { PATHNAME_CONVERT_OUT (path); return stat (path, buf); @@ -3048,7 +3132,7 @@ #ifdef ENCAPSULATE_CHMOD int -sys_chmod (CONST char *path, mode_t mode) +sys_chmod (const char *path, mode_t mode) { PATHNAME_CONVERT_OUT (path); return chmod (path, mode); @@ -3058,7 +3142,7 @@ #ifdef ENCAPSULATE_CREAT int -sys_creat (CONST char *path, mode_t mode) +sys_creat (const char *path, mode_t mode) { PATHNAME_CONVERT_OUT (path); return creat (path, mode); @@ -3068,7 +3152,7 @@ #ifdef ENCAPSULATE_LINK int -sys_link (CONST char *existing, CONST char *new) +sys_link (const char *existing, const char *new) { PATHNAME_CONVERT_OUT (existing); PATHNAME_CONVERT_OUT (new); @@ -3079,7 +3163,7 @@ #ifdef ENCAPSULATE_RENAME int -sys_rename (CONST char *old, CONST char *new) +sys_rename (const char *old, const char *new) { PATHNAME_CONVERT_OUT (old); PATHNAME_CONVERT_OUT (new); @@ -3098,7 +3182,7 @@ #ifdef ENCAPSULATE_SYMLINK int -sys_symlink (CONST char *name1, CONST char *name2) +sys_symlink (const char *name1, const char *name2) { PATHNAME_CONVERT_OUT (name1); PATHNAME_CONVERT_OUT (name2); @@ -3109,7 +3193,7 @@ #ifdef ENCAPSULATE_UNLINK int -sys_unlink (CONST char *path) +sys_unlink (const char *path) { PATHNAME_CONVERT_OUT (path); return unlink (path); @@ -3119,7 +3203,7 @@ #ifdef ENCAPSULATE_EXECVP int -sys_execvp (CONST char *path, char * CONST * argv) +sys_execvp (const char *path, char * const * argv) { int i, argc; char ** new_argv; @@ -3147,7 +3231,7 @@ #ifndef HAVE_GETCWD char * -getcwd (char *pathname, int size) +getcwd (char *pathname, size_t size) { return getwd (pathname); } @@ -3191,7 +3275,7 @@ #ifndef HAVE_RENAME int -rename (CONST char *from, CONST char *to) +rename (const char *from, const char *to) { if (access (from, 0) == 0) { @@ -3448,7 +3532,7 @@ #if !defined (SYS_SIGLIST_DECLARED) && !defined (HAVE_SYS_SIGLIST) #if defined(WINDOWSNT) || defined(__CYGWIN32__) -CONST char *sys_siglist[] = +const char *sys_siglist[] = { "bum signal!!", "hangup", @@ -3481,7 +3565,7 @@ #ifdef USG #ifdef AIX -CONST char *sys_siglist[NSIG + 1] = +const char *sys_siglist[NSIG + 1] = { /* AIX has changed the signals a bit */ DEFER_GETTEXT ("bogus signal"), /* 0 */ @@ -3521,7 +3605,7 @@ 0 }; #else /* USG, not AIX */ -CONST char *sys_siglist[NSIG + 1] = +const char *sys_siglist[NSIG + 1] = { DEFER_GETTEXT ("bogus signal"), /* 0 */ DEFER_GETTEXT ("hangup"), /* 1 SIGHUP */ @@ -3570,7 +3654,7 @@ #endif /* not AIX */ #endif /* USG */ #ifdef DGUX -CONST char *sys_siglist[NSIG + 1] = +const char *sys_siglist[NSIG + 1] = { DEFER_GETTEXT ("null signal"), /* 0 SIGNULL */ DEFER_GETTEXT ("hangup"), /* 1 SIGHUP */ @@ -3675,7 +3759,7 @@ #ifdef NONSYSTEM_DIR_LIBRARY DIR * -opendir (CONST char *filename) /* name of directory */ +opendir (const char *filename) /* name of directory */ { DIR *dirp; /* -> malloc'ed storage */ int fd; /* file descriptor for read */ @@ -3777,7 +3861,7 @@ MKDIR_PROTOTYPE #else int -mkdir (CONST char *dpath, int dmode) +mkdir (const char *dpath, int dmode) #endif { int cpid, status, fd; @@ -3837,7 +3921,7 @@ #ifndef HAVE_RMDIR int -rmdir (CONST char *dpath) +rmdir (const char *dpath) { int cpid, status, fd; struct stat statbuf; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/sysdep.h --- a/src/sysdep.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/sysdep.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,16 +20,14 @@ /* Synched up with: FSF 19.30. Split out of sysdep.c/emacs.c. */ -#ifndef _XEMACS_SYSDEP_H_ -#define _XEMACS_SYSDEP_H_ +#ifndef INCLUDED_sysdep_h_ +#define INCLUDED_sysdep_h_ #include <setjmp.h> +#ifndef WINDOWSNT extern char **environ; - -struct emacs_tty; -int emacs_get_tty (int fd, struct emacs_tty *settings); -int emacs_set_tty (int fd, struct emacs_tty *settings, int waitp); +#endif int eight_bit_tty (struct device *d); @@ -48,7 +46,12 @@ /* Wait for subprocess with process id `pid' to terminate and make sure it will get eliminated (not remain forever as a zombie) */ +#ifdef WINDOWSNT +#include <windows.h> +void wait_for_termination (HANDLE pid); +#else void wait_for_termination (int pid); +#endif /* flush any pending output * (may flush input as well; it does not matter the way we use it) @@ -78,10 +81,10 @@ extern JMP_BUF break_system_call_jump; extern volatile int can_break_system_calls; -int sys_write_1 (int fildes, CONST void *buf, size_t nbyte, - int allow_quit); -int sys_read_1 (int fildes, void *buf, size_t nbyte, - int allow_quit); +ssize_t sys_write_1 (int fildes, const void *buf, size_t nbyte, + int allow_quit); +ssize_t sys_read_1 (int fildes, void *buf, size_t nbyte, + int allow_quit); /* Call these functions if you want to change some terminal parameter -- reset the console, change the parameter, and init it again. */ @@ -142,11 +145,11 @@ void init_system_name (void); #ifndef HAVE_GETCWD -char *getcwd (char *pathname, int size); +char *getcwd (char *pathname, size_t size); #endif #ifndef HAVE_RENAME -int rename (CONST char *from, CONST char *to); +int rename (const char *from, const char *to); #endif #ifndef HAVE_DUP2 @@ -158,7 +161,7 @@ # ifdef strerror # undef strerror # endif -CONST char *strerror (int); +const char *strerror (int); #endif #ifdef WINDOWSNT @@ -166,7 +169,7 @@ void mswindows_set_last_errno (void); #endif -int interruptible_open (CONST char *path, int oflag, int mode); +int interruptible_open (const char *path, int oflag, int mode); #ifndef HAVE_H_ERRNO extern int h_errno; @@ -175,7 +178,7 @@ #ifdef HAVE_REALPATH #define xrealpath realpath #else -char *xrealpath(CONST char *path, char resolved_path []); +char *xrealpath(const char *path, char resolved_path []); #endif -#endif /* _XEMACS_SYSDEP_H_ */ +#endif /* INCLUDED_sysdep_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/sysdir.h --- a/src/sysdir.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/sysdir.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,6 +20,9 @@ /* Synched up with: Not really in FSF. */ +#ifndef INCLUDED_sysdir_h_ +#define INCLUDED_sysdir_h_ + #ifdef HAVE_UNISTD_H #include <unistd.h> #endif @@ -64,7 +67,7 @@ /* encapsulation: directory calls */ #ifdef ENCAPSULATE_CHDIR -int sys_chdir (CONST char *path); +int sys_chdir (const char *path); #endif #if defined (ENCAPSULATE_CHDIR) && !defined (DONT_ENCAPSULATE) # undef chdir @@ -75,7 +78,7 @@ #endif #ifdef ENCAPSULATE_MKDIR -int sys_mkdir (CONST char *path, mode_t mode); +int sys_mkdir (const char *path, mode_t mode); #endif #if defined (ENCAPSULATE_MKDIR) && !defined (DONT_ENCAPSULATE) # undef mkdir @@ -86,7 +89,7 @@ #endif #ifdef ENCAPSULATE_OPENDIR -DIR *sys_opendir (CONST char *filename); +DIR *sys_opendir (const char *filename); #endif #if defined (ENCAPSULATE_OPENDIR) && !defined (DONT_ENCAPSULATE) # undef opendir @@ -119,7 +122,7 @@ #endif #ifdef ENCAPSULATE_RMDIR -int sys_rmdir (CONST char *path); +int sys_rmdir (const char *path); #endif #if defined (ENCAPSULATE_RMDIR) && !defined (DONT_ENCAPSULATE) # undef rmdir @@ -129,3 +132,4 @@ # define sys_rmdir rmdir #endif +#endif /* INCLUDED_sysdir_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/sysdll.c --- a/src/sysdll.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/sysdll.c Mon Aug 13 11:13:30 2007 +0200 @@ -23,6 +23,7 @@ #include <config.h> #endif +#include <stdlib.h> #include "sysdll.h" /* This whole file is conditional upon HAVE_SHLIB */ @@ -48,13 +49,13 @@ #endif int -dll_init (CONST char *arg) +dll_init (const char *arg) { return 0; } dll_handle -dll_open (CONST char *fname) +dll_open (const char *fname) { return (dll_handle)dlopen (fname, RTLD_LAZY | RTLD_GLOBAL); } @@ -66,7 +67,7 @@ } dll_func -dll_function (dll_handle h, CONST char *n) +dll_function (dll_handle h, const char *n) { #ifdef DLSYM_NEEDS_UNDERSCORE char *buf = alloca_array (char, strlen (n) + 2); @@ -78,7 +79,7 @@ } dll_var -dll_variable (dll_handle h, CONST char *n) +dll_variable (dll_handle h, const char *n) { #ifdef DLSYM_NEEDS_UNDERSCORE char *buf = alloca_array (char, strlen (n) + 2); @@ -89,11 +90,11 @@ return (dll_var)dlsym ((void *)h, n); } -CONST char * +const char * dll_error (dll_handle h) { #if defined(HAVE_DLERROR) || defined(dlerror) - return (CONST char *)dlerror (); + return (const char *)dlerror (); #elif defined(HAVE__DLERROR) return (const char *)_dlerror(); #else @@ -105,13 +106,13 @@ /* This is the HP/UX version */ #include <dl.h> int -dll_init (CONST char *arg) +dll_init (const char *arg) { return 0; } dll_handle -dll_open (CONST char *fname) +dll_open (const char *fname) { shl_t h = shl_load (fname, BIND_DEFERRED,0L); shl_t *hp = NULL; @@ -136,7 +137,7 @@ } dll_func -dll_function (dll_handle h, CONST char *n) +dll_function (dll_handle h, const char *n) { long handle = 0L; @@ -147,7 +148,7 @@ } dll_var -dll_variable (dll_handle h, CONST char *n) +dll_variable (dll_handle h, const char *n) { long handle = 0L; @@ -157,7 +158,7 @@ return (dll_var)handle; } -CONST char * +const char * dll_error (dll_handle h) { /* #### WTF?! Shouldn't this at least attempt to get strerror or @@ -168,7 +169,7 @@ #elif defined(HAVE_INIT_DLD) #include <dld.h> int -dll_init (CONST char *arg) +dll_init (const char *arg) { char *real_exe = dld_find_executable (arg); int rc; @@ -183,7 +184,7 @@ } dll_handle -dll_open (CONST char *fname) +dll_open (const char *fname) { rc = dld_link (fname); if (rc) @@ -205,25 +206,25 @@ } DLL_FUNC -dll_function (dll_handle h, CONST char *n) +dll_function (dll_handle h, const char *n) { return dld_get_func(n); } DLL_FUNC -dll_variable (dll_handle h, CONST char *n) +dll_variable (dll_handle h, const char *n) { return dld_get_symbol(n); } #elif defined(_WINDOWS) || defined(WIN32) int -dll_init (CONST char *arg) +dll_init (const char *arg) { return 0; } dll_handle -dll_open (CONST char *fname) +dll_open (const char *fname) { return (dll_handle)LoadLibrary (fname); } @@ -235,18 +236,18 @@ } dll_func -dll_function (dll_handle h, CONST char *n) +dll_function (dll_handle h, const char *n) { return (dll_func)GetProcAddress (h,n); } dll_func -dll_variable (dll_handle h, CONST char *n) +dll_variable (dll_handle h, const char *n) { return (dll_func)GetProcAddress (h,n); } -CONST char * +const char * dll_error (dll_handle h) { return "Windows DLL Error"; @@ -254,13 +255,13 @@ #else /* Catchall if we don't know about this systems method of dynamic loading */ int -dll_init (CONST char *arg) +dll_init (const char *arg) { return -1; } dll_handle -dll_open (CONST char *fname) +dll_open (const char *fname) { return NULL; } @@ -272,18 +273,18 @@ } dll_func -dll_function (dll_handle h, CONST char *n) +dll_function (dll_handle h, const char *n) { return NULL; } dll_func -dll_variable (dll_handle h, CONST char *n) +dll_variable (dll_handle h, const char *n) { return NULL; } -CONST char * +const char * dll_error (dll_handle h) { return "Shared libraries not implemented on this system"; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/sysdll.h --- a/src/sysdll.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/sysdll.h Mon Aug 13 11:13:30 2007 +0200 @@ -19,8 +19,8 @@ Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -#ifndef _SYSDLL_H -#define _SYSDLL_H +#ifndef INCLUDED_sysdll_h_ +#define INCLUDED_sysdll_h_ #ifdef __cplusplus extern "C" { @@ -38,16 +38,16 @@ typedef void * dll_func; typedef void * dll_var; -int dll_init(CONST char *); +int dll_init(const char *); int dll_shutdown(void); -dll_handle dll_open(CONST char *); +dll_handle dll_open(const char *); int dll_close(dll_handle); -dll_func dll_function(dll_handle,CONST char *); -dll_var dll_variable(dll_handle,CONST char *); -CONST char *dll_error(dll_handle); +dll_func dll_function(dll_handle,const char *); +dll_var dll_variable(dll_handle,const char *); +const char *dll_error(dll_handle); #ifdef __cplusplus } #endif -#endif /* _SYSDLL_H */ +#endif /* INCLUDED_sysdll_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/sysfile.h --- a/src/sysfile.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/sysfile.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,6 +20,9 @@ /* Synched up with: Not really in FSF. */ +#ifndef INCLUDED_sysfile_h_ +#define INCLUDED_sysfile_h_ + #include <errno.h> #ifndef WINDOWSNT @@ -203,10 +206,6 @@ #define S_ISNWK(m) (((m) & S_IFMT) == S_IFNWK) #endif -#if !defined (USG) && !defined (WINDOWSNT) -# define HAVE_FSYNC -#endif - #ifndef MAXPATHLEN /* in 4.1, param.h fails to define this. */ #define MAXPATHLEN 1024 @@ -244,7 +243,7 @@ Other encapsulations are declared in the appropriate sys*.h file. */ #ifdef ENCAPSULATE_READ -int sys_read (int, void *, size_t); +ssize_t sys_read (int, void *, size_t); #endif #if defined (ENCAPSULATE_READ) && !defined (DONT_ENCAPSULATE) # undef read @@ -255,7 +254,7 @@ #endif #ifdef ENCAPSULATE_WRITE -int sys_write (int, CONST void *, size_t); +ssize_t sys_write (int, const void *, size_t); #endif #if defined (ENCAPSULATE_WRITE) && !defined (DONT_ENCAPSULATE) # undef write @@ -266,7 +265,7 @@ #endif #ifdef ENCAPSULATE_OPEN -int sys_open (CONST char *, int, ...); +int sys_open (const char *, int, ...); #endif #if defined (ENCAPSULATE_OPEN) && !defined (DONT_ENCAPSULATE) # undef open @@ -301,7 +300,7 @@ #endif #ifdef ENCAPSULATE_FWRITE -size_t sys_fwrite (CONST void *, size_t, size_t, FILE *); +size_t sys_fwrite (const void *, size_t, size_t, FILE *); #endif #if defined (ENCAPSULATE_FWRITE) && !defined (DONT_ENCAPSULATE) # undef fwrite @@ -312,7 +311,7 @@ #endif #ifdef ENCAPSULATE_FOPEN -FILE *sys_fopen (CONST char *, CONST char *); +FILE *sys_fopen (const char *, const char *); #endif #if defined (ENCAPSULATE_FOPEN) && !defined (DONT_ENCAPSULATE) # undef fopen @@ -337,7 +336,7 @@ /* encapsulations: file-information calls */ #ifdef ENCAPSULATE_ACCESS -int sys_access (CONST char *path, int mode); +int sys_access (const char *path, int mode); #endif #if defined (ENCAPSULATE_ACCESS) && !defined (DONT_ENCAPSULATE) # undef access @@ -348,7 +347,7 @@ #endif #ifdef ENCAPSULATE_EACCESS -int sys_eaccess (CONST char *path, int mode); +int sys_eaccess (const char *path, int mode); #endif #if defined (ENCAPSULATE_EACCESS) && !defined (DONT_ENCAPSULATE) # undef eaccess @@ -359,7 +358,7 @@ #endif #ifdef ENCAPSULATE_LSTAT -int sys_lstat (CONST char *path, struct stat *buf); +int sys_lstat (const char *path, struct stat *buf); #endif #if defined (ENCAPSULATE_LSTAT) && !defined (DONT_ENCAPSULATE) # undef lstat @@ -370,7 +369,7 @@ #endif #ifdef ENCAPSULATE_READLINK -int sys_readlink (CONST char *path, char *buf, size_t bufsiz); +int sys_readlink (const char *path, char *buf, size_t bufsiz); #endif #if defined (ENCAPSULATE_READLINK) && !defined (DONT_ENCAPSULATE) # undef readlink @@ -380,8 +379,20 @@ # define sys_readlink readlink #endif +#ifdef ENCAPSULATE_FSTAT +int sys_fstat (int fd, struct stat *buf); +#endif +#if defined (ENCAPSULATE_FSTAT) && !defined (DONT_ENCAPSULATE) +# undef fstat +/* Need to use arguments to avoid messing with struct stat */ +# define fstat(fd, buf) sys_fstat (fd, buf) +#endif +#if !defined (ENCAPSULATE_FSTAT) && defined (DONT_ENCAPSULATE) +# define sys_fstat fstat +#endif + #ifdef ENCAPSULATE_STAT -int sys_stat (CONST char *path, struct stat *buf); +int sys_stat (const char *path, struct stat *buf); #endif #if defined (ENCAPSULATE_STAT) && !defined (DONT_ENCAPSULATE) # undef stat @@ -395,7 +406,7 @@ /* encapsulations: file-manipulation calls */ #ifdef ENCAPSULATE_CHMOD -int sys_chmod (CONST char *path, mode_t mode); +int sys_chmod (const char *path, mode_t mode); #endif #if defined (ENCAPSULATE_CHMOD) && !defined (DONT_ENCAPSULATE) # undef chmod @@ -406,7 +417,7 @@ #endif #ifdef ENCAPSULATE_CREAT -int sys_creat (CONST char *path, mode_t mode); +int sys_creat (const char *path, mode_t mode); #endif #if defined (ENCAPSULATE_CREAT) && !defined (DONT_ENCAPSULATE) # undef creat @@ -417,7 +428,7 @@ #endif #ifdef ENCAPSULATE_LINK -int sys_link (CONST char *existing, CONST char *new); +int sys_link (const char *existing, const char *new); #endif #if defined (ENCAPSULATE_LINK) && !defined (DONT_ENCAPSULATE) # undef link @@ -428,7 +439,7 @@ #endif #ifdef ENCAPSULATE_RENAME -int sys_rename (CONST char *old, CONST char *new); +int sys_rename (const char *old, const char *new); #endif #if defined (ENCAPSULATE_RENAME) && !defined (DONT_ENCAPSULATE) # undef rename @@ -439,7 +450,7 @@ #endif #ifdef ENCAPSULATE_SYMLINK -int sys_symlink (CONST char *name1, CONST char *name2); +int sys_symlink (const char *name1, const char *name2); #endif #if defined (ENCAPSULATE_SYMLINK) && !defined (DONT_ENCAPSULATE) # undef symlink @@ -450,7 +461,7 @@ #endif #ifdef ENCAPSULATE_UNLINK -int sys_unlink (CONST char *path); +int sys_unlink (const char *path); #endif #if defined (ENCAPSULATE_UNLINK) && !defined (DONT_ENCAPSULATE) # undef unlink @@ -461,7 +472,7 @@ #endif #ifdef ENCAPSULATE_EXECVP -int sys_execvp (CONST char *, char * CONST *); +int sys_execvp (const char *, char * const *); #endif #if defined (ENCAPSULATE_EXECVP) && !defined (DONT_ENCAPSULATE) # undef execvp @@ -470,3 +481,5 @@ #if !defined (ENCAPSULATE_EXECVP) && defined (DONT_ENCAPSULATE) # define sys_execvp execvp #endif + +#endif /* INCLUDED_sysfile_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/sysfloat.h --- a/src/sysfloat.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/sysfloat.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,6 +20,9 @@ /* Synched up with: Not really in FSF. */ +#ifndef INCLUDED_sysfloat_h_ +#define INCLUDED_sysfloat_h_ + /* Work around a problem that happens because math.h on hpux 7 defines two static variables--which, in Emacs, are not really static, because `static' is defined as nothing. The problem is that they are @@ -86,3 +89,4 @@ # define isnan(x) ((x) != (x)) #endif +#endif /* INCLUDED_sysfloat_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/sysproc.h --- a/src/sysproc.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/sysproc.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,6 +20,9 @@ /* Synched up with: Not really in FSF. */ +#ifndef INCLUDED_sysproc_h_ +#define INCLUDED_sysproc_h_ + #ifdef HAVE_VFORK_H # include <vfork.h> #endif @@ -103,3 +106,5 @@ /* Damn that local process.h! Instead we can define P_WAIT ourselves. */ #define P_WAIT 1 #endif + +#endif /* INCLUDED_sysproc_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/syssignal.h --- a/src/syssignal.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/syssignal.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,8 +20,8 @@ /* Synched up with: FSF 19.30. */ -#ifndef _XEMACS_SYSSIGNAL_H_ -#define _XEMACS_SYSSIGNAL_H_ +#ifndef INCLUDED_syssignal_h_ +#define INCLUDED_syssignal_h_ /* In the old world, one could not #include <signal.h> here. The party line was that that header should always be #included before <config.h>, because @@ -213,7 +213,7 @@ #define EMACS_KILLPG(gid, signo) killpg (gid, signo) #else #ifdef WINDOWSNT -#define EMACS_KILLPG(gid, signo) (kill (gid, signo)) +#define EMACS_KILLPG(gid, signo) kill (gid, signo) #else #define EMACS_KILLPG(gid, signo) kill (-(gid), signo) #endif @@ -227,14 +227,14 @@ configure incorrectly fails to find it, so s/linux.h defines HAVE_SYS_SIGLIST. */ #if !defined (SYS_SIGLIST_DECLARED) && !defined (HAVE_SYS_SIGLIST) -extern CONST char *sys_siglist[]; +extern const char *sys_siglist[]; #endif #ifdef SIGDANGER SIGTYPE memory_warning_signal (int sig); #endif -#ifdef _WIN32 +#ifdef WINDOWSNT /* Prototypes for signal functions, see nt.c */ typedef void (__cdecl *msw_sighandler) (int); msw_sighandler msw_sigset (int sig, msw_sighandler handler); @@ -244,4 +244,4 @@ int msw_raise (int nsig); #endif /* _WIN32 */ -#endif /* _XEMACS_SYSSIGNAL_H_ */ +#endif /* INCLUDED_syssignal_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/systime.h --- a/src/systime.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/systime.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,8 +20,8 @@ /* Synched up with: FSF 19.30. */ -#ifndef _XEMACS_SYSTIME_H_ -#define _XEMACS_SYSTIME_H_ +#ifndef INCLUDED_systime_h_ +#define INCLUDED_systime_h_ #ifdef TIME_WITH_SYS_TIME #include <sys/time.h> @@ -51,7 +51,7 @@ # include <utime.h> #endif -#ifdef HAVE_TZNAME +#if defined(HAVE_TZNAME) && !defined(WINDOWSNT) && !defined(__CYGWIN32__) #ifndef tzname /* For SGI. */ extern char *tzname[]; /* RS6000 and others want it this way. */ #endif @@ -147,37 +147,23 @@ #define EMACS_SET_USECS(time, microseconds) ((time).tv_usec = (microseconds)) #if !defined (HAVE_GETTIMEOFDAY) -struct timezone; -int gettimeofday (struct timeval *, struct timezone *); +int gettimeofday (struct timeval *, void *); #endif /* On SVR4, the compiler may complain if given this extra BSD arg. */ #ifdef GETTIMEOFDAY_ONE_ARGUMENT -# ifdef SOLARIS2 -/* Solaris (at least) omits this prototype. IRIX5 has it and chokes if we - declare it here. */ -int gettimeofday (struct timeval *); -# endif +#define EMACS_GETTIMEOFDAY(time) gettimeofday(time) +#else +#define EMACS_GETTIMEOFDAY(time) gettimeofday(time,0) +#endif + /* According to the Xt sources, some NTP daemons on some systems may return non-normalized values. */ #define EMACS_GET_TIME(time) \ do { \ - gettimeofday (&(time)); \ + EMACS_GETTIMEOFDAY (&(time)); \ EMACS_NORMALIZE_TIME (time); \ } while (0) -#else /* not GETTIMEOFDAY_ONE_ARGUMENT */ -# ifdef SOLARIS2 -/* Solaris doesn't provide any prototype of this unless a bunch of - crap we don't define are defined. */ -int gettimeofday (struct timeval *, void *dummy); -# endif -#define EMACS_GET_TIME(time) \ -do { \ - struct timezone dummy; \ - gettimeofday (&(time), &dummy); \ - EMACS_NORMALIZE_TIME (time); \ -} while (0) -#endif /* not GETTIMEOFDAY_ONE_ARGUMENT */ #define EMACS_NORMALIZE_TIME(time) \ do { \ @@ -231,7 +217,7 @@ void get_process_times (double *user_time, double *system_time, double *real_time); -#if defined(WINDOWSNT) || defined(BROKEN_CYGWIN) +#if defined(WINDOWSNT) || defined(BROKEN_CYGWIN) || defined(__MINGW32__) /* setitimer emulation for Win32 (see nt.c) */ @@ -249,4 +235,4 @@ #endif /* WINDOWSNT */ -#endif /* _XEMACS_SYSTIME_H_ */ +#endif /* INCLUDED_systime_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/systty.h --- a/src/systty.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/systty.h Mon Aug 13 11:13:30 2007 +0200 @@ -20,8 +20,8 @@ /* Synched up with: FSF 19.30. */ -#ifndef _XEMACS_SYSTTY_H_ -#define _XEMACS_SYSTTY_H_ +#ifndef INCLUDED_systty_h_ +#define INCLUDED_systty_h_ #ifdef HAVE_TERMIOS # define HAVE_TCATTR @@ -181,10 +181,6 @@ /* ----------------------------------------------------- */ -#ifdef APOLLO -#undef TIOCSTART -#endif - #if defined (XENIX) || defined (BROKEN_TIOCGETC) #undef TIOCGETC /* Avoid confusing some conditionals that test this. */ #endif @@ -337,6 +333,8 @@ No big loss -- it just means that ^Z won't work right if we're run from sh. */ # define EMACS_SET_PROCESS_GROUP(pg) +#elif defined(__MINGW32__) +# define EMACS_SEPARATE_PROCESS_GROUP() #else /* Under NeXTstep, a process group of 0 is not the same as specifying your own process ID, so we go ahead and specify it explicitly. */ @@ -356,11 +354,11 @@ emacs_tty should contain an element for each parameter struct that Emacs may change. - EMACS_GET_TTY (int FD, struct emacs_tty *P) stores the parameters + emacs_get_tty (int FD, struct emacs_tty *P) stores the parameters of the tty on FD in *P. Return zero if all's well, or -1 if we ran into an error we couldn't deal with. - EMACS_SET_TTY (int FD, struct emacs_tty *P, int flushp) + emacs_set_tty (int FD, struct emacs_tty *P, int flushp) sets the parameters of the tty on FD according to the contents of *P. If flushp is non-zero, we discard queued input to be written before making the change. @@ -407,15 +405,9 @@ #endif /* HAVE_TCHARS */ #endif /* HAVE_TERMIOS */ }; - -/* Define EMACS_GET_TTY and EMACS_SET_TTY, - the macros for reading and setting parts of `struct emacs_tty'. - These got pretty unmanageable (huge macros are hard to debug), and - finally needed some code which couldn't be done as part of an - expression, so we moved them out to their own functions in sysdep.c. */ -#define EMACS_GET_TTY(fd, p) emacs_get_tty (fd, p) -#define EMACS_SET_TTY(fd, p, waitp) emacs_set_tty (fd, p, waitp) +int emacs_get_tty (int fd, struct emacs_tty *settings); +int emacs_set_tty (int fd, struct emacs_tty *settings, int flushp); /* --------------------------------------------------------- */ @@ -445,4 +437,4 @@ #endif /* not def HAVE_TERMIO */ #endif /* not def HAVE_TERMIOS */ -#endif /* _XEMACS_SYSTTY_H_ */ +#endif /* INCLUDED_systty_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/syswait.h --- a/src/syswait.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/syswait.h Mon Aug 13 11:13:30 2007 +0200 @@ -19,7 +19,8 @@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -/* Cleanup by Martin Buchholz for Autoconf 2 (see the Autoconf Manual) */ +#ifndef INCLUDED_syswait_h_ +#define INCLUDED_syswait_h_ #include <sys/types.h> @@ -52,3 +53,4 @@ #define WRETCODE(s) ((s) >> 8) #endif +#endif /* INCLUDED_syswait_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/termcap.c --- a/src/termcap.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/termcap.c Mon Aug 13 11:13:30 2007 +0200 @@ -26,18 +26,9 @@ #include "lisp.h" /* For encapsulated open, close, read */ #include "device.h" /* For DEVICE_BAUD_RATE */ #else /* not emacs */ -#if defined(USG) || defined(STDC_HEADERS) -#define memcpy(d, s, n) memcpy ((d), (s), (n)) -#endif -#ifdef STDC_HEADERS #include <stdlib.h> #include <string.h> -#else -char *getenv (); -char *malloc (); -char *realloc (); -#endif #ifdef HAVE_UNISTD_H #include <unistd.h> @@ -103,16 +94,16 @@ for tgetnum, tgetflag and tgetstr to find. */ static char *term_entry; -static CONST char *tgetst1 (CONST char *ptr, char **area); +static const char *tgetst1 (const char *ptr, char **area); /* Search entry BP for capability CAP. Return a pointer to the capability (in BP) if found, 0 if not found. */ -static CONST char * +static const char * find_capability (bp, cap) - CONST char *bp; - CONST char *cap; + const char *bp; + const char *cap; { for (; *bp; bp++) if (bp[0] == ':' @@ -124,9 +115,9 @@ int tgetnum (cap) - CONST char *cap; + const char *cap; { - CONST char *ptr = find_capability (term_entry, cap); + const char *ptr = find_capability (term_entry, cap); if (!ptr || ptr[-1] != '#') return -1; return atoi (ptr); @@ -134,9 +125,9 @@ int tgetflag (cap) - CONST char *cap; + const char *cap; { - CONST char *ptr = find_capability (term_entry, cap); + const char *ptr = find_capability (term_entry, cap); return 0 != ptr && ptr[-1] == ':'; } @@ -145,12 +136,12 @@ to store the string. That pointer is advanced over the space used. If AREA is zero, space is allocated with `malloc'. */ -CONST char * +const char * tgetstr (cap, area) - CONST char *cap; + const char *cap; char **area; { - CONST char *ptr = find_capability (term_entry, cap); + const char *ptr = find_capability (term_entry, cap); if (!ptr || (ptr[-1] != '=' && ptr[-1] != '~')) return 0; return tgetst1 (ptr, area); @@ -171,12 +162,12 @@ into the block that *AREA points to, or to newly allocated storage if AREA is 0. */ -static CONST char * +static const char * tgetst1 (ptr, area) - CONST char *ptr; + const char *ptr; char **area; { - CONST char *p; + const char *p; char *r; int c; int size; @@ -259,7 +250,7 @@ void tputs (string, nlines, outfun) - CONST char *string; + const char *string; int nlines; void (*outfun) (int); { @@ -278,7 +269,7 @@ if (string == (char *) 0) return; - while (isdigit (* (CONST unsigned char *) string)) + while (isdigit (* (const unsigned char *) string)) { padcount += *string++ - '0'; padcount *= 10; @@ -337,23 +328,21 @@ If BP is zero, space is dynamically allocated. */ -extern char *getenv (); - int tgetent (bp, name) char *bp; - CONST char *name; + const char *name; { char *tem; int fd; struct buffer buf; char *bp1; char *bp2; - CONST char *term; + const char *term; int malloc_size = 0; int c; char *tcenv; /* TERMCAP value, if it contais :tc=. */ - CONST char *indirect = 0; /* Terminal type in :tc= in TERMCAP value. */ + const char *indirect = 0; /* Terminal type in :tc= in TERMCAP value. */ tem = getenv ("TERMCAP"); if (tem && *tem == 0) tem = 0; @@ -365,7 +354,7 @@ it is the entry itself, but only if the name the caller requested matches the TERM variable. */ - if (tem && !IS_DIRECTORY_SEP (*tem) && !strcmp (name, (char *) getenv ("TERM"))) + if (tem && !IS_DIRECTORY_SEP (*tem) && !strcmp (name, getenv ("TERM"))) { indirect = tgetst1 (find_capability (tem, "tc"), 0); if (!indirect) @@ -648,7 +637,7 @@ } tprint (cap) - CONST char *cap; + const char *cap; { char *x = tgetstr (cap, 0); char *y; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/terminfo.c --- a/src/terminfo.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/terminfo.c Mon Aug 13 11:13:30 2007 +0200 @@ -65,14 +65,14 @@ extern void *xmalloc (int size); #if 0 /* If this isn't declared somewhere, too bad */ -extern char * tparm (CONST char *string, int arg1, int arg2, int arg3, +extern char * tparm (const char *string, int arg1, int arg2, int arg3, int arg4, int arg5, int arg6, int arg7, int arg8, int arg9); #endif /* XEmacs: renamed this function because just tparam() conflicts with ncurses (We don't use this function anyway!) */ char * -emacs_tparam (CONST char *string, char *outstring, int len, int arg1, +emacs_tparam (const char *string, char *outstring, int len, int arg1, int arg2, int arg3, int arg4, int arg5, int arg6, int arg7, int arg8, int arg9) { @@ -81,7 +81,7 @@ temp = (char *) tparm (string, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9); if (outstring == 0) - outstring = ((char *) (xmalloc ((strlen (temp)) + 1))); + outstring = (char *) xmalloc (strlen (temp) + 1); strcpy (outstring, temp); return outstring; } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/tests.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/tests.c Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,436 @@ +/* C support for testing XEmacs - see tests/automated/c-tests.el + Copyright (C) 2000 Martin Buchholz + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Author: Martin Buchholz + + This file provides support for running tests for XEmacs that cannot + be written entirely in Lisp. These tests are run automatically via + tests/automated/c-tests.el, or can be run by hand using M-x */ + + +#include <config.h> +#include "lisp.h" +#include "buffer.h" +#include "lstream.h" +#include "opaque.h" + +static Lisp_Object Vtest_function_list; + + +DEFUN ("test-data-format-conversion", Ftest_data_format_conversion, 0, 0, "", /* +Test TO_EXTERNAL_FORMAT() and TO_INTERNAL_FORMAT() +*/ + ()) +{ + void *ptr; size_t len; + Lisp_Object string, opaque; + + Bufbyte int_foo[] = "\n\nfoo\nbar"; + Extbyte ext_unix[]= "\n\nfoo\nbar"; + + Extbyte ext_dos[] = "\r\n\r\nfoo\r\nbar"; + Extbyte ext_mac[] = "\r\rfoo\rbar"; + Lisp_Object opaque_dos = make_opaque (ext_dos, sizeof (ext_dos) - 1); + Lisp_Object string_foo = make_string (int_foo, sizeof (int_foo) - 1); + + Extbyte ext_latin[] = "f\372b\343\340"; + Bufbyte int_latin1[] = "f\201\372b\201\343\201\340"; + Bufbyte int_latin2[] = "f\202\372b\202\343\202\340"; +#ifdef MULE + Extbyte ext_latin12[]= "f\033-A\372b\343\340\033-B"; + Extbyte ext_tilde[] = "f~b~~"; + Lisp_Object string_latin2 = make_string (int_latin2, sizeof (int_latin2) - 1); +#endif + Lisp_Object opaque_latin = make_opaque (ext_latin, sizeof (ext_latin) - 1); + Lisp_Object opaque0_latin = make_opaque (ext_latin, sizeof (ext_latin)); + Lisp_Object string_latin1 = make_string (int_latin1, sizeof (int_latin1) - 1); + + /* Check for expected strings before and after conversion. + Conversions depend on whether MULE is defined, + and on whether FILE_CODING is defined. */ +#ifdef MULE +#define DFC_CHECK_DATA_COND_MULE(ptr,len, \ + constant_string_mule, \ + constant_string_non_mule) \ + DFC_CHECK_DATA (ptr, len, constant_string_mule) +#define DFC_CHECK_DATA_COND_MULE_NUL(ptr,len, \ + constant_string_mule, \ + constant_string_non_mule) \ + DFC_CHECK_DATA_NUL (ptr, len, constant_string_mule) +#else +#define DFC_CHECK_DATA_COND_MULE(ptr,len, \ + constant_string_mule, \ + constant_string_non_mule) \ + DFC_CHECK_DATA (ptr, len, constant_string_non_mule) +#define DFC_CHECK_DATA_COND_MULE_NUL(ptr,len, \ + constant_string_mule, \ + constant_string_non_mule) \ + DFC_CHECK_DATA_NUL (ptr, len, constant_string_non_mule) +#endif + +#ifdef FILE_CODING +#define DFC_CHECK_DATA_COND_EOL(ptr,len, \ + constant_string_eol, \ + constant_string_non_eol) \ + DFC_CHECK_DATA (ptr, len, constant_string_eol) +#define DFC_CHECK_DATA_COND_EOL_NUL(ptr,len, \ + constant_string_eol, \ + constant_string_non_eol) \ + DFC_CHECK_DATA_NUL (ptr, len, constant_string_eol) +#else +#define DFC_CHECK_DATA_COND_EOL(ptr,len, \ + constant_string_eol, \ + constant_string_non_eol) \ + DFC_CHECK_DATA (ptr, len, constant_string_non_eol) +#define DFC_CHECK_DATA_COND_EOL_NUL(ptr,len, \ + constant_string_eol, \ + constant_string_non_eol) \ + DFC_CHECK_DATA_NUL (ptr, len, constant_string_non_eol) +#endif + + /* Check for expected strings before and after conversion. */ +#define DFC_CHECK_DATA(ptr,len, constant_string) do { \ + assert ((len) == sizeof (constant_string) - 1); \ + assert (!memcmp (ptr, constant_string, len)); \ + } while (0) + + /* Macro version that includes the trailing NULL byte. */ +#define DFC_CHECK_DATA_NUL(ptr,len,constant_string) do {\ + assert ((len) == sizeof (constant_string)); \ + assert (!memcmp (ptr, constant_string, len)); \ + } while (0) + +#ifdef MULE + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2)), + ALLOCA, (ptr, len), + Fget_coding_system (intern ("iso-8859-2"))); + DFC_CHECK_DATA_NUL (ptr, len, ext_latin); + + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (LISP_STRING, string_latin2, + ALLOCA, (ptr, len), + Fget_coding_system (intern ("iso-8859-2"))); + DFC_CHECK_DATA (ptr, len, ext_latin); + + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (LISP_STRING, string_latin1, + ALLOCA, (ptr, len), + Fget_coding_system (intern ("iso-8859-2"))); + DFC_CHECK_DATA (ptr, len, ext_latin12); + + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2) - 1), + MALLOC, (ptr, len), + Fget_coding_system (intern ("iso-8859-2"))); + DFC_CHECK_DATA (ptr, len, ext_latin); + xfree (ptr); + + TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2) - 1), + LISP_OPAQUE, opaque, + Fget_coding_system (intern ("iso-8859-2"))); + DFC_CHECK_DATA (XOPAQUE_DATA (opaque), XOPAQUE_SIZE (opaque), ext_latin); + + ptr = NULL, len = rand(); + TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin) - 1), + ALLOCA, (ptr, len), + intern ("iso-8859-2")); + DFC_CHECK_DATA (ptr, len, int_latin2); + + ptr = NULL, len = rand(); + TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin) - 1), + MALLOC, (ptr, len), + intern ("iso-8859-2")); + DFC_CHECK_DATA (ptr, len, int_latin2); + xfree (ptr); + + TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin) - 1), + LISP_STRING, string, + intern ("iso-8859-2")); + DFC_CHECK_DATA (XSTRING_DATA (string), XSTRING_LENGTH (string), int_latin2); + + TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_latin, + LISP_STRING, string, + intern ("iso-8859-2")); + DFC_CHECK_DATA (XSTRING_DATA (string), XSTRING_LENGTH (string), int_latin2); + + TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque0_latin, + LISP_STRING, string, + intern ("iso-8859-2")); + DFC_CHECK_DATA_NUL (XSTRING_DATA (string), XSTRING_LENGTH (string), int_latin2); + + TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque0_latin, + LISP_BUFFER, Fcurrent_buffer(), + intern ("iso-8859-2")); + DFC_CHECK_DATA_NUL (BUF_BYTE_ADDRESS (current_buffer, BUF_PT (current_buffer)), + sizeof (int_latin2), int_latin2); + + TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_latin, + LISP_BUFFER, Fcurrent_buffer(), + intern ("iso-8859-1")); + DFC_CHECK_DATA (BUF_BYTE_ADDRESS (current_buffer, BUF_PT (current_buffer)), + sizeof (int_latin1) - 1, int_latin1); + + TO_INTERNAL_FORMAT (DATA, (ext_latin12, sizeof (ext_latin12) - 1), + ALLOCA, (ptr, len), + intern ("iso-8859-2")); + DFC_CHECK_DATA (ptr, len, int_latin1); + +#endif /* MULE */ + + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1), + ALLOCA, (ptr, len), + Qbinary); + DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1); + + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1)), + ALLOCA, (ptr, len), + Qbinary); + DFC_CHECK_DATA_COND_MULE_NUL (ptr, len, ext_latin, int_latin1); + + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2) - 1), + ALLOCA, (ptr, len), + Fget_coding_system (Qbinary)); + DFC_CHECK_DATA_COND_MULE (ptr, len, ext_tilde, int_latin2); + + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1), + ALLOCA, (ptr, len), + intern ("iso-8859-1")); + DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1); + + + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (LISP_STRING, string_latin1, + ALLOCA, (ptr, len), + Qbinary); + DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1); + + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (LISP_STRING, string_latin1, + ALLOCA, (ptr, len), + Fget_coding_system (Qbinary)); + DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1); + + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (LISP_STRING, string_latin1, + ALLOCA, (ptr, len), + intern ("iso-8859-1")); + DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1); + + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1), + MALLOC, (ptr, len), + Qbinary); + DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1); + xfree (ptr); + + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2)), + MALLOC, (ptr, len), + Fget_coding_system (Qbinary)); + DFC_CHECK_DATA_COND_MULE_NUL (ptr, len, ext_tilde, int_latin2); + xfree (ptr); + + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1), + MALLOC, (ptr, len), + intern ("iso-8859-1")); + DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1); + xfree (ptr); + + TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1), + LISP_OPAQUE, opaque, + Qbinary); + DFC_CHECK_DATA_COND_MULE (XOPAQUE_DATA (opaque), + XOPAQUE_SIZE (opaque), ext_latin, int_latin1); + + TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2)), + LISP_OPAQUE, opaque, + Fget_coding_system (Qbinary)); + DFC_CHECK_DATA_COND_MULE_NUL (XOPAQUE_DATA (opaque), + XOPAQUE_SIZE (opaque), ext_tilde, int_latin2); + + TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1), + LISP_OPAQUE, opaque, + intern ("iso-8859-1")); + DFC_CHECK_DATA_COND_MULE (XOPAQUE_DATA (opaque), + XOPAQUE_SIZE (opaque), ext_latin, int_latin1); + + ptr = NULL, len = rand(); + TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin) - 1), + ALLOCA, (ptr, len), + Qbinary); + DFC_CHECK_DATA_COND_MULE (ptr, len, int_latin1, ext_latin); + + ptr = NULL, len = rand(); + TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin)), + ALLOCA, (ptr, len), + intern ("iso-8859-1")); + DFC_CHECK_DATA_COND_MULE_NUL (ptr, len, int_latin1, ext_latin); + + ptr = NULL, len = rand(); + TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin)), + MALLOC, (ptr, len), + intern ("iso-8859-1")); + DFC_CHECK_DATA_COND_MULE_NUL (ptr, len, int_latin1, ext_latin); + xfree (ptr); + + ptr = NULL, len = rand(); + TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin)), + MALLOC, (ptr, len), + Qnil); + DFC_CHECK_DATA_COND_MULE_NUL (ptr, len, int_latin1, ext_latin); + xfree (ptr); + + TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin) - 1), + LISP_STRING, string, + intern ("iso-8859-1")); + DFC_CHECK_DATA_COND_MULE (XSTRING_DATA (string), + XSTRING_LENGTH (string), int_latin1, ext_latin); + + TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_latin, + LISP_STRING, string, + intern ("iso-8859-1")); + DFC_CHECK_DATA_COND_MULE (XSTRING_DATA (string), + XSTRING_LENGTH (string), int_latin1, ext_latin); + + TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque0_latin, + LISP_STRING, string, + intern ("iso-8859-1")); + DFC_CHECK_DATA_COND_MULE_NUL (XSTRING_DATA (string), + XSTRING_LENGTH (string), int_latin1, ext_latin); + + + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (DATA, (int_foo, sizeof (int_foo)), + MALLOC, (ptr, len), + Fget_coding_system (Qbinary)); + DFC_CHECK_DATA_COND_EOL_NUL (ptr, len, ext_unix, int_foo); + xfree (ptr); + + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (DATA, (int_foo, sizeof (int_foo) - 1), + LISP_OPAQUE, opaque, + intern ("raw-text-mac")); + DFC_CHECK_DATA_COND_EOL (XOPAQUE_DATA (opaque), + XOPAQUE_SIZE (opaque), ext_mac, int_foo); + + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (LISP_STRING, string_foo, + ALLOCA, (ptr, len), + intern ("raw-text-dos")); + DFC_CHECK_DATA_COND_EOL (ptr, len, ext_dos, int_foo); + + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (DATA, (int_foo, sizeof (int_foo) - 1), + ALLOCA, (ptr, len), + intern ("raw-text-unix")); + DFC_CHECK_DATA_COND_EOL (ptr, len, ext_unix, int_foo); + + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (LISP_STRING, string_foo, + MALLOC, (ptr, len), + intern ("no-conversion-mac")); + DFC_CHECK_DATA_COND_EOL (ptr, len, ext_mac, int_foo); + xfree (ptr); + + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (DATA, (int_foo, sizeof (int_foo) - 1), + ALLOCA, (ptr, len), + Fget_coding_system (intern ("no-conversion-dos"))); + DFC_CHECK_DATA_COND_EOL (ptr, len, ext_dos, int_foo); + + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (DATA, (int_foo, sizeof (int_foo)), + ALLOCA, (ptr, len), + intern ("no-conversion-unix")); + DFC_CHECK_DATA_COND_EOL_NUL (ptr, len, ext_unix, int_foo); + +#ifdef FILE_CODING + TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_dos, + LISP_BUFFER, Fcurrent_buffer(), + intern ("undecided")); + DFC_CHECK_DATA (BUF_BYTE_ADDRESS (current_buffer, BUF_PT (current_buffer)), + sizeof (int_foo) - 1, int_foo); + +#endif /* FILE_CODING */ + + TO_INTERNAL_FORMAT (DATA, (ext_mac, sizeof (ext_mac) - 1), + LISP_STRING, string, + intern ("iso-8859-1")); + DFC_CHECK_DATA_COND_EOL (XSTRING_DATA (string), + XSTRING_LENGTH (string), int_foo, ext_mac); + + { + Lisp_Object stream = + make_fixed_buffer_input_stream (ext_dos, sizeof (ext_dos) - 1); + TO_INTERNAL_FORMAT (LISP_LSTREAM, stream, + LISP_STRING, string, + intern ("iso-8859-1")); + DFC_CHECK_DATA_COND_EOL (XSTRING_DATA (string), + XSTRING_LENGTH (string), int_foo, ext_dos); + } + + TO_INTERNAL_FORMAT (DATA, (ext_unix, sizeof (ext_unix) - 1), + LISP_STRING, string, + intern ("no-conversion")); + DFC_CHECK_DATA_COND_EOL (XSTRING_DATA (string), + XSTRING_LENGTH (string), int_foo, ext_unix); + + + ptr = NULL, len = rand(); + TO_EXTERNAL_FORMAT (LISP_OPAQUE, opaque_dos, + ALLOCA, (ptr, len), + Qbinary); + DFC_CHECK_DATA (ptr, len, ext_dos); + + return intern ("PASS"); +} + + + +#define TESTS_DEFSUBR(Fname) do { \ + DEFSUBR (Fname); \ + Vtest_function_list = \ + Fcons (intern (subr_name (&S##Fname)), \ + Vtest_function_list); \ +} while (0) + +void +syms_of_tests (void) +{ + Vtest_function_list = Qnil; + + TESTS_DEFSUBR (Ftest_data_format_conversion); + /* Add other test functions here with TESTS_DEFSUBR */ +} + +void +vars_of_tests (void) +{ + DEFVAR_LISP ("test-function-list", &Vtest_function_list /* +List of all test functions defined in tests.c. +For use by the automated test suite. See tests/automated/c-tests. +*/ ); +} diff -r f4aeb21a5bad -r 74fd4e045ea6 src/toolbar-msw.c --- a/src/toolbar-msw.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/toolbar-msw.c Mon Aug 13 11:13:30 2007 +0200 @@ -59,6 +59,9 @@ #define MSWINDOWS_BLANK_SIZE 5 #define MSWINDOWS_MINIMUM_TOOLBAR_SIZE 8 +static void +mswindows_move_toolbar (struct frame *f, enum toolbar_pos pos); + #define SET_TOOLBAR_WAS_VISIBLE_FLAG(frame, pos, flag) \ do { \ switch (pos) \ @@ -205,10 +208,11 @@ { struct toolbar_button *tb = XTOOLBAR_BUTTON (button); - checksum = HASH4 (checksum, + checksum = HASH5 (checksum, internal_hash (get_toolbar_button_glyph(w, tb), 0), internal_hash (tb->callback, 0), - width); + width, + LISP_HASH (w->toolbar_buttons_captioned_p)); button = tb->next; nbuttons++; } @@ -258,7 +262,7 @@ if (IMAGE_INSTANCEP (instance)) { - struct Lisp_Image_Instance* p = XIMAGE_INSTANCE (instance); + Lisp_Image_Instance* p = XIMAGE_INSTANCE (instance); if (IMAGE_INSTANCE_PIXMAP_TYPE_P (p)) { @@ -459,6 +463,9 @@ /* now display the window */ ShowWindow (toolbarwnd, SW_SHOW); + /* no idea why this is necessary but initial display will not + happen otherwise. */ + mswindows_move_toolbar (f, pos); if (button_tbl) xfree (button_tbl); @@ -524,6 +531,13 @@ } static void +mswindows_redraw_frame_toolbars (struct frame *f) +{ + mswindows_redraw_exposed_toolbars (f, 0, 0, FRAME_PIXWIDTH (f), + FRAME_PIXHEIGHT (f)); +} + +static void mswindows_initialize_frame_toolbars (struct frame *f) { @@ -572,7 +586,7 @@ } /* map toolbar hwnd to pos*/ -int mswindows_find_toolbar_pos(struct frame* f, HWND ctrl) +static int mswindows_find_toolbar_pos(struct frame* f, HWND ctrl) { int id = GetDlgCtrlID(ctrl); return id ? id - TOOLBAR_ID_BIAS : -1; @@ -635,5 +649,6 @@ CONSOLE_HAS_METHOD (mswindows, initialize_frame_toolbars); CONSOLE_HAS_METHOD (mswindows, free_frame_toolbars); CONSOLE_HAS_METHOD (mswindows, redraw_exposed_toolbars); + CONSOLE_HAS_METHOD (mswindows, redraw_frame_toolbars); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/toolbar-x.c --- a/src/toolbar-x.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/toolbar-x.c Mon Aug 13 11:13:30 2007 +0200 @@ -77,7 +77,8 @@ /* Draw the outline. */ x_output_shadows (f, sx, sy, swidth, sheight, top_shadow_gc, - bottom_shadow_gc, background_gc, shadow_thickness); + bottom_shadow_gc, background_gc, shadow_thickness, + EDGE_ALL); /* Blank the middle. */ XFillRectangle (dpy, x_win, background_gc, sx + shadow_thickness, @@ -108,7 +109,7 @@ GC top_shadow_gc, bottom_shadow_gc, background_gc; Lisp_Object instance, frame, window, glyph; struct toolbar_button *tb = XTOOLBAR_BUTTON (button); - struct Lisp_Image_Instance *p; + Lisp_Image_Instance *p; struct window *w; int vertical = tb->vertical; int border_width = tb->border_width; @@ -158,7 +159,8 @@ x_output_shadows (f, tb->x + x_adj, tb->y + y_adj, tb->width + width_adj, tb->height + height_adj, top_shadow_gc, - bottom_shadow_gc, background_gc, shadow_thickness); + bottom_shadow_gc, background_gc, shadow_thickness, + EDGE_ALL); /* Clear the pixmap area. */ XFillRectangle (dpy, x_win, background_gc, tb->x + x_adj + shadow_thickness, @@ -211,8 +213,8 @@ } x_output_x_pixmap (f, XIMAGE_INSTANCE (instance), tb->x + x_offset, - tb->y + y_offset, 0, 0, 0, 0, width, height, - 0, 0, 0, background_gc); + tb->y + y_offset, 0, 0, width, height, + 0, 0, background_gc); } else if (IMAGE_INSTANCE_TYPE (p) == IMAGE_TEXT) { @@ -294,9 +296,9 @@ return XINT (f->toolbar_size[pos]); if (vert) - size = glyph_height (glyph, Vdefault_face, 0, window); + size = glyph_height (glyph, window); else - size = glyph_width (glyph, Vdefault_face, 0, window); + size = glyph_width (glyph, window); } if (!size) diff -r f4aeb21a5bad -r 74fd4e045ea6 src/toolbar.c --- a/src/toolbar.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/toolbar.c Mon Aug 13 11:13:30 2007 +0200 @@ -57,19 +57,19 @@ static Lisp_Object -mark_toolbar_button (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_toolbar_button (Lisp_Object obj) { struct toolbar_button *data = XTOOLBAR_BUTTON (obj); - markobj (data->next); - markobj (data->frame); - markobj (data->up_glyph); - markobj (data->down_glyph); - markobj (data->disabled_glyph); - markobj (data->cap_up_glyph); - markobj (data->cap_down_glyph); - markobj (data->cap_disabled_glyph); - markobj (data->callback); - markobj (data->enabled_p); + mark_object (data->next); + mark_object (data->frame); + mark_object (data->up_glyph); + mark_object (data->down_glyph); + mark_object (data->disabled_glyph); + mark_object (data->cap_up_glyph); + mark_object (data->cap_down_glyph); + mark_object (data->cap_disabled_glyph); + mark_object (data->callback); + mark_object (data->enabled_p); return data->help_string; } @@ -90,7 +90,7 @@ DEFINE_LRECORD_IMPLEMENTATION ("toolbar-button", toolbar_button, mark_toolbar_button, print_toolbar_button, - 0, 0, 0, + 0, 0, 0, 0, struct toolbar_button); DEFUN ("toolbar-button-p", Ftoolbar_button_p, 1, 1, 0, /* @@ -303,7 +303,7 @@ if (!tb) { - tb = alloc_lcrecord_type (struct toolbar_button, lrecord_toolbar_button); + tb = alloc_lcrecord_type (struct toolbar_button, &lrecord_toolbar_button); tb->next = Qnil; XSETFRAME (tb->frame, f); tb->up_glyph = Qnil; @@ -1312,6 +1312,12 @@ } void +reinit_specifier_type_create_toolbar (void) +{ + REINITIALIZE_SPECIFIER_TYPE (toolbar); +} + +void specifier_vars_of_toolbar (void) { Lisp_Object fb; @@ -1428,8 +1434,7 @@ automatically knew about specifier fallbacks, so we didn't have to do it ourselves. */ set_specifier_caching (Vdefault_toolbar, - slot_offset (struct window, - default_toolbar), + offsetof (struct window, default_toolbar), default_toolbar_specs_changed, 0, 0); @@ -1441,8 +1446,7 @@ */ ); Vtoolbar[TOP_TOOLBAR] = Fmake_specifier (Qtoolbar); set_specifier_caching (Vtoolbar[TOP_TOOLBAR], - slot_offset (struct window, - toolbar[TOP_TOOLBAR]), + offsetof (struct window, toolbar[TOP_TOOLBAR]), toolbar_specs_changed, 0, 0); @@ -1459,8 +1463,7 @@ */ ); Vtoolbar[BOTTOM_TOOLBAR] = Fmake_specifier (Qtoolbar); set_specifier_caching (Vtoolbar[BOTTOM_TOOLBAR], - slot_offset (struct window, - toolbar[BOTTOM_TOOLBAR]), + offsetof (struct window, toolbar[BOTTOM_TOOLBAR]), toolbar_specs_changed, 0, 0); @@ -1477,8 +1480,7 @@ */ ); Vtoolbar[LEFT_TOOLBAR] = Fmake_specifier (Qtoolbar); set_specifier_caching (Vtoolbar[LEFT_TOOLBAR], - slot_offset (struct window, - toolbar[LEFT_TOOLBAR]), + offsetof (struct window, toolbar[LEFT_TOOLBAR]), toolbar_specs_changed, 0, 0); @@ -1495,8 +1497,7 @@ */ ); Vtoolbar[RIGHT_TOOLBAR] = Fmake_specifier (Qtoolbar); set_specifier_caching (Vtoolbar[RIGHT_TOOLBAR], - slot_offset (struct window, - toolbar[RIGHT_TOOLBAR]), + offsetof (struct window, toolbar[RIGHT_TOOLBAR]), toolbar_specs_changed, 0, 0); @@ -1550,11 +1551,9 @@ */ ); Vdefault_toolbar_height = Fmake_specifier (Qnatnum); set_specifier_caching (Vdefault_toolbar_height, - slot_offset (struct window, - default_toolbar_height), + offsetof (struct window, default_toolbar_height), default_toolbar_size_changed_in_window, - slot_offset (struct frame, - default_toolbar_height), + offsetof (struct frame, default_toolbar_height), default_toolbar_size_changed_in_frame); DEFVAR_SPECIFIER ("default-toolbar-width", &Vdefault_toolbar_width /* @@ -1565,11 +1564,9 @@ */ ); Vdefault_toolbar_width = Fmake_specifier (Qnatnum); set_specifier_caching (Vdefault_toolbar_width, - slot_offset (struct window, - default_toolbar_width), + offsetof (struct window, default_toolbar_width), default_toolbar_size_changed_in_window, - slot_offset (struct frame, - default_toolbar_width), + offsetof (struct frame, default_toolbar_width), default_toolbar_size_changed_in_frame); DEFVAR_SPECIFIER ("top-toolbar-height", @@ -1581,11 +1578,9 @@ */ ); Vtoolbar_size[TOP_TOOLBAR] = Fmake_specifier (Qnatnum); set_specifier_caching (Vtoolbar_size[TOP_TOOLBAR], - slot_offset (struct window, - toolbar_size[TOP_TOOLBAR]), + offsetof (struct window, toolbar_size[TOP_TOOLBAR]), toolbar_geometry_changed_in_window, - slot_offset (struct frame, - toolbar_size[TOP_TOOLBAR]), + offsetof (struct frame, toolbar_size[TOP_TOOLBAR]), frame_size_slipped); DEFVAR_SPECIFIER ("bottom-toolbar-height", @@ -1597,11 +1592,9 @@ */ ); Vtoolbar_size[BOTTOM_TOOLBAR] = Fmake_specifier (Qnatnum); set_specifier_caching (Vtoolbar_size[BOTTOM_TOOLBAR], - slot_offset (struct window, - toolbar_size[BOTTOM_TOOLBAR]), + offsetof (struct window, toolbar_size[BOTTOM_TOOLBAR]), toolbar_geometry_changed_in_window, - slot_offset (struct frame, - toolbar_size[BOTTOM_TOOLBAR]), + offsetof (struct frame, toolbar_size[BOTTOM_TOOLBAR]), frame_size_slipped); DEFVAR_SPECIFIER ("left-toolbar-width", @@ -1613,11 +1606,9 @@ */ ); Vtoolbar_size[LEFT_TOOLBAR] = Fmake_specifier (Qnatnum); set_specifier_caching (Vtoolbar_size[LEFT_TOOLBAR], - slot_offset (struct window, - toolbar_size[LEFT_TOOLBAR]), + offsetof (struct window, toolbar_size[LEFT_TOOLBAR]), toolbar_geometry_changed_in_window, - slot_offset (struct frame, - toolbar_size[LEFT_TOOLBAR]), + offsetof (struct frame, toolbar_size[LEFT_TOOLBAR]), frame_size_slipped); DEFVAR_SPECIFIER ("right-toolbar-width", @@ -1629,11 +1620,9 @@ */ ); Vtoolbar_size[RIGHT_TOOLBAR] = Fmake_specifier (Qnatnum); set_specifier_caching (Vtoolbar_size[RIGHT_TOOLBAR], - slot_offset (struct window, - toolbar_size[RIGHT_TOOLBAR]), + offsetof (struct window, toolbar_size[RIGHT_TOOLBAR]), toolbar_geometry_changed_in_window, - slot_offset (struct frame, - toolbar_size[RIGHT_TOOLBAR]), + offsetof (struct frame, toolbar_size[RIGHT_TOOLBAR]), frame_size_slipped); fb = Qnil; @@ -1694,11 +1683,9 @@ */ ); Vdefault_toolbar_border_width = Fmake_specifier (Qnatnum); set_specifier_caching (Vdefault_toolbar_border_width, - slot_offset (struct window, - default_toolbar_border_width), + offsetof (struct window, default_toolbar_border_width), default_toolbar_border_width_changed_in_window, - slot_offset (struct frame, - default_toolbar_border_width), + offsetof (struct frame, default_toolbar_border_width), default_toolbar_border_width_changed_in_frame); DEFVAR_SPECIFIER ("top-toolbar-border-width", @@ -1710,11 +1697,11 @@ */ ); Vtoolbar_border_width[TOP_TOOLBAR] = Fmake_specifier (Qnatnum); set_specifier_caching (Vtoolbar_border_width[TOP_TOOLBAR], - slot_offset (struct window, - toolbar_border_width[TOP_TOOLBAR]), + offsetof (struct window, + toolbar_border_width[TOP_TOOLBAR]), toolbar_geometry_changed_in_window, - slot_offset (struct frame, - toolbar_border_width[TOP_TOOLBAR]), + offsetof (struct frame, + toolbar_border_width[TOP_TOOLBAR]), frame_size_slipped); DEFVAR_SPECIFIER ("bottom-toolbar-border-width", @@ -1726,11 +1713,11 @@ */ ); Vtoolbar_border_width[BOTTOM_TOOLBAR] = Fmake_specifier (Qnatnum); set_specifier_caching (Vtoolbar_border_width[BOTTOM_TOOLBAR], - slot_offset (struct window, - toolbar_border_width[BOTTOM_TOOLBAR]), + offsetof (struct window, + toolbar_border_width[BOTTOM_TOOLBAR]), toolbar_geometry_changed_in_window, - slot_offset (struct frame, - toolbar_border_width[BOTTOM_TOOLBAR]), + offsetof (struct frame, + toolbar_border_width[BOTTOM_TOOLBAR]), frame_size_slipped); DEFVAR_SPECIFIER ("left-toolbar-border-width", @@ -1742,11 +1729,11 @@ */ ); Vtoolbar_border_width[LEFT_TOOLBAR] = Fmake_specifier (Qnatnum); set_specifier_caching (Vtoolbar_border_width[LEFT_TOOLBAR], - slot_offset (struct window, - toolbar_border_width[LEFT_TOOLBAR]), + offsetof (struct window, + toolbar_border_width[LEFT_TOOLBAR]), toolbar_geometry_changed_in_window, - slot_offset (struct frame, - toolbar_border_width[LEFT_TOOLBAR]), + offsetof (struct frame, + toolbar_border_width[LEFT_TOOLBAR]), frame_size_slipped); DEFVAR_SPECIFIER ("right-toolbar-border-width", @@ -1758,11 +1745,11 @@ */ ); Vtoolbar_border_width[RIGHT_TOOLBAR] = Fmake_specifier (Qnatnum); set_specifier_caching (Vtoolbar_border_width[RIGHT_TOOLBAR], - slot_offset (struct window, - toolbar_border_width[RIGHT_TOOLBAR]), + offsetof (struct window, + toolbar_border_width[RIGHT_TOOLBAR]), toolbar_geometry_changed_in_window, - slot_offset (struct frame, - toolbar_border_width[RIGHT_TOOLBAR]), + offsetof (struct frame, + toolbar_border_width[RIGHT_TOOLBAR]), frame_size_slipped); fb = Qnil; @@ -1806,11 +1793,9 @@ */ ); Vdefault_toolbar_visible_p = Fmake_specifier (Qboolean); set_specifier_caching (Vdefault_toolbar_visible_p, - slot_offset (struct window, - default_toolbar_visible_p), + offsetof (struct window, default_toolbar_visible_p), default_toolbar_visible_p_changed_in_window, - slot_offset (struct frame, - default_toolbar_visible_p), + offsetof (struct frame, default_toolbar_visible_p), default_toolbar_visible_p_changed_in_frame); DEFVAR_SPECIFIER ("top-toolbar-visible-p", @@ -1822,11 +1807,11 @@ */ ); Vtoolbar_visible_p[TOP_TOOLBAR] = Fmake_specifier (Qboolean); set_specifier_caching (Vtoolbar_visible_p[TOP_TOOLBAR], - slot_offset (struct window, - toolbar_visible_p[TOP_TOOLBAR]), + offsetof (struct window, + toolbar_visible_p[TOP_TOOLBAR]), toolbar_geometry_changed_in_window, - slot_offset (struct frame, - toolbar_visible_p[TOP_TOOLBAR]), + offsetof (struct frame, + toolbar_visible_p[TOP_TOOLBAR]), frame_size_slipped); DEFVAR_SPECIFIER ("bottom-toolbar-visible-p", @@ -1838,11 +1823,11 @@ */ ); Vtoolbar_visible_p[BOTTOM_TOOLBAR] = Fmake_specifier (Qboolean); set_specifier_caching (Vtoolbar_visible_p[BOTTOM_TOOLBAR], - slot_offset (struct window, - toolbar_visible_p[BOTTOM_TOOLBAR]), + offsetof (struct window, + toolbar_visible_p[BOTTOM_TOOLBAR]), toolbar_geometry_changed_in_window, - slot_offset (struct frame, - toolbar_visible_p[BOTTOM_TOOLBAR]), + offsetof (struct frame, + toolbar_visible_p[BOTTOM_TOOLBAR]), frame_size_slipped); DEFVAR_SPECIFIER ("left-toolbar-visible-p", @@ -1854,11 +1839,11 @@ */ ); Vtoolbar_visible_p[LEFT_TOOLBAR] = Fmake_specifier (Qboolean); set_specifier_caching (Vtoolbar_visible_p[LEFT_TOOLBAR], - slot_offset (struct window, - toolbar_visible_p[LEFT_TOOLBAR]), + offsetof (struct window, + toolbar_visible_p[LEFT_TOOLBAR]), toolbar_geometry_changed_in_window, - slot_offset (struct frame, - toolbar_visible_p[LEFT_TOOLBAR]), + offsetof (struct frame, + toolbar_visible_p[LEFT_TOOLBAR]), frame_size_slipped); DEFVAR_SPECIFIER ("right-toolbar-visible-p", @@ -1870,11 +1855,11 @@ */ ); Vtoolbar_visible_p[RIGHT_TOOLBAR] = Fmake_specifier (Qboolean); set_specifier_caching (Vtoolbar_visible_p[RIGHT_TOOLBAR], - slot_offset (struct window, - toolbar_visible_p[RIGHT_TOOLBAR]), + offsetof (struct window, + toolbar_visible_p[RIGHT_TOOLBAR]), toolbar_geometry_changed_in_window, - slot_offset (struct frame, - toolbar_visible_p[RIGHT_TOOLBAR]), + offsetof (struct frame, + toolbar_visible_p[RIGHT_TOOLBAR]), frame_size_slipped); /* initially, top inherits from default; this can be @@ -1896,8 +1881,7 @@ */ ); Vtoolbar_buttons_captioned_p = Fmake_specifier (Qboolean); set_specifier_caching (Vtoolbar_buttons_captioned_p, - slot_offset (struct window, - toolbar_buttons_captioned_p), + offsetof (struct window, toolbar_buttons_captioned_p), toolbar_buttons_captioned_p_changed, 0, 0); set_specifier_fallback (Vtoolbar_buttons_captioned_p, diff -r f4aeb21a5bad -r 74fd4e045ea6 src/toolbar.h --- a/src/toolbar.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/toolbar.h Mon Aug 13 11:13:30 2007 +0200 @@ -22,8 +22,8 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_TOOLBAR_H_ -#define _XEMACS_TOOLBAR_H_ +#ifndef INCLUDED_toolbar_h_ +#define INCLUDED_toolbar_h_ #ifdef HAVE_TOOLBARS @@ -34,7 +34,7 @@ #define FRAME_CURRENT_TOOLBAR_SIZE(frame, pos) \ ((frame)->current_toolbar_size[pos]) #define DEVICE_SUPPORTS_TOOLBARS_P(d) \ - (HAS_DEVMETH_P ((d), output_frame_toolbars)) + HAS_DEVMETH_P (d, output_frame_toolbars) struct toolbar_button { @@ -73,7 +73,6 @@ #define XTOOLBAR_BUTTON(x) XRECORD (x, toolbar_button, struct toolbar_button) #define XSETTOOLBAR_BUTTON(x, p) XSETRECORD (x, p, toolbar_button) #define TOOLBAR_BUTTONP(x) RECORDP (x, toolbar_button) -#define GC_TOOLBAR_BUTTONP(x) GC_RECORDP (x, toolbar_button) #define CHECK_TOOLBAR_BUTTON(x) CHECK_RECORD (x, toolbar_button) #define CONCHECK_TOOLBAR_BUTTON(x) CONCHECK_RECORD (x, toolbar_button) @@ -111,4 +110,4 @@ #endif /* HAVE_TOOLBARS */ -#endif /* _XEMACS_TOOLBAR_H_ */ +#endif /* INCLUDED_toolbar_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/tooltalk.c --- a/src/tooltalk.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/tooltalk.c Mon Aug 13 11:13:30 2007 +0200 @@ -22,7 +22,7 @@ /* Synched up with: Not in FSF. */ /* Written by John Rose <john.rose@eng.sun.com>. - Heavily modified and cleaned up by Ben Wing <ben.wing@eng.sun.com>. */ + Heavily modified and cleaned up by Ben Wing <ben@xemacs.org>. */ #include <config.h> #include "lisp.h" @@ -151,9 +151,9 @@ }; static Lisp_Object -mark_tooltalk_message (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_tooltalk_message (Lisp_Object obj) { - markobj (XTOOLTALK_MESSAGE (obj)->callback); + mark_object (XTOOLTALK_MESSAGE (obj)->callback); return XTOOLTALK_MESSAGE (obj)->plist_sym; } @@ -161,7 +161,7 @@ print_tooltalk_message (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { - struct Lisp_Tooltalk_Message *p = XTOOLTALK_MESSAGE (obj); + Lisp_Tooltalk_Message *p = XTOOLTALK_MESSAGE (obj); char buf[200]; @@ -175,16 +175,15 @@ DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-message", tooltalk_message, mark_tooltalk_message, print_tooltalk_message, - 0, 0, 0, - struct Lisp_Tooltalk_Message); + 0, 0, 0, 0, + Lisp_Tooltalk_Message); static Lisp_Object make_tooltalk_message (Tt_message m) { Lisp_Object val; - struct Lisp_Tooltalk_Message *msg = - alloc_lcrecord_type (struct Lisp_Tooltalk_Message, - lrecord_tooltalk_message); + Lisp_Tooltalk_Message *msg = + alloc_lcrecord_type (Lisp_Tooltalk_Message, &lrecord_tooltalk_message); msg->m = m; msg->callback = Qnil; @@ -225,9 +224,9 @@ }; static Lisp_Object -mark_tooltalk_pattern (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_tooltalk_pattern (Lisp_Object obj) { - markobj (XTOOLTALK_PATTERN (obj)->callback); + mark_object (XTOOLTALK_PATTERN (obj)->callback); return XTOOLTALK_PATTERN (obj)->plist_sym; } @@ -235,7 +234,7 @@ print_tooltalk_pattern (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { - struct Lisp_Tooltalk_Pattern *p = XTOOLTALK_PATTERN (obj); + Lisp_Tooltalk_Pattern *p = XTOOLTALK_PATTERN (obj); char buf[200]; @@ -249,15 +248,14 @@ DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-pattern", tooltalk_pattern, mark_tooltalk_pattern, print_tooltalk_pattern, - 0, 0, 0, - struct Lisp_Tooltalk_Pattern); + 0, 0, 0, 0, + Lisp_Tooltalk_Pattern); static Lisp_Object make_tooltalk_pattern (Tt_pattern p) { - struct Lisp_Tooltalk_Pattern *pat = - alloc_lcrecord_type (struct Lisp_Tooltalk_Pattern, - lrecord_tooltalk_pattern); + Lisp_Tooltalk_Pattern *pat = + alloc_lcrecord_type (Lisp_Tooltalk_Pattern, &lrecord_tooltalk_pattern); Lisp_Object val; pat->p = p; @@ -502,7 +500,7 @@ static Lisp_Object tt_build_string (char *s) { - return build_string ((s) ? s : ""); + return build_string (s ? s : ""); } static Lisp_Object @@ -702,8 +700,10 @@ { Tt_message m = unbox_tooltalk_message (message_); int n = 0; + Tt_status (*fun_str) (Tt_message, const char *) = 0; CHECK_SYMBOL (attribute); + if (EQ (attribute, (Qtt_arg_bval)) || EQ (attribute, (Qtt_arg_ival)) || EQ (attribute, (Qtt_arg_val))) @@ -715,7 +715,7 @@ if (!VALID_TOOLTALK_MESSAGEP (m)) return Qnil; - else if (EQ (attribute, Qtt_address)) + if (EQ (attribute, Qtt_address)) { CHECK_TOOLTALK_CONSTANT (value); tt_message_address_set (m, (Tt_address) tooltalk_constant_value (value)); @@ -731,73 +731,37 @@ tt_message_disposition_set (m, ((Tt_disposition) tooltalk_constant_value (value))); } - else if (EQ (attribute, Qtt_file)) - { - CONST char *value_ext; - CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); - tt_message_file_set (m, value_ext); - } - else if (EQ (attribute, Qtt_handler_ptype)) - { - CONST char *value_ext; - CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); - tt_message_handler_ptype_set (m, value_ext); - } - else if (EQ (attribute, Qtt_handler)) - { - CONST char *value_ext; - CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); - tt_message_handler_set (m, value_ext); - } - else if (EQ (attribute, Qtt_object)) - { - CONST char *value_ext; - CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); - tt_message_object_set (m, value_ext); - } - else if (EQ (attribute, Qtt_op)) - { - CONST char *value_ext; - CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); - tt_message_op_set (m, value_ext); - } - else if (EQ (attribute, Qtt_otype)) - { - CONST char *value_ext; - CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); - tt_message_otype_set (m, value_ext); - } else if (EQ (attribute, Qtt_scope)) { CHECK_TOOLTALK_CONSTANT (value); tt_message_scope_set (m, (Tt_scope) tooltalk_constant_value (value)); } + else if (EQ (attribute, Qtt_file)) + fun_str = tt_message_file_set; + else if (EQ (attribute, Qtt_handler_ptype)) + fun_str = tt_message_handler_ptype_set; + else if (EQ (attribute, Qtt_handler)) + fun_str = tt_message_handler_set; + else if (EQ (attribute, Qtt_object)) + fun_str = tt_message_object_set; + else if (EQ (attribute, Qtt_op)) + fun_str = tt_message_op_set; + else if (EQ (attribute, Qtt_otype)) + fun_str = tt_message_otype_set; else if (EQ (attribute, Qtt_sender_ptype)) - { - CONST char *value_ext; - CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); - tt_message_sender_ptype_set (m, value_ext); - } + fun_str = tt_message_sender_ptype_set; else if (EQ (attribute, Qtt_session)) - { - CONST char *value_ext; - CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); - tt_message_session_set (m, value_ext); - } + fun_str = tt_message_session_set; + else if (EQ (attribute, Qtt_status_string)) + fun_str = tt_message_status_string_set; else if (EQ (attribute, Qtt_arg_bval)) { Extbyte *value_ext; Extcount value_ext_len; CHECK_STRING (value); - GET_STRING_OS_DATA_ALLOCA (value, value_ext, value_ext_len); + TO_EXTERNAL_FORMAT (LISP_STRING, value, + ALLOCA, (value_ext, value_ext_len), + Qnative); tt_message_arg_bval_set (m, n, value_ext, value_ext_len); } else if (EQ (attribute, Qtt_arg_ival)) @@ -807,9 +771,9 @@ } else if (EQ (attribute, Qtt_arg_val)) { - CONST char *value_ext; + const char *value_ext; CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); tt_message_arg_val_set (m, n, value_ext); } else if (EQ (attribute, Qtt_status)) @@ -817,13 +781,6 @@ CHECK_INT (value); tt_message_status_set (m, XINT (value)); } - else if (EQ (attribute, Qtt_status_string)) - { - CONST char *value_ext; - CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); - tt_message_status_string_set (m, value_ext); - } else if (EQ (attribute, Qtt_callback)) { CHECK_SYMBOL (value); @@ -836,6 +793,15 @@ else signal_simple_error ("Invalid value for `set-tooltalk-message-attribute'", attribute); + + if (fun_str) + { + const char *value_ext; + CHECK_STRING (value); + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); + (*fun_str) (m, value_ext); + } + return Qnil; } @@ -946,15 +912,15 @@ if (!VALID_TOOLTALK_MESSAGEP (m)) return Qnil; { - CONST char *vtype_ext; + const char *vtype_ext; - GET_C_STRING_OS_DATA_ALLOCA (vtype, vtype_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, vtype, C_STRING_ALLOCA, vtype_ext, Qnative); if (NILP (value)) tt_message_arg_add (m, n, vtype_ext, NULL); else if (STRINGP (value)) { - CONST char *value_ext; - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); + const char *value_ext; + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); tt_message_arg_add (m, n, vtype_ext, value_ext); } else if (INTP (value)) @@ -1057,30 +1023,30 @@ } else if (EQ (attribute, Qtt_file)) { - CONST char *value_ext; + const char *value_ext; CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); tt_pattern_file_add (p, value_ext); } else if (EQ (attribute, Qtt_object)) { - CONST char *value_ext; + const char *value_ext; CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); tt_pattern_object_add (p, value_ext); } else if (EQ (attribute, Qtt_op)) { - CONST char *value_ext; + const char *value_ext; CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); tt_pattern_op_add (p, value_ext); } else if (EQ (attribute, Qtt_otype)) { - CONST char *value_ext; + const char *value_ext; CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); tt_pattern_otype_add (p, value_ext); } else if (EQ (attribute, Qtt_scope)) @@ -1090,23 +1056,23 @@ } else if (EQ (attribute, Qtt_sender)) { - CONST char *value_ext; + const char *value_ext; CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); tt_pattern_sender_add (p, value_ext); } else if (EQ (attribute, Qtt_sender_ptype)) { - CONST char *value_ext; + const char *value_ext; CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); tt_pattern_sender_ptype_add (p, value_ext); } else if (EQ (attribute, Qtt_session)) { - CONST char *value_ext; + const char *value_ext; CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); tt_pattern_session_add (p, value_ext); } else if (EQ (attribute, Qtt_state)) @@ -1145,15 +1111,15 @@ return Qnil; { - CONST char *vtype_ext; + const char *vtype_ext; - GET_C_STRING_OS_DATA_ALLOCA (vtype, vtype_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, vtype, C_STRING_ALLOCA, vtype_ext, Qnative); if (NILP (value)) tt_pattern_arg_add (p, n, vtype_ext, NULL); else if (STRINGP (value)) { - CONST char *value_ext; - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); + const char *value_ext; + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); tt_pattern_arg_add (p, n, vtype_ext, value_ext); } else if (INTP (value)) @@ -1256,7 +1222,28 @@ Lisp_Object lp; Lisp_Object fil; + + /* tt_open() messes with our signal handler flags (at least when no + ttsessions is running on the machine), therefore we save the + actions and restore them after the call */ +#ifdef HAVE_SIGPROCMASK + { + struct sigaction ActSIGQUIT; + struct sigaction ActSIGINT; + struct sigaction ActSIGCHLD; + sigaction (SIGQUIT, NULL, &ActSIGQUIT); + sigaction (SIGINT, NULL, &ActSIGINT); + sigaction (SIGCHLD, NULL, &ActSIGCHLD); +#endif retval = tt_open (); +#ifdef HAVE_SIGPROCMASK + sigaction (SIGQUIT, &ActSIGQUIT, NULL); + sigaction (SIGINT, &ActSIGINT, NULL); + sigaction (SIGCHLD, &ActSIGCHLD, NULL); + } +#endif + + if (tt_ptr_error (retval) != TT_OK) return; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/tooltalk.h --- a/src/tooltalk.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/tooltalk.h Mon Aug 13 11:13:30 2007 +0200 @@ -22,24 +22,22 @@ /* Synched up with: Not in FSF. */ -#ifndef _XEMACS_TOOLTALK_H_ -#define _XEMACS_TOOLTALK_H_ +#ifndef INCLUDED_tooltalk_h_ +#define INCLUDED_tooltalk_h_ #include TT_C_H_PATH -struct Lisp_Tooltalk_Message; -DECLARE_LRECORD (tooltalk_message, struct Lisp_Tooltalk_Message); -#define XTOOLTALK_MESSAGE(x) XRECORD (x, tooltalk_message, struct Lisp_Tooltalk_Message) +typedef struct Lisp_Tooltalk_Message Lisp_Tooltalk_Message; +DECLARE_LRECORD (tooltalk_message, Lisp_Tooltalk_Message); +#define XTOOLTALK_MESSAGE(x) XRECORD (x, tooltalk_message, Lisp_Tooltalk_Message) #define XSETTOOLTALK_MESSAGE(x, p) XSETRECORD (x, p, tooltalk_message) #define TOOLTALK_MESSAGEP(x) RECORDP (x, tooltalk_message) -#define GC_TOOLTALK_MESSAGEP(x) GC_RECORDP (x, tooltalk_message) #define CHECK_TOOLTALK_MESSAGE(x) CHECK_RECORD (x, tooltalk_message) -struct Lisp_Tooltalk_Pattern; -DECLARE_LRECORD (tooltalk_pattern, struct Lisp_Tooltalk_Pattern); -#define XTOOLTALK_PATTERN(x) XRECORD (x, tooltalk_pattern, struct Lisp_Tooltalk_Pattern) +typedef struct Lisp_Tooltalk_Pattern Lisp_Tooltalk_Pattern; +DECLARE_LRECORD (tooltalk_pattern, Lisp_Tooltalk_Pattern); +#define XTOOLTALK_PATTERN(x) XRECORD (x, tooltalk_pattern, Lisp_Tooltalk_Pattern) #define XSETTOOLTALK_PATTERN(x, p) XSETRECORD (x, p, tooltalk_pattern) #define TOOLTALK_PATTERNP(x) RECORDP (x, tooltalk_pattern) -#define GC_TOOLTALK_PATTERNP(x) GC_RECORDP (x, tooltalk_pattern) #define CHECK_TOOLTALK_PATTERN(x) CHECK_RECORD (x, tooltalk_pattern) #define TOOLTALK_MESSAGE_KEY 100 @@ -61,4 +59,4 @@ extern Lisp_Object Qtooltalk_error; -#endif /* _XEMACS_TOOLTALK_H_ */ +#endif /* INCLUDED_tooltalk_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/tparam.c --- a/src/tparam.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/tparam.c Mon Aug 13 11:13:30 2007 +0200 @@ -57,16 +57,16 @@ The fourth and following args to tparam serve as the parameter values. */ -static char *tparam1 (CONST char *string, char *outstring, int len, - CONST char *up, CONST char *left, +static char *tparam1 (const char *string, char *outstring, int len, + const char *up, const char *left, int *argp); /* XEmacs: renamed this function because just tparam() conflicts with ncurses */ -char *emacs_tparam (CONST char *string, char *outstring, int len, int arg0, +char *emacs_tparam (const char *string, char *outstring, int len, int arg0, int arg1, int arg2, int arg3); char * -emacs_tparam (CONST char *string, char *outstring, int len, int arg0, +emacs_tparam (const char *string, char *outstring, int len, int arg0, int arg1, int arg2, int arg3) { int arg[4]; @@ -77,14 +77,14 @@ return tparam1 (string, outstring, len, 0, 0, arg); } -CONST char *BC; -CONST char *UP; +const char *BC; +const char *UP; static char tgoto_buf[50]; -char *tgoto (CONST char *cm, int hpos, int vpos); +char *tgoto (const char *cm, int hpos, int vpos); char * -tgoto (CONST char *cm, int hpos, int vpos) +tgoto (const char *cm, int hpos, int vpos) { int args[2]; if (!cm) @@ -95,11 +95,11 @@ } static char * -tparam1 (CONST char *string, char *outstring, int len, CONST char *up, - CONST char *left, int *argp) +tparam1 (const char *string, char *outstring, int len, const char *up, + const char *left, int *argp) { int c; - CONST char *p = string; + const char *p = string; char *op = outstring; char *outend; int outlen = 0; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/undo.c --- a/src/undo.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/undo.c Mon Aug 13 11:13:30 2007 +0200 @@ -46,7 +46,7 @@ which will be added to the list at the end of the command. This ensures we can't run out of space while trying to make an undo-boundary. */ -Lisp_Object pending_boundary; +static Lisp_Object pending_boundary; static void undo_boundary (struct buffer *b) @@ -281,7 +281,7 @@ && NILP (XCAR (next))) { /* Add in the space occupied by this element and its chain link. */ - size_so_far += sizeof (struct Lisp_Cons); + size_so_far += sizeof (Lisp_Cons); /* Advance to next element. */ prev = next; @@ -294,12 +294,12 @@ elt = XCAR (next); /* Add in the space occupied by this element and its chain link. */ - size_so_far += sizeof (struct Lisp_Cons); + size_so_far += sizeof (Lisp_Cons); if (CONSP (elt)) { - size_so_far += sizeof (struct Lisp_Cons); + size_so_far += sizeof (Lisp_Cons); if (STRINGP (XCAR (elt))) - size_so_far += (sizeof (struct Lisp_String) - 1 + size_so_far += (sizeof (Lisp_String) - 1 + XSTRING_LENGTH (XCAR (elt))); } @@ -329,12 +329,12 @@ } /* Add in the space occupied by this element and its chain link. */ - size_so_far += sizeof (struct Lisp_Cons); + size_so_far += sizeof (Lisp_Cons); if (CONSP (elt)) { - size_so_far += sizeof (struct Lisp_Cons); + size_so_far += sizeof (Lisp_Cons); if (STRINGP (XCAR (elt))) - size_so_far += (sizeof (struct Lisp_String) - 1 + size_so_far += (sizeof (Lisp_String) - 1 + XSTRING_LENGTH (XCAR (elt))); } @@ -547,9 +547,16 @@ } void +reinit_vars_of_undo (void) +{ + inside_undo = 0; +} + +void vars_of_undo (void) { - inside_undo = 0; + reinit_vars_of_undo (); + pending_boundary = Qnil; staticpro (&pending_boundary); last_undo_buffer = Qnil; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/unexaix.c --- a/src/unexaix.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/unexaix.c Mon Aug 13 11:13:30 2007 +0200 @@ -439,7 +439,6 @@ { int i, nwrite, ret; char buf[80]; - extern int errno; char zeros[UnexBlockSz]; for (i = 0; ptr < end;) diff -r f4aeb21a5bad -r 74fd4e045ea6 src/unexalpha.c --- a/src/unexalpha.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/unexalpha.c Mon Aug 13 11:13:30 2007 +0200 @@ -31,6 +31,7 @@ #include <sys/stat.h> #include <sys/mman.h> #include <stdio.h> +#include <errno.h> #include <varargs.h> #include <filehdr.h> #include <aouthdr.h> @@ -54,9 +55,6 @@ if (lseek (_fd, _position, L_SET) != _position) \ fatal_unexec (_error_message, _error_arg); -extern int errno; -extern char *strerror (); - void *sbrk(); #define EEOF -1 diff -r f4aeb21a5bad -r 74fd4e045ea6 src/unexcw.c --- a/src/unexcw.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/unexcw.c Mon Aug 13 11:13:30 2007 +0200 @@ -21,7 +21,7 @@ */ /* This is a complete rewrite, some code snarfed from unexnt.c and - unexec.c, Andy Piper (andyp@parallax.co.uk) 13-1-98 */ + unexec.c, Andy Piper (andy@xemacs.org) 13-1-98 */ #include <stdio.h> #include <stdlib.h> @@ -39,8 +39,9 @@ } #else -#undef CONST -#include <windows.h> +#ifndef MAX_PATH +#define MAX_PATH 260 +#endif #include <a.out.h> #define ALLOC_UNIT 0xFFFF diff -r f4aeb21a5bad -r 74fd4e045ea6 src/unexec.c --- a/src/unexec.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/unexec.c Mon Aug 13 11:13:30 2007 +0200 @@ -136,7 +136,7 @@ program text). HDR's standard fields are already correct, except that this adjustment to the `a_text' field has not yet been made; thus, the amount of offset can depend on the data in the file. - + * A_TEXT_SEEK(HDR) If defined, this macro specifies the number of bytes to seek into the @@ -186,19 +186,12 @@ # undef _POSIX_SOURCE # endif -# if defined(__lucid) && !defined(__STDC_EXTENDED__) -# define __STDC_EXTENDED__ 1 -# endif - # include <stddef.h> # include <stdlib.h> # include <unistd.h> # include <string.h> # include <stddef.h> - -# ifdef __lucid -# include <sysent.h> -# endif +# include <errno.h> #endif @@ -373,14 +366,12 @@ #include "lisp.h" static void -report_error (file, fd) - CONST char *file; - int fd; +report_error (const char *file, int fd) { if (fd) close (fd); report_file_error ("Cannot unexec", - Fcons (build_ext_string (file, FORMAT_FILENAME), Qnil)); + Fcons (build_ext_string (file, Qfile_name), Qnil)); } #endif /* emacs */ @@ -391,7 +382,7 @@ static void report_error_1 (fd, msg, a1, a2) int fd; - CONST char *msg; + const char *msg; int a1, a2; { close (fd); @@ -443,7 +434,7 @@ { close (new); /* unlink (new_name); / * Failed, unlink new a.out */ - return -1; + return -1; } close (new); @@ -998,7 +989,7 @@ char c; int mcount_address, mcount_offset, count; extern char *_execname; - + /* The use of _execname is incompatible with RISCiX 1.1 */ sprintf (command, "nm %s | fgrep mcount", _execname); @@ -1018,7 +1009,7 @@ { sprintf (errbuf, "Failed to execute the command '%s'\n", command); PERROR (errbuf); - } + } sscanf(address_text, "%x", &mcount_address); ptr = (char *) unexec_text_start; @@ -1076,7 +1067,6 @@ #if 0 char buf[80]; #endif - extern int errno; /* This is the normal amount to write at once. It is the size of block that NFS uses. */ int writesize = 1 << 13; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/unexelf.c --- a/src/unexelf.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/unexelf.c Mon Aug 13 11:13:30 2007 +0200 @@ -18,7 +18,7 @@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -/* Synched up with: FSF 20.2. */ +/* Synched up with: FSF 20.4. */ /* * unexec.c - Convert a running program into an a.out file. @@ -413,7 +413,7 @@ #define fatal(a, b, c) fprintf (stderr, a, b, c), exit (1) #else #include <config.h> -extern void fatal (CONST char *, ...); +extern void fatal (const char *, ...); #endif #include <sys/types.h> @@ -424,10 +424,98 @@ #include <errno.h> #include <unistd.h> #include <fcntl.h> +#if !defined (__NetBSD__) && !defined (__OpenBSD__) #include <elf.h> +#endif #include <sys/mman.h> +#if defined (__sony_news) && defined (_SYSTYPE_SYSV) +#include <sys/elf_mips.h> +#include <sym.h> +#endif /* __sony_news && _SYSTYPE_SYSV */ +#ifdef __sgi +#include <sym.h> /* for HDRR declaration */ +#endif /* __sgi */ -#if __GLIBC__ - 0 >= 2 +#if defined (__alpha__) && !defined (__NetBSD__) && !defined (__OpenBSD__) +/* Declare COFF debugging symbol table. This used to be in + /usr/include/sym.h, but this file is no longer included in Red Hat + 5.0 and presumably in any other glibc 2.x based distribution. */ +typedef struct { + short magic; + short vstamp; + int ilineMax; + int idnMax; + int ipdMax; + int isymMax; + int ioptMax; + int iauxMax; + int issMax; + int issExtMax; + int ifdMax; + int crfd; + int iextMax; + long cbLine; + long cbLineOffset; + long cbDnOffset; + long cbPdOffset; + long cbSymOffset; + long cbOptOffset; + long cbAuxOffset; + long cbSsOffset; + long cbSsExtOffset; + long cbFdOffset; + long cbRfdOffset; + long cbExtOffset; +} HDRR, *pHDRR; +#define cbHDRR sizeof(HDRR) +#define hdrNil ((pHDRR)0) +#endif + +#ifdef __NetBSD__ +/* + * NetBSD does not have normal-looking user-land ELF support. + */ +# ifdef __alpha__ +# define ELFSIZE 64 +# else +# define ELFSIZE 32 +# endif +# include <sys/exec_elf.h> + +# define PT_LOAD Elf_pt_load +# define SHT_SYMTAB Elf_sht_symtab +# define SHT_DYNSYM Elf_sht_dynsym +# define SHT_NULL Elf_sht_null +# define SHT_NOBITS Elf_sht_nobits +# define SHT_REL Elf_sht_rel +# define SHT_RELA Elf_sht_rela + +# define SHN_UNDEF Elf_eshn_undefined +# define SHN_ABS Elf_eshn_absolute +# define SHN_COMMON Elf_eshn_common + +/* + * The magic of picking the right size types is handled by the ELFSIZE + * definition above. + */ +# ifdef __STDC__ +# define ElfW(type) Elf_##type +# else +# define ElfW(type) Elf_/**/type +# endif + +# ifdef __alpha__ +# include <sys/exec_ecoff.h> +# define HDRR struct ecoff_symhdr +# define pHDRR HDRR * +# endif +#endif /* __NetBSD__ */ + +#ifdef __OpenBSD__ +# include <sys/exec_elf.h> +#endif + +#if __GNU_LIBRARY__ - 0 >= 6 # include <link.h> /* get ElfW etc */ #endif @@ -487,8 +575,8 @@ /* Round X up to a multiple of Y. */ -static int -round_up (int x, int y) +static ElfW(Addr) +round_up (ElfW(Addr) x, ElfW(Addr) y) { int rem = x % y; if (rem == 0) @@ -531,7 +619,8 @@ ElfW(Off) new_data2_offset; ElfW(Addr) new_data2_addr; - int n, nn, old_bss_index, old_data_index; + int n, nn, old_bss_index, old_data_index, new_data2_index; + int old_sbss_index, old_mdebug_index; struct stat stat_buf; /* Open the old file & map it into the address space. */ @@ -544,7 +633,7 @@ if (fstat (old_file, &stat_buf) == -1) fatal ("Can't fstat (%s): errno %d\n", old_name, errno); - old_base = mmap (0, stat_buf.st_size, PROT_READ, MAP_SHARED, old_file, 0); + old_base = (caddr_t) mmap (0, stat_buf.st_size, PROT_READ, MAP_SHARED, old_file, 0); if (old_base == (caddr_t) -1) fatal ("Can't mmap (%s): errno %d\n", old_name, errno); @@ -580,8 +669,48 @@ if (old_bss_index == old_file_h->e_shnum) fatal ("Can't find .bss in %s.\n", old_name, 0); - old_bss_addr = OLD_SECTION_H (old_bss_index).sh_addr; - old_bss_size = OLD_SECTION_H (old_bss_index).sh_size; + for (old_sbss_index = 1; old_sbss_index < (int) old_file_h->e_shnum; + old_sbss_index++) + { +#ifdef DEBUG + fprintf (stderr, "Looking for .sbss - found %s\n", + old_section_names + OLD_SECTION_H (old_sbss_index).sh_name); +#endif + if (!strcmp (old_section_names + OLD_SECTION_H (old_sbss_index).sh_name, + ".sbss")) + break; + } + if (old_sbss_index == old_file_h->e_shnum) + { + old_sbss_index = -1; + old_bss_addr = OLD_SECTION_H(old_bss_index).sh_addr; + old_bss_size = OLD_SECTION_H(old_bss_index).sh_size; + new_data2_offset = OLD_SECTION_H(old_bss_index).sh_offset; + new_data2_index = old_bss_index; + } + else + { + old_bss_addr = OLD_SECTION_H(old_sbss_index).sh_addr; + old_bss_size = OLD_SECTION_H(old_bss_index).sh_size + + OLD_SECTION_H(old_sbss_index).sh_size; + new_data2_offset = OLD_SECTION_H(old_sbss_index).sh_offset; + new_data2_index = old_sbss_index; + } + + for (old_mdebug_index = 1; old_mdebug_index < (int) old_file_h->e_shnum; + old_mdebug_index++) + { +#ifdef DEBUG + fprintf (stderr, "Looking for .mdebug - found %s\n", + old_section_names + OLD_SECTION_H (old_mdebug_index).sh_name); +#endif + if (!strcmp (old_section_names + OLD_SECTION_H (old_mdebug_index).sh_name, + ".mdebug")) + break; + } + if (old_mdebug_index == old_file_h->e_shnum) + old_mdebug_index = 0; + #if defined (emacs) || !defined (DEBUG) new_bss_addr = (ElfW(Addr)) sbrk (0); #else @@ -589,7 +718,6 @@ #endif new_data2_addr = old_bss_addr; new_data2_size = new_bss_addr - old_bss_addr; - new_data2_offset = OLD_SECTION_H (old_bss_index).sh_offset; #ifdef DEBUG fprintf (stderr, "old_bss_index %d\n", old_bss_index); @@ -618,13 +746,13 @@ if (ftruncate (new_file, new_file_size)) fatal ("Can't ftruncate (%s): errno %d\n", new_name, errno); + new_base = (caddr_t) mmap (0, new_file_size, PROT_READ | PROT_WRITE, #ifdef UNEXEC_USE_MAP_PRIVATE - new_base = mmap (0, new_file_size, PROT_READ | PROT_WRITE, MAP_PRIVATE, - new_file, 0); + MAP_PRIVATE, #else - new_base = mmap (0, new_file_size, PROT_READ | PROT_WRITE, MAP_SHARED, - new_file, 0); + MAP_SHARED, #endif + new_file, 0); if (new_base == (caddr_t) -1) fatal ("Can't mmap (%s): errno %d\n", new_name, errno); @@ -674,24 +802,31 @@ if ((OLD_SECTION_H (old_bss_index)).sh_addralign > alignment) alignment = OLD_SECTION_H (old_bss_index).sh_addralign; -#ifndef __mips /* ifndef added by jwz at suggestion of - r02kar@x4u2.desy.de (Karsten Kuenne) to avoid - "Program segment above .bss" when dumping. - */ - if (NEW_PROGRAM_H (n).p_vaddr + NEW_PROGRAM_H (n).p_filesz > old_bss_addr) - fatal ("Program segment above .bss in %s\n", old_name, 0); -#endif /* __mips */ +#ifdef __mips + /* According to r02kar@x4u2.desy.de (Karsten Kuenne) + and oliva@gnu.org (Alexandre Oliva), on IRIX 5.2, we + always get "Program segment above .bss" when dumping + when the executable doesn't have an sbss section. */ + if (old_sbss_index != -1) +#endif /* __mips */ + if (NEW_PROGRAM_H (n).p_vaddr + NEW_PROGRAM_H (n).p_filesz + > (old_sbss_index == -1 + ? old_bss_addr + : round_up (old_bss_addr, alignment))) + fatal ("Program segment above .bss in %s\n", old_name, 0); if (NEW_PROGRAM_H (n).p_type == PT_LOAD - && (round_up ((int) ((NEW_PROGRAM_H (n)).p_vaddr - + (NEW_PROGRAM_H (n)).p_filesz), + && (round_up ((NEW_PROGRAM_H (n)).p_vaddr + + (NEW_PROGRAM_H (n)).p_filesz, alignment) - == round_up ((int) old_bss_addr, alignment))) + == round_up (old_bss_addr, alignment))) break; } if (n < 0) fatal ("Couldn't find segment next to .bss in %s\n", old_name, 0); + /* Make sure that the size includes any padding before the old .bss + section. */ NEW_PROGRAM_H (n).p_filesz = new_bss_addr - NEW_PROGRAM_H (n).p_vaddr; NEW_PROGRAM_H (n).p_memsz = NEW_PROGRAM_H (n).p_filesz; @@ -726,8 +861,10 @@ for (n = 1, nn = 1; n < (int) old_file_h->e_shnum; n++, nn++) { caddr_t src; - /* If it is bss section, insert the new data2 section before it. */ - if (n == old_bss_index) + /* If it is (s)bss section, insert the new data2 section before it. */ + /* new_data2_index is the index of either old_sbss or old_bss, that was + chosen as a section for new_data2. */ + if (n == new_data2_index) { /* Steal the data section header for this data2 section. */ memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (old_data_index), @@ -744,21 +881,24 @@ /* Now copy over what we have in the memory now. */ memcpy (NEW_SECTION_H (nn).sh_offset + new_base, (caddr_t) OLD_SECTION_H (n).sh_addr, - /* #### mrb: should be old_bss_size instead? */ new_data2_size); nn++; } memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (n), old_file_h->e_shentsize); - - /* The new bss section's size is zero, and its file offset and virtual - address should be off by NEW_DATA2_SIZE. */ - if (n == old_bss_index) + + if (n == old_bss_index + /* The new bss and sbss section's size is zero, and its file offset + and virtual address should be off by NEW_DATA2_SIZE. */ + || n == old_sbss_index + ) { - /* NN should be `old_bss_index + 1' at this point. */ - NEW_SECTION_H (nn).sh_offset += new_data2_size; - NEW_SECTION_H (nn).sh_addr += new_data2_size; + /* NN should be `old_s?bss_index + 1' at this point. */ + NEW_SECTION_H (nn).sh_offset = + NEW_SECTION_H (new_data2_index).sh_offset + new_data2_size; + NEW_SECTION_H (nn).sh_addr = + NEW_SECTION_H (new_data2_index).sh_addr + new_data2_size; /* Let the new bss section address alignment be the same as the section address alignment followed the old bss section, so this section will be placed in exactly the same place. */ @@ -782,7 +922,9 @@ >= OLD_SECTION_H (old_bss_index-1).sh_offset) NEW_SECTION_H (nn).sh_offset += new_data2_size; #else - if (NEW_SECTION_H (nn).sh_offset >= new_data2_offset) + if (round_up (NEW_SECTION_H (nn).sh_offset, + OLD_SECTION_H (old_bss_index).sh_addralign) + >= new_data2_offset) NEW_SECTION_H (nn).sh_offset += new_data2_size; #endif /* Any section that was originally placed after the section @@ -811,17 +953,24 @@ /* Write out the sections. .data and .data1 (and data2, called ".data" in the strings table) get copied from the current process instead of the old file. */ -#ifdef __powerpc__ - /* The PowerPC has additional 'data' segments which need to be saved */ - if (!strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".data") || - !strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".data1") || - !strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".sdata") || - !strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".sdata1")) -#else if (!strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".data") || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name), + ".sdata") + /* Taking these sections from the current process, breaks + Linux in a subtle way. Binaries only run on the + architecture (e.g. i586 vs i686) of the dumping machine */ +#ifdef __sgi + || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name), + ".lit4") + || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name), + ".lit8") + || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name), + ".got") +#endif + || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name), + ".sdata1") + || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name), ".data1")) -#endif src = (caddr_t) OLD_SECTION_H (n).sh_addr; else src = old_base + OLD_SECTION_H (n).sh_offset; @@ -829,6 +978,106 @@ memcpy (NEW_SECTION_H (nn).sh_offset + new_base, src, NEW_SECTION_H (nn).sh_size); +#ifdef __alpha__ + /* Update Alpha COFF symbol table: */ + if (strcmp (old_section_names + OLD_SECTION_H (n).sh_name, ".mdebug") + == 0) + { + pHDRR symhdr = (pHDRR) (NEW_SECTION_H (nn).sh_offset + new_base); + + symhdr->cbLineOffset += new_data2_size; + symhdr->cbDnOffset += new_data2_size; + symhdr->cbPdOffset += new_data2_size; + symhdr->cbSymOffset += new_data2_size; + symhdr->cbOptOffset += new_data2_size; + symhdr->cbAuxOffset += new_data2_size; + symhdr->cbSsOffset += new_data2_size; + symhdr->cbSsExtOffset += new_data2_size; + symhdr->cbFdOffset += new_data2_size; + symhdr->cbRfdOffset += new_data2_size; + symhdr->cbExtOffset += new_data2_size; + } +#endif /* __alpha__ */ + +#if defined (__sony_news) && defined (_SYSTYPE_SYSV) + if (NEW_SECTION_H (nn).sh_type == SHT_MIPS_DEBUG && old_mdebug_index) + { + int diff = NEW_SECTION_H(nn).sh_offset + - OLD_SECTION_H(old_mdebug_index).sh_offset; + HDRR *phdr = (HDRR *)(NEW_SECTION_H (nn).sh_offset + new_base); + + if (diff) + { + phdr->cbLineOffset += diff; + phdr->cbDnOffset += diff; + phdr->cbPdOffset += diff; + phdr->cbSymOffset += diff; + phdr->cbOptOffset += diff; + phdr->cbAuxOffset += diff; + phdr->cbSsOffset += diff; + phdr->cbSsExtOffset += diff; + phdr->cbFdOffset += diff; + phdr->cbRfdOffset += diff; + phdr->cbExtOffset += diff; + } + } +#endif /* __sony_news && _SYSTYPE_SYSV */ + +#ifdef __sgi + /* Adjust the HDRR offsets in .mdebug and copy the + line data if it's in its usual 'hole' in the object. + Makes the new file debuggable with dbx. + patches up two problems: the absolute file offsets + in the HDRR record of .mdebug (see /usr/include/syms.h), and + the ld bug that gets the line table in a hole in the + elf file rather than in the .mdebug section proper. + David Anderson. davea@sgi.com Jan 16,1994. */ + if (n == old_mdebug_index) + { +#define MDEBUGADJUST(__ct,__fileaddr) \ + if (n_phdrr->__ct > 0) \ + { \ + n_phdrr->__fileaddr += movement; \ + } + + HDRR * o_phdrr = (HDRR *)((byte *)old_base + OLD_SECTION_H (n).sh_offset); + HDRR * n_phdrr = (HDRR *)((byte *)new_base + NEW_SECTION_H (nn).sh_offset); + unsigned movement = new_data2_size; + + MDEBUGADJUST (idnMax, cbDnOffset); + MDEBUGADJUST (ipdMax, cbPdOffset); + MDEBUGADJUST (isymMax, cbSymOffset); + MDEBUGADJUST (ioptMax, cbOptOffset); + MDEBUGADJUST (iauxMax, cbAuxOffset); + MDEBUGADJUST (issMax, cbSsOffset); + MDEBUGADJUST (issExtMax, cbSsExtOffset); + MDEBUGADJUST (ifdMax, cbFdOffset); + MDEBUGADJUST (crfd, cbRfdOffset); + MDEBUGADJUST (iextMax, cbExtOffset); + /* The Line Section, being possible off in a hole of the object, + requires special handling. */ + if (n_phdrr->cbLine > 0) + { + if (o_phdrr->cbLineOffset > (OLD_SECTION_H (n).sh_offset + + OLD_SECTION_H (n).sh_size)) + { + /* line data is in a hole in elf. do special copy and adjust + for this ld mistake. + */ + n_phdrr->cbLineOffset += movement; + + memcpy (n_phdrr->cbLineOffset + new_base, + o_phdrr->cbLineOffset + old_base, n_phdrr->cbLine); + } + else + { + /* somehow line data is in .mdebug as it is supposed to be. */ + MDEBUGADJUST (cbLine, cbLineOffset); + } + } + } +#endif /* __sgi */ + /* If it is the symbol table, its st_shndx field needs to be patched. */ if (NEW_SECTION_H (nn).sh_type == SHT_SYMTAB || NEW_SECTION_H (nn).sh_type == SHT_DYNSYM) @@ -886,17 +1135,21 @@ be no harm in that provided that r_offset is always the first member. */ nn = section.sh_info; -#ifdef __powerpc__ - /* The PowerPC has additional 'data' segments which need to be saved */ - if (!strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".data") || - !strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".data1") || - !strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".sdata") || - !strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".sdata1")) -#else if (!strcmp (old_section_names + NEW_SECTION_H (nn).sh_name, ".data") || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), + ".sdata") +#ifdef __sgi + || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), + ".lit4") + || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), + ".lit8") + || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), + ".got") +#endif + || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), + ".sdata1") + || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), ".data1")) -#endif { ElfW(Addr) offset = NEW_SECTION_H (nn).sh_addr - NEW_SECTION_H (nn).sh_offset; @@ -905,6 +1158,13 @@ reloc += section.sh_entsize) { ElfW(Addr) addr = ((ElfW(Rel) *) reloc)->r_offset - offset; +#ifdef __alpha__ + /* The Alpha ELF binutils currently have a bug that + sometimes results in relocs that contain all + zeroes. Work around this for now... */ + if (((ElfW(Rel) *) reloc)->r_offset == 0) + continue; +#endif memcpy (new_base + addr, old_base + addr, sizeof(ElfW(Addr))); } } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/unexelfsgi.c --- a/src/unexelfsgi.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/unexelfsgi.c Mon Aug 13 11:13:30 2007 +0200 @@ -615,6 +615,7 @@ l_Elf_Ehdr *old_file_h, *new_file_h; l_Elf_Phdr *old_program_h, *new_program_h; l_Elf_Shdr *old_section_h, *new_section_h; + l_Elf_Shdr *oldbss; /* Point to the section name table in the old file. */ char *old_section_names; @@ -697,8 +698,8 @@ (new_data2_addr - OLD_SECTION_H (old_data_index).sh_addr); new_base_offset = OLD_SECTION_H (old_data_index).sh_offset + (old_base_addr - OLD_SECTION_H (old_data_index).sh_addr); - new_offsets_shift = new_bss_addr - - ((old_base_addr & ~0xfff) + ((old_base_addr & 0xfff) ? 0x1000 : 0)); + new_offsets_shift = new_bss_addr - (old_base_addr & ~0xfff) + + ((old_base_addr & 0xfff) ? 0x1000 : 0); #ifdef DEBUG fprintf (stderr, "old_bss_index %d\n", old_bss_index); @@ -768,37 +769,41 @@ /* Fix up a new program header. Extend the writable data segment so that the bss area is covered too. Find that segment by looking - for a segment that ends just before the .bss area. Make sure - that no segments are above the new .data2. Put a loop at the end - to adjust the offset and address of any segment that is above - data2, just in case we decide to allow this later. */ + for one that starts before and ends after the .bss and it PT_LOADable. + Put a loop at the end to adjust the offset and address of any segment + that is above data2, just in case we decide to allow this later. */ + oldbss = &OLD_SECTION_H(old_bss_index); for (n = new_file_h->e_phnum - 1; n >= 0; n--) { /* Compute maximum of all requirements for alignment of section. */ - int alignment = (NEW_PROGRAM_H (n)).p_align; - if ((OLD_SECTION_H (old_bss_index)).sh_addralign > alignment) - alignment = OLD_SECTION_H (old_bss_index).sh_addralign; - - /* Supposedly this condition is okay for the SGI. */ -#if 0 - if (NEW_PROGRAM_H (n).p_vaddr + NEW_PROGRAM_H (n).p_filesz > old_base_addr) - fatal ("Program segment above .bss in %s\n", old_name); + l_Elf_Phdr * ph = (l_Elf_Phdr *)((byte *) new_program_h + + new_file_h->e_phentsize*(n)); +#ifdef DEBUG + printf ("%d @ %0x + %0x against %0x + %0x", + n, ph->p_vaddr, ph->p_memsz, + oldbss->sh_addr, oldbss->sh_size); #endif - - if (NEW_PROGRAM_H (n).p_type == PT_LOAD - && (round_up ((NEW_PROGRAM_H (n)).p_vaddr - + (NEW_PROGRAM_H (n)).p_filesz, - alignment) - == round_up (old_base_addr, alignment))) - break; + if ((ph->p_type == PT_LOAD) && + (ph->p_vaddr <= oldbss->sh_addr) && + ((ph->p_vaddr + ph->p_memsz)>=(oldbss->sh_addr + oldbss->sh_size))) { + ph->p_filesz += new_offsets_shift; + ph->p_memsz = ph->p_filesz; +#ifdef DEBUG + puts (" That's the one!"); + fflush (stdout); +#endif + break; + } +#ifdef DEBUG + putchar ('\n'); + fflush (stdout); +#endif } if (n < 0) fatal ("Couldn't find segment next to %s in %s\n", old_sbss_index == -1 ? ".sbss" : ".bss", old_name); - NEW_PROGRAM_H (n).p_filesz += new_offsets_shift; - NEW_PROGRAM_H (n).p_memsz = NEW_PROGRAM_H (n).p_filesz; #if 1 /* Maybe allow section after data2 - does this ever happen? */ for (n = new_file_h->e_phnum - 1; n >= 0; n--) diff -r f4aeb21a5bad -r 74fd4e045ea6 src/unexfreebsd.c --- a/src/unexfreebsd.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/unexfreebsd.c Mon Aug 13 11:13:30 2007 +0200 @@ -40,6 +40,7 @@ #include <sys/types.h> #include <string.h> #include <stdio.h> +#include <errno.h> #include <a.out.h> #include <unistd.h> #include <ctype.h> @@ -70,7 +71,7 @@ /********************** Function Prototypes/Declarations ***********/ -static void unexec_error (CONST char *m, int use_errno, ...); +static void unexec_error (const char *m, int use_errno, ...); static int unexec_open (char *filename, int flag, int mode); static caddr_t unexec_mmap (int fd, size_t len, int prot, int flags); static long unexec_seek (int fd, long position); @@ -95,7 +96,6 @@ /********************** Variables **********************************/ /* for reporting error messages from system calls */ -extern int errno; extern int _DYNAMIC; extern char **environ; @@ -104,9 +104,9 @@ /*******************************************************************/ static void -unexec_error (CONST char *fmt, int use_errno, ...) +unexec_error (const char *fmt, int use_errno, ...) { - CONST char *err_msg = SYS_ERR; + const char *err_msg = SYS_ERR; va_list args; fprintf (stderr, "unexec - "); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/unexhp9k3.c --- a/src/unexhp9k3.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/unexhp9k3.c Mon Aug 13 11:13:30 2007 +0200 @@ -40,6 +40,7 @@ #include <sys/types.h> #include <string.h> #include <stdio.h> +#include <errno.h> #include <signal.h> #ifdef __hp9000s300 # include </usr/include/debug.h> @@ -71,7 +72,7 @@ /********************** Function Prototypes/Declarations ***********/ -static void unexec_error (CONST char *fmt, int use_errno, ...); +static void unexec_error (const char *fmt, int use_errno, ...); static int unexec_open (char *filename, int flag, int mode); static long unexec_seek (int fd, long position); static void unexec_read (int fd, long position, char *buf, int bytes); @@ -87,7 +88,6 @@ /* for reporting error messages from system calls */ extern int sys_nerr; -extern int errno; extern int _DYNAMIC; extern char **environ; @@ -96,9 +96,9 @@ /*******************************************************************/ static void -unexec_error (CONST char *fmt, int use_errno, ...) +unexec_error (const char *fmt, int use_errno, ...) { - CONST char *err_msg = SYS_ERR; + const char *err_msg = SYS_ERR; va_list args; fprintf (stderr, "unexec - "); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/unexhp9k800.c --- a/src/unexhp9k800.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/unexhp9k800.c Mon Aug 13 11:13:30 2007 +0200 @@ -52,6 +52,7 @@ #include <config.h> +#include <stdlib.h> #include <stdio.h> #include <fcntl.h> #include <errno.h> @@ -80,7 +81,7 @@ #ifdef HPUX_USE_SHLIBS #include <dl.h> /* User-space dynamic loader entry points */ -void Save_Shared_Data(); +void Save_Shared_Data(void); int run_time_remap(); #endif diff -r f4aeb21a5bad -r 74fd4e045ea6 src/unexmips.c --- a/src/unexmips.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/unexmips.c Mon Aug 13 11:13:30 2007 +0200 @@ -26,6 +26,7 @@ #include <sys/file.h> #include <sys/stat.h> #include <stdio.h> +#include <errno.h> #include <varargs.h> #ifdef MACH @@ -95,7 +96,6 @@ if (lseek (_fd, _position, L_SET) != _position) \ fatal_unexec (_error_message, _error_arg); -extern int errno; extern char *strerror (); #define EEOF -1 diff -r f4aeb21a5bad -r 74fd4e045ea6 src/unexnt.c --- a/src/unexnt.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/unexnt.c Mon Aug 13 11:13:30 2007 +0200 @@ -111,10 +111,16 @@ version, we need to bootstrap our heap and .bss section into our address space before we can actually hand off control to the startup code supplied by NT (primarily because that code relies upon malloc ()). */ + +/* ********************** + Hackers please remember, this _start() thingy is *not* called neither + when dumping portably, nor when running from temacs! Do not put + significant XEmacs initialization here! + ********************** */ + void _start (void) { - char * p; extern void mainCRTStartup (void); /* Cache system info, e.g., the NT page size. */ @@ -134,18 +140,29 @@ exit (1); } - /* To allow profiling, make sure executable_path names the .exe - file, not the file created by the profiler */ - p = strrchr (executable_path, '\\'); - strcpy (p+1, PATH_PROGNAME ".exe"); + /* #### This is super-bogus. When I rename xemacs.exe, + the renamed file still loads its heap from xemacs.exe --kkm */ +#if 0 + { + /* To allow profiling, make sure executable_path names the .exe + file, not the file created by the profiler */ + char *p = strrchr (executable_path, '\\'); + strcpy (p+1, PATH_PROGNAME ".exe"); + } +#endif recreate_heap (executable_path); heap_state = HEAP_LOADED; } + /* #### This is bogus, too. _fmode is set to different values + when we run `xemacs' and `temacs run-emacs'. The sooner we + hit and fix all the weirdities this causes us, the better --kkm */ +#if 0 /* The default behavior is to treat files as binary and patch up text files appropriately, in accordance with the MSDOS code. */ _fmode = O_BINARY; +#endif #if 0 /* This prevents ctrl-c's in shells running while we're suspended from @@ -261,39 +278,7 @@ int -open_input_file (file_data *p_file, char *filename) -{ - HANDLE file; - HANDLE file_mapping; - void *file_base; - unsigned long size, upper_size; - - file = CreateFile (filename, GENERIC_READ, FILE_SHARE_READ, NULL, - OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); - if (file == INVALID_HANDLE_VALUE) - return FALSE; - - size = GetFileSize (file, &upper_size); - file_mapping = CreateFileMapping (file, NULL, PAGE_READONLY, - 0, size, NULL); - if (!file_mapping) - return FALSE; - - file_base = MapViewOfFile (file_mapping, FILE_MAP_READ, 0, 0, size); - if (file_base == 0) - return FALSE; - - p_file->name = filename; - p_file->size = size; - p_file->file = file; - p_file->file_mapping = file_mapping; - p_file->file_base = file_base; - - return TRUE; -} - -int -open_output_file (file_data *p_file, char *filename, unsigned long size) +open_output_file (file_data *p_file, const char *filename, unsigned long size) { HANDLE file; HANDLE file_mapping; @@ -322,16 +307,6 @@ return TRUE; } -/* Close the system structures associated with the given file. */ -void -close_file_data (file_data *p_file) -{ - UnmapViewOfFile (p_file->file_base); - CloseHandle (p_file->file_mapping); - CloseHandle (p_file->file); -} - - /* Routines to manipulate NT executable file sections. */ #ifndef DUMP_SEPARATE_SECTION @@ -375,27 +350,6 @@ } #endif -/* Return pointer to section header for section containing the given - relative virtual address. */ -IMAGE_SECTION_HEADER * -rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header) -{ - PIMAGE_SECTION_HEADER section; - int i; - - section = IMAGE_FIRST_SECTION (nt_header); - - for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++) - { - if (rva >= section->VirtualAddress - && rva < section->VirtualAddress + section->SizeOfRawData) - return section; - section++; - } - return NULL; -} - - /* Flip through the executable and cache the info necessary for dumping. */ static void get_section_info (file_data *p_infile) diff -r f4aeb21a5bad -r 74fd4e045ea6 src/unexsunos4.c --- a/src/unexsunos4.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/unexsunos4.c Mon Aug 13 11:13:30 2007 +0200 @@ -80,7 +80,7 @@ /********************** Function Prototypes/Declarations ***********/ -static void unexec_error (CONST char *m, int use_errno, ...); +static void unexec_error (const char *m, int use_errno, ...); static int unexec_open (char *filename, int flag, int mode); static caddr_t unexec_mmap (int fd, size_t len, int prot, int flags); static long unexec_seek (int fd, long position); @@ -116,9 +116,9 @@ /*******************************************************************/ static void -unexec_error (CONST char *fmt, int use_errno, ...) +unexec_error (const char *fmt, int use_errno, ...) { - CONST char *err_msg = SYS_ERR; + const char *err_msg = SYS_ERR; va_list args; fprintf (stderr, "unexec - "); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/vm-limit.c --- a/src/vm-limit.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/vm-limit.c Mon Aug 13 11:13:30 2007 +0200 @@ -45,7 +45,7 @@ /* Function to call to issue a warning; 0 means don't issue them. */ -static void (*warn_function) (CONST char *); +static void (*warn_function) (const char *); /* Get more memory space, complaining if we're near the end. */ @@ -119,7 +119,7 @@ also declare where the end of pure storage is. */ void -memory_warnings (void *start, void (*warnfun) (CONST char *)) +memory_warnings (void *start, void (*warnfun) (const char *)) { extern void (* __after_morecore_hook) (void); /* From gmalloc.c */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/widget.c --- a/src/widget.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/widget.c Mon Aug 13 11:13:30 2007 +0200 @@ -101,7 +101,7 @@ newargs[0] = Fwidget_get (args[0], args[1]); newargs[1] = args[0]; newargs[2] = Flist (nargs - 2, args + 2); - GCPRO1 ((newargs[2])); + GCPRO1 (newargs[2]); RETURN_UNGCPRO (Fapply (3, newargs)); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/window.c --- a/src/window.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/window.c Mon Aug 13 11:13:30 2007 +0200 @@ -38,9 +38,10 @@ #include "window.h" #include "elhash.h" #include "commands.h" +#include "gutter.h" Lisp_Object Qwindowp, Qwindow_live_p, Qwindow_configurationp; -Lisp_Object Qscroll_up, Qscroll_down, Qdisplay_buffer; +Lisp_Object Qdisplay_buffer; #ifdef MEMORY_USAGE_STATS Lisp_Object Qface_cache, Qglyph_cache, Qline_start_cache, Qother_redisplay; @@ -84,6 +85,9 @@ /* Spacing between outer egde of divider border and window edge */ Lisp_Object Vvertical_divider_spacing; +/* How much to scroll by per-line. */ +Lisp_Object Vwindow_pixel_scroll_increment; + /* Scroll if point lands on the bottom line and that line is partially clipped. */ int scroll_on_clipped_lines; @@ -117,7 +121,7 @@ int next_screen_context_lines; /* List of freed window configurations with 1 - 10 windows. */ -Lisp_Object Vwindow_configuration_free_list[10]; +static Lisp_Object Vwindow_configuration_free_list[10]; #define SET_LAST_MODIFIED(w, cache_too) \ do { \ @@ -137,38 +141,38 @@ #define MARK_DISP_VARIABLE(field) \ - markobj (window->field[CURRENT_DISP]); \ - markobj (window->field[DESIRED_DISP]); \ - markobj (window->field[CMOTION_DISP]); + mark_object (window->field[CURRENT_DISP]); \ + mark_object (window->field[DESIRED_DISP]); \ + mark_object (window->field[CMOTION_DISP]); static Lisp_Object -mark_window (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_window (Lisp_Object obj) { struct window *window = XWINDOW (obj); - markobj (window->frame); - markobj (window->mini_p); - markobj (window->next); - markobj (window->prev); - markobj (window->hchild); - markobj (window->vchild); - markobj (window->parent); - markobj (window->buffer); + mark_object (window->frame); + mark_object (window->mini_p); + mark_object (window->next); + mark_object (window->prev); + mark_object (window->hchild); + mark_object (window->vchild); + mark_object (window->parent); + mark_object (window->buffer); MARK_DISP_VARIABLE (start); MARK_DISP_VARIABLE (pointm); - markobj (window->sb_point); /* #### move to scrollbar.c? */ - markobj (window->use_time); + mark_object (window->sb_point); /* #### move to scrollbar.c? */ + mark_object (window->use_time); MARK_DISP_VARIABLE (last_modified); MARK_DISP_VARIABLE (last_point); MARK_DISP_VARIABLE (last_start); MARK_DISP_VARIABLE (last_facechange); - markobj (window->line_cache_last_updated); - markobj (window->redisplay_end_trigger); - markobj (window->subwindow_instance_cache); - - mark_face_cachels (window->face_cachels, markobj); - mark_glyph_cachels (window->glyph_cachels, markobj); - -#define WINDOW_SLOT(slot, compare) ((void) (markobj (window->slot))) + mark_object (window->line_cache_last_updated); + mark_object (window->redisplay_end_trigger); + mark_object (window->subwindow_instance_cache); + + mark_face_cachels (window->face_cachels); + mark_glyph_cachels (window->glyph_cachels); + +#define WINDOW_SLOT(slot, compare) mark_object (window->slot) #include "winslots.h" return Qnil; @@ -231,7 +235,7 @@ DEFINE_LRECORD_IMPLEMENTATION ("window", window, mark_window, print_window, finalize_window, - 0, 0, struct window); + 0, 0, 0, struct window); #define INIT_DISP_VARIABLE(field, initialization) \ @@ -252,7 +256,7 @@ allocate_window (void) { Lisp_Object val; - struct window *p = alloc_lcrecord_type (struct window, lrecord_window); + struct window *p = alloc_lcrecord_type (struct window, &lrecord_window); zero_lcrecord (p); XSETWINDOW (val, p); @@ -641,7 +645,7 @@ return window_is_leftmost (w) && window_is_rightmost (w); } -static int +int window_is_highest (struct window *w) { Lisp_Object parent, current_ancestor, window; @@ -669,7 +673,7 @@ return 0; } -static int +int window_is_lowest (struct window *w) { Lisp_Object parent, current_ancestor, window; @@ -705,6 +709,11 @@ int window_truncation_on (struct window *w) { + /* Minibuffer windows are never truncated. + #### is this the right way ? */ + if (MINI_WINDOW_P (w)) + return 0; + /* Horizontally scrolled windows are truncated. */ if (w->hscroll) return 1; @@ -723,6 +732,17 @@ return 0; } +DEFUN ("window-truncated-p", Fwindow_truncated_p, 0, 1, 0, /* +Returns non-nil if text in the window is truncated. +*/ + (window)) +{ + struct window *w = decode_window (window); + + return window_truncation_on (w) ? Qt : Qnil; +} + + static int have_undivided_common_edge (struct window *w_right, void *closure) { @@ -972,32 +992,6 @@ return margin_width_internal (w, 0); } -static int -window_top_toolbar_height (struct window *w) -{ - /* #### implement this shit. */ - return 0; -} - -/* #### Currently used in scrollbar.c. Does it actually need to be? */ -int -window_bottom_toolbar_height (struct window *w) -{ - return 0; -} - -static int -window_left_toolbar_width (struct window *w) -{ - return 0; -} - -static int -window_right_toolbar_width (struct window *w) -{ - return 0; -} - /***************************************************************************** Window Gutters @@ -1019,47 +1013,45 @@ int window_top_gutter_height (struct window *w) { - int toolbar_height = window_top_toolbar_height (w); + int gutter = WINDOW_REAL_TOP_GUTTER_BOUNDS (w); if (!NILP (w->hchild) || !NILP (w->vchild)) return 0; #ifdef HAVE_SCROLLBARS if (!NILP (w->scrollbar_on_top_p)) - return window_scrollbar_height (w) + toolbar_height; + return window_scrollbar_height (w) + gutter; else #endif - return toolbar_height; + return gutter; } int window_bottom_gutter_height (struct window *w) { - int other_height; + int gutter = WINDOW_REAL_BOTTOM_GUTTER_BOUNDS (w); if (!NILP (w->hchild) || !NILP (w->vchild)) return 0; - else - other_height = - window_modeline_height (w) + window_bottom_toolbar_height (w); + + gutter += window_modeline_height (w); #ifdef HAVE_SCROLLBARS if (NILP (w->scrollbar_on_top_p)) - return window_scrollbar_height (w) + other_height; + return window_scrollbar_height (w) + gutter; else #endif - return other_height; + return gutter; } int window_left_gutter_width (struct window *w, int modeline) { - int gutter = window_left_toolbar_width (w); + int gutter = WINDOW_REAL_LEFT_GUTTER_BOUNDS (w); if (!NILP (w->hchild) || !NILP (w->vchild)) return 0; - #ifdef HAVE_SCROLLBARS if (!modeline && !NILP (w->scrollbar_on_left_p)) gutter += window_scrollbar_width (w); @@ -1071,7 +1063,7 @@ int window_right_gutter_width (struct window *w, int modeline) { - int gutter = window_right_toolbar_width (w); + int gutter = WINDOW_REAL_RIGHT_GUTTER_BOUNDS (w); if (!NILP (w->hchild) || !NILP (w->vchild)) return 0; @@ -1123,6 +1115,26 @@ } } +DEFUN ("last-nonminibuf-window", Flast_nonminibuf_window, 0, 1, 0, /* +Return the last selected window that is not a minibuffer window. +If the optional argument CON-DEV-OR-FRAME is specified and is a frame, +return the last non-minibuffer window used by that frame. If +CON-DEV-OR-FRAME is a device, then the selected frame on that device +will be used. If CON-DEV-OR-FRAME is a console, the selected frame on +that console's selected device will be used. Otherwise, the selected +frame is used. +*/ + (con_dev_or_frame)) +{ + if (NILP (con_dev_or_frame) && NILP (Fselected_device (Qnil))) + return Qnil; /* happens at startup */ + + { + struct frame *f = decode_frame_or_selected (con_dev_or_frame); + return FRAME_LAST_NONMINIBUF_WINDOW (f); + } +} + DEFUN ("minibuffer-window", Fminibuffer_window, 0, 1, 0, /* Return the window used now for minibuffers. If the optional argument CON-DEV-OR-FRAME is specified and is a frame, return @@ -1136,7 +1148,7 @@ return FRAME_MINIBUF_WINDOW (decode_frame_or_selected (con_dev_or_frame)); } -DEFUN ("window-minibuffer-p", Fwindow_minibuffer_p, 1, 1, 0, /* +DEFUN ("window-minibuffer-p", Fwindow_minibuffer_p, 0, 1, 0, /* Return non-nil if WINDOW is a minibuffer window. */ (window)) @@ -1345,7 +1357,7 @@ if (NILP (window)) window = Fselected_window (Qnil); - CHECK_WINDOW (window); + CHECK_LIVE_WINDOW (window); w = XWINDOW (window); start = marker_position (w->start[CURRENT_DISP]); @@ -1425,22 +1437,23 @@ return make_int (decode_window (window)->hscroll); } -#ifdef MODELINE_IS_SCROLLABLE DEFUN ("modeline-hscroll", Fmodeline_hscroll, 0, 1, 0, /* -Return the number of columns by which WINDOW's modeline is scrolled from -left margin. If the window has no modeline, return nil. +Return the horizontal scrolling ammount of WINDOW's modeline. +If the window has no modeline, return nil. */ (window)) { struct window *w = decode_window (window); - return (WINDOW_HAS_MODELINE_P (w)) ? make_int (w->modeline_hscroll) : Qnil; + return (WINDOW_HAS_MODELINE_P (w)) ? make_int ((int) w->modeline_hscroll) : + Qnil; } DEFUN ("set-modeline-hscroll", Fset_modeline_hscroll, 2, 2, 0, /* -Set number of columns WINDOW's modeline is scrolled from left margin to NCOL. -NCOL should be zero or positive. If NCOL is negative, it will be forced to 0. -If the window has no modeline, do nothing and return nil. +Set the horizontal scrolling ammount of WINDOW's modeline to NCOL. +If NCOL is negative, it will silently be forced to 0. +If the window has no modeline, return nil. Otherwise, return the actual +value that was set. */ (window, ncol)) { @@ -1448,18 +1461,20 @@ if (WINDOW_HAS_MODELINE_P (w)) { - int ncols; + Charcount ncols; + CHECK_INT (ncol); - ncols = XINT (ncol); - if (ncols < 0) ncols = 0; - if (w->modeline_hscroll != ncols) - MARK_MODELINE_CHANGED; - w->modeline_hscroll = ncols; - return ncol; + ncols = (XINT (ncol) <= 0) ? 0 : (Charcount) XINT (ncol); + if (ncols != w->modeline_hscroll) + { + MARK_MODELINE_CHANGED; + w->modeline_hscroll = ncols; + } + return make_int ((int) ncols); } + return Qnil; } -#endif /* MODELINE_IS_SCROLLABLE */ DEFUN ("set-window-hscroll", Fset_window_hscroll, 2, 2, 0, /* Set number of columns WINDOW is scrolled from left margin to NCOL. @@ -1608,6 +1623,28 @@ } } +DEFUN ("window-last-line-visible-height", Fwindow_last_line_visible_height, 0, 1, 0, /* +Return pixel height of visible part of last window line if it is clipped. +If the last line is not clipped, return nil. +*/ + (window)) +{ + struct window *w = decode_window (window); + display_line_dynarr *dla = window_display_lines (w, CURRENT_DISP); + int num_lines = Dynarr_length (dla); + struct display_line *dl; + + /* No lines - no clipped lines */ + if (num_lines == 0 || (num_lines == 1 && Dynarr_atp (dla, 0)->modeline)) + return Qnil; + + dl = Dynarr_atp (dla, num_lines - 1); + if (dl->clip == 0) + return Qnil; + + return make_int (dl->ascent + dl->descent - dl->clip); +} + DEFUN ("set-window-point", Fset_window_point, 2, 2, 0, /* Make point value in WINDOW be at position POS in WINDOW's buffer. */ @@ -1853,6 +1890,12 @@ par = XWINDOW (parent); MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f); + /* It's quite likely that deleting a window will result in + subwindows needing to be deleted also (since they are cached + per-window). So we mark them as changed, so that the cachels will + get reset by redisplay and thus deleted subwindows can get + GC'd. */ + MARK_FRAME_SUBWINDOWS_CHANGED (f); /* Are we trying to delete any frame's selected window? Note that we could be dealing with a non-leaf window @@ -2584,7 +2627,7 @@ new_buffer = Fother_buffer (obj, Qnil, Qnil); if (NILP (new_buffer)) new_buffer = Fget_buffer_create (QSscratch); - Fset_window_buffer (w, new_buffer); + Fset_window_buffer (w, new_buffer, Qnil); if (EQ (w, Fselected_window (Qnil))) Fset_buffer (p->buffer); } @@ -2656,7 +2699,7 @@ /* Otherwise show a different buffer in the window. */ p->dedicated = Qnil; - Fset_window_buffer (w, another_buffer); + Fset_window_buffer (w, another_buffer, Qnil); if (EQ (w, Fselected_window (Qnil))) Fset_buffer (p->buffer); } @@ -2957,17 +3000,41 @@ window_min_height = MIN_SAFE_WINDOW_HEIGHT; } +static int +frame_min_height (struct frame *frame) +{ + /* For height, we have to see whether the frame has a minibuffer, and + whether it wants a modeline. */ + return (FRAME_MINIBUF_ONLY_P (frame) ? MIN_SAFE_WINDOW_HEIGHT - 1 + : (! FRAME_HAS_MINIBUF_P (frame)) ? MIN_SAFE_WINDOW_HEIGHT + : 2 * MIN_SAFE_WINDOW_HEIGHT - 1); +} + +/* Return non-zero if both frame sizes are less than or equal to + minimal allowed values. ROWS and COLS are in characters */ +int +frame_size_valid_p (struct frame *frame, int rows, int cols) +{ + return (rows >= frame_min_height (frame) + && cols >= MIN_SAFE_WINDOW_WIDTH); +} + +/* Return non-zero if both frame sizes are less than or equal to + minimal allowed values. WIDTH and HEIGHT are in pixels */ +int +frame_pixsize_valid_p (struct frame *frame, int width, int height) +{ + int rows, cols; + pixel_to_real_char_size (frame, width, height, &cols, &rows); + return frame_size_valid_p (frame, rows, cols); +} + /* If *ROWS or *COLS are too small a size for FRAME, set them to the minimum allowable size. */ void check_frame_size (struct frame *frame, int *rows, int *cols) { - /* For height, we have to see whether the frame has a minibuffer, and - whether it wants a modeline. */ - int min_height = - (FRAME_MINIBUF_ONLY_P (frame) ? MIN_SAFE_WINDOW_HEIGHT - 1 - : (! FRAME_HAS_MINIBUF_P (frame)) ? MIN_SAFE_WINDOW_HEIGHT - : 2 * MIN_SAFE_WINDOW_HEIGHT - 1); + int min_height = frame_min_height (frame); if (*rows < min_height) *rows = min_height; @@ -3117,11 +3184,14 @@ static int window_select_count; -DEFUN ("set-window-buffer", Fset_window_buffer, 2, 2, 0, /* +DEFUN ("set-window-buffer", Fset_window_buffer, 2, 3, 0, /* Make WINDOW display BUFFER as its contents. BUFFER can be a buffer or buffer name. + +With non-nil optional argument `norecord', do not modify the +global or per-frame buffer ordering. */ - (window, buffer)) + (window, buffer, norecord)) { Lisp_Object tem; struct window *w = decode_window (window); @@ -3180,6 +3250,9 @@ recompute_all_cached_specifiers_in_window (w); if (EQ (window, Fselected_window (Qnil))) { + if (NILP (norecord)) + Frecord_buffer (buffer); + Fset_buffer (buffer); } return Qnil; @@ -3319,7 +3392,7 @@ { Lisp_Object new; struct window *o = XWINDOW (window); - struct window *p = alloc_lcrecord_type (struct window, lrecord_window); + struct window *p = alloc_lcrecord_type (struct window, &lrecord_window); XSETWINDOW (new, p); copy_lcrecord (p, o); @@ -3366,7 +3439,7 @@ if (NILP (window)) window = Fselected_window (Qnil); else - CHECK_WINDOW (window); + CHECK_LIVE_WINDOW (window); o = XWINDOW (window); f = XFRAME (WINDOW_FRAME (o)); @@ -3482,7 +3555,7 @@ /* do this last (after the window is completely initialized and the mirror-dirty flag is set) so that specifier recomputation caused as a result of this will work properly and not abort. */ - Fset_window_buffer (new, o->buffer); + Fset_window_buffer (new, o->buffer, Qt); return new; } @@ -3926,6 +3999,8 @@ SET_LAST_MODIFIED (w, 0); SET_LAST_FACECHANGE (w); MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f); + /* overkill maybe, but better to be correct */ + MARK_FRAME_GUTTERS_CHANGED (f); } #undef MINSIZE #undef CURBEG @@ -3935,7 +4010,8 @@ -/* Scroll contents of window WINDOW up N lines. */ +/* Scroll contents of window WINDOW up N lines. If N < (top line height / + average line height) then we just adjust the top clip. */ void window_scroll (Lisp_Object window, Lisp_Object n, int direction, Error_behavior errb) @@ -3945,6 +4021,9 @@ int selected = EQ (window, Fselected_window (Qnil)); int value = 0; Lisp_Object point, tem; + display_line_dynarr *dla; + int fheight, fwidth, modeline = 0; + struct display_line* dl; if (selected) point = make_int (BUF_PT (b)); @@ -3974,6 +4053,7 @@ window, Qnil); Fset_marker (w->start[CURRENT_DISP], point, w->buffer); w->start_at_line_beg = beginning_of_line_p (b, XINT (point)); + WINDOW_TEXT_TOP_CLIP (w) = 0; MARK_WINDOWS_CHANGED (w); } @@ -4017,82 +4097,164 @@ { return; } - else if (value > 0) + + /* Determine parameters to test for partial line scrolling with. */ + dla = window_display_lines (w, CURRENT_DISP); + + if (INTP (Vwindow_pixel_scroll_increment)) + fheight = XINT (Vwindow_pixel_scroll_increment); + else if (!NILP (Vwindow_pixel_scroll_increment)) + default_face_height_and_width (window, &fheight, &fwidth); + + if (Dynarr_length (dla) >= 1) + modeline = Dynarr_atp (dla, 0)->modeline; + + dl = Dynarr_atp (dla, modeline); + + if (value > 0) { - int vtarget; - Bufpos startp, old_start; - - old_start = marker_position (w->start[CURRENT_DISP]); - startp = vmotion (w, old_start, value, &vtarget); - - if (vtarget < value && - (w->window_end_pos[CURRENT_DISP] == -1 - || (BUF_Z (b) - w->window_end_pos[CURRENT_DISP] > BUF_ZV (b)))) + /* Go for partial display line scrolling. This just means bumping + the clip by a reasonable amount and redisplaying, everything else + remains unchanged. */ + if (!NILP (Vwindow_pixel_scroll_increment) + && + Dynarr_length (dla) >= (1 + modeline) + && + (dl->ascent - dl->top_clip) - fheight * value > 0) { - maybe_signal_error (Qend_of_buffer, Qnil, Qwindow, errb); - return; + WINDOW_TEXT_TOP_CLIP (w) += value * fheight; + MARK_WINDOWS_CHANGED (w); } else { - set_marker_restricted (w->start[CURRENT_DISP], make_int (startp), - w->buffer); - w->force_start = 1; - w->start_at_line_beg = beginning_of_line_p (b, startp); - MARK_WINDOWS_CHANGED (w); - - if (!point_would_be_visible (w, startp, XINT (point))) + int vtarget; + Bufpos startp, old_start; + + if (WINDOW_TEXT_TOP_CLIP (w)) + { + WINDOW_TEXT_TOP_CLIP (w) = 0; + MARK_WINDOWS_CHANGED (w); + } + + old_start = marker_position (w->start[CURRENT_DISP]); + startp = vmotion (w, old_start, value, &vtarget); + + if (vtarget < value && + (w->window_end_pos[CURRENT_DISP] == -1 + || (BUF_Z (b) - w->window_end_pos[CURRENT_DISP] > BUF_ZV (b)))) { - if (selected) - BUF_SET_PT (b, startp); - else - set_marker_restricted (w->pointm[CURRENT_DISP], - make_int (startp), - w->buffer); + maybe_signal_error (Qend_of_buffer, Qnil, Qwindow, errb); + return; + } + else + { + set_marker_restricted (w->start[CURRENT_DISP], make_int (startp), + w->buffer); + w->force_start = 1; + w->start_at_line_beg = beginning_of_line_p (b, startp); + MARK_WINDOWS_CHANGED (w); + + if (!point_would_be_visible (w, startp, XINT (point))) + { + if (selected) + BUF_SET_PT (b, startp); + else + set_marker_restricted (w->pointm[CURRENT_DISP], + make_int (startp), + w->buffer); + } } } } else if (value < 0) { - int vtarget; - Bufpos startp, old_start; - - old_start = marker_position (w->start[CURRENT_DISP]); - startp = vmotion (w, old_start, value, &vtarget); - - if (vtarget > value - && marker_position (w->start[CURRENT_DISP]) == BUF_BEGV (b)) + /* Go for partial display line scrolling. This just means bumping + the clip by a reasonable amount and redisplaying, everything else + remains unchanged. */ + if (!NILP (Vwindow_pixel_scroll_increment) + && + Dynarr_length (dla) >= (1 + modeline) + && + (dl->ascent - dl->top_clip) - fheight * value < + (dl->ascent + dl->descent - dl->clip) + && + WINDOW_TEXT_TOP_CLIP (w) + value * fheight > 0) { - maybe_signal_error (Qbeginning_of_buffer, Qnil, Qwindow, errb); - return; + WINDOW_TEXT_TOP_CLIP (w) += value * fheight; + MARK_WINDOWS_CHANGED (w); } else { - set_marker_restricted (w->start[CURRENT_DISP], make_int (startp), - w->buffer); - w->force_start = 1; - w->start_at_line_beg = beginning_of_line_p (b, startp); - MARK_WINDOWS_CHANGED (w); - - if (!point_would_be_visible (w, startp, XINT (point))) + int vtarget; + Bufpos startp, old_start; + + if (WINDOW_TEXT_TOP_CLIP (w)) + { + WINDOW_TEXT_TOP_CLIP (w) = 0; + MARK_WINDOWS_CHANGED (w); + } + + old_start = marker_position (w->start[CURRENT_DISP]); + startp = vmotion (w, old_start, value, &vtarget); + + if (vtarget > value + && marker_position (w->start[CURRENT_DISP]) == BUF_BEGV (b)) + { + maybe_signal_error (Qbeginning_of_buffer, Qnil, Qwindow, errb); + return; + } + else { - Bufpos new_point; - - if (MINI_WINDOW_P (w)) - new_point = startp; - else - new_point = start_of_last_line (w, startp); - - if (selected) - BUF_SET_PT (b, new_point); - else - set_marker_restricted (w->pointm[CURRENT_DISP], - make_int (new_point), - w->buffer); + set_marker_restricted (w->start[CURRENT_DISP], make_int (startp), + w->buffer); + w->force_start = 1; + w->start_at_line_beg = beginning_of_line_p (b, startp); + MARK_WINDOWS_CHANGED (w); + + /* #### Scroll back by less than a line. This code was + originally for scrolling over large pixmaps and it + loses when a line being *exposed* at the top of the + window is bigger than the current one. However, for + pixel based scrolling in general we can guess that + the line we are going to display is probably the same + size as the one we are on. In that instance we can + have a reasonable stab at a suitable top clip. Fixing + this properly is hard (and probably slow) as we would + have to call redisplay to figure out the exposed line + size. */ + if (!NILP (Vwindow_pixel_scroll_increment) + && Dynarr_length (dla) >= (1 + modeline) + && dl->ascent + fheight * value > 0) + { + WINDOW_TEXT_TOP_CLIP (w) = (dl->ascent + fheight * value); + } + + if (!point_would_be_visible (w, startp, XINT (point))) + { + Bufpos new_point; + + if (MINI_WINDOW_P (w)) + new_point = startp; + else + new_point = start_of_last_line (w, startp); + + if (selected) + BUF_SET_PT (b, new_point); + else + set_marker_restricted (w->pointm[CURRENT_DISP], + make_int (new_point), + w->buffer); + } } } } else /* value == 0 && direction == -1 */ { + if (WINDOW_TEXT_TOP_CLIP (w)) + { + WINDOW_TEXT_TOP_CLIP (w) = 0; + MARK_WINDOWS_CHANGED (w); + } if (marker_position (w->start[CURRENT_DISP]) == BUF_BEGV (b)) { maybe_signal_error (Qbeginning_of_buffer, Qnil, Qwindow, errb); @@ -4130,7 +4292,6 @@ } } } - } DEFUN ("scroll-up", Fscroll_up, 0, 1, "_P", /* @@ -4304,7 +4465,7 @@ if (NILP (window)) window = Fselected_window (Qnil); else - CHECK_WINDOW (window); + CHECK_LIVE_WINDOW (window); w = XWINDOW (window); b = XBUFFER (w->buffer); @@ -4606,7 +4767,7 @@ int pixel_width; int pixel_height; int hscroll; - int modeline_hscroll; + Charcount modeline_hscroll; int parent_index; /* index into saved_windows */ int prev_index; /* index into saved_windows */ char start_at_line_beg; /* boolean */ @@ -4621,8 +4782,8 @@ struct window_config { struct lcrecord_header header; - int frame_width; - int frame_height; + /* int frame_width; No longer needed, JV + int frame_height; */ #if 0 /* FSFmacs */ Lisp_Object selected_frame; #endif @@ -4630,6 +4791,7 @@ Lisp_Object current_buffer; Lisp_Object minibuffer_scroll_window; Lisp_Object root_window; + int minibuf_height; /* 0 = no minibuffer, <0, size in lines, >0 in pixels */ /* Record the values of window-min-width and window-min-height so that window sizes remain consistent with them. */ int min_width, min_height; @@ -4642,36 +4804,35 @@ #define XWINDOW_CONFIGURATION(x) XRECORD (x, window_configuration, struct window_config) #define XSETWINDOW_CONFIGURATION(x, p) XSETRECORD (x, p, window_configuration) #define WINDOW_CONFIGURATIONP(x) RECORDP (x, window_configuration) -#define GC_WINDOW_CONFIGURATIONP(x) GC_RECORDP (x, window_configuration) #define CHECK_WINDOW_CONFIGURATION(x) CHECK_RECORD (x, window_configuration) static Lisp_Object -mark_window_config (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_window_config (Lisp_Object obj) { struct window_config *config = XWINDOW_CONFIGURATION (obj); int i; - markobj (config->current_window); - markobj (config->current_buffer); - markobj (config->minibuffer_scroll_window); - markobj (config->root_window); + mark_object (config->current_window); + mark_object (config->current_buffer); + mark_object (config->minibuffer_scroll_window); + mark_object (config->root_window); for (i = 0; i < config->saved_windows_count; i++) { struct saved_window *s = SAVED_WINDOW_N (config, i); - markobj (s->window); - markobj (s->buffer); - markobj (s->start); - markobj (s->pointm); - markobj (s->sb_point); - markobj (s->mark); + mark_object (s->window); + mark_object (s->buffer); + mark_object (s->start); + mark_object (s->pointm); + mark_object (s->sb_point); + mark_object (s->mark); #if 0 /* #### This looked like this. I do not see why specifier cached values should not be marked, as such specifiers as toolbars might have GC-able instances. Freed configs are not marked, aren't they? -- kkm */ - markobj (s->dedicated); + mark_object (s->dedicated); #else -#define WINDOW_SLOT(slot, compare) ((void) (markobj (s->slot))) +#define WINDOW_SLOT(slot, compare) mark_object (s->slot) #include "winslots.h" #endif } @@ -4687,9 +4848,9 @@ } static size_t -sizeof_window_config (CONST void *h) -{ - CONST struct window_config *c = (CONST struct window_config *) h; +sizeof_window_config (const void *h) +{ + const struct window_config *c = (const struct window_config *) h; return sizeof_window_config_for_n_windows (c->saved_windows_count); } @@ -4710,7 +4871,7 @@ window_configuration, mark_window_config, print_window_config, - 0, 0, 0, sizeof_window_config, + 0, 0, 0, 0, sizeof_window_config, struct window_config); @@ -4761,9 +4922,10 @@ EQ (fig1->current_window, fig2->current_window) && EQ (fig1->current_buffer, fig2->current_buffer) && EQ (fig1->root_window, fig2->root_window) && - EQ (fig1->minibuffer_scroll_window, fig2->minibuffer_scroll_window) && + EQ (fig1->minibuffer_scroll_window, fig2->minibuffer_scroll_window))) + /* && fig1->frame_width == fig2->frame_width && - fig1->frame_height == fig2->frame_height)) + fig1->frame_height == fig2->frame_height)) */ return 0; for (i = 0; i < fig1->saved_windows_count; i++) @@ -4859,8 +5021,15 @@ struct frame *f; struct gcpro gcpro1; Lisp_Object old_window_config; - int previous_frame_height; - int previous_frame_width; + /* int previous_frame_height; + int previous_frame_width;*/ + int previous_pixel_top; + int previous_pixel_height; + int previous_pixel_left; + int previous_pixel_width; + int previous_minibuf_height, previous_minibuf_top,previous_minibuf_width; + int real_font_height; + int converted_minibuf_height,target_minibuf_height; int specpdl_count = specpdl_depth (); GCPRO1 (configuration); @@ -4925,6 +5094,20 @@ mark_windows_in_use (f, 1); +#if 0 + /* JV: This is bogus, + First of all, the units are inconsistent. The frame sizes are measured + in characters but the window sizes are stored in pixels. So if a + font size change happened between saving and restoring, the + frame "sizes" maybe equal but the windows still should be + resized. This is tickled alot by the new "character size + stays constant" policy in 21.0. It leads to very wierd + glitches (and possibly craches when asserts are tickled). + + Just changing the units doens't help because changing the + toolbar configuration can also change the pixel positions. + Luckily there is a much simpler way of doing this, see below. + */ previous_frame_width = FRAME_WIDTH (f); previous_frame_height = FRAME_HEIGHT (f); /* If the frame has been resized since this window configuration was @@ -4934,6 +5117,37 @@ if (config->frame_height != FRAME_HEIGHT (f) || config->frame_width != FRAME_WIDTH (f)) change_frame_size (f, config->frame_height, config->frame_width, 0); +#endif + + previous_pixel_top = XWINDOW (FRAME_ROOT_WINDOW (f))->pixel_top; + previous_pixel_height = XWINDOW (FRAME_ROOT_WINDOW (f))->pixel_height; + previous_pixel_left = XWINDOW (FRAME_ROOT_WINDOW (f))->pixel_left; + previous_pixel_width = XWINDOW (FRAME_ROOT_WINDOW (f))->pixel_width; + + /* remember some properties of the minibuffer */ + + default_face_height_and_width (frame, &real_font_height, 0); + assert(real_font_height > 0); + + if (FRAME_HAS_MINIBUF_P (f) && ! FRAME_MINIBUF_ONLY_P (f)) + { + previous_minibuf_height + = XWINDOW(FRAME_MINIBUF_WINDOW(f))->pixel_height; + previous_minibuf_top + = XWINDOW(FRAME_MINIBUF_WINDOW(f))->pixel_top; + previous_minibuf_width + = XWINDOW(FRAME_MINIBUF_WINDOW(f))->pixel_width; + } + else + { + previous_minibuf_height = 0; + previous_minibuf_top = 0; + previous_minibuf_width = 0; + } + converted_minibuf_height = + (previous_minibuf_height % real_font_height) == 0 ? + - (previous_minibuf_height / real_font_height ) : /* lines */ + previous_minibuf_height; /* pixels */ /* Temporarily avoid any problems with windows that are smaller than they are supposed to be. */ @@ -5022,7 +5236,7 @@ SET_LAST_FACECHANGE (w); w->config_mark = 0; -#define WINDOW_SLOT(slot, compare) w->slot = p->slot; +#define WINDOW_SLOT(slot, compare) w->slot = p->slot #include "winslots.h" /* Reinstall the saved buffer and pointers into it. */ @@ -5100,10 +5314,60 @@ currently selected, or just set the selected window of the window config's frame. */ +#if 0 /* Set the frame height to the value it had before this function. */ if (previous_frame_height != FRAME_HEIGHT (f) || previous_frame_width != FRAME_WIDTH (f)) change_frame_size (f, previous_frame_height, previous_frame_width, 0); +#endif + /* We just reset the size and position of the minibuffer, to its old + value, which needn't be valid. So we do some magic to see which value + to actually take. Then we set it. + + The magic: + We take the old value if is in the same units but differs from the + current value. + + #### Now we get more cases correct then ever before, but + are we treating all? For instance what if the frames minibuf window + is no longer the same one? + */ + target_minibuf_height = previous_minibuf_height; + if (converted_minibuf_height && + (converted_minibuf_height * config->minibuf_height) > 0 && + (converted_minibuf_height != config->minibuf_height)) + { + target_minibuf_height = config->minibuf_height < 0 ? + - (config->minibuf_height * real_font_height) : + config->minibuf_height; + target_minibuf_height = + max(target_minibuf_height,real_font_height); + } + if (previous_minibuf_height) + { + XWINDOW (FRAME_MINIBUF_WINDOW (f))->pixel_top + = previous_minibuf_top - + (target_minibuf_height - previous_minibuf_height); + set_window_pixheight (FRAME_MINIBUF_WINDOW (f), + target_minibuf_height, 0); + set_window_pixwidth (FRAME_MINIBUF_WINDOW (f), + previous_minibuf_width, 0); + } + + /* This is a better way to deal with frame resizing, etc. + What we _actually_ want is for the old (just restored) + root window to fit + into the place of the new one. So we just do that. Simple! */ + XWINDOW (FRAME_ROOT_WINDOW (f))->pixel_top = previous_pixel_top; + /* Note that this function also updates the subwindow + "pixel_top"s */ + set_window_pixheight (FRAME_ROOT_WINDOW (f), + previous_pixel_height - + (target_minibuf_height - previous_minibuf_height), 0); + XWINDOW (FRAME_ROOT_WINDOW (f))->pixel_left = previous_pixel_left; + /* Note that this function also updates the subwindow + "pixel_left"s */ + set_window_pixwidth (FRAME_ROOT_WINDOW (f), previous_pixel_width, 0); /* If restoring in the current frame make the window current, otherwise just update the frame selected_window slot to be @@ -5246,7 +5510,7 @@ p->hscroll = w->hscroll; p->modeline_hscroll = w->modeline_hscroll; -#define WINDOW_SLOT(slot, compare) p->slot = w->slot; +#define WINDOW_SLOT(slot, compare) p->slot = w->slot #include "winslots.h" if (!NILP (w->buffer)) @@ -5319,6 +5583,8 @@ struct frame *f = decode_frame (frame); struct window_config *config; int n_windows = count_windows (XWINDOW (FRAME_ROOT_WINDOW (f))); + int minibuf_height; + int real_font_height; if (n_windows <= countof (Vwindow_configuration_free_list)) config = XWINDOW_CONFIGURATION (allocate_managed_lcrecord @@ -5328,11 +5594,11 @@ /* More than ten windows; just allocate directly */ config = (struct window_config *) alloc_lcrecord (sizeof_window_config_for_n_windows (n_windows), - lrecord_window_configuration); + &lrecord_window_configuration); XSETWINDOW_CONFIGURATION (result, config); - + /* config->frame_width = FRAME_WIDTH (f); - config->frame_height = FRAME_HEIGHT (f); + config->frame_height = FRAME_HEIGHT (f); */ config->current_window = FRAME_SELECTED_WINDOW (f); XSETBUFFER (config->current_buffer, current_buffer); config->minibuffer_scroll_window = Vminibuffer_scroll_window; @@ -5341,6 +5607,22 @@ config->min_width = window_min_width; config->saved_windows_count = n_windows; save_window_save (FRAME_ROOT_WINDOW (f), config, 0); + + /* save the minibuffer height using the heuristics from + change_frame_size_1 */ + + XSETFRAME (frame, f); /* frame could have been nil ! */ + default_face_height_and_width (frame, &real_font_height, 0); + assert(real_font_height > 0); + + if (FRAME_HAS_MINIBUF_P (f) && ! FRAME_MINIBUF_ONLY_P (f)) + minibuf_height = XWINDOW(FRAME_MINIBUF_WINDOW(f))->pixel_height; + else + minibuf_height = 0; + config->minibuf_height = (minibuf_height % real_font_height) == 0 ? + - (minibuf_height / real_font_height ) : /* lines */ + minibuf_height; /* pixels */ + return result; } @@ -5370,6 +5652,78 @@ return unbind_to (speccount, val); } +DEFUN ("current-pixel-column", Fcurrent_pixel_column, 0, 2, 0, /* +Return the horizontal pixel position of POS in window. +Beginning of line is column 0. This is calculated using the redisplay +display tables. If WINDOW is nil, the current window is assumed. +If POS is nil, point is assumed. Note that POS must be visible for +a non-nil result to be returned. +*/ + (window, pos)) +{ + struct window* w = decode_window (window); + display_line_dynarr *dla = window_display_lines (w, CURRENT_DISP); + + struct display_line *dl = 0; + struct display_block *db = 0; + struct rune* rb = 0; + int y = w->last_point_y[CURRENT_DISP]; + int x = w->last_point_x[CURRENT_DISP]; + + if (MINI_WINDOW_P (w)) + return Qnil; + + if (y<0 || x<0 || y >= Dynarr_length (dla) || !NILP (pos)) + { + int first_line, i; + Bufpos point; + + if (NILP (pos)) + pos = Fwindow_point (window); + + CHECK_INT (pos); + point = XINT (pos); + + if (Dynarr_length (dla) && Dynarr_atp (dla, 0)->modeline) + first_line = 1; + else + first_line = 0; + + for (i = first_line; i < Dynarr_length (dla); i++) + { + dl = Dynarr_atp (dla, i); + /* find the vertical location first */ + if (point >= dl->bufpos && point <= dl->end_bufpos) + { + db = get_display_block_from_line (dl, TEXT); + for (i = 0; i < Dynarr_length (db->runes); i++) + { + rb = Dynarr_atp (db->runes, i); + if (point <= rb->bufpos) + goto found_bufpos; + } + return Qnil; + } + } + return Qnil; + found_bufpos: + ; + } + else + { + /* optimised case */ + dl = Dynarr_atp (dla, y); + db = get_display_block_from_line (dl, TEXT); + + if (x >= Dynarr_length (db->runes)) + return Qnil; + + rb = Dynarr_atp (db->runes, x); + } + + return make_int (rb->xpos - WINDOW_LEFT (w)); +} + #ifdef DEBUG_XEMACS /* This is short and simple in elisp, but... it was written to debug @@ -5422,8 +5776,6 @@ defsymbol (&Qwindowp, "windowp"); defsymbol (&Qwindow_live_p, "window-live-p"); defsymbol (&Qwindow_configurationp, "window-configuration-p"); - defsymbol (&Qscroll_up, "scroll-up"); - defsymbol (&Qscroll_down, "scroll-down"); defsymbol (&Qtemp_buffer_show_hook, "temp-buffer-show-hook"); defsymbol (&Qdisplay_buffer, "display-buffer"); @@ -5439,6 +5791,7 @@ #endif DEFSUBR (Fselected_window); + DEFSUBR (Flast_nonminibuf_window); DEFSUBR (Fminibuffer_window); DEFSUBR (Fwindow_minibuffer_p); DEFSUBR (Fwindowp); @@ -5449,6 +5802,7 @@ DEFSUBR (Fwindow_previous_child); DEFSUBR (Fwindow_parent); DEFSUBR (Fwindow_lowest_p); + DEFSUBR (Fwindow_truncated_p); DEFSUBR (Fwindow_highest_p); DEFSUBR (Fwindow_leftmost_p); DEFSUBR (Fwindow_rightmost_p); @@ -5464,20 +5818,19 @@ DEFSUBR (Fwindow_displayed_text_pixel_height); DEFSUBR (Fwindow_text_area_pixel_width); DEFSUBR (Fwindow_hscroll); -#ifdef MODELINE_IS_SCROLLABLE + DEFSUBR (Fset_window_hscroll); DEFSUBR (Fmodeline_hscroll); DEFSUBR (Fset_modeline_hscroll); -#endif /* MODELINE_IS_SCROLLABLE */ #if 0 /* bogus FSF crock */ DEFSUBR (Fwindow_redisplay_end_trigger); DEFSUBR (Fset_window_redisplay_end_trigger); #endif - DEFSUBR (Fset_window_hscroll); DEFSUBR (Fwindow_pixel_edges); DEFSUBR (Fwindow_text_area_pixel_edges); DEFSUBR (Fwindow_point); DEFSUBR (Fwindow_start); DEFSUBR (Fwindow_end); + DEFSUBR (Fwindow_last_line_visible_height); DEFSUBR (Fset_window_point); DEFSUBR (Fset_window_start); DEFSUBR (Fwindow_dedicated_p); @@ -5517,14 +5870,30 @@ DEFSUBR (Fset_window_configuration); DEFSUBR (Fcurrent_window_configuration); DEFSUBR (Fsave_window_excursion); + DEFSUBR (Fcurrent_pixel_column); +} + +void +reinit_vars_of_window (void) +{ + int i; + /* Make sure all windows get marked */ + minibuf_window = Qnil; + staticpro_nodump (&minibuf_window); + + for (i = 0; i < countof (Vwindow_configuration_free_list); i++) + { + Vwindow_configuration_free_list[i] = + make_lcrecord_list (sizeof_window_config_for_n_windows (i + 1), + &lrecord_window_configuration); + staticpro_nodump (&Vwindow_configuration_free_list[i]); + } } void vars_of_window (void) { - /* Make sure all windows get marked */ - minibuf_window = Qnil; - staticpro (&minibuf_window); + reinit_vars_of_window (); DEFVAR_BOOL ("scroll-on-clipped-lines", &scroll_on_clipped_lines /* *Non-nil means to scroll if point lands on a line which is clipped. @@ -5555,6 +5924,13 @@ */ ); Vother_window_scroll_buffer = Qnil; + DEFVAR_LISP ("window-pixel-scroll-increment", &Vwindow_pixel_scroll_increment /* +*Number of pixels to scroll by per requested line. +If nil then normal line scrolling occurs regardless of line height. +If t then scrolling is done in increments equal to the height of the default face. +*/ ); + Vwindow_pixel_scroll_increment = Qt; + DEFVAR_INT ("next-screen-context-lines", &next_screen_context_lines /* *Number of lines of continuity when scrolling by screenfuls. */ ); @@ -5569,18 +5945,6 @@ *Delete any window less than this wide. */ ); window_min_width = 10; - - { - int i; - - for (i = 0; i < countof (Vwindow_configuration_free_list); i++) - { - Vwindow_configuration_free_list[i] = - make_lcrecord_list (sizeof_window_config_for_n_windows (i + 1), - lrecord_window_configuration); - staticpro (&Vwindow_configuration_free_list[i]); - } - } } void @@ -5601,8 +5965,7 @@ Fadd_spec_to_specifier (Vmodeline_shadow_thickness, make_int (2), Qnil, Qnil, Qnil); set_specifier_caching (Vmodeline_shadow_thickness, - slot_offset (struct window, - modeline_shadow_thickness), + offsetof (struct window, modeline_shadow_thickness), modeline_shadow_thickness_changed, 0, 0); @@ -5614,8 +5977,7 @@ set_specifier_fallback (Vhas_modeline_p, list1 (Fcons (Qnil, Qt))); set_specifier_caching (Vhas_modeline_p, - slot_offset (struct window, - has_modeline_p), + offsetof (struct window, has_modeline_p), /* #### It's strange that we need a special flag to indicate that the shadow-thickness has changed, but not one to indicate that @@ -5637,8 +5999,8 @@ set_specifier_fallback (Vvertical_divider_always_visible_p, list1 (Fcons (Qnil, Qt))); set_specifier_caching (Vvertical_divider_always_visible_p, - slot_offset (struct window, - vertical_divider_always_visible_p), + offsetof (struct window, + vertical_divider_always_visible_p), vertical_divider_changed_in_window, 0, 0); @@ -5652,8 +6014,8 @@ Fadd_spec_to_specifier (Vvertical_divider_shadow_thickness, make_int (2), Qnil, Qnil, Qnil); set_specifier_caching (Vvertical_divider_shadow_thickness, - slot_offset (struct window, - vertical_divider_shadow_thickness), + offsetof (struct window, + vertical_divider_shadow_thickness), vertical_divider_changed_in_window, 0, 0); DEFVAR_SPECIFIER ("vertical-divider-line-width", &Vvertical_divider_line_width /* @@ -5683,8 +6045,8 @@ set_specifier_fallback (Vvertical_divider_line_width, fb); } set_specifier_caching (Vvertical_divider_line_width, - slot_offset (struct window, - vertical_divider_line_width), + offsetof (struct window, + vertical_divider_line_width), vertical_divider_changed_in_window, 0, 0); @@ -5713,8 +6075,7 @@ set_specifier_fallback (Vvertical_divider_spacing, fb); } set_specifier_caching (Vvertical_divider_spacing, - slot_offset (struct window, - vertical_divider_spacing), + offsetof (struct window, vertical_divider_spacing), vertical_divider_changed_in_window, 0, 0); } diff -r f4aeb21a5bad -r 74fd4e045ea6 src/window.h --- a/src/window.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/window.h Mon Aug 13 11:13:30 2007 +0200 @@ -24,8 +24,8 @@ /* Synched up with: FSF 19.30. */ -#ifndef _XEMACS_WINDOW_H_ -#define _XEMACS_WINDOW_H_ +#ifndef INCLUDED_window_h_ +#define INCLUDED_window_h_ #include "redisplay.h" #ifdef HAVE_SCROLLBARS @@ -129,7 +129,15 @@ /* Number of columns display within the window is scrolled to the left. */ int hscroll; /* Idem for the window's modeline */ - int modeline_hscroll; + Charcount modeline_hscroll; + /* Amount to clip off the top line for pixel-based scrolling. Point + will remain constant but this will be incremented to + incrementally shift lines up. */ + int top_yoffset; + /* Amount to clip off the left of the lines for pixel-based + scrolling. Hscroll will remain constant but this will be + incremented to incrementally shift lines left.*/ + int left_xoffset; /* Number saying how recently window was selected */ Lisp_Object use_time; /* text.modified of displayed buffer as of last time display completed */ @@ -254,7 +262,6 @@ #define XWINDOW(x) XRECORD (x, window, struct window) #define XSETWINDOW(x, p) XSETRECORD (x, p, window) #define WINDOWP(x) RECORDP (x, window) -#define GC_WINDOWP(x) GC_RECORDP (x, window) #define CHECK_WINDOW(x) CHECK_RECORD (x, window) #define CONCHECK_WINDOW(x) CONCHECK_RECORD (x, window) @@ -303,7 +310,7 @@ EXFUN (Freplace_buffer_in_windows, 1); EXFUN (Fselect_window, 2); EXFUN (Fselected_window, 1); -EXFUN (Fset_window_buffer, 2); +EXFUN (Fset_window_buffer, 3); EXFUN (Fset_window_hscroll, 2); EXFUN (Fset_window_point, 2); EXFUN (Fset_window_start, 3); @@ -329,6 +336,8 @@ int window_displayed_height (struct window *); int window_is_leftmost (struct window *w); int window_is_rightmost (struct window *w); +int window_is_lowest (struct window *w); +int window_is_highest (struct window *w); int window_truncation_on (struct window *w); int window_needs_vertical_divider (struct window *); int window_scrollbar_width (struct window *w); @@ -340,7 +349,6 @@ int window_bottom_gutter_height (struct window *w); int window_left_gutter_width (struct window *w, int modeline); int window_right_gutter_width (struct window *w, int modeline); -int window_bottom_toolbar_height (struct window *w); void delete_all_subwindows (struct window *w); void set_window_pixheight (Lisp_Object window, int pixheight, @@ -352,6 +360,8 @@ int buffer_window_count (struct buffer *b, struct frame *f); int buffer_window_mru (struct window *w); void check_frame_size (struct frame *frame, int *rows, int *cols); +int frame_pixsize_valid_p (struct frame *frame, int width, int height); +int frame_size_valid_p (struct frame *frame, int rows, int cols); struct window *decode_window (Lisp_Object window); struct window *find_window_by_pixel_pos (int pix_x, int pix_y, Lisp_Object win); @@ -381,6 +391,7 @@ /* XEmacs window size and positioning macros. */ #define WINDOW_TOP(w) ((w)->pixel_top) #define WINDOW_TEXT_TOP(w) (WINDOW_TOP (w) + window_top_gutter_height (w)) +#define WINDOW_TEXT_TOP_CLIP(w) ((w)->top_yoffset) #define WINDOW_BOTTOM(w) ((w)->pixel_top + (w)->pixel_height) #define WINDOW_TEXT_BOTTOM(w) (WINDOW_BOTTOM (w) - window_bottom_gutter_height (w)) #define WINDOW_LEFT(w) ((w)->pixel_left) @@ -416,4 +427,4 @@ #endif /* emacs */ -#endif /* _XEMACS_WINDOW_H_ */ +#endif /* INCLUDED_window_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/winslots.h --- a/src/winslots.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/winslots.h Mon Aug 13 11:13:30 2007 +0200 @@ -97,6 +97,29 @@ WINDOW_SLOT (default_toolbar_visible_p, EQ); WINDOW_SLOT (default_toolbar_border_width, EQ); #endif /* HAVE_TOOLBARS */ + + /* Gutter specification for each of the four positions. + This is not a size hog because the value here is not copied, + and will be shared with the specs in the specifier. */ + WINDOW_SLOT_ARRAY (gutter, 4, EQUAL_WRAPPED); + /* Gutter size for each of the four positions. */ + WINDOW_SLOT_ARRAY (gutter_size, 4, EQUAL_WRAPPED); + /* Real (pre-calculated) gutter size for each of the four positions. + This is not a specifier, it is calculated by the specifier change + functions. */ + WINDOW_SLOT_ARRAY (real_gutter_size, 4, EQUAL_WRAPPED); + /* Gutter border width for each of the four positions. */ + WINDOW_SLOT_ARRAY (gutter_border_width, 4, EQUAL_WRAPPED); + /* Gutter visibility status for each of the four positions. */ + WINDOW_SLOT_ARRAY (gutter_visible_p, 4, EQUAL_WRAPPED); + /* The following five don't really need to be cached except + that we need to know when they've changed. */ + WINDOW_SLOT (default_gutter, EQUAL_WRAPPED); + WINDOW_SLOT (default_gutter_width, EQ); + WINDOW_SLOT (default_gutter_height, EQ); + WINDOW_SLOT (default_gutter_visible_p, EQ); + WINDOW_SLOT (default_gutter_border_width, EQ); +/* margins */ WINDOW_SLOT (left_margin_width, EQ); WINDOW_SLOT (right_margin_width, EQ); WINDOW_SLOT (minimum_line_ascent, EQ); diff -r f4aeb21a5bad -r 74fd4e045ea6 src/xgccache.c --- a/src/xgccache.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/xgccache.c Mon Aug 13 11:13:30 2007 +0200 @@ -93,9 +93,9 @@ #ifdef GCCACHE_HASH static unsigned long -gc_cache_hash (CONST void *arg) +gc_cache_hash (const void *arg) { - CONST struct gcv_and_mask *gcvm = (CONST struct gcv_and_mask *) arg; + const struct gcv_and_mask *gcvm = (const struct gcv_and_mask *) arg; unsigned long *longs = (unsigned long *) &gcvm->gcv; unsigned long hash = gcvm->mask; int i; @@ -112,7 +112,7 @@ #endif /* GCCACHE_HASH */ static int -gc_cache_eql (CONST void *arg1, CONST void *arg2) +gc_cache_eql (const void *arg1, const void *arg2) { /* See comment in gc_cache_hash */ return !memcmp (arg1, arg2, sizeof (struct gcv_and_mask)); @@ -166,7 +166,7 @@ #ifdef GCCACHE_HASH - if (gethash (&gcvm, cache->table, (CONST void **) &cell)) + if (gethash (&gcvm, cache->table, (const void **) &cell)) #else /* !GCCACHE_HASH */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/xgccache.h --- a/src/xgccache.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/xgccache.h Mon Aug 13 11:13:30 2007 +0200 @@ -23,12 +23,12 @@ /* Written by jwz, 14 jun 93 */ -#ifndef _XGCCACHE_H_ -#define _XGCCACHE_H_ +#ifndef INCLUDED_xgccache_h_ +#define INCLUDED_xgccache_h_ struct gc_cache; struct gc_cache *make_gc_cache (Display *, Window); void free_gc_cache (struct gc_cache *cache); GC gc_cache_lookup (struct gc_cache *, XGCValues *, unsigned long mask); -#endif /* _XGCCACHE_H_ */ +#endif /* INCLUDED_xgccache_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/xintrinsic.h --- a/src/xintrinsic.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/xintrinsic.h Mon Aug 13 11:13:30 2007 +0200 @@ -19,12 +19,9 @@ /* Synched up with: Not in FSF. */ -#undef CONST /* X11R4 header thinks it can define CONST */ +#ifndef INCLUDED_xintrinsic_h_ +#define INCLUDED_xintrinsic_h_ #include <X11/Intrinsic.h> -#ifdef CONST_IS_LOSING -# define CONST -#else -# define CONST const -#endif +#endif /* INCLUDED_xintrinsic_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/xintrinsicp.h --- a/src/xintrinsicp.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/xintrinsicp.h Mon Aug 13 11:13:30 2007 +0200 @@ -19,14 +19,11 @@ /* Synched up with: Not in FSF. */ -#undef CONST /* X11R4 header thinks it can define CONST */ +#ifndef INCLUDED_xintrinsicp_h_ +#define INCLUDED_xintrinsicp_h_ #include <X11/Intrinsic.h> #include <X11/IntrinsicP.h> #include <X11/ObjectP.h> /* apparently some IntrinsicP.h don't have this */ -#ifdef CONST_IS_LOSING -# define CONST -#else -# define CONST const -#endif +#endif /* INCLUDED_xintrinsicp_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/xmmanagerp.h --- a/src/xmmanagerp.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/xmmanagerp.h Mon Aug 13 11:13:30 2007 +0200 @@ -23,9 +23,14 @@ /* ManagerP.h doesn't exist in old versions of Motif; the stuff is in XmP.h instead */ +#ifndef INCLUDED_xmmanagerp_h_ +#define INCLUDED_xmmanagerp_h_ + #include <Xm/Xm.h> /* to get XmVersion */ #if (XmVersion >= 1002) # include <Xm/ManagerP.h> #else # include <Xm/XmP.h> #endif + +#endif /* INCLUDED_xmmanagerp_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/xmprimitivep.h --- a/src/xmprimitivep.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/xmprimitivep.h Mon Aug 13 11:13:30 2007 +0200 @@ -23,9 +23,14 @@ /* PrimitiveP.h doesn't exist in old versions of Motif; the stuff is in XmP.h instead */ +#ifndef INCLUDED_xmprimitivep_h_ +#define INCLUDED_xmprimitivep_h_ + #include <Xm/Xm.h> /* to get XmVersion */ #if (XmVersion >= 1002) # include <Xm/PrimitiveP.h> #else # include <Xm/XmP.h> #endif + +#endif /* INCLUDED_xmprimitivep_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/xmu.c --- a/src/xmu.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/xmu.c Mon Aug 13 11:13:30 2007 +0200 @@ -53,10 +53,10 @@ #include <ctype.h> -int XmuCursorNameToIndex (CONST char *name) +int XmuCursorNameToIndex (const char *name) { - static CONST struct _CursorName { - CONST char *name; + static const struct _CursorName { + const char *name; unsigned int shape; } cursor_names[] = { {"x_cursor", XC_X_cursor}, @@ -137,7 +137,7 @@ {"watch", XC_watch}, {"xterm", XC_xterm}, }; - CONST struct _CursorName *table; + const struct _CursorName *table; int i; char tmp[40]; @@ -368,7 +368,7 @@ } -int XmuReadBitmapDataFromFile (CONST char *filename, +int XmuReadBitmapDataFromFile (const char *filename, /* Remaining args are RETURNED */ unsigned int *width, unsigned int *height, @@ -530,7 +530,7 @@ return XmuPrintDefaultErrorMessage (dpy, errorp, stderr); } -void XmuCopyISOLatin1Lowered(char *dst, CONST char *src) +void XmuCopyISOLatin1Lowered(char *dst, const char *src) { unsigned char *dest = (unsigned char *) dst; unsigned char *source = (unsigned char *) src; diff -r f4aeb21a5bad -r 74fd4e045ea6 src/xmu.h --- a/src/xmu.h Mon Aug 13 11:12:06 2007 +0200 +++ b/src/xmu.h Mon Aug 13 11:13:30 2007 +0200 @@ -2,6 +2,9 @@ /* Synched up with: Not in FSF. */ +#ifndef INCLUDED_xmu_h_ +#define INCLUDED_xmu_h_ + #ifdef HAVE_XMU # include <X11/Xmu/CharSet.h> @@ -9,6 +12,7 @@ # include <X11/Xmu/CurUtil.h> # include <X11/Xmu/Drawing.h> # include <X11/Xmu/Error.h> +# include <X11/Xmu/Misc.h> /* Do the EDITRES protocol if running X11R5 (or later) version */ #if (XtSpecificationRelease >= 5) @@ -20,12 +24,19 @@ #else -int XmuCursorNameToIndex (CONST char *name); -int XmuReadBitmapDataFromFile (CONST char *filename, unsigned int *width, +int XmuCursorNameToIndex (const char *name); +int XmuReadBitmapDataFromFile (const char *filename, unsigned int *width, unsigned int *height, unsigned char **datap, int *x_hot, int *y_hot); int XmuPrintDefaultErrorMessage (Display *dpy, XErrorEvent *event, FILE *fp); -void XmuCopyISOLatin1Lowered (char *, CONST char *); +void XmuCopyISOLatin1Lowered (char *, const char *); -#endif +#define Max(x, y) (((x) > (y)) ? (x) : (y)) +#define Min(x, y) (((x) < (y)) ? (x) : (y)) +#define AssignMax(x, y) {if ((y) > (x)) x = (y);} +#define AssignMin(x, y) {if ((y) < (x)) x = (y);} +typedef enum {XtorientHorizontal, XtorientVertical} XtOrientation; +#endif /* HAVE_XMU */ + +#endif /* INCLUDED_xmu_h_ */ diff -r f4aeb21a5bad -r 74fd4e045ea6 src/xselect.c --- a/src/xselect.c Mon Aug 13 11:12:06 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2144 +0,0 @@ -/* X Selection processing for XEmacs - Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. - -This file is part of XEmacs. - -XEmacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -XEmacs is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not synched with FSF. */ - -/* Rewritten by jwz */ - -#include <config.h> -#include "lisp.h" - -#include "buffer.h" -#include "console-x.h" -#include "objects-x.h" - -#include "frame.h" -#include "opaque.h" -#include "systime.h" - -int lisp_to_time (Lisp_Object, time_t *); -Lisp_Object time_to_lisp (time_t); - -#ifdef LWLIB_USES_MOTIF -# define MOTIF_CLIPBOARDS -#endif - -#ifdef MOTIF_CLIPBOARDS -# include <Xm/CutPaste.h> -static void hack_motif_clipboard_selection (Atom selection_atom, - Lisp_Object selection_value, - Time thyme, Display *display, - Window selecting_window, - Bool owned_p); -#endif - -#define CUT_BUFFER_SUPPORT - -Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP, - QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL, - QATOM_PAIR, QCOMPOUND_TEXT; - -#ifdef CUT_BUFFER_SUPPORT -Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3, - QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7; -#endif - -Lisp_Object Vx_lost_selection_hooks; -Lisp_Object Vx_sent_selection_hooks; - -/* If this is a smaller number than the max-request-size of the display, - emacs will use INCR selection transfer when the selection is larger - than this. The max-request-size is usually around 64k, so if you want - emacs to use incremental selection transfers when the selection is - smaller than that, set this. I added this mostly for debugging the - incremental transfer stuff, but it might improve server performance. - */ -#define MAX_SELECTION_QUANTUM 0xFFFFFF - -#define SELECTION_QUANTUM(dpy) ((XMaxRequestSize (dpy) << 2) - 100) - -/* This is an association list whose elements are of the form - ( selection-name selection-value selection-timestamp ) - selection-name is a lisp symbol, whose name is the name of an X Atom. - selection-value is the value that emacs owns for that selection. - It may be any kind of Lisp object. - selection-timestamp is the time at which emacs began owning this selection, - as a cons of two 16-bit numbers (making a 32 bit time). - If there is an entry in this alist, then it can be assumed that emacs owns - that selection. - The only (eq) parts of this list that are visible from elisp are the - selection-values. - */ -Lisp_Object Vselection_alist; - -/* This is an alist whose CARs are selection-types (whose names are the same - as the names of X Atoms) and whose CDRs are the names of Lisp functions to - call to convert the given Emacs selection value to a string representing - the given selection type. This is for elisp-level extension of the emacs - selection handling. - */ -Lisp_Object Vselection_converter_alist; - -/* "Selection owner couldn't convert selection" */ -Lisp_Object Qselection_conversion_error; - -/* If the selection owner takes too long to reply to a selection request, - we give up on it. This is in seconds (0 = no timeout). - */ -int x_selection_timeout; - - -/* Utility functions */ - -static void lisp_data_to_selection_data (struct device *, - Lisp_Object obj, - unsigned char **data_ret, - Atom *type_ret, - unsigned int *size_ret, - int *format_ret); -static Lisp_Object selection_data_to_lisp_data (struct device *, - unsigned char *data, - size_t size, - Atom type, - int format); -static Lisp_Object x_get_window_property_as_lisp_data (Display *, - Window, - Atom property, - Lisp_Object target_type, - Atom selection_atom); - -static int expect_property_change (Display *, Window, Atom prop, int state); -static void wait_for_property_change (long); -static void unexpect_property_change (int); -static int waiting_for_other_props_on_window (Display *, Window); - -/* This converts a Lisp symbol to a server Atom, avoiding a server - roundtrip whenever possible. - */ -static Atom -symbol_to_x_atom (struct device *d, Lisp_Object sym, int only_if_exists) -{ - Display *display = DEVICE_X_DISPLAY (d); - - if (NILP (sym)) return XA_PRIMARY; - if (EQ (sym, Qt)) return XA_SECONDARY; - if (EQ (sym, QPRIMARY)) return XA_PRIMARY; - if (EQ (sym, QSECONDARY)) return XA_SECONDARY; - if (EQ (sym, QSTRING)) return XA_STRING; - if (EQ (sym, QINTEGER)) return XA_INTEGER; - if (EQ (sym, QATOM)) return XA_ATOM; - if (EQ (sym, QCLIPBOARD)) return DEVICE_XATOM_CLIPBOARD (d); - if (EQ (sym, QTIMESTAMP)) return DEVICE_XATOM_TIMESTAMP (d); - if (EQ (sym, QTEXT)) return DEVICE_XATOM_TEXT (d); - if (EQ (sym, QDELETE)) return DEVICE_XATOM_DELETE (d); - if (EQ (sym, QMULTIPLE)) return DEVICE_XATOM_MULTIPLE (d); - if (EQ (sym, QINCR)) return DEVICE_XATOM_INCR (d); - if (EQ (sym, QEMACS_TMP)) return DEVICE_XATOM_EMACS_TMP (d); - if (EQ (sym, QTARGETS)) return DEVICE_XATOM_TARGETS (d); - if (EQ (sym, QNULL)) return DEVICE_XATOM_NULL (d); - if (EQ (sym, QATOM_PAIR)) return DEVICE_XATOM_ATOM_PAIR (d); - if (EQ (sym, QCOMPOUND_TEXT)) return DEVICE_XATOM_COMPOUND_TEXT (d); - -#ifdef CUT_BUFFER_SUPPORT - if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0; - if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1; - if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2; - if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3; - if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4; - if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5; - if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6; - if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7; -#endif /* CUT_BUFFER_SUPPORT */ - - { - CONST char *nameext; - GET_C_STRING_CTEXT_DATA_ALLOCA (Fsymbol_name (sym), nameext); - return XInternAtom (display, nameext, only_if_exists ? True : False); - } -} - - -/* This converts a server Atom to a Lisp symbol, avoiding server roundtrips - and calls to intern whenever possible. - */ -static Lisp_Object -x_atom_to_symbol (struct device *d, Atom atom) -{ - Display *display = DEVICE_X_DISPLAY (d); - - if (! atom) return Qnil; - if (atom == XA_PRIMARY) return QPRIMARY; - if (atom == XA_SECONDARY) return QSECONDARY; - if (atom == XA_STRING) return QSTRING; - if (atom == XA_INTEGER) return QINTEGER; - if (atom == XA_ATOM) return QATOM; - if (atom == DEVICE_XATOM_CLIPBOARD (d)) return QCLIPBOARD; - if (atom == DEVICE_XATOM_TIMESTAMP (d)) return QTIMESTAMP; - if (atom == DEVICE_XATOM_TEXT (d)) return QTEXT; - if (atom == DEVICE_XATOM_DELETE (d)) return QDELETE; - if (atom == DEVICE_XATOM_MULTIPLE (d)) return QMULTIPLE; - if (atom == DEVICE_XATOM_INCR (d)) return QINCR; - if (atom == DEVICE_XATOM_EMACS_TMP (d)) return QEMACS_TMP; - if (atom == DEVICE_XATOM_TARGETS (d)) return QTARGETS; - if (atom == DEVICE_XATOM_NULL (d)) return QNULL; - if (atom == DEVICE_XATOM_ATOM_PAIR (d)) return QATOM_PAIR; - if (atom == DEVICE_XATOM_COMPOUND_TEXT (d)) return QCOMPOUND_TEXT; - -#ifdef CUT_BUFFER_SUPPORT - if (atom == XA_CUT_BUFFER0) return QCUT_BUFFER0; - if (atom == XA_CUT_BUFFER1) return QCUT_BUFFER1; - if (atom == XA_CUT_BUFFER2) return QCUT_BUFFER2; - if (atom == XA_CUT_BUFFER3) return QCUT_BUFFER3; - if (atom == XA_CUT_BUFFER4) return QCUT_BUFFER4; - if (atom == XA_CUT_BUFFER5) return QCUT_BUFFER5; - if (atom == XA_CUT_BUFFER6) return QCUT_BUFFER6; - if (atom == XA_CUT_BUFFER7) return QCUT_BUFFER7; -#endif - - { - Lisp_Object newsym; - CONST Bufbyte *intstr; - char *str = XGetAtomName (display, atom); - - if (! str) return Qnil; - - GET_C_CHARPTR_INT_CTEXT_DATA_ALLOCA (str, intstr); - newsym = intern ((char *) intstr); - XFree (str); - return newsym; - } -} - - -/* Do protocol to assert ourself as a selection owner. - Update the Vselection_alist so that we can reply to later requests for - our selection. - */ -static void -x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value) -{ - struct device *d = decode_x_device (Qnil); - Display *display = DEVICE_X_DISPLAY (d); - struct frame *sel_frame = selected_frame (); - Window selecting_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame)); - /* Use the time of the last-read mouse or keyboard event. - For selection purposes, we use this as a sleazy way of knowing what the - current time is in server-time. This assumes that the most recently read - mouse or keyboard event has something to do with the assertion of the - selection, which is probably true. - */ - Time thyme = DEVICE_X_MOUSE_TIMESTAMP (d); - Atom selection_atom; - - CHECK_SYMBOL (selection_name); - selection_atom = symbol_to_x_atom (d, selection_name, 0); - - XSetSelectionOwner (display, selection_atom, selecting_window, thyme); - - /* Now update the local cache */ - { - /* We do NOT use time_to_lisp() here any more, like we used to. - That assumed equivalence of time_t and Time, which is not - necessarily the case (e.g. under OSF on the Alphas, where - Time is a 64-bit quantity and time_t is a 32-bit quantity). - - Opaque pointers are the clean way to go here. - */ - Lisp_Object selection_time = make_opaque (sizeof (thyme), (void *) &thyme); - Lisp_Object selection_data = list3 (selection_name, - selection_value, - selection_time); - Lisp_Object prev_value = assq_no_quit (selection_name, Vselection_alist); - Vselection_alist = Fcons (selection_data, Vselection_alist); - - /* If we already owned the selection, remove the old selection data. - Perhaps we should destructively modify it instead. - Don't use Fdelq() as that may QUIT;. - */ - if (!NILP (prev_value)) - { - Lisp_Object rest; /* we know it's not the CAR, so it's easy. */ - for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest)) - if (EQ (prev_value, Fcar (XCDR (rest)))) - { - XCDR (rest) = Fcdr (XCDR (rest)); - break; - } - } -#ifdef MOTIF_CLIPBOARDS - hack_motif_clipboard_selection (selection_atom, selection_value, - thyme, display, selecting_window, - !NILP (prev_value)); -#endif - } -} - - -#ifdef MOTIF_CLIPBOARDS /* Bend over baby. Take it and like it. */ - -# ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK -static void motif_clipboard_cb (); -# endif - -static void -hack_motif_clipboard_selection (Atom selection_atom, - Lisp_Object selection_value, - Time thyme, - Display *display, - Window selecting_window, - Bool owned_p) -{ - struct device *d = get_device_from_display (display); - /* Those Motif wankers can't be bothered to follow the ICCCM, and do - their own non-Xlib non-Xt clipboard processing. So we have to do - this so that linked-in Motif widgets don't get themselves wedged. - */ - if (selection_atom == DEVICE_XATOM_CLIPBOARD (d) - && STRINGP (selection_value) - - /* If we already own the clipboard, don't own it again in the Motif - way. This might lose in some subtle way, since the timestamp won't - be current, but owning the selection on the Motif way does a - SHITLOAD of X protocol, and it makes killing text be incredibly - slow when using an X terminal. ARRRRGGGHHH!!!! - */ - /* No, this is no good, because then Motif text fields don't bother - to look up the new value, and you can't Copy from a buffer, Paste - into a text field, then Copy something else from the buffer and - paste it into the text field -- it pastes the first thing again. */ -/* && !owned_p */ - ) - { -#ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK - Widget widget = FRAME_X_TEXT_WIDGET (selected_frame()); -#endif - long itemid; -#if XmVersion >= 1002 - long dataid; -#else - int dataid; /* 1.2 wants long, but 1.1.5 wants int... */ -#endif - XmString fmh; - String encoding = "STRING"; - CONST Extbyte *data = XSTRING_DATA (selection_value); - Extcount bytes = XSTRING_LENGTH (selection_value); - -#ifdef MULE - { - enum { ASCII, LATIN_1, WORLD } chartypes = ASCII; - CONST Bufbyte *ptr = data, *end = ptr + bytes; - /* Optimize for the common ASCII case */ - while (ptr <= end) - { - if (BYTE_ASCII_P (*ptr)) - { - ptr++; - continue; - } - - if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 || - (*ptr) == LEADING_BYTE_CONTROL_1) - { - chartypes = LATIN_1; - ptr += 2; - continue; - } - - chartypes = WORLD; - break; - } - - if (chartypes == LATIN_1) - GET_STRING_BINARY_DATA_ALLOCA (selection_value, data, bytes); - else if (chartypes == WORLD) - { - GET_STRING_CTEXT_DATA_ALLOCA (selection_value, data, bytes); - encoding = "COMPOUND_TEXT"; - } - } -#endif /* MULE */ - - fmh = XmStringCreateLtoR ("Clipboard", XmSTRING_DEFAULT_CHARSET); - while (ClipboardSuccess != - XmClipboardStartCopy (display, selecting_window, fmh, thyme, -#ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK - widget, motif_clipboard_cb, -#else - 0, NULL, -#endif - &itemid)) - ; - XmStringFree (fmh); - while (ClipboardSuccess != - XmClipboardCopy (display, selecting_window, itemid, encoding, -#ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK - /* O'Reilly examples say size can be 0, - but this clearly is not the case. */ - 0, bytes, (int) selecting_window, /* private id */ -#else /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */ - (XtPointer) data, bytes, 0, -#endif /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */ - &dataid)) - ; - while (ClipboardSuccess != - XmClipboardEndCopy (display, selecting_window, itemid)) - ; - } -} - -# ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK -/* I tried to treat the clipboard like a real selection, and not send - the data until it was requested, but it looks like that just doesn't - work at all unless the selection owner and requestor are in different - processes. From reading the Motif source, it looks like they never - even considered having two widgets in the same application transfer - data between each other using "by-name" clipboard values. What a - bunch of fuckups. - */ -static void -motif_clipboard_cb (Widget widget, int *data_id, int *private_id, int *reason) -{ - switch (*reason) - { - case XmCR_CLIPBOARD_DATA_REQUEST: - { - Display *dpy = XtDisplay (widget); - Window window = (Window) *private_id; - Lisp_Object selection = assq_no_quit (QCLIPBOARD, Vselection_alist); - if (NILP (selection)) abort (); - selection = XCDR (selection); - if (!STRINGP (selection)) abort (); - XmClipboardCopyByName (dpy, window, *data_id, - (char *) XSTRING_DATA (selection), - XSTRING_LENGTH (selection) + 1, - 0); - } - break; - case XmCR_CLIPBOARD_DATA_DELETE: - default: - /* don't need to free anything */ - break; - } -} -# endif /* MOTIF_INCREMENTAL_CLIPBOARDS_WORK */ -#endif /* MOTIF_CLIPBOARDS */ - - -/* Given a selection-name and desired type, this looks up our local copy of - the selection value and converts it to the type. It returns nil or a - string. This calls random elisp code, and may signal or gc. - */ -static Lisp_Object -x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type) -{ - /* This function can GC */ - Lisp_Object local_value = assq_no_quit (selection_symbol, Vselection_alist); - Lisp_Object handler_fn, value, check; - - if (NILP (local_value)) return Qnil; - - /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */ - if (EQ (target_type, QTIMESTAMP)) - { - handler_fn = Qnil; - value = XCAR (XCDR (XCDR (local_value))); - } - -#if 0 /* #### MULTIPLE doesn't work yet */ - else if (CONSP (target_type) && - XCAR (target_type) == QMULTIPLE) - { - Lisp_Object pairs = XCDR (target_type); - int len = XVECTOR_LENGTH (pairs); - int i; - /* If the target is MULTIPLE, then target_type looks like - (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ]) - We modify the second element of each pair in the vector and - return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ] - */ - for (i = 0; i < len; i++) - { - Lisp_Object pair = XVECTOR_DATA (pairs) [i]; - XVECTOR_DATA (pair) [1] = - x_get_local_selection (XVECTOR_DATA (pair) [0], - XVECTOR_DATA (pair) [1]); - } - return pairs; - } -#endif - else - { - CHECK_SYMBOL (target_type); - handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist)); - if (NILP (handler_fn)) return Qnil; - value = call3 (handler_fn, - selection_symbol, target_type, - XCAR (XCDR (local_value))); - } - - /* This lets the selection function to return (TYPE . VALUE). For example, - when the selected type is LINE_NUMBER, the returned type is SPAN, not - INTEGER. - */ - check = value; - if (CONSP (value) && SYMBOLP (XCAR (value))) - check = XCDR (value); - - /* Strings, vectors, and symbols are converted to selection data format in - the obvious way. Integers are converted to 16 bit quantities if they're - small enough, otherwise 32 bits are used. - */ - if (STRINGP (check) || - VECTORP (check) || - SYMBOLP (check) || - INTP (check) || - CHARP (check) || - NILP (value)) - return value; - - /* (N . M) or (N M) get turned into a 32 bit quantity. So if you want to - always return a small quantity as 32 bits, your converter routine needs - to return a cons. - */ - else if (CONSP (check) && - INTP (XCAR (check)) && - (INTP (XCDR (check)) || - (CONSP (XCDR (check)) && - INTP (XCAR (XCDR (check))) && - NILP (XCDR (XCDR (check)))))) - return value; - /* Otherwise the lisp converter function returned something unrecognized. - */ - else - signal_error (Qerror, - list3 (build_string - ("unrecognized selection-conversion type"), - handler_fn, - value)); - - return Qnil; /* suppress compiler warning */ -} - - - -/* Send a SelectionNotify event to the requestor with property=None, meaning - we were unable to do what they wanted. - */ -static void -x_decline_selection_request (XSelectionRequestEvent *event) -{ - XSelectionEvent reply; - reply.type = SelectionNotify; - reply.display = event->display; - reply.requestor = event->requestor; - reply.selection = event->selection; - reply.time = event->time; - reply.target = event->target; - reply.property = None; - - XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply); - XFlush (reply.display); -} - - -/* Used as an unwind-protect clause so that, if a selection-converter signals - an error, we tell the requestor that we were unable to do what they wanted - before we throw to top-level or go into the debugger or whatever. - */ -static Lisp_Object -x_selection_request_lisp_error (Lisp_Object closure) -{ - XSelectionRequestEvent *event = (XSelectionRequestEvent *) - get_opaque_ptr (closure); - - free_opaque_ptr (closure); - if (event->type == 0) /* we set this to mean "completed normally" */ - return Qnil; - x_decline_selection_request (event); - return Qnil; -} - - -/* Convert our selection to the requested type, and put that data where the - requestor wants it. Then tell them whether we've succeeded. - */ -static void -x_reply_selection_request (XSelectionRequestEvent *event, int format, - unsigned char *data, int size, Atom type) -{ - /* This function can GC */ - XSelectionEvent reply; - Display *display = event->display; - struct device *d = get_device_from_display (display); - Window window = event->requestor; - int bytes_remaining; - int format_bytes = format/8; - int max_bytes = SELECTION_QUANTUM (display); - if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM; - - reply.type = SelectionNotify; - reply.display = display; - reply.requestor = window; - reply.selection = event->selection; - reply.time = event->time; - reply.target = event->target; - reply.property = (event->property == None ? event->target : event->property); - - /* #### XChangeProperty can generate BadAlloc, and we must handle it! */ - - /* Store the data on the requested property. - If the selection is large, only store the first N bytes of it. - */ - bytes_remaining = size * format_bytes; - if (bytes_remaining <= max_bytes) - { - /* Send all the data at once, with minimal handshaking. */ -#if 0 - stderr_out ("\nStoring all %d\n", bytes_remaining); -#endif - XChangeProperty (display, window, reply.property, type, format, - PropModeReplace, data, size); - /* At this point, the selection was successfully stored; ack it. */ - XSendEvent (display, window, False, 0L, (XEvent *) &reply); - XFlush (display); - } - else - { - /* Send an INCR selection. */ - int prop_id; - - if (x_window_to_frame (d, window)) /* #### debug */ - error ("attempt to transfer an INCR to ourself!"); -#if 0 - stderr_out ("\nINCR %d\n", bytes_remaining); -#endif - prop_id = expect_property_change (display, window, reply.property, - PropertyDelete); - - XChangeProperty (display, window, reply.property, DEVICE_XATOM_INCR (d), - 32, PropModeReplace, (unsigned char *) - &bytes_remaining, 1); - XSelectInput (display, window, PropertyChangeMask); - /* Tell 'em the INCR data is there... */ - XSendEvent (display, window, False, 0L, (XEvent *) &reply); - XFlush (display); - - /* First, wait for the requestor to ack by deleting the property. - This can run random lisp code (process handlers) or signal. - */ - wait_for_property_change (prop_id); - - while (bytes_remaining) - { - int i = ((bytes_remaining < max_bytes) - ? bytes_remaining - : max_bytes); - prop_id = expect_property_change (display, window, reply.property, - PropertyDelete); -#if 0 - stderr_out (" INCR adding %d\n", i); -#endif - /* Append the next chunk of data to the property. */ - XChangeProperty (display, window, reply.property, type, format, - PropModeAppend, data, i / format_bytes); - bytes_remaining -= i; - data += i; - - /* Now wait for the requestor to ack this chunk by deleting the - property. This can run random lisp code or signal. - */ - wait_for_property_change (prop_id); - } - /* Now write a zero-length chunk to the property to tell the requestor - that we're done. */ -#if 0 - stderr_out (" INCR done\n"); -#endif - if (! waiting_for_other_props_on_window (display, window)) - XSelectInput (display, window, 0L); - - XChangeProperty (display, window, reply.property, type, format, - PropModeReplace, data, 0); - } -} - - - -/* Called from the event-loop in response to a SelectionRequest event. - */ -void -x_handle_selection_request (XSelectionRequestEvent *event) -{ - /* This function can GC */ - struct gcpro gcpro1, gcpro2, gcpro3; - Lisp_Object local_selection_data = Qnil; - Lisp_Object selection_symbol; - Lisp_Object target_symbol = Qnil; - Lisp_Object converted_selection = Qnil; - Time local_selection_time; - Lisp_Object successful_p = Qnil; - int count; - struct device *d = get_device_from_display (event->display); - - GCPRO3 (local_selection_data, converted_selection, target_symbol); - - selection_symbol = x_atom_to_symbol (d, event->selection); - - local_selection_data = assq_no_quit (selection_symbol, Vselection_alist); - -#if 0 - /* This list isn't user-visible, so it can't "go bad." */ - assert (CONSP (local_selection_data)); - assert (CONSP (XCDR (local_selection_data))); - assert (CONSP (XCDR (XCDR (local_selection_data)))); - assert (NILP (XCDR (XCDR (XCDR (local_selection_data))))); - assert (CONSP (XCAR (XCDR (XCDR (local_selection_data))))); - assert (INTP (XCAR (XCAR (XCDR (XCDR (local_selection_data)))))); - assert (INTP (XCDR (XCAR (XCDR (XCDR (local_selection_data)))))); -#endif - - if (NILP (local_selection_data)) - { - /* Someone asked for the selection, but we don't have it any more. */ - x_decline_selection_request (event); - goto DONE_LABEL; - } - - local_selection_time = - * (Time *) XOPAQUE_DATA (XCAR (XCDR (XCDR (local_selection_data)))); - - if (event->time != CurrentTime && - local_selection_time > event->time) - { - /* Someone asked for the selection, and we have one, but not the one - they're looking for. */ - x_decline_selection_request (event); - goto DONE_LABEL; - } - - count = specpdl_depth (); - record_unwind_protect (x_selection_request_lisp_error, - make_opaque_ptr (event)); - target_symbol = x_atom_to_symbol (d, event->target); - -#if 0 /* #### MULTIPLE doesn't work yet */ - if (EQ (target_symbol, QMULTIPLE)) - target_symbol = fetch_multiple_target (event); -#endif - - /* Convert lisp objects back into binary data */ - - converted_selection = - x_get_local_selection (selection_symbol, target_symbol); - - if (! NILP (converted_selection)) - { - unsigned char *data; - unsigned int size; - int format; - Atom type; - lisp_data_to_selection_data (d, converted_selection, - &data, &type, &size, &format); - - x_reply_selection_request (event, format, data, size, type); - successful_p = Qt; - /* Tell x_selection_request_lisp_error() it's cool. */ - event->type = 0; - xfree (data); - } - unbind_to (count, Qnil); - - DONE_LABEL: - - UNGCPRO; - - /* Let random lisp code notice that the selection has been asked for. */ - { - Lisp_Object rest; - Lisp_Object val = Vx_sent_selection_hooks; - if (!UNBOUNDP (val) && !NILP (val)) - { - if (CONSP (val) && !EQ (XCAR (val), Qlambda)) - for (rest = val; !NILP (rest); rest = Fcdr (rest)) - call3 (Fcar(rest), selection_symbol, target_symbol, - successful_p); - else - call3 (val, selection_symbol, target_symbol, - successful_p); - } - } -} - - -/* Called from the event-loop in response to a SelectionClear event. - */ -void -x_handle_selection_clear (XSelectionClearEvent *event) -{ - Display *display = event->display; - struct device *d = get_device_from_display (display); - Atom selection = event->selection; - Time changed_owner_time = event->time; - - Lisp_Object selection_symbol, local_selection_data; - Time local_selection_time; - - selection_symbol = x_atom_to_symbol (d, selection); - - local_selection_data = assq_no_quit (selection_symbol, Vselection_alist); - - /* Well, we already believe that we don't own it, so that's just fine. */ - if (NILP (local_selection_data)) return; - - local_selection_time = - * (Time *) XOPAQUE_DATA (XCAR (XCDR (XCDR (local_selection_data)))); - - /* This SelectionClear is for a selection that we no longer own, so we can - disregard it. (That is, we have reasserted the selection since this - request was generated.) - */ - if (changed_owner_time != CurrentTime && - local_selection_time > changed_owner_time) - return; - - /* Otherwise, we're really honest and truly being told to drop it. - Don't use Fdelq() as that may QUIT;. - */ - if (EQ (local_selection_data, Fcar (Vselection_alist))) - Vselection_alist = Fcdr (Vselection_alist); - else - { - Lisp_Object rest; - for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest)) - if (EQ (local_selection_data, Fcar (XCDR (rest)))) - { - XCDR (rest) = Fcdr (XCDR (rest)); - break; - } - } - - /* Let random lisp code notice that the selection has been stolen. - */ - { - Lisp_Object rest; - Lisp_Object val = Vx_lost_selection_hooks; - if (!UNBOUNDP (val) && !NILP (val)) - { - if (CONSP (val) && !EQ (XCAR (val), Qlambda)) - for (rest = val; !NILP (rest); rest = Fcdr (rest)) - call1 (Fcar (rest), selection_symbol); - else - call1 (val, selection_symbol); - } - } -} - - -/* This stuff is so that INCR selections are reentrant (that is, so we can - be servicing multiple INCR selection requests simultaneously). I haven't - actually tested that yet. - */ - -static int prop_location_tick; - -static struct prop_location { - int tick; - Display *display; - Window window; - Atom property; - int desired_state; - struct prop_location *next; -} *for_whom_the_bell_tolls; - - -static int -property_deleted_p (void *tick) -{ - struct prop_location *rest = for_whom_the_bell_tolls; - while (rest) - if (rest->tick == (long) tick) - return 0; - else - rest = rest->next; - return 1; -} - -static int -waiting_for_other_props_on_window (Display *display, Window window) -{ - struct prop_location *rest = for_whom_the_bell_tolls; - while (rest) - if (rest->display == display && rest->window == window) - return 1; - else - rest = rest->next; - return 0; -} - - -static int -expect_property_change (Display *display, Window window, - Atom property, int state) -{ - struct prop_location *pl = xnew (struct prop_location); - pl->tick = ++prop_location_tick; - pl->display = display; - pl->window = window; - pl->property = property; - pl->desired_state = state; - pl->next = for_whom_the_bell_tolls; - for_whom_the_bell_tolls = pl; - return pl->tick; -} - -static void -unexpect_property_change (int tick) -{ - struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls; - while (rest) - { - if (rest->tick == tick) - { - if (prev) - prev->next = rest->next; - else - for_whom_the_bell_tolls = rest->next; - xfree (rest); - return; - } - prev = rest; - rest = rest->next; - } -} - -static void -wait_for_property_change (long tick) -{ - /* This function can GC */ - wait_delaying_user_input (property_deleted_p, (void *) tick); -} - - -/* Called from the event-loop in response to a PropertyNotify event. - */ -void -x_handle_property_notify (XPropertyEvent *event) -{ - struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls; - while (rest) - { - if (rest->property == event->atom && - rest->window == event->window && - rest->display == event->display && - rest->desired_state == event->state) - { -#if 0 - stderr_out ("Saw expected prop-%s on %s\n", - (event->state == PropertyDelete ? "delete" : "change"), - (char *) string_data (XSYMBOL (x_atom_to_symbol (get_device_from_display (event->display), event->atom))->name); -#endif - if (prev) - prev->next = rest->next; - else - for_whom_the_bell_tolls = rest->next; - xfree (rest); - return; - } - prev = rest; - rest = rest->next; - } -#if 0 - stderr_out ("Saw UNexpected prop-%s on %s\n", - (event->state == PropertyDelete ? "delete" : "change"), - (char *) string_data (XSYMBOL (x_atom_to_symbol (get_device_from_display (event->display), event->atom))->name)); -#endif -} - - - -#if 0 /* #### MULTIPLE doesn't work yet */ - -static Lisp_Object -fetch_multiple_target (XSelectionRequestEvent *event) -{ - /* This function can GC */ - Display *display = event->display; - Window window = event->requestor; - Atom target = event->target; - Atom selection_atom = event->selection; - int result; - - return - Fcons (QMULTIPLE, - x_get_window_property_as_lisp_data (display, window, target, - QMULTIPLE, - selection_atom)); -} - -static Lisp_Object -copy_multiple_data (Lisp_Object obj) -{ - Lisp_Object vec; - int i; - int len; - if (CONSP (obj)) - return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj))); - - CHECK_VECTOR (obj); - len = XVECTOR_LENGTH (obj); - vec = make_vector (len, Qnil); - for (i = 0; i < len; i++) - { - Lisp_Object vec2 = XVECTOR_DATA (obj) [i]; - CHECK_VECTOR (vec2); - if (XVECTOR_LENGTH (vec2) != 2) - signal_error (Qerror, list2 (build_string - ("vectors must be of length 2"), - vec2)); - XVECTOR_DATA (vec) [i] = make_vector (2, Qnil); - XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [0] = XVECTOR_DATA (vec2) [0]; - XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [1] = XVECTOR_DATA (vec2) [1]; - } - return vec; -} - -#endif /* 0 */ - - -static Window reading_selection_reply; -static Atom reading_which_selection; -static int selection_reply_timed_out; - -static int -selection_reply_done (void *ignore) -{ - return !reading_selection_reply; -} - -static Lisp_Object Qx_selection_reply_timeout_internal; - -DEFUN ("x-selection-reply-timeout-internal", Fx_selection_reply_timeout_internal, - 1, 1, 0, /* -*/ - (arg)) -{ - selection_reply_timed_out = 1; - reading_selection_reply = 0; - return Qnil; -} - - -/* Do protocol to read selection-data from the server. - Converts this to lisp data and returns it. - */ -static Lisp_Object -x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type) -{ - /* This function can GC */ - struct device *d = decode_x_device (Qnil); - Display *display = DEVICE_X_DISPLAY (d); - struct frame *sel_frame = selected_frame (); - Window requestor_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame)); - Time requestor_time = DEVICE_X_MOUSE_TIMESTAMP (d); - Atom target_property = DEVICE_XATOM_EMACS_TMP (d); - Atom selection_atom = symbol_to_x_atom (d, selection_symbol, 0); - int speccount; - Atom type_atom = symbol_to_x_atom (d, (CONSP (target_type) ? - XCAR (target_type) : target_type), 0); - - XConvertSelection (display, selection_atom, type_atom, target_property, - requestor_window, requestor_time); - - /* Block until the reply has been read. */ - reading_selection_reply = requestor_window; - reading_which_selection = selection_atom; - selection_reply_timed_out = 0; - - speccount = specpdl_depth (); - - /* add a timeout handler */ - if (x_selection_timeout > 0) - { - Lisp_Object id = Fadd_timeout (make_int (x_selection_timeout), - Qx_selection_reply_timeout_internal, - Qnil, Qnil); - record_unwind_protect (Fdisable_timeout, id); - } - - /* This is ^Gable */ - wait_delaying_user_input (selection_reply_done, 0); - - if (selection_reply_timed_out) - error ("timed out waiting for reply from selection owner"); - - unbind_to (speccount, Qnil); - - /* otherwise, the selection is waiting for us on the requested property. */ - return - x_get_window_property_as_lisp_data (display, requestor_window, - target_property, target_type, - selection_atom); -} - - -static void -x_get_window_property (Display *display, Window window, Atom property, - unsigned char **data_ret, int *bytes_ret, - Atom *actual_type_ret, int *actual_format_ret, - unsigned long *actual_size_ret, int delete_p) -{ - int total_size; - unsigned long bytes_remaining; - int offset = 0; - unsigned char *tmp_data = 0; - int result; - int buffer_size = SELECTION_QUANTUM (display); - if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM; - - /* First probe the thing to find out how big it is. */ - result = XGetWindowProperty (display, window, property, - 0, 0, False, AnyPropertyType, - actual_type_ret, actual_format_ret, - actual_size_ret, - &bytes_remaining, &tmp_data); - if (result != Success) - { - *data_ret = 0; - *bytes_ret = 0; - return; - } - XFree ((char *) tmp_data); - - if (*actual_type_ret == None || *actual_format_ret == 0) - { - if (delete_p) XDeleteProperty (display, window, property); - *data_ret = 0; - *bytes_ret = 0; - return; - } - - total_size = bytes_remaining + 1; - *data_ret = (unsigned char *) xmalloc (total_size); - - /* Now read, until we've gotten it all. */ - while (bytes_remaining) - { -#if 0 - int last = bytes_remaining; -#endif - result = - XGetWindowProperty (display, window, property, - offset/4, buffer_size/4, - (delete_p ? True : False), - AnyPropertyType, - actual_type_ret, actual_format_ret, - actual_size_ret, &bytes_remaining, &tmp_data); -#if 0 - stderr_out ("<< read %d\n", last-bytes_remaining); -#endif - /* If this doesn't return Success at this point, it means that - some clod deleted the selection while we were in the midst of - reading it. Deal with that, I guess.... - */ - if (result != Success) break; - *actual_size_ret *= *actual_format_ret / 8; - memcpy ((*data_ret) + offset, tmp_data, *actual_size_ret); - offset += *actual_size_ret; - XFree ((char *) tmp_data); - } - *bytes_ret = offset; -} - - -static void -receive_incremental_selection (Display *display, Window window, Atom property, - /* this one is for error messages only */ - Lisp_Object target_type, - unsigned int min_size_bytes, - unsigned char **data_ret, int *size_bytes_ret, - Atom *type_ret, int *format_ret, - unsigned long *size_ret) -{ - /* This function can GC */ - int offset = 0; - int prop_id; - *size_bytes_ret = min_size_bytes; - *data_ret = (unsigned char *) xmalloc (*size_bytes_ret); -#if 0 - stderr_out ("\nread INCR %d\n", min_size_bytes); -#endif - /* At this point, we have read an INCR property, and deleted it (which - is how we ack its receipt: the sending window will be selecting - PropertyNotify events on our window to notice this). - - Now, we must loop, waiting for the sending window to put a value on - that property, then reading the property, then deleting it to ack. - We are done when the sender places a property of length 0. - */ - prop_id = expect_property_change (display, window, property, - PropertyNewValue); - while (1) - { - unsigned char *tmp_data; - int tmp_size_bytes; - wait_for_property_change (prop_id); - /* expect it again immediately, because x_get_window_property may - .. no it won't, I don't get it. - .. Ok, I get it now, the Xt code that implements INCR is broken. - */ - prop_id = expect_property_change (display, window, property, - PropertyNewValue); - x_get_window_property (display, window, property, - &tmp_data, &tmp_size_bytes, - type_ret, format_ret, size_ret, 1); - - if (tmp_size_bytes == 0) /* we're done */ - { -#if 0 - stderr_out (" read INCR done\n"); -#endif - unexpect_property_change (prop_id); - if (tmp_data) xfree (tmp_data); - break; - } -#if 0 - stderr_out (" read INCR %d\n", tmp_size_bytes); -#endif - if (*size_bytes_ret < offset + tmp_size_bytes) - { -#if 0 - stderr_out (" read INCR realloc %d -> %d\n", - *size_bytes_ret, offset + tmp_size_bytes); -#endif - *size_bytes_ret = offset + tmp_size_bytes; - *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret); - } - memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes); - offset += tmp_size_bytes; - xfree (tmp_data); - } -} - - -static Lisp_Object -x_get_window_property_as_lisp_data (Display *display, - Window window, - Atom property, - /* next two for error messages only */ - Lisp_Object target_type, - Atom selection_atom) -{ - /* This function can GC */ - Atom actual_type; - int actual_format; - unsigned long actual_size; - unsigned char *data = NULL; - int bytes = 0; - Lisp_Object val; - struct device *d = get_device_from_display (display); - - x_get_window_property (display, window, property, &data, &bytes, - &actual_type, &actual_format, &actual_size, 1); - if (! data) - { - if (XGetSelectionOwner (display, selection_atom)) - /* there is a selection owner */ - signal_error - (Qselection_conversion_error, - Fcons (build_string ("selection owner couldn't convert"), - Fcons (x_atom_to_symbol (d, selection_atom), - actual_type ? - list2 (target_type, x_atom_to_symbol (d, actual_type)) : - list1 (target_type)))); - else - signal_error (Qerror, - list2 (build_string ("no selection"), - x_atom_to_symbol (d, selection_atom))); - } - - if (actual_type == DEVICE_XATOM_INCR (d)) - { - /* Ok, that data wasn't *the* data, it was just the beginning. */ - - unsigned int min_size_bytes = * ((unsigned int *) data); - xfree (data); - receive_incremental_selection (display, window, property, target_type, - min_size_bytes, &data, &bytes, - &actual_type, &actual_format, - &actual_size); - } - - /* It's been read. Now convert it to a lisp object in some semi-rational - manner. */ - val = selection_data_to_lisp_data (d, data, bytes, - actual_type, actual_format); - - xfree (data); - return val; -} - -/* These functions convert from the selection data read from the server into - something that we can use from elisp, and vice versa. - - Type: Format: Size: Elisp Type: - ----- ------- ----- ----------- - * 8 * String - ATOM 32 1 Symbol - ATOM 32 > 1 Vector of Symbols - * 16 1 Integer - * 16 > 1 Vector of Integers - * 32 1 if <=16 bits: Integer - if > 16 bits: Cons of top16, bot16 - * 32 > 1 Vector of the above - - When converting a Lisp number to C, it is assumed to be of format 16 if - it is an integer, and of format 32 if it is a cons of two integers. - - When converting a vector of numbers from Elisp to C, it is assumed to be - of format 16 if every element in the vector is an integer, and is assumed - to be of format 32 if any element is a cons of two integers. - - When converting an object to C, it may be of the form (SYMBOL . <data>) - where SYMBOL is what we should claim that the type is. Format and - representation are as above. - - NOTE: Under Mule, when someone shoves us a string without a type, we - set the type to 'COMPOUND_TEXT and automatically convert to Compound - Text. If the string has a type, we assume that the user wants the - data sent as-is so we just do "binary" conversion. - */ - - -static Lisp_Object -selection_data_to_lisp_data (struct device *d, - unsigned char *data, - size_t size, - Atom type, - int format) -{ - if (type == DEVICE_XATOM_NULL (d)) - return QNULL; - - /* Convert any 8-bit data to a string, for compactness. */ - else if (format == 8) - return make_ext_string (data, size, - type == DEVICE_XATOM_TEXT (d) || - type == DEVICE_XATOM_COMPOUND_TEXT (d) - ? FORMAT_CTEXT : FORMAT_BINARY); - - /* Convert a single atom to a Lisp Symbol. - Convert a set of atoms to a vector of symbols. */ - else if (type == XA_ATOM) - { - if (size == sizeof (Atom)) - return x_atom_to_symbol (d, *((Atom *) data)); - else - { - int i; - int len = size / sizeof (Atom); - Lisp_Object v = Fmake_vector (make_int (len), Qzero); - for (i = 0; i < len; i++) - Faset (v, make_int (i), x_atom_to_symbol (d, ((Atom *) data) [i])); - return v; - } - } - - /* Convert a single 16 or small 32 bit number to a Lisp Int. - If the number is > 16 bits, convert it to a cons of integers, - 16 bits in each half. - */ - else if (format == 32 && size == sizeof (long)) - return word_to_lisp (((unsigned long *) data) [0]); - else if (format == 16 && size == sizeof (short)) - return make_int ((int) (((unsigned short *) data) [0])); - - /* Convert any other kind of data to a vector of numbers, represented - as above (as an integer, or a cons of two 16 bit integers). - - #### Perhaps we should return the actual type to lisp as well. - - (x-get-selection-internal 'PRIMARY 'LINE_NUMBER) - ==> [4 4] - - and perhaps it should be - - (x-get-selection-internal 'PRIMARY 'LINE_NUMBER) - ==> (SPAN . [4 4]) - - Right now the fact that the return type was SPAN is discarded before - lisp code gets to see it. - */ - else if (format == 16) - { - int i; - Lisp_Object v = make_vector (size / 4, Qzero); - for (i = 0; i < (int) size / 4; i++) - { - int j = (int) ((unsigned short *) data) [i]; - Faset (v, make_int (i), make_int (j)); - } - return v; - } - else - { - int i; - Lisp_Object v = make_vector (size / 4, Qzero); - for (i = 0; i < (int) size / 4; i++) - { - unsigned long j = ((unsigned long *) data) [i]; - Faset (v, make_int (i), word_to_lisp (j)); - } - return v; - } -} - - -static void -lisp_data_to_selection_data (struct device *d, - Lisp_Object obj, - unsigned char **data_ret, - Atom *type_ret, - unsigned int *size_ret, - int *format_ret) -{ - Lisp_Object type = Qnil; - - if (CONSP (obj) && SYMBOLP (XCAR (obj))) - { - type = XCAR (obj); - obj = XCDR (obj); - if (CONSP (obj) && NILP (XCDR (obj))) - obj = XCAR (obj); - } - - if (EQ (obj, QNULL) || (EQ (type, QNULL))) - { /* This is not the same as declining */ - *format_ret = 32; - *size_ret = 0; - *data_ret = 0; - type = QNULL; - } - else if (STRINGP (obj)) - { - CONST Extbyte *extval; - Extcount extvallen; - - if (NILP (type)) - GET_STRING_CTEXT_DATA_ALLOCA (obj, extval, extvallen); - else - GET_STRING_BINARY_DATA_ALLOCA (obj, extval, extvallen); - *format_ret = 8; - *size_ret = extvallen; - *data_ret = (unsigned char *) xmalloc (*size_ret); - memcpy (*data_ret, extval, *size_ret); -#ifdef MULE - if (NILP (type)) type = QCOMPOUND_TEXT; -#else - if (NILP (type)) type = QSTRING; -#endif - } - else if (CHARP (obj)) - { - Bufbyte buf[MAX_EMCHAR_LEN]; - Bytecount len; - CONST Extbyte *extval; - Extcount extvallen; - - *format_ret = 8; - len = set_charptr_emchar (buf, XCHAR (obj)); - GET_CHARPTR_EXT_CTEXT_DATA_ALLOCA (buf, len, extval, extvallen); - *size_ret = extvallen; - *data_ret = (unsigned char *) xmalloc (*size_ret); - memcpy (*data_ret, extval, *size_ret); -#ifdef MULE - if (NILP (type)) type = QCOMPOUND_TEXT; -#else - if (NILP (type)) type = QSTRING; -#endif - } - else if (SYMBOLP (obj)) - { - *format_ret = 32; - *size_ret = 1; - *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1); - (*data_ret) [sizeof (Atom)] = 0; - (*(Atom **) data_ret) [0] = symbol_to_x_atom (d, obj, 0); - if (NILP (type)) type = QATOM; - } - else if (INTP (obj) && - XINT (obj) <= 0x7FFF && - XINT (obj) >= -0x8000) - { - *format_ret = 16; - *size_ret = 1; - *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1); - (*data_ret) [sizeof (short)] = 0; - (*(short **) data_ret) [0] = (short) XINT (obj); - if (NILP (type)) type = QINTEGER; - } - else if (INTP (obj) || CONSP (obj)) - { - *format_ret = 32; - *size_ret = 1; - *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1); - (*data_ret) [sizeof (long)] = 0; - (*(unsigned long **) data_ret) [0] = lisp_to_word (obj); - if (NILP (type)) type = QINTEGER; - } - else if (VECTORP (obj)) - { - /* Lisp Vectors may represent a set of ATOMs; - a set of 16 or 32 bit INTEGERs; - or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...] - */ - int i; - - if (SYMBOLP (XVECTOR_DATA (obj) [0])) - /* This vector is an ATOM set */ - { - if (NILP (type)) type = QATOM; - *size_ret = XVECTOR_LENGTH (obj); - *format_ret = 32; - *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom)); - for (i = 0; i < (int) (*size_ret); i++) - if (SYMBOLP (XVECTOR_DATA (obj) [i])) - (*(Atom **) data_ret) [i] = - symbol_to_x_atom (d, XVECTOR_DATA (obj) [i], 0); - else - signal_error (Qerror, /* Qselection_error */ - list2 (build_string - ("all elements of the vector must be of the same type"), - obj)); - } -#if 0 /* #### MULTIPLE doesn't work yet */ - else if (VECTORP (XVECTOR_DATA (obj) [0])) - /* This vector is an ATOM_PAIR set */ - { - if (NILP (type)) type = QATOM_PAIR; - *size_ret = XVECTOR_LENGTH (obj); - *format_ret = 32; - *data_ret = (unsigned char *) - xmalloc ((*size_ret) * sizeof (Atom) * 2); - for (i = 0; i < *size_ret; i++) - if (VECTORP (XVECTOR_DATA (obj) [i])) - { - Lisp_Object pair = XVECTOR_DATA (obj) [i]; - if (XVECTOR_LENGTH (pair) != 2) - signal_error (Qerror, - list2 (build_string - ("elements of the vector must be vectors of exactly two elements"), - pair)); - - (*(Atom **) data_ret) [i * 2] = - symbol_to_x_atom (d, XVECTOR_DATA (pair) [0], 0); - (*(Atom **) data_ret) [(i * 2) + 1] = - symbol_to_x_atom (d, XVECTOR_DATA (pair) [1], 0); - } - else - signal_error (Qerror, - list2 (build_string - ("all elements of the vector must be of the same type"), - obj)); - } -#endif - else - /* This vector is an INTEGER set, or something like it */ - { - *size_ret = XVECTOR_LENGTH (obj); - if (NILP (type)) type = QINTEGER; - *format_ret = 16; - for (i = 0; i < (int) (*size_ret); i++) - if (CONSP (XVECTOR_DATA (obj) [i])) - *format_ret = 32; - else if (!INTP (XVECTOR_DATA (obj) [i])) - signal_error (Qerror, /* Qselection_error */ - list2 (build_string - ("all elements of the vector must be integers or conses of integers"), - obj)); - - *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8)); - for (i = 0; i < (int) (*size_ret); i++) - if (*format_ret == 32) - (*((unsigned long **) data_ret)) [i] = - lisp_to_word (XVECTOR_DATA (obj) [i]); - else - (*((unsigned short **) data_ret)) [i] = - (unsigned short) lisp_to_word (XVECTOR_DATA (obj) [i]); - } - } - else - signal_error (Qerror, /* Qselection_error */ - list2 (build_string ("unrecognized selection data"), - obj)); - - *type_ret = symbol_to_x_atom (d, type, 0); -} - -static Lisp_Object -clean_local_selection_data (Lisp_Object obj) -{ - if (CONSP (obj) && - INTP (XCAR (obj)) && - CONSP (XCDR (obj)) && - INTP (XCAR (XCDR (obj))) && - NILP (XCDR (XCDR (obj)))) - obj = Fcons (XCAR (obj), XCDR (obj)); - - if (CONSP (obj) && - INTP (XCAR (obj)) && - INTP (XCDR (obj))) - { - if (XINT (XCAR (obj)) == 0) - return XCDR (obj); - if (XINT (XCAR (obj)) == -1) - return make_int (- XINT (XCDR (obj))); - } - if (VECTORP (obj)) - { - int i; - int len = XVECTOR_LENGTH (obj); - Lisp_Object copy; - if (len == 1) - return clean_local_selection_data (XVECTOR_DATA (obj) [0]); - copy = make_vector (len, Qnil); - for (i = 0; i < len; i++) - XVECTOR_DATA (copy) [i] = - clean_local_selection_data (XVECTOR_DATA (obj) [i]); - return copy; - } - return obj; -} - - -/* Called from the event loop to handle SelectionNotify events. - I don't think this needs to be reentrant. - */ -void -x_handle_selection_notify (XSelectionEvent *event) -{ - if (! reading_selection_reply) - message ("received an unexpected SelectionNotify event"); - else if (event->requestor != reading_selection_reply) - message ("received a SelectionNotify event for the wrong window"); - else if (event->selection != reading_which_selection) - message ("received the wrong selection type in SelectionNotify!"); - else - reading_selection_reply = 0; /* we're done now. */ -} - - -DEFUN ("x-own-selection-internal", Fx_own_selection_internal, 2, 2, 0, /* -Assert an X selection of the given TYPE with the given VALUE. -TYPE is a symbol, typically PRIMARY, SECONDARY, or CLIPBOARD. -VALUE is typically a string, or a cons of two markers, but may be -anything that the functions on selection-converter-alist know about. -*/ - (selection_name, selection_value)) -{ - CHECK_SYMBOL (selection_name); - if (NILP (selection_value)) error ("selection-value may not be nil."); - x_own_selection (selection_name, selection_value); - return selection_value; -} - - -/* Request the selection value from the owner. If we are the owner, - simply return our selection value. If we are not the owner, this - will block until all of the data has arrived. - */ -DEFUN ("x-get-selection-internal", Fx_get_selection_internal, 2, 2, 0, /* -Return text selected from some X window. -SELECTION_SYMBOL is a symbol, typically PRIMARY, SECONDARY, or CLIPBOARD. -TARGET_TYPE is the type of data desired, typically STRING or COMPOUND_TEXT. -Under Mule, if the resultant data comes back as 8-bit data in type -TEXT or COMPOUND_TEXT, it will be decoded as Compound Text. -*/ - (selection_symbol, target_type)) -{ - /* This function can GC */ - Lisp_Object val = Qnil; - struct gcpro gcpro1, gcpro2; - GCPRO2 (target_type, val); /* we store newly consed data into these */ - CHECK_SYMBOL (selection_symbol); - -#if 0 /* #### MULTIPLE doesn't work yet */ - if (CONSP (target_type) && - XCAR (target_type) == QMULTIPLE) - { - CHECK_VECTOR (XCDR (target_type)); - /* So we don't destructively modify this... */ - target_type = copy_multiple_data (target_type); - } - else -#endif - CHECK_SYMBOL (target_type); - - val = x_get_local_selection (selection_symbol, target_type); - - if (NILP (val)) - { - val = x_get_foreign_selection (selection_symbol, target_type); - } - else - { - if (CONSP (val) && SYMBOLP (XCAR (val))) - { - val = XCDR (val); - if (CONSP (val) && NILP (XCDR (val))) - val = XCAR (val); - } - val = clean_local_selection_data (val); - } - UNGCPRO; - return val; -} - -DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal, 1, 2, 0, /* -If we own the named selection, then disown it (make there be no selection). -*/ - (selection, timeval)) -{ - struct device *d = decode_x_device (Qnil); - Display *display = DEVICE_X_DISPLAY (d); - Time timestamp; - Atom selection_atom; - XSelectionClearEvent event; - - CHECK_SYMBOL (selection); - if (NILP (timeval)) - timestamp = DEVICE_X_MOUSE_TIMESTAMP (d); - else - { - /* #### This is bogus. See the comment above about problems - on OSF/1 and DEC Alphas. Yet another reason why it sucks - to have the implementation (i.e. cons of two 16-bit - integers) exposed. */ - time_t the_time; - lisp_to_time (timeval, &the_time); - timestamp = (Time) the_time; - } - - if (NILP (assq_no_quit (selection, Vselection_alist))) - return Qnil; /* Don't disown the selection when we're not the owner. */ - - selection_atom = symbol_to_x_atom (d, selection, 0); - - XSetSelectionOwner (display, selection_atom, None, timestamp); - - /* It doesn't seem to be guaranteed that a SelectionClear event will be - generated for a window which owns the selection when that window sets - the selection owner to None. The NCD server does, the MIT Sun4 server - doesn't. So we synthesize one; this means we might get two, but - that's ok, because the second one won't have any effect. - */ - event.display = display; - event.selection = selection_atom; - event.time = timestamp; - x_handle_selection_clear (&event); - - return Qt; -} - - -DEFUN ("x-selection-owner-p", Fx_selection_owner_p, 0, 1, 0, /* -Return t if current emacs process owns the given X Selection. -The arg should be the name of the selection in question, typically one of -the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience, the symbol -nil is the same as PRIMARY, and t is the same as SECONDARY.) -*/ - (selection)) -{ - CHECK_SYMBOL (selection); - if (EQ (selection, Qnil)) selection = QPRIMARY; - else if (EQ (selection, Qt)) selection = QSECONDARY; - - return NILP (Fassq (selection, Vselection_alist)) ? Qnil : Qt; -} - -DEFUN ("x-selection-exists-p", Fx_selection_exists_p, 0, 1, 0, /* -Whether there is an owner for the given X Selection. -The arg should be the name of the selection in question, typically one of -the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience, the symbol -nil is the same as PRIMARY, and t is the same as SECONDARY.) -*/ - (selection)) -{ - struct device *d = decode_x_device (Qnil); - Display *dpy = DEVICE_X_DISPLAY (d); - CHECK_SYMBOL (selection); - if (!NILP (Fx_selection_owner_p (selection))) - return Qt; - return XGetSelectionOwner (dpy, symbol_to_x_atom (d, selection, 0)) != None ? - Qt : Qnil; -} - - -#ifdef CUT_BUFFER_SUPPORT - -static int cut_buffers_initialized; /* Whether we're sure they all exist */ - -/* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */ -static void -initialize_cut_buffers (Display *display, Window window) -{ - static unsigned CONST char * CONST data = (unsigned CONST char *) ""; -#define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \ - PropModeAppend, data, 0) - FROB (XA_CUT_BUFFER0); - FROB (XA_CUT_BUFFER1); - FROB (XA_CUT_BUFFER2); - FROB (XA_CUT_BUFFER3); - FROB (XA_CUT_BUFFER4); - FROB (XA_CUT_BUFFER5); - FROB (XA_CUT_BUFFER6); - FROB (XA_CUT_BUFFER7); -#undef FROB - cut_buffers_initialized = 1; -} - -#define CHECK_CUTBUFFER(symbol) \ - { CHECK_SYMBOL (symbol); \ - if (!EQ((symbol),QCUT_BUFFER0) && !EQ((symbol),QCUT_BUFFER1) && \ - !EQ((symbol),QCUT_BUFFER2) && !EQ((symbol),QCUT_BUFFER3) && \ - !EQ((symbol),QCUT_BUFFER4) && !EQ((symbol),QCUT_BUFFER5) && \ - !EQ((symbol),QCUT_BUFFER6) && !EQ((symbol),QCUT_BUFFER7)) \ - signal_error (Qerror, list2 (build_string ("Doesn't name a cutbuffer"), \ - (symbol))); \ - } - -DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal, 1, 1, 0, /* -Return the value of the named CUTBUFFER (typically CUT_BUFFER0). -*/ - (cutbuffer)) -{ - struct device *d = decode_x_device (Qnil); - Display *display = DEVICE_X_DISPLAY (d); - Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */ - Atom cut_buffer_atom; - unsigned char *data; - int bytes; - Atom type; - int format; - unsigned long size; - Lisp_Object ret; - - CHECK_CUTBUFFER (cutbuffer); - cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0); - - x_get_window_property (display, window, cut_buffer_atom, &data, &bytes, - &type, &format, &size, 0); - if (!data) return Qnil; - - if (format != 8 || type != XA_STRING) - signal_simple_error_2 ("Cut buffer doesn't contain 8-bit STRING data", - x_atom_to_symbol (d, type), - make_int (format)); - - /* We cheat - if the string contains an ESC character, that's - technically not allowed in a STRING, so we assume it's - COMPOUND_TEXT that we stored there ourselves earlier, - in x-store-cutbuffer-internal */ - ret = (bytes ? - make_ext_string (data, bytes, - memchr (data, 0x1b, bytes) ? - FORMAT_CTEXT : FORMAT_BINARY) - : Qnil); - xfree (data); - return ret; -} - - -DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal, 2, 2, 0, /* -Set the value of the named CUTBUFFER (typically CUT_BUFFER0) to STRING. -*/ - (cutbuffer, string)) -{ - struct device *d = decode_x_device (Qnil); - Display *display = DEVICE_X_DISPLAY (d); - Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */ - Atom cut_buffer_atom; - CONST Extbyte *data = XSTRING_DATA (string); - Extcount bytes = XSTRING_LENGTH (string); - Extcount bytes_remaining; - int max_bytes = SELECTION_QUANTUM (display); -#ifdef MULE - CONST Bufbyte *ptr, *end; - enum { ASCII, LATIN_1, WORLD } chartypes = ASCII; -#endif - - if (max_bytes > MAX_SELECTION_QUANTUM) - max_bytes = MAX_SELECTION_QUANTUM; - - CHECK_CUTBUFFER (cutbuffer); - CHECK_STRING (string); - cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0); - - if (! cut_buffers_initialized) - initialize_cut_buffers (display, window); - - /* We use the STRING encoding (Latin-1 only) if we can, else COMPOUND_TEXT. - We cheat and use type = `STRING' even when using COMPOUND_TEXT. - The ICCCM requires that this be so, and other clients assume it, - as we do ourselves in initialize_cut_buffers. */ - -#ifdef MULE - /* Optimize for the common ASCII case */ - for (ptr = data, end = ptr + bytes; ptr <= end; ) - { - if (BYTE_ASCII_P (*ptr)) - { - ptr++; - continue; - } - - if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 || - (*ptr) == LEADING_BYTE_CONTROL_1) - { - chartypes = LATIN_1; - ptr += 2; - continue; - } - - chartypes = WORLD; - break; - } - - if (chartypes == LATIN_1) - GET_STRING_BINARY_DATA_ALLOCA (string, data, bytes); - else if (chartypes == WORLD) - GET_STRING_CTEXT_DATA_ALLOCA (string, data, bytes); -#endif /* MULE */ - - bytes_remaining = bytes; - - while (bytes_remaining) - { - int chunk = bytes_remaining < max_bytes ? bytes_remaining : max_bytes; - XChangeProperty (display, window, cut_buffer_atom, XA_STRING, 8, - (bytes_remaining == bytes - ? PropModeReplace : PropModeAppend), - data, chunk); - data += chunk; - bytes_remaining -= chunk; - } - return string; -} - - -DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal, 1, 1, 0, /* -Rotate the values of the cutbuffers by the given number of steps; -positive means move values forward, negative means backward. -*/ - (n)) -{ - struct device *d = decode_x_device (Qnil); - Display *display = DEVICE_X_DISPLAY (d); - Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */ - Atom props [8]; - - CHECK_INT (n); - if (XINT (n) == 0) - return n; - if (! cut_buffers_initialized) - initialize_cut_buffers (display, window); - props[0] = XA_CUT_BUFFER0; - props[1] = XA_CUT_BUFFER1; - props[2] = XA_CUT_BUFFER2; - props[3] = XA_CUT_BUFFER3; - props[4] = XA_CUT_BUFFER4; - props[5] = XA_CUT_BUFFER5; - props[6] = XA_CUT_BUFFER6; - props[7] = XA_CUT_BUFFER7; - XRotateWindowProperties (display, window, props, 8, XINT (n)); - return n; -} - -#endif /* CUT_BUFFER_SUPPORT */ - - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_xselect (void) -{ - DEFSUBR (Fx_get_selection_internal); - DEFSUBR (Fx_own_selection_internal); - DEFSUBR (Fx_disown_selection_internal); - DEFSUBR (Fx_selection_owner_p); - DEFSUBR (Fx_selection_exists_p); - -#ifdef CUT_BUFFER_SUPPORT - DEFSUBR (Fx_get_cutbuffer_internal); - DEFSUBR (Fx_store_cutbuffer_internal); - DEFSUBR (Fx_rotate_cutbuffers_internal); -#endif /* CUT_BUFFER_SUPPORT */ - - /* Unfortunately, timeout handlers must be lisp functions. */ - defsymbol (&Qx_selection_reply_timeout_internal, - "x-selection-reply-timeout-internal"); - DEFSUBR (Fx_selection_reply_timeout_internal); - - defsymbol (&QPRIMARY, "PRIMARY"); - defsymbol (&QSECONDARY, "SECONDARY"); - defsymbol (&QSTRING, "STRING"); - defsymbol (&QINTEGER, "INTEGER"); - defsymbol (&QCLIPBOARD, "CLIPBOARD"); - defsymbol (&QTIMESTAMP, "TIMESTAMP"); - defsymbol (&QTEXT, "TEXT"); - defsymbol (&QDELETE, "DELETE"); - defsymbol (&QMULTIPLE, "MULTIPLE"); - defsymbol (&QINCR, "INCR"); - defsymbol (&QEMACS_TMP, "_EMACS_TMP_"); - defsymbol (&QTARGETS, "TARGETS"); - defsymbol (&QATOM, "ATOM"); - defsymbol (&QATOM_PAIR, "ATOM_PAIR"); - defsymbol (&QCOMPOUND_TEXT, "COMPOUND_TEXT"); - defsymbol (&QNULL, "NULL"); - -#ifdef CUT_BUFFER_SUPPORT - defsymbol (&QCUT_BUFFER0, "CUT_BUFFER0"); - defsymbol (&QCUT_BUFFER1, "CUT_BUFFER1"); - defsymbol (&QCUT_BUFFER2, "CUT_BUFFER2"); - defsymbol (&QCUT_BUFFER3, "CUT_BUFFER3"); - defsymbol (&QCUT_BUFFER4, "CUT_BUFFER4"); - defsymbol (&QCUT_BUFFER5, "CUT_BUFFER5"); - defsymbol (&QCUT_BUFFER6, "CUT_BUFFER6"); - defsymbol (&QCUT_BUFFER7, "CUT_BUFFER7"); -#endif /* CUT_BUFFER_SUPPORT */ - - deferror (&Qselection_conversion_error, - "selection-conversion-error", - "selection-conversion error", Qio_error); -} - -void -vars_of_xselect (void) -{ -#ifdef CUT_BUFFER_SUPPORT - cut_buffers_initialized = 0; - Fprovide (intern ("cut-buffer")); -#endif - - reading_selection_reply = 0; - reading_which_selection = 0; - selection_reply_timed_out = 0; - for_whom_the_bell_tolls = 0; - prop_location_tick = 0; - - Vselection_alist = Qnil; - staticpro (&Vselection_alist); - - DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist /* -An alist associating selection-types (such as STRING and TIMESTAMP) with -functions. These functions will be called with three args: the name of the -selection (typically PRIMARY, SECONDARY, or CLIPBOARD); a desired type to -which the selection should be converted; and the local selection value - (whatever had been passed to `x-own-selection'). These functions should -return the value to send to the X server, which should be one of: - --- nil (the conversion could not be done) --- a cons of a symbol and any of the following values; the symbol - explicitly specifies the type that will be sent. --- a string (If the type is not specified, then if Mule support exists, - the string will be converted to Compound Text and sent in - the 'COMPOUND_TEXT format; otherwise (no Mule support), - the string will be left as-is and sent in the 'STRING - format. If the type is specified, the string will be - left as-is (or converted to binary format under Mule). - In all cases, 8-bit data it sent.) --- a character (With Mule support, will be converted to Compound Text - whether or not a type is specified. If a type is not - specified, a type of 'STRING or 'COMPOUND_TEXT will be - sent, as for strings.) --- the symbol 'NULL (Indicates that there is no meaningful return value. - Empty 32-bit data with a type of 'NULL will be sent.) --- a symbol (Will be converted into an atom. If the type is not specified, - a type of 'ATOM will be sent.) --- an integer (Will be converted into a 16-bit or 32-bit integer depending - on the value. If the type is not specified, a type of - 'INTEGER will be sent.) --- a cons (HIGH . LOW) of integers (Will be converted into a 32-bit integer. - If the type is not specified, a type of - 'INTEGER will be sent.) --- a vector of symbols (Will be converted into a list of atoms. If the type - is not specified, a type of 'ATOM will be sent.) --- a vector of integers (Will be converted into a list of 16-bit integers. - If the type is not specified, a type of 'INTEGER - will be sent.) --- a vector of integers and/or conses (HIGH . LOW) of integers - (Will be converted into a list of 16-bit integers. - If the type is not specified, a type of 'INTEGER - will be sent.) -*/ ); - Vselection_converter_alist = Qnil; - - DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks /* -A function or functions to be called after the X server has notified us -that we have lost the selection. The function(s) will be called with one -argument, a symbol naming the selection (typically PRIMARY, SECONDARY, or -CLIPBOARD). -*/ ); - Vx_lost_selection_hooks = Qunbound; - - DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks /* -A function or functions to be called after we have responded to some -other client's request for the value of a selection that we own. The -function(s) will be called with four arguments: - - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD); - - the name of the selection-type which we were requested to convert the - selection into before sending (for example, STRING or LENGTH); - - and whether we successfully transmitted the selection. -We might have failed (and declined the request) for any number of reasons, -including being asked for a selection that we no longer own, or being asked -to convert into a type that we don't know about or that is inappropriate. -This hook doesn't let you change the behavior of emacs's selection replies, -it merely informs you that they have happened. -*/ ); - Vx_sent_selection_hooks = Qunbound; - - DEFVAR_INT ("x-selection-timeout", &x_selection_timeout /* -If the selection owner doesn't reply in this many seconds, we give up. -A value of 0 means wait as long as necessary. This is initialized from the -\"*selectionTimeout\" resource (which is expressed in milliseconds). -*/ ); - x_selection_timeout = 0; -} - -void -Xatoms_of_xselect (struct device *d) -{ - Display *D = DEVICE_X_DISPLAY (d); - - /* Non-predefined atoms that we might end up using a lot */ - DEVICE_XATOM_CLIPBOARD (d) = XInternAtom (D, "CLIPBOARD", False); - DEVICE_XATOM_TIMESTAMP (d) = XInternAtom (D, "TIMESTAMP", False); - DEVICE_XATOM_TEXT (d) = XInternAtom (D, "TEXT", False); - DEVICE_XATOM_DELETE (d) = XInternAtom (D, "DELETE", False); - DEVICE_XATOM_MULTIPLE (d) = XInternAtom (D, "MULTIPLE", False); - DEVICE_XATOM_INCR (d) = XInternAtom (D, "INCR", False); - DEVICE_XATOM_TARGETS (d) = XInternAtom (D, "TARGETS", False); - DEVICE_XATOM_NULL (d) = XInternAtom (D, "NULL", False); - DEVICE_XATOM_ATOM_PAIR (d) = XInternAtom (D, "ATOM_PAIR", False); - DEVICE_XATOM_COMPOUND_TEXT (d) = XInternAtom (D, "COMPOUND_TEXT", False); - DEVICE_XATOM_EMACS_TMP (d) = XInternAtom (D, "_EMACS_TMP_", False); -} diff -r f4aeb21a5bad -r 74fd4e045ea6 tests/ChangeLog --- a/tests/ChangeLog Mon Aug 13 11:12:06 2007 +0200 +++ b/tests/ChangeLog Mon Aug 13 11:13:30 2007 +0200 @@ -1,3 +1,156 @@ +2000-02-16 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.29 is released. + +2000-02-13 Martin Buchholz <martin@xemacs.org> + + * automated/lisp-tests.el: Add subseq tests. + +2000-02-07 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.28 is released. + +2000-02-07 Martin Buchholz <martin@xemacs.org> + + * automated/lisp-tests.el: Add plist manipulation tests. + +2000-02-02 Martin Buchholz <martin@xemacs.org> + + * automated/symbol-tests.el: Crashes fixed, so resurrect + makunbound test for dontusethis-set-symbol-value-handler. + Add more dontusethis-set-symbol-value-handler tests. + Should fix any lingering problems with gnus playing with + pathname-coding-system. + +2000-01-25 Martin Buchholz <martin@xemacs.org> + + * mule-tests.el: Add coding-system tests. + +2000-01-18 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.27 is released. + +1999-12-24 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp> + + * automated/syntax-tests.el: New file. + Add test for scan_words using forward-word and backword-word. + +2000-01-08 Martin Buchholz <martin@xemacs.org> + + * automated/mule-tests.el: + Test resizing of small and big (> 8k bytes) strings. + +1999-12-31 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.26 is released. + +1999-12-24 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.25 is released. + +1999-12-21 Martin Buchholz <martin@xemacs.org> + + * automated/byte-compiler-tests.el: Add Jan's tests for equal + effect of bytecode and interpreted code. + + * automated/lisp-tests.el: Add tests for near-text functions. + +1999-12-19 Martin Buchholz <martin@xemacs.org> + + * automated/mule-tests.el: Add tests for fillarray, aset. + +1999-12-17 Martin Buchholz <martin@xemacs.org> + + * automated/lisp-tests.el: Add tests for mapcar1() crashes. + +1999-12-14 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.24 is released. + +1999-12-07 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.23 is released. + +1999-11-29 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.22 is released + +1999-11-28 Martin Buchholz <martin@xemacs.org> + + * XEmacs 21.2.21 is released. + +1999-11-10 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.20 is released + +1999-07-30 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.19 is released + +1999-07-13 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.18 is released + +1999-06-22 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.17 is released + +1999-06-11 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.16 is released + +1999-06-07 Hrvoje Niksic <hniksic@srce.hr> + + * automated/base64-tests.el: Check for error instead for nil where + error conditions are expected. + + * automated/base64-tests.el: Comment out (for now) the code that + causes crashes. + +1999-06-05 Hrvoje Niksic <hniksic@srce.hr> + + * automated/base64-tests.el: Check that the decoder handles + arbitrary characters. Cut down on the number of tests. + +1999-06-04 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.15 is released + +1999-06-02 Oscar Figueiredo <oscar@xemacs.org> + + * automated/lisp-tests.el: Test `split-string' + +1999-05-27 Hrvoje Niksic <hniksic@srce.hr> + + * automated/base64-tests.el: New file. + +1999-05-14 XEmacs Build Bot <builds@cvs.xemacs.org> + + * XEmacs 21.2.14 is released + +1999-05-06 Hrvoje Niksic <hniksic@srce.hr> + + * automated/symbol-tests.el: Add many more tests. + +1999-05-06 Hrvoje Niksic <hniksic@srce.hr> + + * automated/lisp-tests.el: Ditto. + + * automated/hash-table-tests.el: Ditto. + + * automated/database-tests.el: Don't use backquote where quote + would suffice. + + * automated/symbol-tests.el: Add tests for magic symbols. + +1999-05-04 Hrvoje Niksic <hniksic@srce.hr> + + * automated/hash-table-tests.el: Fix comment. + +1999-04-22 Hrvoje Niksic <hniksic@srce.hr> + + * automated/test-harness.el (batch-test-emacs): Minor fixes. + 1999-03-12 XEmacs Build Bot <builds@cvs.xemacs.org> * XEmacs 21.2.13 is released diff -r f4aeb21a5bad -r 74fd4e045ea6 tests/Dnd/droptest.sh --- a/tests/Dnd/droptest.sh Mon Aug 13 11:12:06 2007 +0200 +++ b/tests/Dnd/droptest.sh Mon Aug 13 11:13:30 2007 +0200 @@ -1,8 +1,10 @@ #!/bin/sh -cat README > /tmp/DropTest.txt +TEMPDIR=/tmp -cat > /tmp/DropTest.html <<EOF +cat README > $TEMPDIR/DropTest.txt + +cat > $TEMPDIR/DropTest.html <<EOF <HTML> <HEAD> <TITLE>DropTest Page @@ -14,7 +16,7 @@ EOF -cat > /tmp/DropTest.tex < $TEMPDIR/DropTest.tex < /tmp/DropTest.xpm < $TEMPDIR/DropTest.xpm < RET'. You will see a log of +passed and failed tests, which should allow you to investigate the +source of the error and ultimately fix the bug. + +Adding a new test file is trivial: just create a new file here and it +will be run. There is no need to byte-compile any of the files in +this directory -- the test-harness will take care of any necessary +byte-compilation. + +Look at the existing test cases for the examples of coding test cases. +It all boils down to your imagination and judicious use of the macros +`Assert', `Check-Error', `Check-Error-Message', and `Check-Message'. diff -r f4aeb21a5bad -r 74fd4e045ea6 tests/automated/base64-tests.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/automated/base64-tests.el Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,242 @@ +;; Copyright (C) 1999 Free Software Foundation, Inc. + +;; Author: Hrvoje Niksic +;; Maintainer: Hrvoje Niksic +;; Created: 1999 +;; Keywords: tests + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF. + +;;; Commentary: + +;; Test base64 functions. +;; See test-harness.el for instructions on how to run these tests. + +(eval-when-compile + (condition-case nil + (require 'test-harness) + (file-error + (push "." load-path) + (when (and (boundp 'load-file-name) (stringp load-file-name)) + (push (file-name-directory load-file-name) load-path)) + (require 'test-harness)))) + +;; We need to test the buffer and string functions. We do it by +;; testing them in various circumstances, asserting the same result, +;; and returning that result. + +(defvar bt-test-buffer (get-buffer-create " *base64-workhorse*")) + +(defun bt-base64-encode-string (string &optional no-line-break) + (let ((string-result (base64-encode-string string no-line-break)) + length) + (with-current-buffer bt-test-buffer + ;; the whole buffer + (erase-buffer) + (insert string) + (setq length (base64-encode-region (point-min) (point-max) no-line-break)) + (Assert (eq length (- (point-max) (point-min)))) + (Assert (equal (buffer-string) string-result)) + ;; partial + (erase-buffer) + (insert "random junk........\0\0';'eqwrkw[erpqf") + (let ((p1 (point)) p2) + (insert string) + (setq p2 (point-marker)) + (insert "...more random junk.q,f3/.qrm314.r,m2typ' 2436T@W$^@$#^T@") + (setq length (base64-encode-region p1 p2 no-line-break)) + (Assert (eq length (- p2 p1))) + (Assert (equal (buffer-substring p1 p2) string-result)))) + string-result)) + +(defun bt-base64-decode-string (string) + (let ((string-result (base64-decode-string string)) + length) + (with-current-buffer bt-test-buffer + ;; the whole buffer + (erase-buffer) + (insert string) + (setq length (base64-decode-region (point-min) (point-max))) + (cond (string-result + (Assert (eq length (- (point-max) (point-min)))) + (Assert (equal (buffer-string) string-result))) + (t + (Assert (null length)) + ;; The buffer should not have been modified. + (Assert (equal (buffer-string) string)))) + ;; partial + (erase-buffer) + (insert "random junk........\0\0';'eqwrkw[erpqf") + (let ((p1 (point)) p2) + (insert string) + (setq p2 (point-marker)) + (insert "...more random junk.q,f3/.qrm314.\0\0r,m2typ' 2436T@W$^@$#T@") + (setq length (base64-decode-region p1 p2)) + (cond (string-result + (Assert (eq length (- p2 p1))) + (Assert (equal (buffer-substring p1 p2) string-result))) + (t + (Assert (null length)) + ;; The buffer should not have been modified. + (Assert (equal (buffer-substring p1 p2) string)))))) + string-result)) + +(defun bt-remove-newlines (str) + (apply #'string (delete ?\n (mapcar #'identity str)))) + +(defconst bt-allchars + (let ((str (make-string 256 ?\0))) + (dotimes (i 256) + (aset str i (int-char i))) + str)) + +(defconst bt-test-strings + `(("" "") + ("foo" "Zm9v") + ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" + "QUJDREVGR0hJSktMTU5PUFFSU1RVVldYWVphYmNkZWZnaGlqa2xtbm9wcXJzdHV2d3h5ejAx +MjM0NTY3ODk=") + (,bt-allchars + "AAECAwQFBgcICQoLDA0ODxAREhMUFRYXGBkaGxwdHh8gISIjJCUmJygpKissLS4vMDEyMzQ1 +Njc4OTo7PD0+P0BBQkNERUZHSElKS0xNTk9QUVJTVFVWV1hZWltcXV5fYGFiY2RlZmdoaWpr +bG1ub3BxcnN0dXZ3eHl6e3x9fn+AgYKDhIWGh4iJiouMjY6PkJGSk5SVlpeYmZqbnJ2en6Ch +oqOkpaanqKmqq6ytrq+wsbKztLW2t7i5uru8vb6/wMHCw8TFxsfIycrLzM3Oz9DR0tPU1dbX +2Nna29zd3t/g4eLj5OXm5+jp6uvs7e7v8PHy8/T19vf4+fr7/P3+/w==") + )) + +;;----------------------------------------------------- +;; Encoding base64 +;;----------------------------------------------------- + +(loop for (raw encoded) in bt-test-strings do + (Assert (equal (bt-base64-encode-string raw) encoded)) + ;; test the NO-LINE-BREAK flag + (Assert (equal (bt-base64-encode-string raw t) (bt-remove-newlines encoded)))) + +;; When Mule is around, Lisp programmers should make sure that the +;; buffer contains only characters whose `char-int' is in the [0, 256) +;; range. If this condition is not satisfied for any character, an +;; error is signaled. +(when (featurep 'mule) + ;; #### remove subtraction of 128 -- no longer needed with make-char + ;; patch! + (let* ((mule-string (format "Hrvoje Nik%ci%c" + ;; scaron == 185 in Latin 2 + (make-char 'latin-iso8859-2 (- 185 128)) + ;; cacute == 230 in Latin 2 + (make-char 'latin-iso8859-2 (- 230 128))))) + (Check-Error-Message error "Non-ascii character in base64 input" + (bt-base64-encode-string mule-string)))) + +;;----------------------------------------------------- +;; Decoding base64 +;;----------------------------------------------------- + +(loop for (raw encoded) in bt-test-strings do + (Assert (equal (bt-base64-decode-string encoded) raw)) + (Assert (equal (bt-base64-decode-string (bt-remove-newlines encoded)) raw))) + +;; Test errors +(dolist (str `("foo" "AAC" "foo\0bar" "====" "Zm=9v" ,bt-allchars)) + (Check-Error error (base64-decode-string str))) + +;; base64-decode-string should ignore non-base64 characters anywhere +;; in the string. We test this in the cheesiest manner possible, by +;; inserting non-base64 chars at the beginning, at the end, and in the +;; middle of the string. + +(defconst bt-base64-chars '(?A ?B ?C ?D ?E ?F ?G ?H ?I ?J + ;; sometimes I hate Emacs indentation. + ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T + ?U ?V ?W ?X ?Y ?Z ?a ?b ?c ?d + ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n + ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x + ?y ?z ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 + ?8 ?9 ?+ ?/ ?=)) + +(defconst bt-nonbase64-chars (set-difference (mapcar #'identity bt-allchars) + bt-base64-chars)) + +(loop for (raw encoded) in bt-test-strings do + (unless (equal raw "") + (let* ((middlepos (/ (1+ (length encoded)) 2)) + (left (substring encoded 0 middlepos)) + (right (substring encoded middlepos))) + ;; Whitespace at the beginning, end, and middle. + (let ((mangled (concat bt-nonbase64-chars left bt-nonbase64-chars right + bt-nonbase64-chars))) + (Assert (equal (bt-base64-decode-string mangled) raw))) + + ;; Whitespace between every char. + (let ((mangled (concat bt-nonbase64-chars + ;; ENCODED with bt-nonbase64-chars + ;; between every character. + (mapconcat #'char-to-string encoded + (apply #'string bt-nonbase64-chars)) + bt-nonbase64-chars))) + (Assert (equal (bt-base64-decode-string mangled) raw)))))) + +;;----------------------------------------------------- +;; Mixed... +;;----------------------------------------------------- + +;; The whole point of base64 is to ensure that an arbitrary sequence +;; of bytes passes through gateway hellfire unscathed, protected by +;; the asbestos suit of base64. Here we test that +;; (base64-decode-string (base64-decode-string FOO)) equals FOO for +;; any FOO we can think of. The following stunts stress-test +;; practically all aspects of the encoding and decoding process. + +(loop for (raw ignored) in bt-test-strings do + (Assert (equal (bt-base64-decode-string + (bt-base64-encode-string raw)) + raw)) + (Assert (equal (bt-base64-decode-string + (bt-base64-decode-string + (bt-base64-encode-string + (bt-base64-encode-string raw)))) + raw)) + (Assert (equal (bt-base64-decode-string + (bt-base64-decode-string + (bt-base64-decode-string + (bt-base64-encode-string + (bt-base64-encode-string + (bt-base64-encode-string raw)))))) + raw)) + (Assert (equal (bt-base64-decode-string + (bt-base64-decode-string + (bt-base64-decode-string + (bt-base64-decode-string + (bt-base64-encode-string + (bt-base64-encode-string + (bt-base64-encode-string + (bt-base64-encode-string raw)))))))) + raw)) + (Assert (equal (bt-base64-decode-string + (bt-base64-decode-string + (bt-base64-decode-string + (bt-base64-decode-string + (bt-base64-decode-string + (bt-base64-encode-string + (bt-base64-encode-string + (bt-base64-encode-string + (bt-base64-encode-string + (bt-base64-encode-string raw)))))))))) + raw))) diff -r f4aeb21a5bad -r 74fd4e045ea6 tests/automated/byte-compiler-tests.el --- a/tests/automated/byte-compiler-tests.el Mon Aug 13 11:12:06 2007 +0200 +++ b/tests/automated/byte-compiler-tests.el Mon Aug 13 11:13:30 2007 +0200 @@ -22,7 +22,7 @@ ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;; 02111-1307, USA. -;;; Synched up with: not in FSF Emacs. +;;; Synched up with: Not in FSF. ;;; Commentary: @@ -91,3 +91,30 @@ error "`let' bindings can have only one value-form" (eval '(let* ((x 1 2)) 3))) +(defmacro before-and-after-compile-equal (&rest form) + `(Assert (equal (funcall (quote (lambda () ,@form))) + (funcall (byte-compile (quote (lambda () ,@form))))))) + +(defvar simplyamarker (point-min-marker)) + +;; The byte optimizer must be careful with +/- with a single argument. + +(before-and-after-compile-equal (+)) +(before-and-after-compile-equal (+ 2 2)) +(before-and-after-compile-equal (+ 2 1)) +(before-and-after-compile-equal (+ 1 2)) +;; (+ 1) is OK. but (+1) signals an error. +(before-and-after-compile-equal (+ 1)) +(before-and-after-compile-equal (+ 3)) +(before-and-after-compile-equal (+ simplyamarker 1)) +;; The optimization (+ m) --> m is invalid when m is a marker. +;; Currently the following test fails - controversial. +;; (before-and-after-compile-equal (+ simplyamarker)) +;; Same tests for minus. +(before-and-after-compile-equal (- 2 2)) +(before-and-after-compile-equal (- 2 1)) +(before-and-after-compile-equal (- 1 2)) +(before-and-after-compile-equal (- 1)) +(before-and-after-compile-equal (- 3)) +(before-and-after-compile-equal (- simplyamarker 1)) +(before-and-after-compile-equal (- simplyamarker)) diff -r f4aeb21a5bad -r 74fd4e045ea6 tests/automated/database-tests.el --- a/tests/automated/database-tests.el Mon Aug 13 11:12:06 2007 +0200 +++ b/tests/automated/database-tests.el Mon Aug 13 11:13:30 2007 +0200 @@ -22,7 +22,7 @@ ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;; 02111-1307, USA. -;;; Synched up with: not in FSF Emacs. +;;; Synched up with: Not in FSF. ;;; Commentary: @@ -52,7 +52,7 @@ (let ((filename (expand-file-name "test-harness" (temp-directory)))) - (dolist (db-type `(dbm berkeley-db)) + (dolist (db-type '(dbm berkeley-db)) (when (featurep db-type) (princ "\n") (delete-database-files filename) diff -r f4aeb21a5bad -r 74fd4e045ea6 tests/automated/hash-table-tests.el --- a/tests/automated/hash-table-tests.el Mon Aug 13 11:12:06 2007 +0200 +++ b/tests/automated/hash-table-tests.el Mon Aug 13 11:13:30 2007 +0200 @@ -22,11 +22,11 @@ ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;; 02111-1307, USA. -;;; Synched up with: not in FSF Emacs. +;;; Synched up with: Not in FSF. ;;; Commentary: -;;; Test database functionality +;;; Test hash tables implementation ;;; See test-harness.el (condition-case err @@ -37,30 +37,41 @@ (require 'test-harness)))) ;; Test all combinations of make-hash-table keywords -(dolist (type `(non-weak weak key-weak value-weak)) - (dolist (test `(eq eql equal)) - (dolist (size `(0 1 100)) - (dolist (rehash-size `(1.1 9.9)) - (dolist (rehash-threshold `(0.2 .9)) - (dolist (data `(() (1 2) (1 2 3 4))) - (let ((ht (make-hash-table :test test - :type type - :size size - :rehash-size rehash-size - :rehash-threshold rehash-threshold))) +(dolist (test '(eq eql equal)) + (dolist (size '(0 1 100)) + (dolist (rehash-size '(1.1 9.9)) + (dolist (rehash-threshold '(0.2 .9)) + (dolist (weakness '(nil t key value)) + (dolist (data '(() (1 2) (1 2 3 4))) + (let ((ht (make-hash-table + :test test + :size size + :rehash-size rehash-size + :rehash-threshold rehash-threshold + :weakness weakness))) (Assert (equal ht (car (let ((print-readably t)) (read-from-string (prin1-to-string ht)))))) (Assert (eq test (hash-table-test ht))) - (Assert (eq type (hash-table-type ht))) (Assert (<= size (hash-table-size ht))) (Assert (eql rehash-size (hash-table-rehash-size ht))) - (Assert (eql rehash-threshold (hash-table-rehash-threshold ht)))))))))) + (Assert (eql rehash-threshold (hash-table-rehash-threshold ht))) + (Assert (eq weakness (hash-table-weakness ht)))))))))) + +(loop for (fun weakness) in '((make-hashtable nil) + (make-weak-hashtable t) + (make-key-weak-hashtable key) + (make-value-weak-hashtable value)) + do (Assert (eq weakness (hash-table-weakness (funcall fun 10))))) -(loop for (fun type) in `((make-hashtable non-weak) - (make-weak-hashtable weak) - (make-key-weak-hashtable key-weak) - (make-value-weak-hashtable value-weak)) - do (Assert (eq type (hash-table-type (funcall fun 10))))) +(loop for (type weakness) in '((non-weak nil) + (weak t) + (key-weak key) + (value-weak value)) + do (Assert (equal (make-hash-table :type type) + (make-hash-table :weakness weakness)))) + +(Assert (not (equal (make-hash-table :weakness nil) + (make-hash-table :weakness t)))) (let ((ht (make-hash-table :size 20 :rehash-threshold .75 :test 'eq)) (size 80)) @@ -69,6 +80,7 @@ (Assert (eq 'eq (hash-table-test ht))) (Assert (eq 'non-weak (hash-table-type ht))) (Assert (eq 'non-weak (hashtable-type ht))) + (Assert (eq 'nil (hash-table-weakness ht))) (dotimes (j size) (puthash j (- j) ht) (Assert (eq (gethash j ht) (- j))) @@ -193,13 +205,13 @@ )) ;; Test that weak hash-tables are properly handled -(loop for (type expected-count expected-k-sum expected-v-sum) in - `((non-weak 6 38 25) - (weak 3 6 9) - (key-weak 4 38 9) - (value-weak 4 6 25)) +(loop for (weakness expected-count expected-k-sum expected-v-sum) in + '((nil 6 38 25) + (t 3 6 9) + (key 4 38 9) + (value 4 6 25)) do - (let* ((ht (make-hash-table :type type)) + (let* ((ht (make-hash-table :weakness weakness)) (my-obj (cons ht ht))) (garbage-collect) (puthash my-obj 1 ht) @@ -238,9 +250,9 @@ (Assert (= v-sum k-sum)))) ;;; Test reading and printing of hash-table objects -(let ((h1 #s(hashtable type weak rehash-size 3.0 rehash-threshold .2 test eq data (1 2 3 4))) - (h2 #s(hash-table type weak rehash-size 3.0 rehash-threshold .2 test eq data (1 2 3 4))) - (h3 (make-hash-table :type 'weak :rehash-size 3.0 :rehash-threshold .2 :test 'eq))) +(let ((h1 #s(hashtable weakness t rehash-size 3.0 rehash-threshold .2 test eq data (1 2 3 4))) + (h2 #s(hash-table weakness t rehash-size 3.0 rehash-threshold .2 test eq data (1 2 3 4))) + (h3 (make-hash-table :weakness t :rehash-size 3.0 :rehash-threshold .2 :test 'eq))) (Assert (equal h1 h2)) (Assert (not (equal h1 h3))) (puthash 1 2 h3) @@ -267,3 +279,7 @@ (clrhash h2) (Assert (equal h1 h2)) ) + +;;; Test sxhash +(Assert (= (sxhash "foo") (sxhash "foo"))) +(Assert (= (sxhash '(1 2 3)) (sxhash '(1 2 3)))) diff -r f4aeb21a5bad -r 74fd4e045ea6 tests/automated/lisp-tests.el --- a/tests/automated/lisp-tests.el Mon Aug 13 11:12:06 2007 +0200 +++ b/tests/automated/lisp-tests.el Mon Aug 13 11:13:30 2007 +0200 @@ -22,7 +22,7 @@ ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;; 02111-1307, USA. -;;; Synched up with: not in FSF Emacs. +;;; Synched up with: Not in FSF. ;;; Commentary: @@ -119,7 +119,7 @@ (Check-Error wrong-type-argument (nconc 'foo nil)) -(dolist (length `(1 2 3 4 1000 2000)) +(dolist (length '(1 2 3 4 1000 2000)) (Check-Error circular-list (nconc (make-circular-list length) 'foo)) (Check-Error circular-list (nconc '(1 . 2) (make-circular-list length) 'foo)) (Check-Error circular-list (nconc '(1 . 2) '(3 . 4) (make-circular-list length) 'foo))) @@ -158,7 +158,7 @@ (Assert (eq (last x 3) (cdr x))) (Assert (eq (last x 4) x)) (Assert (eq (last x 9) x)) - (Assert (eq (last `(1 . 2) 0) 2)) + (Assert (eq (last '(1 . 2) 0) 2)) ) ;;----------------------------------------------------- @@ -213,7 +213,7 @@ (Check-Error circular-list (copy-list (make-circular-list 1))) (Check-Error circular-list (copy-list (make-circular-list 2000))) (Assert (eq '() (copy-list '()))) -(dolist (x `((1) (1 2) (1 2 3) (1 2 . 3))) +(dolist (x '((1) (1 2) (1 2 3) (1 2 . 3))) (let ((y (copy-list x))) (Assert (and (equal x y) (not (eq x y)))))) @@ -229,6 +229,8 @@ (Assert (= (+ 1.0 1) 2.0)) (Assert (= (+ 1.0 1 1) 3.0)) (Assert (= (+ 1 1 1.0) 3.0)) +(Assert (eq (1+ most-positive-fixnum) most-negative-fixnum)) +(Assert (eq (+ most-positive-fixnum 1) most-negative-fixnum)) ;; Test `-' (Check-Error wrong-number-of-arguments (-)) @@ -242,7 +244,7 @@ (Assert (= (- one one) 0)) (Assert (= (- one one one) -1)) (Assert (= (+ one 1) 2)) - (dolist (zero `(0 0.0 ?\0)) + (dolist (zero '(0 0.0 ?\0)) (Assert (= (+ 1 zero) 1)) (Assert (= (+ zero 1) 1)) (Assert (= (- zero) zero)) @@ -253,10 +255,13 @@ (Assert (= (- 1.5 1) .5)) (Assert (= (- 1 1.5) (- .5))) +(Assert (eq (1- most-negative-fixnum) most-positive-fixnum)) +(Assert (eq (- most-negative-fixnum 1) most-positive-fixnum)) + ;; Test `/' ;; Test division by zero errors -(dolist (zero `(0 0.0 ?\0)) +(dolist (zero '(0 0.0 ?\0)) (Check-Error arith-error (/ zero)) (dolist (n1 `(42 42.0 ?\042 ,(Int-to-Marker 42))) (Check-Error arith-error (/ n1 zero)) @@ -269,14 +274,14 @@ (Assert (= (/ (setq x 2)) 0)) (Assert (= (/ (setq x 2.0)) 0.5))) -(dolist (six `(6 6.0 ?\06)) - (dolist (two `(2 2.0 ?\02)) - (dolist (three `(3 3.0 ?\03)) +(dolist (six '(6 6.0 ?\06)) + (dolist (two '(2 2.0 ?\02)) + (dolist (three '(3 3.0 ?\03)) (Assert (= (/ six two) three))))) -(dolist (three `(3 3.0 ?\03)) +(dolist (three '(3 3.0 ?\03)) (Assert (= (/ three 2.0) 1.5))) -(dolist (two `(2 2.0 ?\02)) +(dolist (two '(2 2.0 ?\02)) (Assert (= (/ 3.0 two) 1.5))) ;; Test `*' @@ -285,18 +290,18 @@ (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1))) (Assert (= 1 (* one)))) -(dolist (two `(2 2.0 ?\02)) +(dolist (two '(2 2.0 ?\02)) (Assert (= 2 (* two)))) -(dolist (six `(6 6.0 ?\06)) - (dolist (two `(2 2.0 ?\02)) - (dolist (three `(3 3.0 ?\03)) +(dolist (six '(6 6.0 ?\06)) + (dolist (two '(2 2.0 ?\02)) + (dolist (three '(3 3.0 ?\03)) (Assert (= (* three two) six))))) -(dolist (three `(3 3.0 ?\03)) - (dolist (two `(2 2.0 ?\02)) +(dolist (three '(3 3.0 ?\03)) + (dolist (two '(2 2.0 ?\02)) (Assert (= (* 1.5 two) three)) - (dolist (five `(5 5.0 ?\05)) + (dolist (five '(5 5.0 ?\05)) (Assert (= 30 (* five two three)))))) ;; Test `+' @@ -305,12 +310,12 @@ (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1))) (Assert (= 1 (+ one)))) -(dolist (two `(2 2.0 ?\02)) +(dolist (two '(2 2.0 ?\02)) (Assert (= 2 (+ two)))) -(dolist (five `(5 5.0 ?\05)) - (dolist (two `(2 2.0 ?\02)) - (dolist (three `(3 3.0 ?\03)) +(dolist (five '(5 5.0 ?\05)) + (dolist (two '(2 2.0 ?\02)) + (dolist (three '(3 3.0 ?\03)) (Assert (= (+ three two) five)) (Assert (= 10 (+ five two three)))))) @@ -341,7 +346,7 @@ (Check-Error wrong-type-argument (logior 3.0)) (Check-Error wrong-type-argument (logand 3.0)) -(dolist (three `(3 ?\03)) +(dolist (three '(3 ?\03)) (Assert (eq 3 (logand three))) (Assert (eq 3 (logxor three))) (Assert (eq 3 (logior three))) @@ -350,11 +355,11 @@ (Assert (eq 3 (logior three three)))) (dolist (one `(1 ?\01 ,(Int-to-Marker 1))) - (dolist (two `(2 ?\02)) + (dolist (two '(2 ?\02)) (Assert (eq 0 (logand one two))) (Assert (eq 3 (logior one two))) (Assert (eq 3 (logxor one two)))) - (dolist (three `(3 ?\03)) + (dolist (three '(3 ?\03)) (Assert (eq 1 (logand one three))) (Assert (eq 3 (logior one three))) (Assert (eq 2 (logxor one three))))) @@ -468,7 +473,7 @@ ;; Meat (dolist (one `(1 1.0 ,(Int-to-Marker 1) ?\01)) - (dolist (two `(2 2.0 ?\02)) + (dolist (two '(2 2.0 ?\02)) (Assert (< one two)) (Assert (<= one two)) (Assert (<= two two)) @@ -489,7 +494,7 @@ )) (dolist (one `(1 1.0 ,(Int-to-Marker 1) ?\01)) - (dolist (two `(2 2.0 ?\02)) + (dolist (two '(2 2.0 ?\02)) (Assert (< one two)) (Assert (<= one two)) (Assert (<= two two)) @@ -537,7 +542,7 @@ (Check-Error wrong-number-of-arguments (,fun)) (Check-Error wrong-number-of-arguments (,fun nil)) (Check-Error malformed-list (,fun nil 1)) - ,@(loop for n in `(1 2 2000) + ,@(loop for n in '(1 2 2000) collect `(Check-Error circular-list (,fun 1 (make-circular-list ,n)))))) (test-funs (&rest funs) `(progn ,@(loop for fun in funs collect `(test-fun ,fun))))) @@ -750,6 +755,29 @@ (Assert (equal (mapconcat #'identity '("1" "2" "3") "|") "1|2|3")) (Assert (equal (mapconcat #'identity ["1" "2" "3"] "|") "1|2|3")) +;; The following 2 functions used to crash XEmacs via mapcar1(). +;; We don't test the actual values of the mapcar, since they're undefined. +(Assert + (let ((x (list (cons 1 1) (cons 2 2) (cons 3 3)))) + (mapcar + (lambda (y) + "Devious evil mapping function" + (when (eq (car y) 2) ; go out onto a limb + (setcdr x nil) ; cut it off behind us + (garbage-collect)) ; are we riding a magic broomstick? + (car y)) ; sorry, hard landing + x))) + +(Assert + (let ((x (list (cons 1 1) (cons 2 2) (cons 3 3)))) + (mapcar + (lambda (y) + "Devious evil mapping function" + (when (eq (car y) 1) + (setcdr (cdr x) 42)) ; drop a brick wall onto the freeway + (car y)) + x))) + ;;----------------------------------------------------- ;; Test vector functions ;;----------------------------------------------------- @@ -785,3 +813,128 @@ (defun test-emacs-buffer-local-parameter (test-emacs-buffer-local-variable) (setq test-emacs-buffer-local-variable nil))) (test-emacs-buffer-local-parameter nil) + +;;----------------------------------------------------- +;; Test split-string +;;----------------------------------------------------- +;; Hrvoje didn't like these tests so I'm disabling them for now. -sb +;(Assert (equal (split-string "foo" "") '("" "f" "o" "o" ""))) +;(Assert (equal (split-string "foo" "^") '("" "foo"))) +;(Assert (equal (split-string "foo" "$") '("foo" ""))) +(Assert (equal (split-string "foo,bar" ",") '("foo" "bar"))) +(Assert (equal (split-string ",foo,bar," ",") '("" "foo" "bar" ""))) +(Assert (equal (split-string ",foo,bar," "^,") '("" "foo,bar,"))) +(Assert (equal (split-string ",foo,bar," ",$") '(",foo,bar" ""))) +(Assert (equal (split-string ",foo,,bar," ",") '("" "foo" "" "bar" ""))) +(Assert (equal (split-string "foo,,,bar" ",") '("foo" "" "" "bar"))) +(Assert (equal (split-string "foo,,bar,," ",") '("foo" "" "bar" "" ""))) +(Assert (equal (split-string "foo,,bar" ",+") '("foo" "bar"))) +(Assert (equal (split-string ",foo,,bar," ",+") '("" "foo" "bar" ""))) + +;;----------------------------------------------------- +;; Test near-text buffer functions. +;;----------------------------------------------------- +(with-temp-buffer + (erase-buffer) + (Assert (eq (char-before) nil)) + (Assert (eq (char-before (point)) nil)) + (Assert (eq (char-before (point-marker)) nil)) + (Assert (eq (char-before (point) (current-buffer)) nil)) + (Assert (eq (char-before (point-marker) (current-buffer)) nil)) + (Assert (eq (char-after) nil)) + (Assert (eq (char-after (point)) nil)) + (Assert (eq (char-after (point-marker)) nil)) + (Assert (eq (char-after (point) (current-buffer)) nil)) + (Assert (eq (char-after (point-marker) (current-buffer)) nil)) + (Assert (eq (preceding-char) 0)) + (Assert (eq (preceding-char (current-buffer)) 0)) + (Assert (eq (following-char) 0)) + (Assert (eq (following-char (current-buffer)) 0)) + (insert "foobar") + (Assert (eq (char-before) ?r)) + (Assert (eq (char-after) nil)) + (Assert (eq (preceding-char) ?r)) + (Assert (eq (following-char) 0)) + (goto-char (point-min)) + (Assert (eq (char-before) nil)) + (Assert (eq (char-after) ?f)) + (Assert (eq (preceding-char) 0)) + (Assert (eq (following-char) ?f)) + ) + +;;----------------------------------------------------- +;; Test plist manipulation functions. +;;----------------------------------------------------- +(let ((sym (make-symbol "test-symbol"))) + (Assert (eq t (get* sym t t))) + (Assert (eq t (get sym t t))) + (Assert (eq t (getf nil t t))) + (Assert (eq t (plist-get nil t t))) + (put sym 'bar 'baz) + (Assert (eq 'baz (get sym 'bar))) + (Assert (eq 'baz (getf '(bar baz) 'bar))) + (Assert (eq 'baz (getf (symbol-plist sym) 'bar))) + (Assert (eq 2 (getf '(1 2) 1))) + (Assert (eq 4 (put sym 3 4))) + (Assert (eq 4 (get sym 3))) + (Assert (eq t (remprop sym 3))) + (Assert (eq nil (remprop sym 3))) + (Assert (eq 5 (get sym 3 5))) + ) + +(loop for obj in + (list (make-symbol "test-symbol") + "test-string" + (make-extent nil nil nil) + (make-face 'test-face)) + do + (Assert (eq 2 (get obj ?1 2))) + (Assert (eq 4 (put obj ?3 4))) + (Assert (eq 4 (get obj ?3))) + (when (or (stringp obj) (symbolp obj)) + (Assert (equal '(?3 4) (object-plist obj)))) + (Assert (eq t (remprop obj ?3))) + (when (or (stringp obj) (symbolp obj)) + (Assert (eq '() (object-plist obj)))) + (Assert (eq nil (remprop obj ?3))) + (when (or (stringp obj) (symbolp obj)) + (Assert (eq '() (object-plist obj)))) + (Assert (eq 5 (get obj ?3 5))) + ) + +(Check-Error-Message + error "Object type has no properties" + (get 2 'property)) + +(Check-Error-Message + error "Object type has no settable properties" + (put (current-buffer) 'property 'value)) + +(Check-Error-Message + error "Object type has no removable properties" + (remprop ?3 'property)) + +(Check-Error-Message + error "Object type has no properties" + (object-plist (symbol-function 'car))) + +(Check-Error-Message + error "Can't remove property from object" + (remprop (make-extent nil nil nil) 'detachable)) + +;;----------------------------------------------------- +;; Test subseq +;;----------------------------------------------------- +(Assert (equal (subseq nil 0) nil)) +(Assert (equal (subseq [1 2 3] 0) [1 2 3])) +(Assert (equal (subseq [1 2 3] 1 -1) [2])) +(Assert (equal (subseq "123" 0) "123")) +(Assert (equal (subseq "1234" -3 -1) "23")) +(Assert (equal (subseq #*0011 0) #*0011)) +(Assert (equal (subseq #*0011 -3 3) #*01)) +(Assert (equal (subseq '(1 2 3) 0) '(1 2 3))) +(Assert (equal (subseq '(1 2 3 4) -3 nil) '(2 3 4))) + +(Check-Error 'wrong-type-argument (subseq 3 2)) +(Check-Error 'args-out-of-range (subseq [1 2 3] -42)) +(Check-Error 'args-out-of-range (subseq [1 2 3] 0 42)) diff -r f4aeb21a5bad -r 74fd4e045ea6 tests/automated/md5-tests.el --- a/tests/automated/md5-tests.el Mon Aug 13 11:12:06 2007 +0200 +++ b/tests/automated/md5-tests.el Mon Aug 13 11:13:30 2007 +0200 @@ -1,7 +1,7 @@ ;; Copyright (C) 1998 Free Software Foundation, Inc. -;; Author: Hrvoje Niksic -;; Maintainer: Hrvoje Niksic +;; Author: Hrvoje Niksic +;; Maintainer: Hrvoje Niksic ;; Created: 1998 ;; Keywords: tests @@ -22,7 +22,7 @@ ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;; 02111-1307, USA. -;;; Synched up with: not in FSF Emacs. +;;; Synched up with: Not in FSF. ;;; Commentary: diff -r f4aeb21a5bad -r 74fd4e045ea6 tests/automated/mule-tests.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/automated/mule-tests.el Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,285 @@ +;; Copyright (C) 1999 Free Software Foundation, Inc. + +;; Author: Hrvoje Niksic +;; Maintainers: Hrvoje Niksic , +;; Martin Buchholz +;; Created: 1999 +;; Keywords: tests + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF. + +;;; Commentary: + +;; Test some Mule functionality (most of these remain to be written) . +;; See test-harness.el for instructions on how to run these tests. + +;; This file will be (read)ed by a non-mule XEmacs, so don't use +;; literal non-Latin1 characters. Use (make-char) instead. + +;;----------------------------------------------------------------- +;; Test whether all legal chars may be safely inserted to a buffer. +;;----------------------------------------------------------------- + +(defun test-chars (&optional for-test-harness) + "Insert all characters in a buffer, to see if XEmacs will crash. +This is done by creating a string with all the legal characters +in [0, 2^19) range, inserting it into the buffer, and checking +that the buffer's contents are equivalent to the string. + +If FOR-TEST-HARNESS is specified, a temporary buffer is used, and +the Assert macro checks for correctness." + (let ((max (expt 2 (if (featurep 'mule) 19 8))) + (list nil) + (i 0)) + (while (< i max) + (and (not for-test-harness) + (zerop (% i 1000)) + (message "%d" i)) + (and (int-char i) + ;; Don't aset to a string directly because random string + ;; access is O(n) under Mule. + (setq list (cons (int-char i) list))) + (setq i (1+ i))) + (let ((string (apply #'string (nreverse list)))) + (if for-test-harness + ;; For use with test-harness, use Assert and a temporary + ;; buffer. + (with-temp-buffer + (insert string) + (Assert (equal (buffer-string) string))) + ;; For use without test harness: use a normal buffer, so that + ;; you can also test whether redisplay works. + (switch-to-buffer (get-buffer-create "test")) + (erase-buffer) + (buffer-disable-undo) + (insert string) + (assert (equal (buffer-string) string)))))) + +;; It would be really *really* nice if test-harness allowed a way to +;; run a test in byte-compiled mode only. It's tedious to have +;; time-consuming tests like this one run twice, once interpreted and +;; once compiled, for no good reason. +(test-chars t) + +;;----------------------------------------------------------------- +;; Test string modification functions that modify the length of a char. +;;----------------------------------------------------------------- + +(when (featurep 'mule) + ;; Test fillarray + (macrolet + ((fillarray-test + (charset1 charset2) + (let ((char1 (make-char charset1 69)) + (char2 (make-char charset2 69))) + `(let ((string (make-string 1000 ,char1))) + (fillarray string ,char2) + (Assert (eq (aref string 0) ,char2)) + (Assert (eq (aref string (1- (length string))) ,char2)) + (Assert (eq (length string) 1000)))))) + (fillarray-test ascii latin-iso8859-1) + (fillarray-test ascii latin-iso8859-2) + (fillarray-test latin-iso8859-1 ascii) + (fillarray-test latin-iso8859-2 ascii)) + + ;; Test aset + (let ((string (string (make-char 'ascii 69) (make-char 'latin-iso8859-2 69)))) + (aset string 0 (make-char 'latin-iso8859-2 42)) + (Assert (eq (aref string 1) (make-char 'latin-iso8859-2 69)))) + + ;; Test coding system functions + + ;; Create alias for coding system without subsidiaries + (Assert (coding-system-p (find-coding-system 'binary))) + (Assert (coding-system-canonical-name-p 'binary)) + (Assert (not (coding-system-alias-p 'binary))) + (Assert (not (coding-system-alias-p 'mule-tests-alias))) + (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) + (Check-Error-Message + error "Symbol is the canonical name of a coding system and cannot be redefined" + (define-coding-system-alias 'binary 'iso8859-2)) + (Check-Error-Message + error "Symbol is not a coding system alias" + (coding-system-aliasee 'binary)) + + (define-coding-system-alias 'mule-tests-alias 'binary) + (Assert (coding-system-alias-p 'mule-tests-alias)) + (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) + (Assert (eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias))) + (Assert (eq 'binary (coding-system-aliasee 'mule-tests-alias))) + (Assert (not (coding-system-alias-p 'mule-tests-alias-unix))) + (Assert (not (coding-system-alias-p 'mule-tests-alias-dos))) + (Assert (not (coding-system-alias-p 'mule-tests-alias-mac))) + + (define-coding-system-alias 'mule-tests-alias (get-coding-system 'binary)) + (Assert (coding-system-alias-p 'mule-tests-alias)) + (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) + (Assert (eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias))) + (Assert (eq 'binary (coding-system-aliasee 'mule-tests-alias))) + (Assert (not (coding-system-alias-p 'mule-tests-alias-unix))) + (Assert (not (coding-system-alias-p 'mule-tests-alias-dos))) + (Assert (not (coding-system-alias-p 'mule-tests-alias-mac))) + + (define-coding-system-alias 'nested-mule-tests-alias 'mule-tests-alias) + (Assert (coding-system-alias-p 'nested-mule-tests-alias)) + (Assert (not (coding-system-canonical-name-p 'nested-mule-tests-alias))) + (Assert (eq (get-coding-system 'binary) (get-coding-system 'nested-mule-tests-alias))) + (Assert (eq (coding-system-aliasee 'nested-mule-tests-alias) 'mule-tests-alias)) + (Assert (eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias))) + (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-unix))) + (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-dos))) + (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-mac))) + + (Check-Error-Message + error "Attempt to create a coding system alias loop" + (define-coding-system-alias 'mule-tests-alias 'nested-mule-tests-alias)) + (Check-Error-Message + error "No such coding system" + (define-coding-system-alias 'no-such-coding-system 'no-such-coding-system)) + (Check-Error-Message + error "Attempt to create a coding system alias loop" + (define-coding-system-alias 'mule-tests-alias 'mule-tests-alias)) + + (define-coding-system-alias 'nested-mule-tests-alias nil) + (define-coding-system-alias 'mule-tests-alias nil) + (Assert (coding-system-p (find-coding-system 'binary))) + (Assert (coding-system-canonical-name-p 'binary)) + (Assert (not (coding-system-alias-p 'binary))) + (Assert (not (coding-system-alias-p 'mule-tests-alias))) + (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) + (Check-Error-Message + error "Symbol is the canonical name of a coding system and cannot be redefined" + (define-coding-system-alias 'binary 'iso8859-2)) + (Check-Error-Message + error "Symbol is not a coding system alias" + (coding-system-aliasee 'binary)) + + (define-coding-system-alias 'nested-mule-tests-alias nil) + (define-coding-system-alias 'mule-tests-alias nil) + + ;; Create alias for coding system with subsidiaries + (define-coding-system-alias 'mule-tests-alias 'iso-8859-7) + (Assert (coding-system-alias-p 'mule-tests-alias)) + (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) + (Assert (eq (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias))) + (Assert (eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias))) + (Assert (coding-system-alias-p 'mule-tests-alias-unix)) + (Assert (coding-system-alias-p 'mule-tests-alias-dos)) + (Assert (coding-system-alias-p 'mule-tests-alias-mac)) + + (define-coding-system-alias 'mule-tests-alias (get-coding-system 'iso-8859-7)) + (Assert (coding-system-alias-p 'mule-tests-alias)) + (Assert (not (coding-system-canonical-name-p 'mule-tests-alias))) + (Assert (eq (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias))) + (Assert (eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias))) + (Assert (coding-system-alias-p 'mule-tests-alias-unix)) + (Assert (coding-system-alias-p 'mule-tests-alias-dos)) + (Assert (coding-system-alias-p 'mule-tests-alias-mac)) + (Assert (eq (find-coding-system 'mule-tests-alias-mac) + (find-coding-system 'iso-8859-7-mac))) + + (define-coding-system-alias 'nested-mule-tests-alias 'mule-tests-alias) + (Assert (coding-system-alias-p 'nested-mule-tests-alias)) + (Assert (not (coding-system-canonical-name-p 'nested-mule-tests-alias))) + (Assert (eq (get-coding-system 'iso-8859-7) + (get-coding-system 'nested-mule-tests-alias))) + (Assert (eq (coding-system-aliasee 'nested-mule-tests-alias) 'mule-tests-alias)) + (Assert (eq 'mule-tests-alias (coding-system-aliasee 'nested-mule-tests-alias))) + (Assert (coding-system-alias-p 'nested-mule-tests-alias-unix)) + (Assert (coding-system-alias-p 'nested-mule-tests-alias-dos)) + (Assert (coding-system-alias-p 'nested-mule-tests-alias-mac)) + (Assert (eq (find-coding-system 'nested-mule-tests-alias-unix) + (find-coding-system 'iso-8859-7-unix))) + + (Check-Error-Message + error "Attempt to create a coding system alias loop" + (define-coding-system-alias 'mule-tests-alias 'nested-mule-tests-alias)) + (Check-Error-Message + error "No such coding system" + (define-coding-system-alias 'no-such-coding-system 'no-such-coding-system)) + (Check-Error-Message + error "Attempt to create a coding system alias loop" + (define-coding-system-alias 'mule-tests-alias 'mule-tests-alias)) + + ;; Test dangling alias deletion + (define-coding-system-alias 'mule-tests-alias nil) + (Assert (not (coding-system-alias-p 'mule-tests-alias))) + (Assert (not (coding-system-alias-p 'mule-tests-alias-unix))) + (Assert (not (coding-system-alias-p 'nested-mule-tests-alias))) + (Assert (not (coding-system-alias-p 'nested-mule-tests-alias-dos))) + + ;; Test strings waxing and waning across the 8k BIG_STRING limit (see alloc.c) + (defun charset-char-string (charset) + (let (lo hi string n) + (if (= (charset-chars charset) 94) + (setq lo 33 hi 126) + (setq lo 32 hi 127)) + (if (= (charset-dimension charset) 1) + (progn + (setq string (make-string (1+ (- hi lo)) ??)) + (setq n 0) + (loop for j from lo to hi do + (progn + (aset string n (make-char charset j)) + (incf n))) + string) + (progn + (setq string (make-string (* (1+ (- hi lo)) (1+ (- hi lo))) ??)) + (setq n 0) + (loop for j from lo to hi do + (loop for k from lo to hi do + (progn + (aset string n (make-char charset j k)) + (incf n)))) + string)))) + + ;; The following two used to crash xemacs! + (Assert (charset-char-string 'japanese-jisx0208)) + (aset (make-string 9003 ??) 1 (make-char 'latin-iso8859-1 77)) + + (let ((greek-string (charset-char-string 'greek-iso8859-7)) + (string (make-string (* 96 60) ??))) + (loop for j from 0 below (length string) do + (aset string j (aref greek-string (mod j 96)))) + (loop for k in '(0 1 58 59) do + (Assert (equal (substring string (* 96 k) (* 96 (1+ k))) greek-string)))) + + (let ((greek-string (charset-char-string 'greek-iso8859-7)) + (string (make-string (* 96 60) ??))) + (loop for j from (1- (length string)) downto 0 do + (aset string j (aref greek-string (mod j 96)))) + (loop for k in '(0 1 58 59) do + (Assert (equal (substring string (* 96 k) (* 96 (1+ k))) greek-string)))) + + (let ((ascii-string (charset-char-string 'ascii)) + (string (make-string (* 94 60) (make-char 'greek-iso8859-7 57)))) + (loop for j from 0 below (length string) do + (aset string j (aref ascii-string (mod j 94)))) + (loop for k in '(0 1 58 59) do + (Assert (equal (substring string (* 94 k) (+ 94 (* 94 k))) ascii-string)))) + + (let ((ascii-string (charset-char-string 'ascii)) + (string (make-string (* 94 60) (make-char 'greek-iso8859-7 57)))) + (loop for j from (1- (length string)) downto 0 do + (aset string j (aref ascii-string (mod j 94)))) + (loop for k in '(0 1 58 59) do + (Assert (equal (substring string (* 94 k) (* 94 (1+ k))) ascii-string)))) + + ) diff -r f4aeb21a5bad -r 74fd4e045ea6 tests/automated/symbol-tests.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/automated/symbol-tests.el Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,326 @@ +;; Copyright (C) 1999 Free Software Foundation, Inc. + +;; Author: Hrvoje Niksic +;; Maintainer: Hrvoje Niksic +;; Created: 1999 +;; Keywords: tests + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF. + +;;; Commentary: + +;; Test symbols operations. +;; See test-harness.el for instructions on how to run these tests. + +(eval-when-compile + (condition-case nil + (require 'test-harness) + (file-error + (push "." load-path) + (when (and (boundp 'load-file-name) (stringp load-file-name)) + (push (file-name-directory load-file-name) load-path)) + (require 'test-harness)))) + + +(defun ts-fresh-symbol-name (name) + "Return a variant of NAME (a string) that is not interned." + (when (intern-soft name) + (let ((count 1) + (orig name)) + (while (progn + (setq name (format "%s-%d" orig count)) + (intern-soft name)) + (incf count)))) + name) + +;;----------------------------------------------------- +;; Creating, reading, and printing symbols +;;----------------------------------------------------- + +(dolist (name '("foo" "bar" "" + "something with space in it" + "a string with \0 in the middle." + "100" "10.0" "#<>[]]]];'\\';" + "!@#$%^^&*(()__")) + (let ((interned (intern name)) + (uninterned (make-symbol name))) + (Assert (symbolp interned)) + (Assert (symbolp uninterned)) + (Assert (equal (symbol-name interned) name)) + (Assert (equal (symbol-name uninterned) name)) + (Assert (not (eq interned uninterned))) + (Assert (not (equal interned uninterned))))) + +(flet ((check-weak-list-unique (weak-list &optional reversep) + "Check that elements of WEAK-LIST are referenced only there." + (let ((len (length (weak-list-list weak-list)))) + (Assert (not (zerop len))) + (garbage-collect) + (Assert (eq (length (weak-list-list weak-list)) + (if (not reversep) 0 len)))))) + (let ((weak-list (make-weak-list)) + (gc-cons-threshold most-positive-fixnum)) + ;; Symbols created with `make-symbol' and `gensym' should be fresh + ;; and not referenced anywhere else. We check that no other + ;; references are available using a weak list. + (eval + ;; This statement must not be run byte-compiled, or the values + ;; remain referenced on the bytecode interpreter stack. + '(set-weak-list-list weak-list (list (make-symbol "foo") (gensym "foo")))) + (check-weak-list-unique weak-list) + + ;; Equivalent test for `intern' and `gentemp'. + (eval + '(set-weak-list-list weak-list + (list (intern (ts-fresh-symbol-name "foo")) + (gentemp (ts-fresh-symbol-name "bar"))))) + (check-weak-list-unique weak-list 'not))) + +(Assert (not (intern-soft (make-symbol "foo")))) +(Assert (not (intern-soft (gensym "foo")))) +(Assert (intern-soft (intern (ts-fresh-symbol-name "foo")))) +(Assert (intern-soft (gentemp (ts-fresh-symbol-name "bar")))) + +;; Reading a symbol should intern it automatically, unless the symbol +;; is marked specially. +(dolist (string (mapcar #'ts-fresh-symbol-name '("foo" "bar" "\\\0\\\1"))) + (setq symbol (read string) + string (read (concat "\"" string "\""))) + (Assert (intern-soft string)) + (Assert (intern-soft symbol)) + (Assert (eq (intern-soft string) (intern-soft symbol)))) + +(let ((fresh (read (concat "#:" (ts-fresh-symbol-name "foo"))))) + (Assert (not (intern-soft fresh)))) + +;; Check #N=OBJECT and #N# read syntax. +(let* ((list (read "(#1=#:foo #1# #2=#:bar #2# #1# #2#)")) + (foo (nth 0 list)) + (foo2 (nth 1 list)) + (bar (nth 2 list)) + (bar2 (nth 3 list)) + (foo3 (nth 4 list)) + (bar3 (nth 5 list))) + (Assert (symbolp foo)) + (Assert (not (intern-soft foo))) + (Assert (equal (symbol-name foo) "foo")) + (Assert (symbolp bar)) + (Assert (not (intern-soft bar))) + (Assert (equal (symbol-name bar) "bar")) + + (Assert (eq foo foo2)) + (Assert (eq foo2 foo3)) + (Assert (eq bar bar2)) + (Assert (eq bar2 bar3))) + +;; Check #N=OBJECT and #N# print syntax. +(let* ((foo (make-symbol "foo")) + (bar (make-symbol "bar")) + (list (list foo foo bar bar foo bar))) + (let* ((print-gensym nil) + (printed-list (prin1-to-string list))) + (Assert (equal printed-list "(foo foo bar bar foo bar)"))) + (let* ((print-gensym t) + (printed-list (prin1-to-string list))) + (Assert (equal printed-list "(#1=#:foo #1# #2=#:bar #2# #1# #2#)")))) + +;;----------------------------------------------------- +;; Read-only symbols +;;----------------------------------------------------- + +(Check-Error setting-constant + (set nil nil)) +(Check-Error setting-constant + (set t nil)) + +;;----------------------------------------------------- +;; Variable indirections +;;----------------------------------------------------- + +(let ((foo 0) + (bar 1)) + (defvaralias 'foo 'bar) + (Assert (eq foo bar)) + (Assert (eq foo 1)) + (Assert (eq (variable-alias 'foo) 'bar)) + (defvaralias 'bar 'foo) + (Check-Error cyclic-variable-indirection + (symbol-value 'foo)) + (Check-Error cyclic-variable-indirection + (symbol-value 'bar)) + (defvaralias 'foo nil) + (Assert (eq foo 0)) + (defvaralias 'bar nil) + (Assert (eq bar 1))) + +;;----------------------------------------------------- +;; Keywords +;;----------------------------------------------------- + +;;; Reading keywords + +;; In Elisp, a keyword is by definition a symbol beginning with `:' +;; that is interned in the global obarray. + +;; In Elisp, a keyword is interned as any other symbol. +(Assert (eq (read ":foo") (intern ":foo"))) + +;; A keyword is self-quoting and evaluates to itself. +(Assert (eq (eval (intern ":foo")) :foo)) + +;; Keywords are recognized as such only if interned in the global +;; obarray, and `keywordp' is aware of that. +(Assert (keywordp :foo)) +(Assert (not (keywordp (intern ":foo" [0])))) + +;; Keywords used to be initialized at read-time, which resulted in +;; (symbol-value (intern ":some-new-keyword")) signaling an error. +;; Now we handle keywords at the time when the symbol is interned, so +;; that (intern ":something) and (read ":something) will be +;; equivalent. These tests check various operations on symbols that +;; are guaranteed to be freshly interned. + +;; Interning a fresh keyword string should produce a regular +;; keyword. +(let* ((fresh-keyword-name (ts-fresh-symbol-name ":foo")) + (fresh-keyword (intern fresh-keyword-name))) + (Assert (eq (symbol-value fresh-keyword) fresh-keyword)) + (Assert (keywordp fresh-keyword))) + +;; Likewise, reading a fresh keyword string should produce a regular +;; keyword. +(let* ((fresh-keyword-name (ts-fresh-symbol-name ":foo")) + (fresh-keyword (read fresh-keyword-name))) + (Assert (eq (symbol-value fresh-keyword) fresh-keyword)) + (Assert (keywordp fresh-keyword))) + +;;; Assigning to keywords + +;; You shouldn't be able to set its value to something bogus. +(Check-Error setting-constant + (set :foo 5)) + +;; But, for backward compatibility, setting to the same value is OK. +(Assert + (eq (set :foo :foo) :foo)) + +;; Playing games with `intern' shouldn't fool us. +(Check-Error setting-constant + (set (intern ":foo" obarray) 5)) +(Assert + (eq (set (intern ":foo" obarray) :foo) :foo)) + +;; But symbols not interned in the global obarray are not real +;; keywords (in elisp): +(Assert (eq (set (intern ":foo" [0]) 5) 5)) + +;;; Printing keywords + +(let ((print-gensym t)) + (Assert (equal (prin1-to-string :foo) ":foo")) + (Assert (equal (prin1-to-string (intern ":foo")) ":foo")) + (Assert (equal (prin1-to-string (intern ":foo" [0])) "#::foo"))) + +(let ((print-gensym nil)) + (Assert (equal (prin1-to-string :foo) ":foo")) + (Assert (equal (prin1-to-string (intern ":foo")) ":foo")) + (Assert (equal (prin1-to-string (intern ":foo" [0])) ":foo"))) + +;; #### Add many more tests for printing and reading symbols, as well +;; as print-gensym and print-gensym-alist! + +;;----------------------------------------------------- +;; Magic symbols +;;----------------------------------------------------- + +;; Magic symbols are only half implemented. However, a subset of the +;; functionality is being used to implement backward compatibility or +;; clearer error messages for new features such as specifiers and +;; glyphs. These tests try to test that working subset. + +(let ((mysym (make-symbol "test-symbol")) + save) + (dontusethis-set-symbol-value-handler + mysym + 'set-value + (lambda (&rest args) + (throw 'test-tag args))) + (Assert (not (boundp mysym))) + (Assert (equal (catch 'test-tag + (set mysym 'foo)) + `(,mysym (foo) set nil nil))) + (Assert (not (boundp mysym))) + (dontusethis-set-symbol-value-handler + mysym + 'set-value + (lambda (&rest args) (setq save (nth 1 args)))) + (set mysym 'foo) + (Assert (equal save '(foo))) + (Assert (eq (symbol-value mysym) 'foo)) + ) + +(let ((mysym (make-symbol "test-symbol")) + save) + (dontusethis-set-symbol-value-handler + mysym + 'make-unbound + (lambda (&rest args) + (throw 'test-tag args))) + (Assert (equal (catch 'test-tag + (makunbound mysym)) + `(,mysym nil makunbound nil nil))) + (dontusethis-set-symbol-value-handler + mysym + 'make-unbound + (lambda (&rest args) (setq save (nth 2 args)))) + (Assert (not (boundp mysym))) + (set mysym 'bar) + (Assert (null save)) + (Assert (eq (symbol-value mysym) 'bar)) + (makunbound mysym) + (Assert (not (boundp mysym))) + (Assert (eq save 'makunbound)) + ) + +(when (featurep 'file-coding) + (Assert (eq pathname-coding-system file-name-coding-system)) + (let ((val1 file-name-coding-system) + (val2 pathname-coding-system)) + (Assert (eq val1 val2)) + (let ((file-name-coding-system 'no-conversion-dos)) + (Assert (eq file-name-coding-system 'no-conversion-dos)) + (Assert (eq pathname-coding-system file-name-coding-system))) + (let ((pathname-coding-system 'no-conversion-mac)) + (Assert (eq file-name-coding-system 'no-conversion-mac)) + (Assert (eq pathname-coding-system file-name-coding-system))) + (Assert (eq file-name-coding-system pathname-coding-system)) + (Assert (eq val1 file-name-coding-system))) + (Assert (eq pathname-coding-system file-name-coding-system))) + + +;(let ((mysym (make-symbol "test-symbol"))) +; (dontusethis-set-symbol-value-handler +; mysym +; 'make-local +; (lambda (&rest args) +; (throw 'test-tag args))) +; (Assert (equal (catch 'test-tag +; (set mysym 'foo)) +; `(,mysym (foo) make-local nil nil)))) diff -r f4aeb21a5bad -r 74fd4e045ea6 tests/automated/syntax-tests.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/automated/syntax-tests.el Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,102 @@ +;; Copyright (C) 1999 Free Software Foundation, Inc. + +;; Author: Yoshiki Hayashi +;; Maintainer: Yoshiki Hayashi +;; Created: 1999 +;; Keywords: tests + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF. + +;;; Commentary: + +;; Test syntax related functions. +;; Right now it tests scan_words using forward-word and backward-word. +;; See test-harness.el for instructions on how to run these tests. + +;;; Notation +;; W: word constituent character. +;; NW: non word constituent character. +;; -!-: current point. +;; EOB: end of buffer +;; BOB: beginning of buffer. + +;; Algorithm of scan_words is simple. It just searches SW and then +;; moves to NW. When with MULE, it also stops at word boundary. Word +;; boundary is tricky and listing all possible cases will be huge. +;; Those test are omitted here as it doesn't affect core +;; functionality. + +(defun test-forward-word (string stop) + (goto-char (point-max)) + (let ((point (point))) + (insert string) + (goto-char point) + (forward-word 1) + (Assert (eq (point) (+ point stop))))) + +(with-temp-buffer + ;; -!- W NW + (test-forward-word "W " 1) + (test-forward-word "WO " 2) + ;; -!- W EOB + (test-forward-word "W" 1) + (test-forward-word "WO" 2) + ;; -!- NW EOB + (test-forward-word " " 1) + (test-forward-word " !" 2) + ;; -!- NW W NW + (test-forward-word " W " 2) + (test-forward-word " WO " 3) + (test-forward-word " !W " 3) + (test-forward-word " !WO " 4) + ;; -!- NW W EOB + (test-forward-word " W" 2) + (test-forward-word " WO" 3) + (test-forward-word " !W" 3) + (test-forward-word " !WO" 4)) + +(defun test-backward-word (string stop) + (goto-char (point-min)) + (insert string) + (let ((point (point))) + (backward-word 1) + (Assert (eq (point) (- point stop))))) + +(with-temp-buffer + ;; NW W -!- + (test-backward-word " W" 1) + (test-backward-word " WO" 2) + ;; BOB W -!- + (test-backward-word "W" 1) + (test-backward-word "WO" 2) + ;; BOB NW -!- + ;; -!-NW EOB + (test-backward-word " " 1) + (test-backward-word " !" 2) + ;; NW W NW -!- + (test-backward-word " W " 2) + (test-backward-word " WO " 3) + (test-backward-word " W !" 3) + (test-backward-word " WO !" 4) + ;; BOB W NW -!- + (test-backward-word "W " 2) + (test-backward-word "WO " 3) + (test-backward-word "W !" 3) + (test-backward-word "WO !" 4)) diff -r f4aeb21a5bad -r 74fd4e045ea6 tests/automated/test-harness.el --- a/tests/automated/test-harness.el Mon Aug 13 11:12:06 2007 +0200 +++ b/tests/automated/test-harness.el Mon Aug 13 11:13:30 2007 +0200 @@ -22,7 +22,7 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;;; Synched up with: Not in FSF +;;; Synched up with: Not in FSF. ;;; Commentary: @@ -31,7 +31,7 @@ ;;; Basically you just create files of emacs-lisp, and use the ;;; Assert, Check-Error, and Check-Message functions to create tests. ;;; You run the tests using M-x test-emacs-test-file, -;;; or $(EMACS) -l .../test-harness.el -f batch-test-emacs file ... +;;; or $(EMACS) -batch -l .../test-harness.el -f batch-test-emacs file ... ;;; which is run for you by the `make check' target in the top-level Makefile. (require 'bytecomp) @@ -42,7 +42,7 @@ (defvar test-harness-current-file nil) -(defvar emacs-lisp-file-regexp (purecopy "\\.el$") +(defvar emacs-lisp-file-regexp (purecopy "\\.el\\'") "*Regexp which matches Emacs Lisp source files.") ;;;###autoload @@ -342,21 +342,17 @@ (if (not noninteractive) (error "`batch-test-emacs' is to be used only with -batch")) (let ((error nil)) - (loop for file in command-line-args-left - do - (if (file-directory-p (expand-file-name file)) - (let ((files (directory-files file)) - source) - (while files - (if (and (string-match emacs-lisp-file-regexp (car files)) - (not (auto-save-file-name-p (car files))) - (setq source (expand-file-name - (car files) - file)) - (if (null (batch-test-emacs-1 source)) - (setq error t))) - (setq files (cdr files))))) - (if (null (batch-test-emacs-1 file)) + (dolist (file command-line-args-left) + (if (file-directory-p file) + (dolist (file-in-dir (directory-files file t)) + (when (and (string-match emacs-lisp-file-regexp file-in-dir) + (not (or (auto-save-file-name-p file-in-dir) + (backup-file-name-p file-in-dir) + (equal (file-name-nondirectory file-in-dir) + "test-harness.el")))) + (or (batch-test-emacs-1 file-in-dir) + (setq error t)))) + (or (batch-test-emacs-1 file) (setq error t)))) ;;(message "%s" (buffer-string nil nil "*Test-Log*")) (message "Done") diff -r f4aeb21a5bad -r 74fd4e045ea6 tests/glyph-test.el --- a/tests/glyph-test.el Mon Aug 13 11:12:06 2007 +0200 +++ b/tests/glyph-test.el Mon Aug 13 11:13:30 2007 +0200 @@ -1,36 +1,84 @@ +(set-extent-begin-glyph + (make-extent (point) (point)) + (setq im (make-glyph [xpm :file "xemacs-icon.xpm"]))) + (set-extent-begin-glyph (make-extent (point) (point)) - (setq icon (make-glyph [xpm :file "../etc/xemacs-icon.xpm"]))) + (make-glyph [string :data "xemacs"])) (defun foo () - (interactive) + (interactive) (setq ok-select (not ok-select))) +(defun fee () (interactive) (message "hello")) + ;; button in a group (setq ok-select nil) (set-extent-begin-glyph (make-extent (point) (point)) - (make-glyph [button :descriptor ["ok " (setq ok-select t) - :style radio :selected ok-select]])) + (setq radio-button1 + (make-glyph + [button :descriptor ["ok " (setq ok-select t) + :style radio :selected ok-select]]))) ;; button in a group (set-extent-begin-glyph (make-extent (point) (point)) - (make-glyph [button :descriptor ["ok" (setq ok-select nil) :style radio - :selected (not ok-select)]])) + (setq radio-button2 + (make-glyph + [button :descriptor ["ok" (setq ok-select nil) :style radio + :selected (not ok-select)]]))) +;; toggle button +(set-extent-begin-glyph + (make-extent (point) (point)) + (setq tbutton + (make-glyph [button :descriptor ["ok" (setq ok-select nil) + :style toggle + :selected (not ok-select)]]))) +(set-extent-begin-glyph + (make-extent (point) (point)) + (setq toggle-button + (make-glyph [button :descriptor ["ok" :style toggle + :callback + (setq ok-select (not ok-select)) + :selected ok-select]]))) + ;; normal pushbutton (set-extent-begin-glyph (make-extent (point) (point)) - (setq pbutton (make-glyph - [button :width 10 :height 2 - :face modeline-mousable - :descriptor "ok" :callback foo - :selected t]))) + (setq push-button + (make-glyph [button :width 10 :height 2 + :face modeline-mousable + :descriptor "ok" :callback foo + :selected t]))) +;; tree view +(set-extent-begin-glyph + (make-extent (point) (point)) + (setq tree (make-glyph + [tree-view :width 10 + :descriptor "My Tree" + :properties (:items (["One" foo] + (["Two" foo] + ["Four" foo] + "Six") + "Three"))]))) + +;; tab control +(set-extent-begin-glyph + (make-extent (point) (point)) + (setq tab (make-glyph + [tab-control :descriptor "My Tab" + :face highlight + :orientation right + :properties (:items (["One" foo] + ["Two" fee] + ["Three" foo]))]))) + ;; progress gauge (set-extent-begin-glyph (make-extent (point) (point)) (setq pgauge (make-glyph - [progress :width 10 :height 2 - :descriptor "ok"]))) + [progress-gauge :width 10 :height 2 + :descriptor "ok"]))) ;; progress the progress ... (let ((x 0)) (while (<= x 100) @@ -42,8 +90,8 @@ (setq global-mode-string (cons (make-extent nil nil) (setq pg (make-glyph - [progress :width 5 :pixel-height 16 - :descriptor "ok"])))) + [progress-gauge :width 5 :pixel-height 16 + :descriptor "ok"])))) ;; progress the progress ... (let ((x 0)) (while (<= x 100) @@ -56,30 +104,36 @@ (make-glyph [button :face modeline-mousable :descriptor "ok" :callback foo - :image (make-glyph - [xpm :file "../etc/xemacs-icon.xpm"])])) + :image [xpm :file "../etc/xemacs-icon.xpm"]])) ;; normal pushbutton (set-extent-begin-glyph (make-extent (point) (point)) - (make-glyph [button :descriptor ["A Big Button" foo ]])) + (setq pbutton + (make-glyph [button :descriptor ["A Big Button" foo ]]))) + ;; edit box (set-extent-begin-glyph (make-extent (point) (point)) - (setq hedit (make-glyph [edit :pixel-width 50 :pixel-height 30 - :face bold-italic - :descriptor ["Hello"]]))) + (setq edit-field (make-glyph [edit-field :pixel-width 50 :pixel-height 30 + :face bold-italic + :descriptor ["Hello"]]))) ;; combo box (set-extent-begin-glyph (make-extent (point) (point)) - (setq hcombo (make-glyph - [combo :width 10 :height 3 :descriptor ["Hello"] - :properties (:items ("One" "Two" "Three"))]))) + (setq combo-box (make-glyph + [combo-box :width 10 :descriptor ["Hello"] + :properties (:items ("One" "Two" "Three"))]))) -;; line +;; label (set-extent-begin-glyph (make-extent (point) (point)) - (make-glyph [label :pixel-width 150 :descriptor "Hello"])) + (setq label (make-glyph [label :pixel-width 150 :descriptor "Hello"]))) + +;; string +(set-extent-begin-glyph + (make-extent (point) (point)) + (setq str (make-glyph [string :data "Hello There"]))) ;; scrollbar ;(set-extent-begin-glyph @@ -87,6 +141,41 @@ ; (make-glyph [scrollbar :width 50 :height 20 :descriptor ["Hello"]])) ;; generic subwindow -(setq sw (make-glyph [subwindow :pixel-width 50 :pixel-height 50])) +(setq sw (make-glyph [subwindow :pixel-width 50 :pixel-height 70])) (set-extent-begin-glyph (make-extent (point) (point)) sw) +;; layout +(setq layout + (make-glyph + [layout :pixel-width 200 :pixel-height 250 + :orientation vertical + :justify left + :border [string :data "Hello There Mrs"] + :items ([layout :orientation horizontal + :items (radio-button1 radio-button2)] + edit-field toggle-button label str)])) +(set-glyph-face layout 'gui-element) +(set-extent-begin-glyph + (make-extent (point) (point)) layout) + +(setq test-toggle-widget nil) + +(defun test-toggle (widget) + (set-extent-begin-glyph + (make-extent (point) (point)) + (make-glyph (vector 'button + :descriptor "ok" + :style 'toggle + :selected `(funcall test-toggle-value + ,widget) + :callback `(funcall test-toggle-action + ,widget))))) + +(defun test-toggle-action (widget &optional event) + (if widget + (message "Widget is t") + (message "Widget is nil"))) + +(defun test-toggle-value (widget) + (setq widget (not widget)) + (not widget)) diff -r f4aeb21a5bad -r 74fd4e045ea6 tests/gutter-test.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/gutter-test.el Mon Aug 13 11:13:30 2007 +0200 @@ -0,0 +1,17 @@ +(setq str "Hello There\nHello Again") +(set-extent-begin-glyph + (make-extent 0 0 str) + (make-glyph [xpm :file "../etc/xemacs-icon.xpm"])) + +(set-extent-begin-glyph + (make-extent 3 3 str) + (make-glyph + [button :width 5 :height 1 + :face modeline-mousable + :descriptor "ok" :selected t])) + +(set-specifier default-gutter-height 'autodetect) +(set-specifier default-gutter-width 40) +(set-specifier default-gutter-border-width 2) +(set-specifier default-gutter str) +(set-default-gutter-position 'bottom) diff -r f4aeb21a5bad -r 74fd4e045ea6 version.sh --- a/version.sh Mon Aug 13 11:12:06 2007 +0200 +++ b/version.sh Mon Aug 13 11:13:30 2007 +0200 @@ -1,8 +1,9 @@ #!/bin/sh +emacs_is_beta=t emacs_major_version=21 emacs_minor_version=2 -emacs_beta_version=13 -xemacs_codename="Demeter" +emacs_beta_version=29 +xemacs_codename="Hestia" infodock_major_version=4 infodock_minor_version=0 -infodock_build_version=1 +infodock_build_version=8